使用R闪亮

时间:2018-02-22 11:33:20

标签: r shiny shinydashboard

我正在编写一个shiny应用程序(shinydashboard),看起来像这个数字(该应用程序在我公司的专用网络上运行,因此我无法与之分享链接)。< / p>

ShinyApp look

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

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

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

我的方法是为每种搜索类型(SearchByGene,SearchByTissue,...)编写一个函数, 使用if-else语句来说明所有可能的组合。 例如,按GeneName,Tissue type和Name进行过滤,但不能用于其他选项。

这导致了一个巨大的14 if-else块,跨越了近50行代码(见下文)。 一切正常,但代码读取和调试可怕。 此外,增加额外搜索可能性的想法(例如通过测序技术搜索) 让我颤抖。

我考虑使用switch构造,但是,有多个条件来测试我不确定它是否会过多地清理代码。

有没有办法简化if-else块,更易于阅读,尤其是维护?

   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)

      })
   }

2 个答案:

答案 0 :(得分:1)

你可以尝试这样的事情,如果输入不为null,我们会在相应列上循环输入和子集。

希望这有帮助!

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)

答案 1 :(得分:1)

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

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)