R 条件面板的不同行为,取决于创建方法
我正在尝试开发一个应用程序,动态创建tabsetPanel,根据用户的选择,不同的绘图应该可视化。当我静态创建conditionalPanel时,它工作得非常好。但是,如果我动态创建conditionalPanel,就会出现一些问题——不仅不会显示绘图,甚至所有conditionalPanel都会消失 不有趣,但需要代码:R 条件面板的不同行为,取决于创建方法,r,shiny,shinydashboard,R,Shiny,Shinydashboard,我正在尝试开发一个应用程序,动态创建tabsetPanel,根据用户的选择,不同的绘图应该可视化。当我静态创建conditionalPanel时,它工作得非常好。但是,如果我动态创建conditionalPanel,就会出现一些问题——不仅不会显示绘图,甚至所有conditionalPanel都会消失 不有趣,但需要代码: library(shiny) library(shinydashboard) library(ggplot2) library(dplyr) library(htmlwidg
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"))
)
)
库(闪亮)
图书馆(shinydashboard)
图书馆(GG2)
图书馆(dplyr)
库(htmlwidgets)
图书馆(rlist)
数据(“中西部”,package=“ggplot2”)
中西部%
选择(州、类别、percprof、地区、poptotal、县)
中西部%
过滤器(类别%c(“AAR”、“LHR”、“ALU”、“LAR”、“HAU”))
类别
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)
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")
)
)
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")
)
)