R Shiny Dashboard: not able to create a Box - r

I am trying to include a fileinput in Shiny Dashboard sidebar, and a box in dashboard body and despite of my several attempts, I am not able to see any box in my dashboard body as long as my fileinput is in Sidebar. Every help is important. Thanks Again.
Following is 1 Sample Code
#UI
library(shinydashboard)
dashboardPage(
dashboardHeader(title= "my dashboard"),
dashboardSidebar(width=250,
sidebarMenu(
menuItem("Data UpLoad", tabName = "dashboard", icon = icon("table"),
fileInput('file1','Choose CSV File',
accept=c('text/csv','text/comma-separated-values,text/plain', '.csv'))),
menuItem("Widgets", tabName = "widgets", icon = icon("th"))
)),
dashboardBody(
tabItems(
#first tab content
tabItem(tabName="dashboard",
fluidRow(
box(title="Data",solidHeader = TRUE, collapsible =
TRUE,tableOutput("table1"))
)
),
tabItem(tabName="widgets")))
)
#server
library(shiny)
library(shinydashboard)
library(dplyr)
server <- function(input, output) {
output$table1= renderTable({
inFile=input$file1
if(is.null(inFile))
return(NULL)
read.csv(inFile$datapath)
})
}

Related

Add an image in tabitem section in shiny app R

I am trying to insert an local image inside a tabitem in shiny app, but some challenges and load it on the page. Could someone help to solve this issue? My code attempt is:
CODE
if (interactive()) {
library(shiny)
library(shinydashboard)
ui <- dashboardPage(skin = "blue",
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
id = "tabs",
menuItem("Dogs", icon = icon("dog"), tabName = "Dogs"),
menuItem("Data", icon = icon("table"), tabName = "Data")
)),
dashboardBody(
mainPanel(
tabItems(
tabItem(tabName = "Dogs", class='active', role="figure",
tags$img(src="dogdogs.png")
)))),
tags$head(
tags$style(HTML(" .main-sidebar {background-color: blue;}"))
)
)
server <- function(input, output) { }
shinyApp(ui, server)
}
Thanks in advance

Embed weather iframe into Shiny Dashboard

I am trying to embed the weather forecast from forecast.io in a Shiny dashboard. I originally had trouble with the ampersand but saw a post that provided an example of how to format HTML code with special characters. However, when I run the app I see a simple "Not Found", even though I know that the link works and is being formatted correctly. I'm not sure what I'm missing.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dashboard"),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard"))
)
),
dashboardBody(
tabItems(
# First tab content
tabItem(tabName = "dashboard",
fluidRow(
column(12,
mainPanel(htmlOutput("frame")
)
)
)
)
)
)
)
server <- shinyServer(function(input, output) {
output$frame <- renderUI({
tags$iframe(id = 'app', src = url("https://forecast.io/embed/#lat=42.3583&lon=-71.0603&name=Downtown Boston"), width = '100%')
})
})
shinyApp(ui,server)
Screen capture of error in Shiny Dashboard
Update with inserted dashboard
I transfered url from server to ui:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dashboard"),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard",
tabName = "dashboard",
icon = icon("dashboard")
)
)
),
dashboardBody(
tabItems(
tabItem(
tabName = "dashboard",
fluidRow(
tags$iframe(
seamless = "seamless",
src = "https://forecast.io/embed/#lat=42.3583&lon=-71.0603&name=Downtown Boston",
height = 800, width = 1400
)
)
)
)
)
)
server <- function(input, output) {}
shinyApp(ui, server)

SideBar Not rendering anything on Dashboard Body: R Shiny Dashboard

