simplify the subset of a table using multiple conditions in R shiny

Question

I am writing a shiny app (shinydashboard) that looks like the figure (the app run on my company private network,so I can't share the link to it).

The dataset consists of a table containing the expression values of different genes (rows) for different samples (columns). The app should return a subset of that table based on the search criteria selected by the user. Information about the samples are stored in a different table (B38.Metadata in the code), that looks like this:

SampleID,RNA.ID,RNAseq.ID,Name,Description,Tissue Type,...
CP3027,CP3027,74,Hs514,Aortic_Endothelial,Vascular system,Endothelial,...
CP3028,CP3028,76,HEr1,Aortic_Endothelial,Vascular system,Endothelial,...

At every search, the metadata are checked and the main table is subset accordingly.

My approach has been to write a function for each search types (SearchByGene,SearchByTissue,...), and use if-else statements to account for all the possible combinations. For example, filter by GeneName, Tissue type, and Name, but not for the other options.

This led to a massive 14 if-else block, spanning almost 50 lines of code (see below). everything works, but the code is dreadful to read and debug. Furthermore the idea of adding additional search possibilities (e.g. search by sequencing technique) made me shiver.

I considered using a switch construct, but, having multiple conditions to test I'm not sure it will clean the code too much.

Is there a way of simplify the if-else block with something easier to read and, especially, maintain?

   Searchfunction <- function(dataSet2){
      selectedTable <- reactive({

         # Create a DF with only the gene names
         DFgeneLevel <- DummyDFgeneLevel(dataSet2)  # not used for now

         # Subset by Columns first
         if(is.null(input$tissues) && is.null(input$samples) && is.null(input$Name)){
            TableByColumns <- dataSet2
         } else if(!is.null(input$tissues) && !is.null(input$samples) && !is.null(input$Name)){
            TableByTissue <- SearchByTissue(input$tissues,B38.metadata,dataSet2)
            TableBySample <- SearchBySample(input$samples,TableByTissue)
            TableByColumns <- SearchByName(input$Name,B38.metadata,TableBySample)
         } else if(!is.null(input$tissues)){
            if(is.null(input$samples) && is.null(input$Name)){
               TableByColumns <- SearchByTissue(input$tissues,B38.metadata,dataSet2)
            } else if(is.null(input$samples) && !is.null(input$Name)){
               TableByTissue <- SearchByTissue(input$tissues,B38.metadata,dataSet2)
               TableByColumns <- SearchByName(input$Name,B38.metadata,TableByTissue)
            } else if(!is.null(input$samples) && is.null(input$Name)){
               TableByTissue <- SearchByTissue(input$tissues,B38.metadata,dataSet2)
               TableByColumns <- SearchBySample(input$samples,TableByTissue)
            }
         } else if(is.null(input$tissues)){
            if(is.null(input$samples) && !is.null(input$Name)){
               TableByColumns <- SearchByName(input$Name,B38.metadata,dataSet2)
            } else if(!is.null(input$samples) && is.null(input$Name)){
               TableByColumns <- SearchBySample(input$samples,dataSet2)
            } else if(!is.null(input$samples) && !is.null(input$Name)){
               TableByName <- SearchBySample(input$samples,dataSet2)
               TableByColumns <- SearchByName(input$Name,B38.metadata,TableByName)
            }
         }

         # Collect all the inputs & subset by Rows
         #genes.Selected <- toupper(genes.Selected) # can't use it as some genes contains lowerletters
         genesFromList <- unlist(strsplit(input$genesLists,","))
         genes.Selected <- unlist(strsplit(input$SearchCrit," "))

         if(input$SearchCrit == '' && input$genesLists == 0){
            TableByRow <- TableByColumns
         } else if(input$SearchCrit != '' && input$genesLists != 0){
            TableByList <- subset(TableByColumns, TableByColumns$GeneName %in% genesFromList)
            TableByRow <- subset(TableByList, TableByList$GeneName %in% genes.Selected)
         } else if(input$SearchCrit != '' && input$genesLists == 0){
            TableByRow <- subset(TableByColumns, TableByColumns$GeneName %in% genes.Selected)
         } else if(input$SearchCrit == '' && input$genesLists != 0) {
            TableByRow <- subset(TableByColumns, TableByColumns$GeneName %in% genesFromList)
         }

         return(TableByRow)

      })
   }

Answer 1

Is that what you are trying to achieve ? Filter samples that match your attributes based on your metadata and display gene expressions only for these samples ?

library(shiny)
library(dplyr)

ui <- fluidPage(

  titlePanel("mtcars"),

  sidebarLayout(
    sidebarPanel(
      selectInput("vs", 
                  label = "vs",
                  choices = c(0, 1),
                  selected = NULL,
                  multiple = TRUE),
      selectInput("carb", 
                  label = "carb",
                  choices = c(1, 2, 3, 4, 6, 8),
                  selected = NULL,
                  multiple = TRUE),
      selectInput("gear", 
                  label = "gear",
                  choices = c(3, 4, 5),
                  selected = NULL,
                  multiple = TRUE)
    ),


    mainPanel(
      tabsetPanel(
        tabPanel("Expression values", tableOutput("mainTable")),
        tabPanel("ID filtering", tableOutput("table"))
      )
    )
  )
)

server <- function(input, output) {

  samples.df <- data.frame(ID = paste0("ID", as.character(round(runif(nrow(mtcars), 
                                                                      min = 0, 
                                                                      max = 100 * nrow(mtcars))))), 
                           gear = as.factor(mtcars$gear),
                           carb = as.factor(mtcars$carb),
                           vs = as.factor(mtcars$vs))

  values.df <- cbind(paste0("Feature", 1:20), 
                     as.data.frame(matrix(runif(20 * nrow(samples.df)), nrow = 20)))

  colnames(values.df) <- c("Feature", as.character(samples.df$ID))

  vs.values <- reactive({
    if (is.null(input$vs)) {
      return(c(0, 1))
    } else {
      return(input$vs)
    } 
  })

  carb.values <- reactive({
    if (is.null(input$carb)) {
      return(c(1, 2, 3, 4, 6, 8))
    } else {
      return(input$carb)
    } 
  })

  gear.values <- reactive({
    if (is.null(input$gear)) {
      return(c(3, 4, 5))
    } else {
      return(input$gear)
    } 
  })

  filtered.samples.df <- reactive({
    return(samples.df %>% filter(gear %in% gear.values(),
                                 vs %in% vs.values(),
                                 carb %in% carb.values()))
  })

  filtered.values.df <- reactive({
    selected.samples <- c("Feature", names(values.df)[names(values.df) %in% filtered.samples.df()$ID])
    return(values.df %>% select(selected.samples))
  })

  output$mainTable <- renderTable({
    filtered.values.df()
  })

  output$table <- renderTable({
    filtered.samples.df()
  })


}

shinyApp(ui = ui, server = server)

Answer 2

You can try something like this, where we loop over the inputs and subset on the according column if the input is not null.

Hope this helps!

library(shiny)

ui <- fluidPage(
selectizeInput('mpg','mpg:',unique(mtcars$mpg),multiple=T),
selectizeInput('cyl','cyl:',unique(mtcars$cyl),multiple=T),
selectizeInput('gear','gear:',unique(mtcars$gear),multiple=T),
selectizeInput('carb','carb:',unique(mtcars$carb),multiple=T),
tableOutput('mytable')
)

server <- function(input,output)
{
  output$mytable <- renderTable({
    df = mtcars
    select_inputs = c('mpg','cyl','gear','carb')
    for (inp in select_inputs)
    {
      if(!is.null(input[[inp]]))
      {
        df = df[df[[inp]] %in% input[[inp]],]
      }
    }

    df

  })
}

shinyApp(ui,server)