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

Question

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

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)

但逻辑似乎不起作用

标签： rshinyshinywidgets

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)