将 slectizeInput 小部件输入与多个 checkboxGroupButtons 小部件输入同步

Question

我的 shiny 应用程序中有多个 checkboxGroupButton 小部件和一个 selectizeInput 小部件。两种类型的输入小部件都使用相同的选项集，并且服务于相同的目的。所以我想同步它们；更新 selectizeInput selectedTags，当任一 checkboxGroupButtons 的选项被选中时，反之亦然。

library(shiny)
library(shinyWidgets)
library(shinyjs)


categoriesList <- c("Research", "Rural Health", "Staff Experience", "Teamwork", "Telehealth", "Transition Care",
                    "Trauma and Injury Management", "Unwarranted Clinical Variation")
departmentsList <- c("Acute Medicine, Subacute and Community", "Speciality Medicine, Cancer and Critical Care",
                     "Surgery and Interventional Services", "Children's", "Women's and Newborn", "Mental Health",
                     "Allied Health and Patient Flow", "Residential Care", "Pathology", "Imaging", "Pharmacy")
organisationsList <- c("Organisation 1", "Organisation 2", "Organisation 3", "Organisation 4",
                       "Organisation 5", "Organisation 6", "Organisation 7", "Organisation 8",
                       "Organisation 9", "Organisation 10", "Organisation 11", "Organisation 12")
statusList <- c("Sustained", "Implementation", "Pre-implementation", "Future Initiative")

ui <- fluidPage(
  
  titlePanel("App"),
  
  mainPanel(
    selectizeInput("selectedTags", "Select",
                   choices = list(
                     Categories = categoriesList,
                     Departments = departmentsList,
                     Organisations = organisationsList,
                     Status = statusList),
                   multiple = TRUE,
                   options = list('plugins' = list('remove_button'))),
    
    checkboxGroupButtons(
      inputId = "selectedCategories",
      choices = categoriesList,
      individual = TRUE
    ),
    checkboxGroupButtons(
      inputId = "selectedDepartments",
      choices = departmentsList,
      individual = TRUE
    ),
    checkboxGroupButtons(
      inputId = "selectedOrganisations",
      choices = organisationsList,
      individual = TRUE
    ),
    checkboxGroupButtons(
      inputId = "selectedStatus",
      choices = statusList,
      individual = TRUE
    )
  )
)

我尝试为每个 checkboxGroupButtons 添加观察事件，如下所示

server <- function(input, output, session) {      
  
  observeEvent(input$selectedCategories, {
    if(input$selectedCategories %in% input$selectedTags)
      selected = input$selectedTags[input$selectedTags != input$selectedCategories]
    else
      selected = c(input$selectedTags, input$selectedCategories)
    updateSelectInput(session, "selectedTags", 
                      selected = selected)
  })
  
  observeEvent(input$selectedDepartments, {
    if(input$selectedDepartments %in% input$selectedTags)
      selected = input$selectedTags[input$selectedTags != input$selectedDepartments]
    else
      selected = c(input$selectedTags, input$selectedDepartments)
    updateSelectInput(session, "selectedTags", 
                      selected = selected)
  })
  
  observeEvent(input$selectedOrganisations, {
    if(input$selectedOrganisations %in% input$selectedTags)
      selected = input$selectedTags[input$selectedTags != input$selectedOrganisations]
    else
      selected = c(input$selectedTags, input$selectedOrganisations)
    updateSelectInput(session, "selectedTags", 
                      selected = selected)
  })
  
  observeEvent(input$selectedStatus, {
    if(input$selectedStatus %in% input$selectedTags)
      selected = input$selectedTags[input$selectedTags != input$selectedStatus]
    else
      selected = c(input$selectedTags, input$selectedStatus)
    updateSelectInput(session, "selectedTags", 
                      selected = selected)
  })
}

shinyApp(ui = ui, server = server)

但是这个逻辑好像不行

Answer 1

这个怎么样？

library(shiny)
library(shinyWidgets)
library(shinyjs)


categoriesList <- c("Research", "Rural Health", "Staff Experience", "Teamwork", "Telehealth", "Transition Care",
                    "Trauma and Injury Management", "Unwarranted Clinical Variation")
departmentsList <- c("Acute Medicine, Subacute and Community", "Speciality Medicine, Cancer and Critical Care",
                     "Surgery and Interventional Services", "Children's", "Women's and Newborn", "Mental Health",
                     "Allied Health and Patient Flow", "Residential Care", "Pathology", "Imaging", "Pharmacy")
organisationsList <- c("Organisation 1", "Organisation 2", "Organisation 3", "Organisation 4",
                       "Organisation 5", "Organisation 6", "Organisation 7", "Organisation 8",
                       "Organisation 9", "Organisation 10", "Organisation 11", "Organisation 12")
statusList <- c("Sustained", "Implementation", "Pre-implementation", "Future Initiative")

ui <- fluidPage(
  
  titlePanel("App"),
  
  mainPanel(
    selectizeInput("selectedTags", "Select",
                   choices = list(
                     Categories = categoriesList,
                     Departments = departmentsList,
                     Organisations = organisationsList,
                     Status = statusList),
                   multiple = TRUE,
                   options = list('plugins' = list('remove_button'))),
    
    checkboxGroupButtons("selectedCategories",choices = categoriesList,individual = TRUE),
    checkboxGroupButtons("selectedDepartments", choices = departmentsList,individual = TRUE),
    checkboxGroupButtons("selectedOrganisations",choices = organisationsList,individual = TRUE),
    checkboxGroupButtons("selectedStatus",choices = statusList,individual = TRUE)
  )
)

server <- function(input, output, session) {  

  observeEvent(input$selectedCategories, {
    updateSelectInput(session, "selectedTags", selected = c(input$selectedTags, input$selectedCategories))
  })
  
  observeEvent(input$selectedDepartments, {
    updateSelectInput(session, "selectedTags", selected = c(input$selectedTags, input$selectedDepartments))
  })
  
  observeEvent(input$selectedOrganisations, {
    updateSelectInput(session, "selectedTags", selected = c(input$selectedTags, input$selectedOrganisations))
  })
  
  observeEvent(input$selectedStatus, {
    updateSelectInput(session, "selectedTags", selected = c(input$selectedTags, input$selectedStatus))
  })
 
}

shinyApp(ui = ui, server = server)

将 slectizeInput 小部件输入与多个 checkboxGroupButtons 小部件输入同步

Syncing slectizeInput widget input with multiple checkboxGroupButtons widget inputs

r

shiny

shinywidgets