I'm trying to conditionally display additional information in the sidebar menu of a shinydashboard based on which menu item is selected and it doesn't seem to be working.
From the shinydashboard pages I can see how to get at the menuItem that is currently selected, so I'm able to validate that I'm checking the right condition.
I have a sample shiny app that you can run. In this app I would expect to only see the additional text when tabOne is selected but I always see the additional text in the sidebar. Based on the RStudio shinydashboard page code I also added the chunk of code to print out the menu item that's currently selected so you can see that my condition is comparing to the right string.
Hopefully a simple mistake I'm overlooking, any thoughts appreciated!
library(shiny)
library(shinydashboard)
library(tidyverse)
library(plotly)
library(nycflights13)
library(shinyjs)
library(V8)
ui <- dashboardPage(skin = "black",
dashboardHeader(
title="Test App"
),
dashboardSidebar(sidebarMenu(id = "sidebar",
menuItem("Tab One", tabName = "tabOne", icon = icon("heartbeat")),
menuItem("Tab Two", tabName = "tabTwo", icon = icon("warning")),
shiny::conditionalPanel(condition="input$sidebar == 'tabOne'",
HTML("Additional text to disply <br>only when menuItem tabOne <br>is selected")),
textOutput("res")
)),
dashboardBody(
useShinyjs(),
extendShinyjs(text = "shinyjs.resetClick = function() { Shiny.onInputChange('.clientValue-plotly_click-month_select', 'null'); }"),
#extendShinyjs(text = "shinyjs.resetClick = function() { Shiny.onInputChange('.clientValue-plotly_click-month_select', 'null'); }"),
tabItems(
tabItem(tabName = "tabOne",
tabsetPanel(id = "flight_tabs",
tabPanel(
title = "Main Dashboard",
value = "page1",
fluidPage(
fluidRow(
shiny::column(width = 2,
selectInput("month","Month: ", unique(nycflights13::flights$month)),
actionLink("remove", "Remove detail tabs")
),
shiny::column(width = 5,
plotlyOutput("plot1")
),
shiny::column(width = 5,
plotlyOutput("plot2")
)
)
)
)
)
),
tabItem(tabName = "tabTwo",
h2("Test")
)
)
)
)
server <- function(input, output, session) {
tab_list_flights <- NULL
output$res <- renderText({
paste("menuItem selected:", input$sidebar)
})
output$plot1 <- renderPlotly({
result <- nycflights13::flights %>%
group_by(month) %>%
count() %>%
as.data.frame()
plot_ly(result, x = ~month, y = result[['n']], type = 'scatter', mode = 'lines+markers', source = 'month_select',
line = list(color = mmm_blue),
marker = list(color = mmm_blue),
hoverinfo = 'text',
text = ~paste('Month: ', month,
'<br> Total Flights: ', n)) %>%
layout(xaxis = list(title = "Month"),
yaxis = list (title = "Count"))
})
output$plot2 <- renderPlotly({
# Get month based on click
event_data <- event_data("plotly_click", source = "month_select")
print(event_data)
selected_month <- input$month
# if(!is.null(event_data)) {
# selected_month <- event_data[[3]]
# }
print(selected_month)
result <- nycflights13::flights %>%
filter(month == selected_month) %>%
group_by(carrier) %>%
count()
# plot <- result %>%
# ggplot(aes(x = carrier, y = n)) +
# geom_bar(stat="identity") +
# labs(x="Airline",y="Flight Count")
#
# plot %>%
# ggplotly()
plot_ly(result, x = ~carrier, y = result[['n']], type = 'bar', source = 'airline_select',
marker = list(color = mmm_blue_light),
hoverinfo = 'text',
text = ~paste('Count: ', n)) %>%
layout(xaxis = list(title = "Airline"),
yaxis = list (title = "Count"))
})
# resets the month_select plotly click to null if the drop down is used
# observeEvent(input$month, {
# js$resetClick()
# })
observeEvent(event_data("plotly_click", source = "month_select"), {
event_data <- event_data("plotly_click", source = "month_select")
updateVarSelectInput(session, "month", selected = event_data[[3]])
})
observeEvent(event_data("plotly_click", source = "airline_select"), {
event_data <- event_data("plotly_click", source = "airline_select")
print(event_data[[3]])
airline <- event_data[[3]]
event_data_month <- event_data("plotly_click", source = "month_select")
selected_month <- input$month
# if(!is.null(event_data_month)) {
# selected_month <- event_data_month[[3]]
# }
tab_title <- paste(airline,"-",selected_month)
if(tab_title %in% tab_list_flights == FALSE){
details <- nycflights13::flights %>%
filter(month == selected_month,
carrier == airline)
appendTab(inputId = "flight_tabs",
tabPanel(
tab_title,
DT::renderDataTable(details)
))
tab_list_flights <<- c(tab_list_flights, tab_title)
}
updateTabsetPanel(session, "flight_tabs", selected = tab_title)
})
observeEvent(input$remove,{
# Use purrr's walk command to cycle through each
# panel tabs and remove them
tab_list_flights %>%
walk(~removeTab("flight_tabs", .x))
tab_list_flights <<- NULL
})
}
# Run the application
shinyApp(ui = ui, server = server)