我有一个Shiny应用程序，在侧栏中有一个第一个Selectizegroup模块，该模块可以过滤3个变量的数据。我想在选项板中放置第二个selectize或pickergroup模块，以生成一些图，并在补充2个变量上过滤数据。但是我发现没有办法将pickerGroup模块应用于通过第一个组模块获得的反应数据。
我已经尝试过用isolate（），update（），observeEvent（）实现它，但是我总是失败。...
我的数据库的一个最小示例：
base <- structure(list(annee = c(2017, 2018, 2017, 2016, 2018, 2017,
2017, 2018, 2018, 2016),
code_composante = structure(c(2L, 1L,2L, 1L, 2L, 2L, 2L, 2L, 2L, 1L),
.Label = c("APS", "FSI"),
class = "factor"),
code_etape = structure(c(25L, 26L, 21L, 28L, 16L, 16L, 12L, 13L, 21L, 28L),
.Label = c("EP3CHE", "EP3EEE", "EP3GCE", "EP3INE", "EP3MAE", "EP3MEE", "EP3PHE", "EP40EE", "EP40GE", "EP40IE", "EP40KE", "EPCHIE", "EPCHSE", "EPEEAE", "EPGCCE", "EPINFE", "EPMACE", "EPMASE", "EPMATE", "EPMECE", "EPMIAE", "EPPHPE", "EPPHSE", "EPSDTE", "EPSDVE", "SP3SCE", "SP40PE", "SPAPSE"),
class = "factor"),
particularite = structure(c(3L,1L, 3L, 3L, 3L, 3L, 3L, 4L, 3L, 3L),
.Label = c("3LA", "4LA","Classique", "Parcours spécial"),
class = "factor"),
origine_gen2 = structure(c(1L, 3L, 3L, 4L, 4L, 3L, 4L, 1L, 3L, 3L),
.Label = c("Bacheliers antérieurs", "Flux latéral", "Néo-bacheliers", "Redoublement ", "Réorientation "),
class = "factor"),
code_resultat = structure(c(2L, 4L, 2L, 3L, 4L, 3L, 3L, 4L, 4L, 1L),
.Label = c("Admis", "Ajourné","Défaillant / démissionnaire", "Donnée manquante", "Réorientation (à affiner)"), class = "factor"),
poursuite = structure(c(4L, 3L, 4L,6L, 3L, 6L, 4L, 3L, 3L, 2L),
.Label = c("Année supérieure - Flux latéral","Année supérieure - Flux normal", "Non déterminé", "Redoublement", "Réorientation", "Sortie UPS - Echec", "Sortie UPS - Réussite" ),
class = "factor")),
class = c("tbl_df", "tbl", "data.frame" ),
row.names = c(NA, -10L))
还有一些闪亮的应用程序：
# contenu global ####
ui <- shinydashboard::dashboardPage(
shinydashboard::dashboardHeader(title = "Devenir et réussite en L1",
titleWidth = 300),
# shiny::uiOutput("logout_button")),
shinydashboard::dashboardSidebar(tags$head(tags$style(HTML(".sidebar { position: fixed; width: 300px;}" ))),
width = 300,
div(h1("Filtres", style = "margin-left: 10px;")),
shinyWidgets::selectizeGroupUI(id = "filterset",
btn_label = "Remettre les filtres à zéro",
inline = FALSE,
params = list(
annee = list(inputId = "annee", title = "Année"),
composante = list(inputId = "code_composante", title = "Code composante"),
particularite = list(inputId = "particularite", title = "Type de L1"),
etape = list(inputId = "code_etape", title = "Code étape")))),
shinydashboard::dashboardBody(
#### onglet "tables" ####
shiny::tabsetPanel(id = "tabset",
shiny::tabPanel(title = "Tables des flux",
shiny::fluidRow(shinydashboard::box(width = 4,
title = "Origine des étudiants",
DT::DTOutput("table_origine")))),
#### onglet "flowchart"####
shiny::tabPanel(title = "Flow chart",
shinydashboard::box(width = 12,
shinyWidgets::pickerGroupUI(id = "filterset_flowchart",
btn_label = "Remettre les filtres à zéro",
params = list(
origine = list(inputId = "origine_gen2", title = "Origine"),
resultat = list(inputId = "code_resultat", title = "Résultat")))),
shinydashboard::box(width = 12, height = "700px", shiny::plotOutput("flowchart"))
))))
####SERVER####
server <- function(input, output, session) {
#first filter
filtered_data <- callModule(
module = shinyWidgets::selectizeGroupServer,
id = "filterset",
data = base ,
vars = c("annee", "code_composante", "particularite", "code_etape")
)
# box_origine ####
output$table_origine <- DT::renderDT({
effectif_origine <- filtered_data() %>%
dplyr::select(origine_gen2) %>%
dplyr::group_by(origine_gen2) %>%
dplyr::count()
DT::datatable(effectif_origine,
selection = 'single')
})
# flowchart ####
filtered_flowchart_data <- callModule(
module = shinyWidgets::pickerGroupServer,
id = "filterset_flowchart",
data = filtered_data() %>%
droplevels()%>%
dplyr::mutate_if(is.factor, as.character),
vars = c("origine_gen2", "code_resultat")
)
output$flowchart <- shiny::renderPlot({
actualized_data <- filtered_flowchart_data() %>%
dplyr::mutate_if(is.character, as.factor) %>%
dplyr::group_by(poursuite) %>%
dplyr::count()%>%
dplyr::ungroup()
pie_chart <- pie(actualized_data$n, labels = actualized_data$poursuite)
})}
shiny::shinyApp(ui, server)
在第二个tabPannel（“流程图”）中，我希望pickerGroup（filtered_flowchart_data）在侧边栏中处理来自selectizeGroup（filtered_data（））的已过滤数据，但是当然不影响其他选项卡的数据:)
使用提供的代码版本，我会收到一条消息 .getReactiveEnvironment（）$ currentContext（）中的错误：如果没有活动的反应性上下文，则不允许进行操作。
我认为可能有一种方法可以将observeEvent，更新反应性和隔离性结合起来，但是我没有实现。...
答案 0 :(得分：0)
您可以在无功导体内调用模块：
filtered_flowchart_data <- reactive({
x <- callModule(
module = shinyWidgets::pickerGroupServer,
id = "filterset_flowchart",
data = filtered_data() %>%
droplevels() %>%
dplyr::mutate_if(is.factor, as.character),
vars = c("origine_gen2", "code_resultat")
)
x()
})
如果有问题，您也可以尝试
filtered_flowchart_data <- reactive({
callModule(
module = shinyWidgets::pickerGroupServer,
id = "filterset_flowchart",
data = filtered_data() %>%
droplevels() %>%
dplyr::mutate_if(is.factor, as.character),
vars = c("origine_gen2", "code_resultat")
)
})
然后通过执行filtered_flowchart_data()()获得数据。
答案 1 :(得分：0)
谢谢您的回答，斯特凡（Stéphane），第二个建议成功了！
filtered_flowchart_data <- reactive({
callModule(
module = shinyWidgets::pickerGroupServer,
id = "filterset_flowchart",
data = filtered_data() %>%
droplevels() %>%
dplyr::mutate_if(is.factor, as.character),
vars = c("origine_gen2", "code_resultat")
)})
并通过使用获取数据：
filtered_flowchart_data()()
我不知道它是否非常干净，我从未使用过或看到过double（）（），但结果是完美的：）