使用R Shiny中的多个条件简化表的子集

我正在编写一个类似于该图的应用shiny程序(shinydashboard)(该应用程序在公司的专用网络上运行,因此我无法共享其链接)。

ShinyApp外观

数据集由一个表组成,该表包含不同样本(列)的不同基因(行)的表达值。应用程序应根据用户选择的搜索条件返回该表的子集。有关样本的信息存储在另一个表中(代码中为B38.Metadata),如下所示:

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,...

在每次搜索时,都会检查元数据,并且相应地主表是子集。

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)

      })
   }
kluu

这就是您要达到的目标吗?根据元数据过滤与您的属性匹配的样本,并仅显示这些样本的基因表达?

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)

本文收集自互联网,转载请注明来源。

如有侵权,请联系 [email protected] 删除。

编辑于
0

我来说两句

0 条评论
登录 后参与评论

相关文章