矢量作為閃亮的選擇:: 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相同的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))

基本上，它添加了一個通過函數生成的中間映射表。