矢量閃亮選擇:: 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()選擇多個值。但是，如果我想將所有變量作爲初始狀態，則這是不可行的。

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

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