Есть ли способ использовать модуль pickerGroup (или selectizeGroup) из woolWidget для реактивных данных? - PullRequest
Новая
       12

Есть ли способ использовать модуль pickerGroup (или selectizeGroup) из woolWidget для реактивных данных?

1 голос
/ 20 июня 2019

У меня есть приложение Shiny, в котором у меня есть первый модуль Selectizegroup на боковой панели, который фильтрует мои данные по 3 переменным. Я хочу поместить второй модуль выбора или группы выбора в панель вкладок, чтобы создать некоторый график с данными, отфильтрованными по дополнительным 2 переменным. Но я не нашел способа применить модуль pickerGroup к реактивным данным, полученным с помощью модуля первой группы.

Я уже пытался добиться этого с помощью isolate (), update (), наблюдайте за событием (), но я всегда терпел неудачу ....

Минимальный пример моей базы данных: 

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)

Во 2-й вкладке tabPannel («Блок-схема») я бы хотел, чтобы pickerGroup (Filter_flowchart_data) работал с отфильтрованными данными из selectizeGroup (Filter_data ()) с боковой панели, но, конечно, не влияя на данные других вкладок :)

С предоставленной версией моего кода я получаю сообщение Ошибка в .getReactiveEnvironment () $ currentContext (): операция не разрешена без активного реактивного контекста.

Я думаю, что, возможно, есть способ с комбинацией наблюдений, обновлений, реактивов и изоляции, но я не достиг этого ...

Ответы [ 2 ]

0 голосов
/ 20 июня 2019

Спасибо за ваш ответ, Стефан, второе предложение достигает цели! 

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 () (), но результат идеален:)

0 голосов
/ 20 июня 2019

Вы можете вызвать модуль внутри реактивного проводника: 

  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()().

...