I am trying to implement a fileInput using library(shinydashboard) to provide the user with the option to upload files (as it was done here with a basic shiny UI - please find the example code below).
I would like to place the fileInput in the dashboardSidebar in an expandable menuItem, but don't know where it should go into the shinydashboard structure.
library(shiny)
ui <- fluidPage(
titlePanel("Uploading Files"),
sidebarLayout(
sidebarPanel(
fileInput("file1", "Choose CSV File",
multiple = TRUE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
tags$hr(),
checkboxInput("header", "Header", TRUE),
radioButtons("sep", "Separator",
choices = c(Comma = ",",
Semicolon = ";",
Tab = "\t"),
selected = ","),
radioButtons("quote", "Quote",
choices = c(None = "",
"Double Quote" = '"',
"Single Quote" = "'"),
selected = '"'),
tags$hr(),
radioButtons("disp", "Display",
choices = c(Head = "head",
All = "all"),
selected = "head")
),
mainPanel(
tableOutput("contents")
)
)
)
server <- function(input, output) {
output$contents <- renderTable({
req(input$file1)
df <- read.csv(input$file1$datapath,
header = input$header,
sep = input$sep,
quote = input$quote)
if(input$disp == "head") {
return(head(df))
}
else {
return(df)
}
})
}
shinyApp(ui, server)
Edit: I cleaned up the code a little to make the difference between childfull and childless menuItem's more clear - the parameters expandedName and startExpanded can only be used with a childfull menuItem in contrast tabName and selected is only used with childless menuItem's.
library(shiny)
library(shinydashboard)
ui <- function(req) {
dashboardPage(
dashboardHeader(title = "Simple tabs"),
dashboardSidebar(sidebarMenu(
id = "sidebarItemSelected",
menuItem(
"Childfull menuItem",
menuItem(
"Childless menuItem 1",
tabName = "childlessTab1",
icon = icon("dashboard"),
selected = TRUE
),
fileInput("upload", "Upload"),
bookmarkButton(),
expandedName = "childfullMenuItem",
startExpanded = TRUE
),
menuItem(
"Childless menuItem 2",
icon = icon("th"),
tabName = "childlessTab2",
badgeLabel = "new",
badgeColor = "green"
)
)),
dashboardBody(tabItems(
tabItem(tabName = "childlessTab1",
h2("Dashboard tab content")),
tabItem(tabName = "childlessTab2",
h2("Widgets tab content"))
))
)
}
server <- function(input, output, session) {
observe({
cat(
paste(
"\nsidebarItemSelected:",
input$sidebarItemSelected,
"\nsidebarItemExpanded:",
input$sidebarItemExpanded,
"\nsidebarCollapsed:",
input$sidebarCollapsed,
"\n"
)
)
})
}
shinyApp(ui, server, enableBookmarking = "url")
Initial answer:
Sure - this is possible (modified version of this example):
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Simple tabs"),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", fileInput("upload", "Upload"), tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", icon = icon("th"), tabName = "widgets",
badgeLabel = "new", badgeColor = "green")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "dashboard",
h2("Dashboard tab content")
),
tabItem(tabName = "widgets",
h2("Widgets tab content")
)
)
)
)
server <- function(input, output, session) {}
shinyApp(ui, server)
Related
Suppose you have a simple shinydashboard which contains links created with menuItem and pages created with tabItems:
library(shiny)
library(shinydashboard)
skin <- Sys.getenv("DASHBOARD_SKIN")
skin <- tolower(skin)
skin <- "blue"
## ui.R ##
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", icon = icon("th"), tabName = "widgets",
badgeLabel = "new", badgeColor = "green")
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "dashboard",
h2("Dashboard tab content")
),
tabItem(tabName = "widgets",
h2("Widgets tab content")
)
)
)
# Put them together into a dashboardPage
ui<-dashboardPage(
dashboardHeader(title = "Simple tabs"),
sidebar,
body
)
server <- function(input, output) {
}
shinyApp(ui, server)
Is it possible to create permalinks for the pages? e.g. the home page (tabName == "dashboard") has a URL of 127.0.0.1:1234/home and the widgets page is at 127.0.0.1:1234/widgets?
It seems that shiny doesn't have URL routing out of the box. shiny.router seems to be a possible alternative but I've found no easy ways to do this with shinydashboard i.e. with the use of menuItem and tabItem. I'm trying to avoid rewriting the app's UI to use something which is more tightly integrated with shiny.router (e.g. shiny.semantic)
Is it possible to keep the above shinydashboard code while implementing permalinks to the various different pages?
Here is how to use the below approach with shiny's tabPanel() function.
Workarounds not using library(shiny.router):
Edit - Alternative using clientData$url_search and mode = "push" for updateQueryString to push a new history entry onto the browser's history stack:
library(shiny)
library(shinydashboard)
ui <- function(request) {
dashboardPage(
header = dashboardHeader(title = "Simple tabs"),
sidebar = dashboardSidebar(
sidebarMenu(
id = "sidebarID",
menuItem(
"Dashboard",
tabName = "dashboard",
icon = icon("tachometer-alt")
),
menuItem(
"Widgets",
icon = icon("th"),
tabName = "widgets",
badgeLabel = "new",
badgeColor = "green"
)
)
),
body = dashboardBody(tabItems(
tabItem(tabName = "dashboard",
h2("Dashboard tab content")),
tabItem(tabName = "widgets",
h2("Widgets tab content"))
))
)
}
server <- function(input, output, session) {
# http://127.0.0.1:6172/?tab=dashboard
# http://127.0.0.1:6172/?tab=widgets
observeEvent(getQueryString(session)$tab, {
currentQueryString <- getQueryString(session)$tab # alternative: parseQueryString(session$clientData$url_search)$tab
if(is.null(input$sidebarID) || !is.null(currentQueryString) && currentQueryString != input$sidebarID){
freezeReactiveValue(input, "sidebarID")
updateTabItems(session, "sidebarID", selected = currentQueryString)
}
}, priority = 1)
observeEvent(input$sidebarID, {
currentQueryString <- getQueryString(session)$tab # alternative: parseQueryString(session$clientData$url_search)$tab
pushQueryString <- paste0("?tab=", input$sidebarID)
if(is.null(currentQueryString) || currentQueryString != input$sidebarID){
freezeReactiveValue(input, "sidebarID")
updateQueryString(pushQueryString, mode = "push", session)
}
}, priority = 0)
}
shinyApp(ui, server, enableBookmarking = "disable")
Another Edit - using url_hash (uri fragments):
library(shiny)
library(shinydashboard)
ui <- function(request) {
dashboardPage(
header = dashboardHeader(title = "Simple tabs"),
sidebar = dashboardSidebar(
sidebarMenu(
id = "sidebarID",
menuItem(
"Dashboard",
tabName = "dashboard",
icon = icon("tachometer-alt")
),
menuItem(
"Widgets",
icon = icon("th"),
tabName = "widgets",
badgeLabel = "new",
badgeColor = "green"
)
)
),
body = dashboardBody(tabItems(
tabItem(tabName = "dashboard",
h2("Dashboard tab content")),
tabItem(tabName = "widgets",
h2("Widgets tab content"))
))
)
}
server <- function(input, output, session) {
observeEvent(input$sidebarID, {
# http://127.0.0.1:6172/#dashboard
# http://127.0.0.1:6172/#widgets
newURL <- paste0(
session$clientData$url_protocol,
"//",
session$clientData$url_hostname,
":",
session$clientData$url_port,
session$clientData$url_pathname,
"#",
input$sidebarID
)
updateQueryString(newURL, mode = "replace", session)
})
observe({
currentTab <- sub("#", "", session$clientData$url_hash)
if(!is.null(currentTab)){
updateTabItems(session, "sidebarID", selected = currentTab)
}
})
}
shinyApp(ui, server, enableBookmarking = "disable")
Edit - using url_search: Actually we can do the same without bookmarking using getQueryString and updateTabItems:
library(shiny)
library(shinydashboard)
ui <- function(request) {
dashboardPage(
header = dashboardHeader(title = "Simple tabs"),
sidebar = dashboardSidebar(
sidebarMenu(
id = "sidebarID",
menuItem(
"Dashboard",
tabName = "dashboard",
icon = icon("tachometer-alt")
),
menuItem(
"Widgets",
icon = icon("th"),
tabName = "widgets",
badgeLabel = "new",
badgeColor = "green"
)
)
),
body = dashboardBody(tabItems(
tabItem(tabName = "dashboard",
h2("Dashboard tab content")),
tabItem(tabName = "widgets",
h2("Widgets tab content"))
))
)
}
server <- function(input, output, session) {
observeEvent(input$sidebarID, {
# http://127.0.0.1:6172/?tab=dashboard
# http://127.0.0.1:6172/?tab=widgets
newURL <- paste0(
session$clientData$url_protocol,
"//",
session$clientData$url_hostname,
":",
session$clientData$url_port,
session$clientData$url_pathname,
"?tab=",
input$sidebarID
)
updateQueryString(newURL, mode = "replace", session)
})
observe({
currentTab <- getQueryString(session)$tab # alternative: parseQueryString(session$clientData$url_search)$tab
if(!is.null(currentTab)){
updateTabItems(session, "sidebarID", selected = currentTab)
}
})
}
shinyApp(ui, server, enableBookmarking = "disable")
Using bookmarks:
Not sure if you are interested in a workaround like this, but you could use shiny's bookmarking and updateQueryString to achive a similar behaviour:
library(shiny)
library(shinydashboard)
ui <- function(request) {
dashboardPage(
header = dashboardHeader(title = "Simple tabs"),
sidebar = dashboardSidebar(
sidebarMenu(
id = "sidebarID",
menuItem(
"Dashboard",
tabName = "dashboard",
icon = icon("tachometer-alt")
),
menuItem(
"Widgets",
icon = icon("th"),
tabName = "widgets",
badgeLabel = "new",
badgeColor = "green"
)
)
),
body = dashboardBody(tabItems(
tabItem(tabName = "dashboard",
h2("Dashboard tab content")),
tabItem(tabName = "widgets",
h2("Widgets tab content"))
))
)
}
server <- function(input, output, session) {
bookmarkingWhitelist <- c("sidebarID")
observe({
setBookmarkExclude(setdiff(names(input), bookmarkingWhitelist))
})
observeEvent(input$sidebarID, {
# http://127.0.0.1:6172/?_inputs_&sidebarID=%22dashboard%22
# http://127.0.0.1:6172/?_inputs_&sidebarID=%22widgets%22
newURL <- paste0(
session$clientData$url_protocol,
"//",
session$clientData$url_hostname,
":",
session$clientData$url_port,
session$clientData$url_pathname,
"?_inputs_&sidebarID=%22",
input$sidebarID,
"%22"
)
updateQueryString(newURL,
mode = "replace",
session)
})
}
shinyApp(ui, server, enableBookmarking = "url")
Some related links:
https://rstudio.github.io/shinydashboard/behavior.html#bookmarking
https://shiny.rstudio.com/reference/shiny/1.7.0/session.html
It is possible to restore a session, locally, in a Shiny app if the inputs have been previously written in a RDS file?
shinyjs - setBookmarkExclude for delay IDs
https://github.com/rstudio/shiny/issues/3546
I am trying to have an action button within the Body of a tab (called "Widgets" in code) link to a different tab (called "data_table" in code). I know how to do this if the tab that I want to connect to, "data_table", is one of the menuItems that appears on the sidebarMenu. However, I do not wish for a link to the "data_table" tab to appear in the sidebar. I am stuck. I would have thought I need an "observeEvent"-type command which links the action button to the "data_table" tab. But I don't know what that is. Advice welcome. The code shows the UI side of things.
ui <- dashboardPage(
dashboardHeader(title = "My query"),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", tabName = "widgets", icon = icon("th"))
)
),
dashboardBody(
tabItems(
tabItem(tabName = "dashboard",
h2("Dashboard tab content")),
tabItem(tabName = "widgets",
h2("Widgets"),
actionButton(inputId="seedata", label = "See data")),
tabItem(tabName = "data_table",
h2("Table with the data"))
)
)
)
server <- function(input, output, session) { }
shinyApp(ui, server)
Perhaps you are looking for something like this.
ui <- dashboardPage(
dashboardHeader(title = "My query"),
dashboardSidebar(
sidebarMenu(# Setting id makes input$tabs give the tabName of currently-selected tab
id = "tabs",
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", tabName = "widgets", icon = icon("th"))
)
),
dashboardBody(
tabItems(
tabItem(tabName = "dashboard",
h2("Dashboard tab content")),
tabItem(tabName = "widgets", h2("Widgets"),
fluidRow(
tabBox(id = "tabset1", height = "850px", width=12, title = "My Data",
### The id lets us use input$tabset1 on the server to find the current tab
tabPanel("Table with the data", value="tab1", " ",
actionButton(inputId="seedata", label = "See data"),
uiOutput("dataTable")
),
tabPanel("Display Data Table", value="tab2", " ",
#uiOutput("someoutput")
DT::dataTableOutput("testtable")
)
)
)
))
)
)
server <- function(input, output, session) {
output$dataTable <- renderUI({
tagList(
div(style="display: block; height: 350px; width: 5px;",HTML("<br>")),
actionBttn(inputId="datatable",
label="Data Table",
style = "simple",
color = "success",
size = "md",
block = FALSE,
no_outline = TRUE
))
})
observeEvent(input$datatable, {
updateTabItems(session, "tabs", "widgets")
if (input$datatable == 0){
return()
}else{
## perform other tasks if necessary
output$testtable <- DT::renderDataTable(
mtcars,
class = "display nowrap compact", # style
filter = "top", # location of column filters
options = list( # options
scrollX = TRUE # allow user to scroll wide tables horizontally
)
)
}
})
observeEvent(input$datatable, {
updateTabsetPanel(session, "tabset1",
selected = "tab2")
})
}
shinyApp(ui, server)
I found that menuSubItem content is not rendering in case of several (more than one) tabItems.
Minimal example demonstrating this behavior is below.
The desired behavior is to show content of the tabItem marked as selected = TRUE on startup. Now, the content shows up only after switching between menuSubItems in the sidebar.
How can I make it work?
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "MINIMAL EXAMPLE"),
dashboardSidebar(
sidebarMenuOutput("menu")
),
dashboardBody(
uiOutput("body")
)
)
server <- function(input, output, session) {
output$menu <- renderMenu(
sidebarMenu(
menuItem(text = "TABS", tabName = "TABS", startExpanded = T,
menuSubItem(text = "tab1", tabName="tab1",
icon = icon("cube"), selected = TRUE),
menuSubItem(text = "tab2", tabName="tab2",
icon = icon("cube"), selected = FALSE)
)
)
)
output$body <- renderUI({
tabItems(
tabItem(tabName = "tab1",
h4("MY TEXT 1")
),
tabItem(tabName = "tab2",
h4("MY TEXT 2")
))
})
}
shinyApp(ui = ui, server = server)
Indeed, putting ui elements directly in UI solves it.
But the approach of putting everything inside ui is limited to situations that do not involve using reactive values. As I understand passing reactive value from server to ui is not possible in general (or limited to special cases). Please correct if I am wrong... Thanks
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "MINIMAL EXAMPLE"),
dashboardSidebar(
sidebarMenuOutput("menu")
),
dashboardBody(
tabItems(
tabItem(tabName = "tab1",
h4("MY TEXT 1")
),
tabItem(tabName = "tab2",
h4("MY TEXT 2")
))
)
)
server <- function(input, output, session) {
output$menu <- renderMenu(
sidebarMenu(
menuItem(text = "TABS", tabName = "TABS", startExpanded = T,
menuSubItem(text = "tab1", tabName="tab1",
icon = icon("cube"), selected = TRUE),
menuSubItem(text = "tab2", tabName="tab2",
icon = icon("cube"), selected = FALSE)
)
)
)
}
shinyApp(ui = ui, server = server)
Renaming your output to something other than "body" helps - please see this.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "MINIMAL EXAMPLE"),
dashboardSidebar(
sidebarMenuOutput("menu")
),
dashboardBody(
uiOutput("myBodyOutput")
)
)
server <- function(input, output, session) {
output$myBodyOutput <- renderUI({
tabItems(
tabItem(tabName = "tab1",
h4("MY TEXT 1")
),
tabItem(tabName = "tab2",
h4("MY TEXT 2")
))
})
output$menu <- renderMenu(
sidebarMenu(id = "sidebarID",
menuItem(text = "TABS", tabName = "TABS", startExpanded = T,
menuSubItem(text = "tab1", tabName="tab1",
icon = icon("cube"), selected = TRUE),
menuSubItem(text = "tab2", tabName="tab2",
icon = icon("cube"), selected = FALSE)
)
)
)
}
shinyApp(ui = ui, server = server)
I am trying to develop an application, that could help the users upload a file and display the summary statistics.
I am using the below UI and Server code to achieve this, once I have completed my file upload, i am unable to see the data frame and its summary statistics.
I am missing something with my code, but unable to guess.
ui<-dashboardPage(
dashboardHeader(title = "Claim Model"),
dashboardSidebar(
sidebarMenu(id="tabs",
menuItem("Data", tabName = "data", icon = icon("table"),startExpanded = TRUE,
menuSubItem("Load", tabName = "data1")
),
menuItem("Visualisation",icon=icon("bar-chart-o"), tabName = "vis"),
menuItem("Result", icon=icon("cog"), tabName = "result")
)
),
dashboardBody(
tags$style(type="text/css",
".shiny-output-error { visibility: hidden; }",
".shiny-output-error:before { visibility: hidden; }"
),
tabItems(
tabItem(tabName = "data1",
fluidPage(
fluidRow(
fileInput("file1","Choose CSV File",
accept = c("text/csv",
"text/comma-seperated-values, text/plain",
".csv")
),
tags$hr(),
checkboxInput("header", "Header", TRUE),
radioButtons("sep","Separator",
choices=c(Comma=",",
semicolon=";",
Tab="\t"),
selected = ";")
),
mainPanel(
tableOutput("contents")
)
)
)
)
)
)
Server Code.
server <- shinyServer(function(input,output){
output$contents <- renderTable({
req(input$file1)
df <- read.csv(input$file1$datapath,
header=input$header,
sep=input$sep)
})
})
Currently i dont have the code for displaying the statistics from data frame. any lead on how to start would be helpful
Here is an example: Inside dashboardBody(), you need a second (and third) tabItem() to "fill" the menuItem(tabName = "vis") and menuItem(tabName = "result"). And in the server, you need code to generate plots or tables or whatever you want to display. Furthermore, note how I assigned the output of read.csv() to a function (called DATA() here) so that it can be used at different places inside the server.
UI:
ui <- dashboardPage(
dashboardHeader(title = "Claim Model"),
dashboardSidebar(
sidebarMenu(id="tabs",
menuItem("Data", tabName = "data", icon = icon("table"),startExpanded = TRUE,
menuSubItem("Load", tabName = "data1")
),
menuItem("Visualisation",icon=icon("bar-chart-o"), tabName = "vis"),
menuItem("Result", icon=icon("cog"), tabName = "result")
)
),
dashboardBody(
tags$style(type="text/css",
".shiny-output-error { visibility: hidden; }",
".shiny-output-error:before { visibility: hidden; }"
),
tabItems(
tabItem(tabName = "data1",
fluidPage(
fluidRow(
fileInput("file1","Choose CSV File",
accept = c("text/csv",
"text/comma-seperated-values, text/plain",
".csv")
),
tags$hr(),
checkboxInput("header", "Header", TRUE),
radioButtons("sep","Separator",
choices=c(Comma=",",
semicolon=";",
Tab="\t"),
selected = ";")
),
mainPanel(
tableOutput("contents")
)
)
),
tabItem(tabName = "vis", h2("Two Plots"),
fluidRow(
box(
title = "Plot 1", solidHeader = TRUE, collapsible = TRUE,
plotOutput("hist1")
),
box(
title = "Plot 2", solidHeader = TRUE, collapsible = TRUE,
plotOutput("hist2")
)
)
)
)
)
)
server:
server <- function(input, output) {
DATA <- reactive({
req(input$file1)
df <- read.csv(input$file1$datapath,
header = input$header,
sep = input$sep)
return(df)
})
output$contents <- renderTable(DATA())
output$hist1 <- renderPlot({
tmp1 <- sample(which(apply(DATA(), 2, is.numeric)), 1)
hist(DATA()[, tmp1], breaks = 10, xlab = names(DATA())[tmp1], main = "")
})
output$hist2 <- renderPlot({
tmp1 <- sample(which(apply(DATA(), 2, is.numeric)), 1)
hist(DATA()[, tmp1], breaks = 20, xlab = names(DATA())[tmp1], main = "")
})
}
run:
library(shiny)
library(shinydashboard)
shinyApp(ui, server)
I am trying to build a shiny application using sidebarMenu with menuItems. Currently the menu items are duplicated,
enter image description here
Clicking the first and second menu items are not showing the table or the plot. Only the last two shows the output. How can I modify it to have only two items - 1) Plots Menu, 2) Table Menu (with sub items) and clicking on it show the respective output. Used the mtcars dataset and the code ispasted below
data(mtcars)
ibrary(shiny)
library(shinydashboard)
library(dplyr)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic sidebar"),
dashboardSidebar(
sidebarMenu(
menuItem("Plots Menu", tabName = "plot_page", icon = icon("line-chart")),
menuItem("Table Menu", tabName="intro_page", icon = icon("info"),
selectInput(inputId = "mcm", label = "Some label",
multiple = TRUE, choices = unique(mtcars$cyl), selected = unique(mtcars$cyl)))
),
sidebarMenuOutput("menu")
),
dashboardBody(tabItems(
tabItem(tabName = "plots", h2("Dashboard plots"),
fluidRow(column(width = 12, class = "well",
h4("Boxplot"),
plotOutput("bxp")))
),
tabItem(tabName = "dashboard", h2("Dashboard tab content"),
dataTableOutput(outputId = "subdt"))
)
)
)
server <- function(input, output, session) {
output$menu <- renderMenu({
sidebarMenu(
menuItem("Plots Menu", tabName = "plots", icon = icon("line-chart")),
menuItem("Table Menu", tabName="dashboard", icon = icon("calendar"))
)
})
datsub <- reactive({
mtcars %>%
filter_at(vars("cyl"), all_vars(. %in% input$mcm))
})
output$subdt <- renderDataTable({
datsub()
})
output$bxp <- renderPlot({
hist(rnorm(100))
})
}
shinyApp(ui, server)
I put the code together.
-Ian
data(mtcars)
library(shiny)
library(shinydashboard)
library(dplyr)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic sidebar"),
dashboardSidebar(sidebarMenu(id = "menu", sidebarMenuOutput("menu"))),
dashboardBody(tabItems
(
tabItem
(tabName = "plots", h2("Dashboard plots"),
fluidRow(column(width = 12, class = "well",
h4("Boxplot"),
plotOutput("bxp")))
),
tabItem(tabName = "dashboard", h2("Dashboard tab content"),
dataTableOutput(outputId = "subdt"))
)
)
)
server <- function(input, output, session) {
output$menu <- renderMenu({
sidebarMenu(
menuItem("Plots Menu", tabName = "plots", icon = icon("line-chart")),
menuItem("Table Menu", icon = icon("info"),
menuSubItem(
"Dashboard", tabName = "dashboard", icon = icon("calendar")
),
selectInput(
inputId = "mcm", label = "Some label", multiple = TRUE,
choices = unique(mtcars$cyl), selected = unique(mtcars$cyl)
)
)
)
})
datsub <- reactive({
mtcars %>%
filter_at(vars("cyl"), all_vars(. %in% input$mcm))
})
output$subdt <- renderDataTable({
datsub()
})
output$bxp <- renderPlot({
hist(rnorm(100))
})
}
shinyApp(ui, server)
You have both the standard and reactive sidebar options running in tandem. If you need a reactive sidebar, just put the contents in the server function and call all of it with sidebarMenuOutput in ui.
ui.R
dashboardSidebar(sidebarMenu(id = "menu", sidebarMenuOutput("menu")))
server.R
output$menu <- renderMenu({
sidebarMenu(
menuItem("Plots Menu", tabName = "plots", icon = icon("line-chart")),
menuItem("Table Menu", icon = icon("info"),
menuSubItem(
"Dashboard", tabName = "dashboard", icon = icon("calendar")
),
selectInput(
inputId = "mcm", label = "Some label", multiple = TRUE,
choices = unique(mtcars$cyl), selected = unique(mtcars$cyl)
)
)
)
})