I am creating a shiny Dashboard which has two tabs in the side bar. Tab1 is for importing a csv and Tab2 is for showing the plots for the selected variable.
Tab2 has 1 select input option for selecting the variable for plot
Problem: After clicking on sidebar tabs, my dashboard body doesn't change. It is always showing me Tab1 Content i.e csv import results.
So despite of clicking on Tab2 in sidebar, nothing happens
Following is my script
library(shinydashboard)
library(shiny)
library(DT)
#UI
sidebar=dashboardSidebar(width=200,
sidebarMenu( id="sidebar",
menuItem("Data UpLoad", tabName = "dashboard", icon = icon("table"),
fileInput('file1','Choose CSV File',
accept=c('text/csv','text/comma-separated-values,text/plain', '.csv'))),
menuItem("Uni Variate", tabName = "Uni", icon = icon("line-chart"),
fluidRow(
selectInput("options",label=h5("Select Column"),"")))))
body= dashboardBody(
tabItems(
tabItem(tabName="dashboard",class='active',
fluidRow(
box(
title="Data",solidHeader = TRUE, collapsible = TRUE,
div(style='overflow-x: scroll',tableOutput("table1"))))),
tabItem(tabName = "Uni",
fluidRow(box(title="Plot",solidHeader = TRUE,plotOutput("plot1"))),
h2("tab content"))))
dashboardPage(
dashboardHeader(title= "test"),sidebar,body)
#Server
server <- function(input, output,session) {
data_set <- reactive({
req(input$file1)
inFile <- input$file1
data_set1<-read.csv(inFile$datapath)
list(data=data_set1)
})
# updating select input of second tab in shiny side bar
observe({
updateSelectInput(
session,
"options",
choices = names(data_set()$data))})
# tab1
output$table1= renderTable({
de=as.data.frame(data_set()$data[1:7,])})
#tab2
output$plot1 <- renderPlot({ggplot(data_set$data,aes(y=input$options,x=Prediction))+geom_histogram(binwidth=0.50, fill="blue") })
}
Every help is important!
It seems that the problem is related to putting widgets on the sidebar, it takes them as sub-menus. Below are a couple of possible solution to have widgets on the sidebar depending if you want to hide them when are inactive.
Option 1- widgets always visible
library(shinydashboard)
library(shiny)
sidebar <- dashboardSidebar(width=200,
sidebarMenu( id="sidebar",
menuItem("Data UpLoad", icon = icon("table"), tabName = "dashboard"),
div(
fileInput('file1','Choose CSV File',
accept=c('text/csv','text/comma-separated-values,text/plain', '.csv'))
),
menuItem("Uni Variate", icon = icon("line-chart"), tabName = "Uni"),
div(
selectInput("options",label=h5("Select Column"),"")
)
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName="dashboard", class='active',
box( title="Data",solidHeader = TRUE, collapsible = TRUE,
div(style='overflow-x: scroll', p("table1"))
)
),
tabItem(tabName = "Uni",
box(title="Plot", solidHeader = TRUE, p("plot1"))
)
)
)
server <- function(input, output,session) {}
shinyApp(dashboardPage(dashboardHeader(title= "test"), sidebar, body), server = server)
Option 2- widgets only visible when tab is active
Please note that to show the correct tab on the body, the users must click on the sub-item.
library(shinydashboard)
library(shiny)
sidebar <- dashboardSidebar(width=200,
sidebarMenu( id="sidebar",
menuItem("data", icon = icon("table"), tabName = "dashboard",
menuSubItem(tabName = "dashboard",
fileInput('file1','Choose CSV File',
accept=c('text/csv','text/comma-separated-values,text/plain', '.csv'))
)),
menuItem("Uni Variate", icon = icon("line-chart"), tabName = "Uni",
menuSubItem( tabName = "Uni",
selectInput("options",label=h5("Select Column"),"")
))
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName="dashboard", class='active',
box( title="Data",solidHeader = TRUE, collapsible = TRUE,
div(style='overflow-x: scroll', p("table1"))
)
),
tabItem(tabName = "Uni",
box(title="Plot", solidHeader = TRUE, p("plot1"))
)
)
)
server <- function(input, output,session) {}
shinyApp(dashboardPage(dashboardHeader(title= "test"), sidebar, body), server = server)

Shinydashboard skin effect is not working after renderUI

