I have 3 selectInput boxes and a pool of 4 options which can be selected by these 3 boxes. I want the options displayed by the selectInputs to change dynamically as other selectInputs are selected. However I want the "NONE" option to be available at all points of time for all the three boxes. The code I am using is
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic selectInput"),
dashboardSidebar(
sidebarMenu(
menuItemOutput("menuitem")
)
),
dashboardBody(
uiOutput('heirarchy1'),
uiOutput('heirarchy2'),
uiOutput('heirarchy3')
)
)
server <- function(input, output) {
output$menuitem <- renderMenu({
menuItem("Menu item", icon = icon("calendar"))
})
heirarchy_vector<-c("NONE","A","B","C")
output$heirarchy1<-renderUI({
selectInput("heir1","Heirarchy1",c("NONE",setdiff(heirarchy_vector,c(input$heir2,input$heir3))),selected="NONE")
})
output$heirarchy2<-renderUI({
selectInput("heir2","Heirarchy2",c("NONE",setdiff(heirarchy_vector,c(input$heir1,input$heir3))),selected="NONE")
})
output$heirarchy3<-renderUI({
selectInput("heir3","Heirarchy3",c("NONE",setdiff(heirarchy_vector,c(input$heir1,input$heir2))),selected="NONE")
})
}
shinyApp(ui, server)
Any help on this will be greatly appreciated
EDIT
I tried using updateSelectInput for this purpose. However the code doesn't seem to run
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic selectInput"),
dashboardSidebar(
sidebarMenu(
menuItemOutput("menuitem")
)
),
dashboardBody(
selectInput("heir1","Heirarchy1",c("NONE","A","B","C"),selected="NONE"),
selectInput("heir2","Heirarchy2",c("NONE","A","B","C"),selected="NONE"),
selectInput("heir3","Heirarchy3",c("NONE","A","B","C"),selected="NONE")
)
)
server <- function(input, output) {
output$menuitem <- renderMenu({
menuItem("Menu item", icon = icon("calendar"))
})
heirarchy<-c("A","B","C")
observe({
hei1<-input$heir1
hei2<-input$heir2
hei3<-input$heir3
choice1<-c("NONE",setdiff(heirarchy,c(hei2,hei3)))
choice2<-c("NONE",setdiff(heirarchy,c(hei1,hei3)))
choice3<-c("NONE",setdiff(heirarchy,c(hei1,hei2)))
updateSelectInput(session,"heir1",choices=choice1)
updateSelectInput(session,"heir2",choices=choice2)
updateSelectInput(session,"heir3",choices=choice3)
})
}
shinyApp(ui, server)
You're close! Two things, you need to assign the session variable when you start your server instance, also when you update the select inputs you need to set which choice was selected, other than that everything looks OK. Try this:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic selectInput"),
dashboardSidebar(
sidebarMenu(
menuItemOutput("menuitem")
)
),
dashboardBody(
selectInput("heir1","Heirarchy1",c("NONE","A","B","C"),selected="NONE"),
selectInput("heir2","Heirarchy2",c("NONE","A","B","C"),selected="NONE"),
selectInput("heir3","Heirarchy3",c("NONE","A","B","C"),selected="NONE")
)
)
server <- function(input, output, session) {
output$menuitem <- renderMenu({
menuItem("Menu item", icon = icon("calendar"))
})
heirarchy<-c("A","B","C")
observe({
hei1<-input$heir1
hei2<-input$heir2
hei3<-input$heir3
choice1<-c("NONE",setdiff(heirarchy,c(hei2,hei3)))
choice2<-c("NONE",setdiff(heirarchy,c(hei1,hei3)))
choice3<-c("NONE",setdiff(heirarchy,c(hei1,hei2)))
updateSelectInput(session,"heir1",choices=choice1,selected=hei1)
updateSelectInput(session,"heir2",choices=choice2,selected=hei2)
updateSelectInput(session,"heir3",choices=choice3,selected=hei3)
})
}
shinyApp(ui, server)
Related
I cannot use updateTabItems() on a menuSubItem created by renderMenu() when I click on actionButton().
To illustrate my problem, here is an example code and a video (end of the post):
library(shiny)
library(DT)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
id = "tabs",
menuItem("First item", "first_item",
actionButton("action_button", "Action"),
menuSubItem("First sub item", "first_sub_item")
),
menuItem("Second item", "second_item",
menuItemOutput("second_sub_item")
)
)
),
dashboardBody(
tabItems(
tabItem("first_sub_item",
DT::dataTableOutput("df")
),
tabItem("second_sub_item",
verbatimTextOutput('row_selected')
)
)
)
)
server <- function(input, output, session){
observeEvent(input$action_button, {
output$df <- DT::renderDataTable(
as.data.frame(replicate(10,sample(0:1,1000,rep=TRUE)))
)
})
observeEvent(input$df_rows_selected, {
output$second_sub_item <- renderMenu({
menuSubItem("Second sub item", tabName = "second_sub_item")
})
updateTabItems(session, "tabs", "second_sub_item")
output$row_selected = renderPrint({
input$df_rows_selected
})
})
}
shinyApp(ui, server)
After clicking on a row of the df localised in the "first_sub_item", the ShinyApp should switch to the "second_sub_item", but it's doesn't work directly.
I have to click once by myself on the "second_sub_item" tab for the updateTabItems() function to work.
When "second_sub_item" is created in the UI, everything works, so the problem seems to come from renderMenu() but I can't solve it...
Thank you in advance for your help!
https://youtu.be/ZZmtN31chiA
I changed menuItemOutput to menuSubItem in your UI. Since it now already exists you don't need to render it again. When you now click on a row it will jump straight to your second menu item. Does this solve your problem?
library(shiny)
library(DT)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
id = "tabs",
menuItem("First item", "first_item",
actionButton("action_button", "Action"),
menuSubItem("First sub item", "first_sub_item")
),
menuItem("Second item", "second_item",
menuSubItem("Second sub item", "second_sub_item") #change to menuSubItem
)
)
),
dashboardBody(
tabItems(
tabItem("first_sub_item",
DT::dataTableOutput("df")
),
tabItem("second_sub_item",
verbatimTextOutput('row_selected')
)
)
)
)
server <- function(input, output, session){
observeEvent(input$action_button, {
output$df <- DT::renderDataTable(
as.data.frame(replicate(10,sample(0:1,1000,rep=TRUE)))
)
})
observeEvent(input$df_rows_selected, {
#Remove rendering of menuSubItem
updateTabItems(session, "tabs", "second_sub_item")
})
output$row_selected = renderPrint({
input$df_rows_selected
})
}
shinyApp(ui, server)
I was making reactive shiny web page and stucked at the code below.
library(shiny)
library(shinydashboard)
ui = dashboardPage(
dashboardHeader(title = "header"),
dashboardSidebar(
sidebarMenuOutput("sideBar")),
dashboardBody(
uiOutput("test")
)
)
server = shinyServer(function(input, output, session) {
output$sideBar <- renderMenu({
sidebarMenu(id = "menu",
menuItem("Dashboard", tabName ="dashboard", icon = icon('dashboard')),
menuItem("DBcentor", tabName ="dbcenter", icon = icon('database'))
)
})
output$test <- renderUI ({
tabItems(
tabItem(tabName = "dashboard", uiOutput("dashboardbody")),
tabItem(tabName = "dbcenter", uiOutput("dbcenterbody"))
)
})
output$dashboardbody <- renderUI ({
box("Dashboard Body")
})
output$dbcenterbody <- renderUI ({
box("Dbcenter Body")
})
})
shinyApp(ui, server)
I used uiOutput to build body but after shiny app is loaded, nothing comes out at the dashboard page.
I changed my code like this,
library(shiny)
library(shinydashboard)
ui = dashboardPage(
dashboardHeader(title = "header"),
dashboardSidebar(
sidebarMenuOutput("sideBar")),
dashboardBody(
tabItems(
tabItem(tabName = "dashboard", uiOutput("dashboardbody")),
tabItem(tabName = "dbcenter", uiOutput("dbcenterbody"))
)
)
)
server = shinyServer(function(input, output, session) {
output$sideBar <- renderMenu({
sidebarMenu(id = "menu",
menuItem("Dashboard", tabName ="dashboard", icon = icon('dashboard')),
menuItem("DBcentor", tabName ="dbcenter", icon = icon('database'))
)
})
output$dashboardbody <- renderUI ({
box("Dashboard Body")
})
output$dbcenterbody <- renderUI ({
box("Dbcenter Body")
})
})
shinyApp(ui, server)
Of course it works and box("dashboadbody") comes out at the first page.
I want to use uiOutput because i should use input data to build menus and items.
Any ways to use uiOutput and get box("dashboard") on the default page at the same time?
Try this
ui = dashboardPage(
dashboardHeader(title = "header"),
dashboardSidebar(
sidebarMenuOutput("sideBar")),
dashboardBody(
uiOutput("test")
)
)
server = shinyServer(function(input, output, session) {
output$sideBar <- renderMenu({
sidebarMenu(id = "menu",
menuItem("Dashboard", tabName ="dashboard", icon = icon('dashboard')),
menuItem("DBcentor", tabName ="dbcenter", icon = icon('database'))
)
})
output$dashboardbody <- renderUI ({
box("Dashboard Body")
})
output$dbcenterbody <- renderUI ({
box("Dbcenter Body")
})
updateTabItems(session,"menu","dbcenter")
updateTabItems(session,"menu","dashboard")
output$test <- renderUI ({
tagList(
tabItems(
tabItem(tabName = "dashboard", uiOutput("dashboardbody")),
tabItem(tabName = "dbcenter", uiOutput("dbcenterbody"))
))
})
})
shinyApp(ui, server)
I'm trying to dynamically generate a menuItem upon the creation of an object or click of a button (Ideally object). I have tried multiple methods and cannot seem to figure out a clean, working solution.
I have a lot of code so below shall include example code:
ui <- fluidPage(
dashboardPage(
dashboardHeader(title = "text"),
dashboardSidebar(
sidebarMenu(id = 'MenuTabs',
menuItem("Tab1", tabName = "tab1", selected = TRUE)
# menuItem("Tab1", tabName = "tab2")
)
),
dashboardBody(
tabItems(
tabItem("tab1",
actionButton("newplot", "New plot")),
tabItem("tab2",
plotOutput('Plot'))
)
)
)
)
server <- function(input, output, session){
output$Plot <- renderPlot({
input$newplot
cars2 <- cars + rnorm(nrow(cars))
plot(cars2)
})
}
shinyApp(ui, server)
Above I have 2 tabs, 1 with a button (shown), and another with a plot (hidden).
How can I get the hidden tab with the plot to appear upon clicking the button?
For bonus points, assuming the button instead created an object, how could I show the hidden menuItem given the creating of said object
Thanks
I've managed to solve it. Below is the code that will create a menuItem by pressing a button show.
ui <- fluidPage(
dashboardPage(
dashboardHeader(title = "text"),
dashboardSidebar(
sidebarMenu(id = 'MenuTabs',
menuItem("Tab1", tabName = "tab1", selected = TRUE),
# menuItem("Tab1", tabName = "tab2")
uiOutput('ui')
)
),
dashboardBody(
tabItems(
tabItem("tab1",
actionButton("newplot", "New plot"),
actionButton("show", "Show")),
tabItem("tab2",
plotOutput('Plot'))
)
)
)
)
server <- function(input, output, session){
output$Plot <- renderPlot({
input$newplot
# Add a little noise to the cars data
cars2 <- cars + rnorm(nrow(cars))
plot(cars2)
})
output$ui <- renderUI({
if(input$show == 0) return()
print(input$show)
sidebarMenu(id = 'MenuTabs',
menuItem("Tab1", tabName = "tab2")
)
})
}
shinyApp(ui, server)
I setup the UI in server.R for more control, but shinyDashboard does not work when defined in server.R.
I use this method with navBarPage without problems.
This code works
library(shiny)
library(shinydashboard)
ui <- dashboardPage( dashboardHeader( ),
dashboardSidebar(),
dashboardBody() )
server <- shinyServer(function(input, output) { })
runApp(list(ui= ui, server = server))
But this one just show an empty page
ui <- uiOutput('dash')
server <- shinyServer(function(input, output) {
output$dash <- renderUI({
dashboardPage(dashboardHeader( ),
dashboardSidebar(),
dashboardBody() )
})
})
runApp(list(ui= ui, server = server))
This is an example using navBarPage, that works fine
ui <- uiOutput('nav')
server <- shinyServer(function(input, output) {
output$nav <- renderUI({
navbarPage("App Title",
tabPanel("Tab 1"),
tabPanel("Tab 2") )
})
})
runApp(list(ui= ui, server = server))
I don't think that you can use only a uiOutput to create a dashboard. I'm assuming that your goal is to create a dynamic dashboard. For that you need to define the header, body and side bar in your UI and use functions such as renderMenu on SERVER to create it. Here is an example to create a dashboard with all the UI defined in the SERVER.
ui <- dashboardPage(
dashboardHeader(title = "My Page"),
dashboardSidebar(sidebarMenuOutput("sideBar_menu_UI")),
dashboardBody(
uiOutput("body_UI"),
uiOutput("test_UI")
)
)
server <- shinyServer(function(input, output, session) {
output$sideBar_menu_UI <- renderMenu({
sidebarMenu(id = "sideBar_Menu",
menuItem("Menu 1", tabName="menu1_tab", icon = icon("calendar")),
menuItem("Menu 2", tabName="menu2_tab", icon = icon("database"))
)
})
output$test_UI <- renderUI ({
tabItems(
tabItem(tabName = "menu1_tab", uiOutput("menu1_UI")),
tabItem(tabName = "menu2_tab", uiOutput("menu2_UI"))
)
})
output$body_UI <- renderUI ({
p("Default content in body outsite any sidebar menus.")
})
output$menu1_UI <- renderUI ({
box("Menu 1 Content")
})
output$menu2_UI <- renderUI ({
box("Menu 2 Content")
})
})
runApp(list(ui= ui, server = server))
In this example, a menu for the sidebar is not selected by default and the content of body_UI will be visible all the time. If you want that your dashboard starts on a specific menu, put the sidebarMenu in your UI. Also you can delete the body_UI.
I have a problem with my dashboard.
I want create a dynamic sidebar menu, but by default, Menu item don't work. The user has to clic on it to show it. I have find an example on this problem
https://github.com/rstudio/shinydashboard/issues/71
but the solution don't work.
If you have ideas... thank you in advance
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic sidebar"),
dashboardSidebar(
sidebarMenuOutput("menu")
),
dashboardBody(tabItems(
tabItem(tabName = "dashboard", h2("Dashboard tab content"))
))
)
server <- function(input, output) {
output$menu <- renderMenu({
sidebarMenu(id="mytabs",
menuItem("Menu item", tabName="dashboard", icon = icon("calendar"))
)
})
}
shinyApp(ui, server)
Here is a solution using updateTabItems.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic sidebar"),
dashboardSidebar(
sidebarMenu(id="mytabs",
sidebarMenuOutput("menu")
)
),
dashboardBody(tabItems(
tabItem(tabName = "dashboard", h2("Dashboard tab content"))
))
)
server <- function(input, output, session) {
output$menu <- renderMenu({
sidebarMenu(
menuItem("Menu item", tabName="dashboard", icon = icon("calendar"))
)
})
isolate({updateTabItems(session, "mytabs", "dashboard")})
}
shinyApp(ui, server)
To extend to dynamic menu you can see this exemple.
R shinydashboard dynamic menu selection
Edit : I think the isolate is not needed but I like to put it in a way to improve the reading of the code