Я пытаюсь разработать приложение с динамическим созданием tabsetPanel, где различные графики должны визуализироваться в зависимости от выбора пользователя.Когда я статически создаю условную панель, она прекрасно работает.Но если я создаю условную панель динамически, что-то идет не так - не только графики не отображаются, но даже исчезают все условные панели.
Не интересно, но необходим код:
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"))
)
)
Вот код тела спример отлично работающей условной панели
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
)
А вот код на стороне сервера:
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)
Я создаю tabsetPanel с динамическим количеством вкладок.Каждый из них содержит tabBox с динамическим количеством вкладок.Каждый из них содержит набор условных панелей с условием, определяемым пользователем.Каждая условная панель должна содержать сюжет, и это суть проблемы.
Код
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")
)
)
прекрасно работает - мы можем видеть условную панель с пустой синей рамкой.Но тот же код с 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")
)
)
имеет совершенно неверный результат.Потому что не только сюжет не виден, но и синий прямоугольник и условная панель.
Я вообще не понимаю, что мне нужно изменить.Любой совет будет очень полезен.