Vector 作为 shiny::selectInput() 中的选择

Question

这是一个工作模板：

require(data.table)
require(shiny)
require(ggplot2)

x <- data.table(v1 = sample(letters[1:5], 100, replace = T), 
                v2 = sample(letters[1:2], 100, replace = T),
                v3 = runif(100, 0, 1))

ui <- fluidPage(
  sidebarPanel(
    selectInput("in1", "Choice v1", selected = "All", choices = c("All" = list(letters[1:5]))),
    selectInput("in2", "Choice v2", selected = "a", choices = letters[1:2])
  ),
  mainPanel(
    plotOutput("out1")
  )
)

server <- function(input, output){
  output$out1 <- renderPlot({
    ggplot(x[v1 %in% input$in1 & v2 %in% input$in2], aes(x = v3)) +
      geom_density(fill = "dodgerblue4", alpha = .7) +
      theme_light()
  })
}

runApp(shinyApp(ui, server))

这里的问题是我想允许在变量中选择值的子集。行selectInput("in1", "Choice v1", selected = "All", choices = c("All" = list(letters[1:5]))) 旨在将letters[1:5] 传递给input$in1，有效地选择所有值并且不对v1 执行数据子集。

同样适用于任何其他值子集，例如选择"a_b_c" = c("a", "b", "c")，或者"All" = x[,unique(v1)]等等。闪亮的作用是将列表中包含的所有值分解，基本上实现了与预期结果相反的结果。 我知道有selectizeInput() 可以选择多个值。但是，如果我希望将所有变量的 selected = "All" 作为初始状态，这是不可行的。

Answer 1

这样的东西有用吗？

#rm(list=ls())
require(data.table)
require(shiny)
require(ggplot2)

x <- data.table(v1 = sample(letters[1:5], 100, replace = T), 
                v2 = sample(letters[1:2], 100, replace = T),
                v3 = runif(100, 0, 1))

ui <- fluidPage(
  sidebarPanel(
    selectInput("in1", "Choice v1", selected = "All", choices = c("All",letters[1:5])),
    selectInput("in2", "Choice v2", selected = "a", choices = letters[1:2])
  ),
  mainPanel(
    plotOutput("out1")
  )
)

server <- function(input, output){
  output$out1 <- renderPlot({
    value <- input$in1
    if(value == "All"){
      value <- letters[1:5]
    }
    ggplot(x[v1 %in% value & v2 %in% input$in2], aes(x = v3)) +
      geom_density(fill = "dodgerblue4", alpha = .7) +
      theme_light()
  })
}

runApp(shinyApp(ui, server))

Answer 2

shiny 支持在selectInput 中选择多个值。您需要设置multiple = TRUE 和selectize = FALSE。我认为这将为您提供所需的功能。

然后您将choices 和selected 变量设为相同以预选所有变量。如果您需要使用“全部”功能，则需要添加一个操作按钮来运行updateSelectInput。结合这两个功能可以通过编写一个模块来完成。

require(data.table)
require(shiny)
require(ggplot2)

x <- data.table(v1 = sample(letters[1:5], 100, replace = T), 
                v2 = sample(letters[1:2], 100, replace = T),
                v3 = runif(100, 0, 1))

ui <- fluidPage(
  sidebarPanel(
    selectInput("in1", "Choice v1", 
                selected = letters[1:5], 
                choices = letters[1:5],
                multiple = TRUE,
                selectize = FALSE),
    selectInput("in2", "Choice v2", 
                selected = letters[1:2], 
                choices = letters[1:2],
                multiple = TRUE,
                selectize = FALSE)
  ),
  mainPanel(
    plotOutput("out1")
  )
)

server <- function(input, output){
  output$out1 <- renderPlot({
    ggplot(x[v1 %in% input$in1 & v2 %in% input$in2], aes(x = v3)) +
      geom_density(fill = "dodgerblue4", alpha = .7) +
      theme_light()
  })
}

runApp(shinyApp(ui, server))

Answer 3

在阅读其他答案并想知道可能的干净和紧凑的解决方法时，这就是我想出的。采用干净的方法来添加新变量至关重要。

require(data.table)
require(shiny)
require(ggplot2)

x <- data.table(v1 = sample(letters[1:5], 100, replace = T), 
                v2 = sample(letters[1:2], 100, replace = T),
                v3 = runif(100, 0, 1))

map.dt <- function(x, variables){
  map.out <- data.table(name = character(), variable = character(), value = character())
  for(i in variables){
    map.out <- rbind(map.out,
                     data.table(name = x[,sort(as.character(na.omit(unique(get(i)))))],
                                variable = i,
                                value = x[,sort(as.character(na.omit(unique(get(i)))))]),
                     data.table(name = "All",
                                variable = i,
                                value = x[,sort(as.character(na.omit(unique(get(i)))))]))
  }
  return(map.out)
}

y <- map.dt(x, c("v1", "v2"))

ui <- fluidPage(
  sidebarPanel(
    selectInput("in1", "Choice v1", selected = "All", choices = c("All", letters[1:5])),
    selectInput("in2", "Choice v2", selected = "All", choices = c("All", letters[1:2]))
  ),
  mainPanel(
    plotOutput("out1")
  )
)

server <- function(input, output){
  output$out1 <- renderPlot({
    ggplot(x[v1 %in%  y[variable == "v1" & name == input$in1, value] & 
               v2 %in% y[variable == "v2" & name == input$in2, value]], 
             aes(x = v3)) +
      geom_density(fill = "dodgerblue4", alpha = .7) +
      theme_light()
  })
}

runApp(shinyApp(ui, server))

基本上，它是添加一个通过函数生成的中间映射表。