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))

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

矢量作为闪亮的选择:: selectInput（）

3 个答案: