How make selectInput() pick up only columns with more than one category/factor in R shiny?

Question

I'm building a Shiny App where I'm uploading multiple files, carry out some operations and output some plots. My plots have a functionality to facet_wrap() by selecting from selectInput(). The selectInput() will refer to the columns in an uploaded dataset and sometimes these columns only have one factor level or a repeated value.

I do not want selectInput() to pick up these columns as faceting or grouping by them makes no difference to the plot (i.e. searching for something that facets or group can get annoying because it's a large dataset). I want to implement an observe() event where the selectInput() only picks up columns with factor levels greater than 1. I have tried using both if statements and ifelse statements but Shiny seems to crash everytime.

The original code is very complex but here's a reproducible example:

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

I return two datasets from the reactive, original_data which is the data uploaded by the user and filtered_data which is the data returned for selectInput.

In ggplot code using as.factor(input$col1) would not work directly, use .data pronoun.

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)