Hi!
I'm trying to develop an app with dynamically creating of tabsetPanel where different plots should be visualized depending on user's choice. When I create conditionalPanel statically it works great. But if I create conditionalPanel dynamically something is going wrong - not only plots are not displayed but even all conditionalPanels disappearing.
Not interesting, but needed code:
library(shiny)
library(shinydashboard)
library(ggplot2)
library(dplyr)
library(htmlwidgets)
library(rlist)
data("midwest", package = "ggplot2")
midwest <- midwest %>%
select(state, category, percprof, area, poptotal, county)
midwest <- midwest %>%
filter(category %in% c("AAR", "LHR", "ALU", "LAR", "HAU"))
categories <- unique(midwest$category)
states <- unique(midwest$state)
max_perc_prof <- max(midwest$percprof)
header <- dashboardHeader(title = "Midwest analysis")
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem(text = "Analysis", tabName = "dcTab", icon = icon("bar-chart-o"))
)
)
Here is body code with example of perfectly working conditional panel
body <- dashboardBody(
tabItems(
tabItem(tabName = "dcTab",
fluidRow(
box(width = 12,
numericInput(inputId = "min_perc_prof",
label = "Minimum percent profession:",
min = 0,
max = max_perc_prof,
value = 2,
step = 1
)
),
conditionalPanel(condition = paste0("input.min_perc_prof", " >= ", 2),
h4("I'm good conditionalPanel"),
box(width = 12, background = "blue", height = 300
# HERE is NOT a problem with plot
, plotOutput("plt_1", height = 280)
)
)
),
fluidRow(
uiOutput(outputId = "dynamicContentUI")
)
)
)
)
ui <- dashboardPage(header = header,
sidebar = sidebar,
body = body
)
And here is a code on server side:
server <- function(input, output, session) {
database <- reactive({
req(input$min_perc_prof)
midwest %>%
filter(percprof >= input$min_perc_prof)
})
tab_state_names <- reactive({
unique(database()$state)
})
tab_category_names <- reactive({
res <- list()
for(i in seq(tab_state_names())){
current_state <- tab_state_names()[[i]]
current_data <- database() %>% filter(state == current_state)
current_categories <- sort(unique(current_data$category))
res[[ current_state ]] <- current_categories
}
res
})
# Init Ggplot
p1 <- ggplot(midwest, aes(x=area, y=poptotal)) + geom_point()
output$plt_1 <- renderPlot({
p1
})
tab_category_content <- reactive({
if (is.null(tab_category_names())) return(NULL)
res_content <- lapply(seq(tab_state_names()), function(current_state){
if(current_state <= length(tab_category_names())){
tabnames <- tab_category_names()[[ current_state ]]
res <- lapply(seq(tabnames), function(current_category){
result_list <- list()
selInputId <- paste0("county_", current_state, "_", current_category)
current_data <- database() %>%
filter(state == tab_state_names()[[current_state]]) %>%
filter(category == tab_category_names()[[current_state]][[current_category]])
county_names <- unique(current_data$county)
sel_input <- selectInput(inputId = selInputId,
label = "Choose county",
choices = county_names
)
result_list <- c(result_list, list(sel_input))
for (current_county in county_names) {
plot_list <- list()
current_panel <- conditionalPanel(condition = paste0("input.", selInputId, " === ", "\"", current_county, "\""),
h5(current_county),
box(width = 12, background = "blue", height = 300,
title = current_county
# HERE is a problem with plot
# , plotOutput("plt_1")
)
)
result_list <- c(result_list, list(current_panel))
}
result_list
})
res
}
})
names(res_content) <- tab_state_names()
res_content
})
tab_state_content <- reactive({
if (is.null(tab_state_names())) return(NULL)
lapply(tab_state_names(), function(current_state){
if(!is.null(tab_category_names()[[ current_state ]])){
tabs <- lapply(seq(tab_category_names()[[ current_state ]]), function(current_category) {
tabPanel(tab_category_names()[[current_state]][[ current_category ]], tab_category_content()[[current_state]][[ current_category ]])
})
args = c(tabs, list(width = 12, id = paste0("tab_cat_in_state_", current_state)))
do.call(tabBox, args)
}
})
})
output$dynamicContentUI <- renderUI({
tabs <- lapply(seq(tab_state_content()), function(current_state) {
tabPanel(tab_state_names()[[ current_state ]], tab_state_content()[[ current_state ]])
})
do.call(tabsetPanel, tabs)
})
}
shinyApp(ui = ui, server = server)
I create a tabsetPanel with dynamic number of tabs. Each of them contains tabBox with dynamic number of tabs. Each of them contains a set of conditionalPanels with condition defined by user choice. Every conditionalPanel should contain a plot and this is an essence of the problem.
A code
current_panel <- conditionalPanel(condition = paste0("input.", selInputId, " === ", "\"", current_county, "\""),
h5(current_county),
box(width = 12, background = "blue", height = 300,
title = current_county
# HERE is a problem with plot
# , plotOutput("plt_1")
)
)
works great - we can see conditionalPanel with empty blue box. But the same code with plotOutput
current_panel <- conditionalPanel(condition = paste0("input.", selInputId, " === ", "\"", current_county, "\""),
h5(current_county),
box(width = 12,
background = "blue", height = 300,
title = current_county
# HERE is a problem with plot
, plotOutput("plt_1")
)
)
has totally wrong result. Because not only plot isn't visible but also blue box and conditional panel are disappearing.
I generally do not understand what I need to change. Any advice will be very useful.
