r - 如何使 selectInput() 仅在 R shiny 中选择具有多个类别/因素的列？

Question

我正在构建一个 Shiny 的应用程序，我正在上传多个文件，执行一些操作并输出一些图。通过从 selectInput() 中进行选择，我的图具有 facet_wrap() 的功能。 selectInput() 将引用上传数据集中的列，有时这些列只有一个因子水平或重复值。

我不希望 selectInput() 选择这些列，因为它们的分面或分组对情节没有影响(即搜索分面或分组可能会很烦人的东西，因为它是一个大数据集)。我想实现一个 observe() 事件，其中 selectInput() 只选择因子水平大于 1 的列。我尝试同时使用 if 语句和 ifelse 语句，但 Shiny 似乎每次都会崩溃。

原始代码非常复杂，但这里有一个可重现的示例:

library(shiny)
library(ggplot2)

sample <- data.frame(column1  = rep('cat',10), column2 = c(rep('cat',5), rep('dog',5)),
                     column3 = c(rep('turtle',3), rep('wolf',7)), column4 = rnorm(10))
write.csv(sample, "sample.csv") #Creating sample csv to be ingested in R shiny

ui <- fluidPage(
  headerPanel("Webpapp"),
  sidebarPanel(
    
    fileInput(inputId = "filedata", #Upload sample.csv here
              label = "Upload the Raw Data File",
              accept = c("text/csv", "text/comma-separated-values,text/plain",
                         ".csv")),
    selectInput("col1", "Select column:", choices = ""), #will be updated in server
  ),
  mainPanel(plotOutput('boxplot')),
)

server <- function(session, input, output) { 
  
  data <- reactive({
    req(input$filedata)
    df <- read.csv(input$filedata$datapath, header = T)
    df[1] <- rep('dog', 10) 
    #I can hardcode it here to delete all columns with less than 2 unique values but prefer not to hard code
    list(df = df)
    
  })
  
  observe({
    req(data()$df)
    updateSelectInput(session, "col1", choices = 
                        list(
                          if(length(levels(as.factor(data()$df[,1])))>1){
                            "Column 1" = colnames(data()$df)[1]},
                          
                          if(length(levels(as.factor(data()$df[,2])))>1){
                            "Column 2" = colnames(data()$df)[2]},
                          
                          if(length(levels(as.factor(data()$df[,3])))>1){
                            "Column 3" = colnames(data()$df)[3]}                          
                          )
  )
  })
  
  output$boxplot <- renderPlot({
    
    ggplot(data()$df, aes(x = as.factor(input$col1), y=column4)) +
      geom_boxplot() + geom_point()
    
    
  })
}

shinyApp(ui = ui, server = server)

Answer 1

我从 reactive 返回两个数据集, original_data这是用户上传的数据和filtered_data这是为 selectInput 返回的数据.

在ggplot代码使用 as.factor(input$col1)不会直接工作，使用 .data代词。

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

sample <- data.frame(column1  = rep('cat',10), column2 = c(rep('cat',5), rep('dog',5)),
                     column3 = c(rep('turtle',3), rep('wolf',7)), column4 = rnorm(10))
write.csv(sample, "sample.csv", row.names = FALSE) #Creating sample csv to be ingested in R shiny

ui <- fluidPage(
  headerPanel("Webpapp"),
  sidebarPanel(
    
    fileInput(inputId = "filedata", #Upload sample.csv here
              label = "Upload the Raw Data File",
              accept = c("text/csv", "text/comma-separated-values,text/plain",
                         ".csv")),
    selectInput("col1", "Select column:", choices = ""), #will be updated in server
  ),
  mainPanel(plotOutput('boxplot')),
)

server <- function(session, input, output) { 
  
  data <- reactive({
    req(input$filedata)
    df <- read.csv(input$filedata$datapath, header = T)
    list(original_data = df, 
         filtered_data = df %>% select(column1:column3) %>% select(where(~n_distinct(.) > 1)))
    
  })
  
  observe({
    req(data()$filtered_data)
    updateSelectInput(session, "col1", choices = names(data()$filtered_data))
  })
  
  output$boxplot <- renderPlot({
    req(data()$original_data, input$col1)
    ggplot(data()$original_data, aes(x = .data[[input$col1]], y=column4)) +
      geom_boxplot() + geom_point()
    
    
  })
}

shinyApp(ui = ui, server = server)