r - 如何根据另一个输入选择多个输入

Question

案子

我确实有以下问题。我有四个案例，比如 A、B、C 和 D。基于这些，我喜欢过滤我的情节和进一步的结果。到目前为止这么直。

此外，还有两种用户，例如 group1 和 group2。Group1 通常（！）只想看到 A 和 B 以及 Group2 C 和 D。但是，有时他们想把它混合起来，只看到 A，或者 A 和 C，等等......

因此，我的目标是可以选择 group1 或 group2 并且自动选择 A&B 或 C&D。但也应该可以选择 group1 和 group2（选择 A&B&C&D）或都不选择并手动选择组。这是一个小例子：

library(shiny)
library(shinyWidgets)
library(ggplot2)
library(dplyr)

ui <- shinyUI(fluidPage(

  titlePanel("Test 1"),

  sidebarLayout(
    sidebarPanel(
      prettyCheckbox(inputId = "g1",
                     label = "Group 1",
                     shape = "round", bigger = TRUE,
                     value = TRUE,
                     inline = TRUE),
      prettyCheckbox(inputId = "g2",
                     label = "Group 2",
                     shape = "round", bigger = TRUE,
                     value = FALSE,
                     inline = TRUE),
      br(),
      prettyCheckbox(inputId = "a",
                     label = "A",
                     value = TRUE,
                     inline = TRUE),
      prettyCheckbox(inputId = "b",
                     label = "B",
                     value = TRUE,
                     inline = TRUE),
      prettyCheckbox(inputId = "c",
                     label = "C",
                     value = FALSE,
                     inline = TRUE),
      prettyCheckbox(inputId = "d",
                     label = "D",
                     value = FALSE,
                     inline = TRUE),
      plotOutput("plot")
    ),

    mainPanel()
  )
))

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

  set.seed(0)
  df <- data.frame(group = sample(LETTERS[1:4], size = 50, replace = T),
                   x = rnorm(50),
                   y = rnorm(50))


  output$plot<- renderPlot({ 
    if(!input$a){
      df <- df %>% 
        filter(group != "A")
    }
    if(!input$b){
      df <- df %>% 
        filter(group != "B")
    }
    if(!input$c){
      df <- df %>% 
        filter(group != "C")
    }
    if(!input$d){
      df <- df %>% 
        filter(group != "D")
    }

    df %>% 
      ggplot(aes(x = x, y = y, color = group)) +
      geom_point()
  })
})

shiny::shinyApp(ui, server)

笔记：

我想查看标记为选中的第二行复选框并按它们过滤。即使选择了相应的组，用户也应该可以取消选中复选框。顶层盒子应该只是方便的帮手。由于我只有四个组，因此 selectPicker() 不是一个选项（从 UX 角度来看）。

O 感觉这应该已经以某种方式实现了，我不想调整 renderUI 和类似的东西。欢迎任何提示！

标签： rshiny

Answer 1

请参阅下面的代码，诀窍是找到updatePrettyCheckbox！

library(shiny)
library(shinyWidgets)
library(ggplot2)
library(dplyr)

ui <- shinyUI(fluidPage(

  titlePanel("Test 1"),

  sidebarLayout(
    sidebarPanel(
      prettyCheckbox(inputId = "g1",
                     label = "Group 1",
                     shape = "round", bigger = TRUE,
                     value = FALSE,
                     inline = TRUE),
      prettyCheckbox(inputId = "g2",
                     label = "Group 2",
                     shape = "round", bigger = TRUE,
                     value = FALSE,
                     inline = TRUE),
      br(),
      prettyCheckbox(inputId = "a",
                     label = "A",
                     value = FALSE,
                     inline = TRUE),
      prettyCheckbox(inputId = "b",
                     label = "B",
                     value = FALSE,
                     inline = TRUE),
      prettyCheckbox(inputId = "c",
                     label = "C",
                     value = FALSE,
                     inline = TRUE),
      prettyCheckbox(inputId = "d",
                     label = "D",
                     value = FALSE,
                     inline = TRUE),
      plotOutput("plot")
    ),

    mainPanel()
  )
))

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

  set.seed(0)
  df <- data.frame(group = sample(LETTERS[1:4], size = 50, replace = T),
                   x = rnorm(50),
                   y = rnorm(50))

  observeEvent(input$g1, {

    if(input$g1 == TRUE){
      updatePrettyToggle(session = session,
                         inputId = "a",
                         value = TRUE)
      updatePrettyToggle(session = session,
                         inputId = "b",
                         value = TRUE)

    }
  })
  observeEvent(input$g2, {

    if(input$g2 == TRUE){
      updatePrettyToggle(session = session,
                         inputId = "c",
                         value = TRUE)
      updatePrettyToggle(session = session,
                         inputId = "d",
                         value = TRUE)

    }
  })



  output$plot<- renderPlot({ 


    if(!input$a){
      df <- df %>% 
        filter(group != "A")
    }
    if(!input$b){
      df <- df %>% 
        filter(group != "B")
    }
    if(!input$c){
      df <- df %>% 
        filter(group != "C")
    }
    if(!input$d){
      df <- df %>% 
        filter(group != "D")
    }

    df %>% 
      ggplot(aes(x = x, y = y, color = group)) +
      geom_point()
  })
})

shiny::shinyApp(ui, server)

我没有包括取消选中 Group1 或 Group 2 会关闭 A&B/C&D 但您只需在代码中添加如下内容：

observeEvent(input$g1, {

if(input$g1 == TRUE){
  updatePrettyToggle(session = session,
                     inputId = "a",
                     value = TRUE)
  updatePrettyToggle(session = session,
                     inputId = "b",
                     value = TRUE)

}
if(input$g1 == FALSE){
  updatePrettyToggle(session = session,
                     inputId = "a",
                     value = FALSE)
  updatePrettyToggle(session = session,
                     inputId = "b",
                     value = FALSE)

}

})

inputId还要检查您的原始代码，您对第 2 组有误