I am trying to render shinydashboard after login page but shinydashboard skin color is not showing.
my code is as follow:
ui.r
library(shinydashboard)
library(shiny)
uiOutput("page")
Login.R
library(shinydashboard)
ui1Output <- function(id, label = "ui1") {
shinyUI(fluidPage(
mainPanel(
textInput("username","Username",placeholder ="UserName"),
passwordInput("password","Password", placeholder ="Password"),
actionButton("login", "Login")
)))
}
dashbaordpage.R
library(shinydashboard)
dashpageOutput <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", tabName = "widgets", icon = icon("th"))
)
),
dashboardBody(
tabItems(
# First tab content
tabItem(tabName = "dashboard",h2("Dashbaord")),
# Second tab content
tabItem(tabName = "widgets",
h2("Widgets tab content")
)
)
)
global.R
source('login.R') #login page
source('dashboardPage.R')#dashbaordpage
server.R
library(shiny)
library(shinydashboard)
shinyServer(function(input, output,session) {
output$page <- renderUI({
ui1Output('ui1Output')
})
observeEvent(input$login,
{
if(True)
{
output$page <- renderUI(dashpageOutput)
}
else
{
Logged<-F
showModal(modalDialog(
title = "Error",
"Enter Correct Username and password"
))
}
})
})
Details: when I going dashboard is showing but not with default skin color or any other skin color. I have tried skin='red' like wise option.
Image for reference how actually showing after login.
Please help me.
Thanks in advance.

Shiny ConditionalPanel for Sidebar

I am trying to use update my Shiny Dashboard Sidebar based on the tab selected in the Main body. So when tab "Overall" is selected then this should display the menu items in Conditional Panel 1 (TA.Name1,TA.Name2), and when tab "Other" is selected then the sidebar displays the menu items for conditional panel 2. Data is bellow:
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
conditionalPanel(condition="input.conditionedPanels==1", sidebarMenu(width=150,
menuItem("TA.Name1", tabName = "TA1")),
menuItem("TA.Name2", tabName = "TA2"))),
conditionalPanel(condition="input.conditionedPanels==2",sidebarMenu(width=150,
menuItem("EA.Name1", tabName = "EA1")),
menuItem("EA.Name2", tabName = "EA2"))),
dashboardBody(
tabsetPanel(
tabPanel("Overall",value=1,fluidRow(
column(3,selectInput("PACO", h5("PACO"), levels(OA$PACO)))),
tabItems(
tabItem(tabName = "TA1","TA1"),fluidRow(
box(title="TA.Name1,dygraphOutput("TA1.data")),
box(title="TA.Name2,dygraphOutput("TA2.data")))),
tabItem(tabName = "TA2","TA2")
)),
tabPanel("Other",value=2,fluidRow(
column(3,selectInput("CV", h5("CV"), levels(OA$CV)))),
tabItems(
tabItem(tabName = "EA1","EA1"),fluidRow(
box(title="EA.Name1,dygraphOutput("EA1.data")),
box(title="EA.Name2,dygraphOutput("EA2.data")))),
tabItem(tabName = "EA2","EA2")
))))
Your Example Code is not good, i think You should have a look at this feed:
http://stackoverflow.com/questions/5963269/how-to-make-a-great-r-reproducible-example
I had to simplify Your code to actually find solution...
Have a look at it:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(id="tabs",
sidebarMenuOutput("menu"))),
dashboardBody(
tabsetPanel(id="tabs2",
tabPanel("Overall",value=1),
tabPanel("Other",value=2))))
server <- function(input, output, session) {
output$menu <- renderMenu({
if (input$tabs2 == 1 ) {
sidebarMenu(
menuItem("TA.Name1", tabName = "TA1"),
menuItem("TA.Name2", tabName = "TA2"))}
else{
sidebarMenu(
menuItem("EA.Name1", tabName = "EA1"),
menuItem("EA.Name2", tabName = "EA2"))
}
})
}
shinyApp(ui = ui, server = server)
It should do what You want -- > reactive sidebarMenu

Resources