我正在尝试开发一个动态创建tabsetPanel的应用程序，其中应根据用户的选择可视化不同的绘图。当我静态创建conditionalPanel时，它工作得很好。但是，如果我动态创建conditionalPanel，则会出现问题 - 不仅不会显示绘图，甚至所有conditionalPanel都会消失。
不感兴趣，但需要代码：
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。它们中的每一个都包含一组conditionPanel，其条件由用户选择定义。每个conditionalPanel都应该包含一个图，这是问题的本质。
代码
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")
)
)
效果很好 - 我们可以看到带有空蓝框的conditionalPanel。但与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")
)
)
结果完全错误。因为不仅可以看到情节，还可以看到蓝框和条件面板。
我一般不明白我需要改变什么。任何建议都非常有用。