一个可以显示图形和 table 的 R shiny 应用程序

Question

我正在尝试编写一个 R shiny app 代码，它可以显示 plotly 图形或 datatable，并带有一些子集选项.输入数据是这个 data.frame:

set.seed(1)
df <- rbind(data.frame(contrast = rep("c1",10000),gene = paste0("g",1:10000), effect = rnorm(10000), p.value = runif(10000,0,1),stringsAsFactors = F),
            data.frame(contrast = rep("c2",10000),gene = paste0("g",1:10000), effect = rnorm(10000), p.value = runif(10000,0,1),stringsAsFactors = F),
            data.frame(contrast = rep("c3",10000),gene = paste0("g",1:10000), effect = rnorm(10000), p.value = runif(10000,0,1),stringsAsFactors = F))

是一个基因差异表达data.frame，来自3个不同的contrast，所以每个基因对于3个[=21]中的每一个都有一个effect和p.value =]s.

我希望 app 显示 plotly 'volcano plot'（-log10(p.value) 与 'effect'） -已选择 contrast，或 df 的数据 table，对于多个已选择 contrasts。

这是我正在尝试的：

suppressPackageStartupMessages(library(dplyr))
suppressPackageStartupMessages(library(shiny))
suppressPackageStartupMessages(library(shinyjs))
suppressPackageStartupMessages(library(DT))
suppressPackageStartupMessages(library(plotly))
suppressPackageStartupMessages(library(rmarkdown))

#plots a specific contrast
volcanoPlot <- function(selected.df)
{
  plot.df <- selected.df %>% dplyr::mutate(log10.p.value = -log10(p.value))
  plot.df <- cbind(plot.df,purrr::imap(plot.df, ~ paste(.y, .x, sep=": ")) %>%
                     dplyr::as_tibble() %>%
                     tidyr::unite(text, sep="\n"))
  volcano.plot <- plotly::plot_ly(type='scatter',mode="markers",marker=list(size=5,color="gray"),x=plot.df$effect,y=plot.df$log10.p.value,text=plot.df$text,hoverinfo="text",showlegend=F) %>%
    plotly::layout(xaxis=list(title="Effect Size",zeroline=F),yaxis=list(title="-log10(P-value)",zeroline=F))
  return(volcano.plot)
}

output.choices <- c("","Contrast Volcano Plot","Contrasts Table")

set.seed(1)
df <- rbind(data.frame(contrast = rep("c1",10000),gene = paste0("g",1:10000), effect = rnorm(10000), p.value = runif(10000,0,1),stringsAsFactors = F),
            data.frame(contrast = rep("c2",10000),gene = paste0("g",1:10000), effect = rnorm(10000), p.value = runif(10000,0,1),stringsAsFactors = F),
            data.frame(contrast = rep("c3",10000),gene = paste0("g",1:10000), effect = rnorm(10000), p.value = runif(10000,0,1),stringsAsFactors = F))

server <- function(input, output, session)
{
  #selection of contrasts
  output$contrasts <- renderUI({
    req(input$outputType)
    if(input$outputType == "Contrast Volcano Plot"){
      selectInput("contrasts", "Select Contrast", choices = unique(df$contrast), multiple = F)
    } else if(input$outputType == "Contrasts Table"){
      selectInput("contrasts", "Select Contrasts", choices = unique(df$contrast), multiple = T)
    }
  })
  
  volcano.plot <- reactive({
    req(input$contrasts)
    volcano.plot.list <- NULL
    selected.df <- df %>% dplyr::filter(contrast == input$contrasts)
    volcano.plot <- volcanoPlot(selected.df=selected.df)
    volcano.plot.list <- list(volcano.plot=volcano.plot,contrasts.df=selected.df)
    return(volcano.plot.list)
  })
  
  contratsTable <- reactive({
    req(input$contrasts)
    return(df %>%  dplyr::filter(contrast %in% input$contrasts))
  })
  
  output$out.plotly <- plotly::renderPlotly({
    if(input$outputType == "Contrast Volcano Plot"){
      volcano.plot()$volcano.plot
    }
  })
  
  output$out.table <- DT::renderDataTable({
    if(input$outputType == "Contrasts Table"){
      contrats.df <- contratsTable()
      DT::dataTableOutput("contrats.df")
    }
  })
  
  observeEvent(input$outputType,{
    if(input$outputType == "Contrast Volcano Plot"){
      hide("out.table")
      show("out.plotly")
    } else{
      hide("out.plotly")
      show("out.table")
    }      
  })
}

ui <- fluidPage(
  titlePanel("Shiny Explorer",windowTitle="Shiny Explorer"),
  sidebarLayout(
    sidebarPanel(
      tags$head(
        tags$style(HTML(".multicol {-webkit-column-count: 3; /* Chrome, Safari, Opera */-moz-column-count: 3; /* Firefox */column-count: 3;}")),
        tags$style(type="text/css", "#loadmessage {position: fixed;top: 0px;left: 0px;width: 100%;padding: 5px 0px 5px 0px;text-align: center;font-weight: bold;font-size: 100%;color: #000000;background-color: #CCFF66;z-index: 105;}"),
        tags$style(type="text/css",".shiny-output-error { visibility: hidden; }",".shiny-output-error:before { visibility: hidden; }")),
      conditionalPanel(condition="$('html').hasClass('shiny-busy')",tags$div("In Progress...",id="loadmessage")),
      selectInput("outputType", "Output Type", choices = output.choices),
      uiOutput("contrasts")
    ),
    mainPanel(
      plotly::plotlyOutput("out.plotly"),
      tableOutput("out.table")
    )
  )
)

shinyApp(ui = ui, server = server)

我遇到的问题是：

如果选择 "Contrast Volcano Plot" 选项，则不会出现选择对比度的列表（但如果选择 "Contrasts Table" 选项，则会出现）。
如果选择 "Contrasts Table" 选项，则 table 不会呈现，我收到此错误：

Error in <Anonymous>: 'data' must be 2-dimensional (e.g. data frame or matrix)

我认为问题 #1 与我需要渲染到不同的输出类型（plotly 图或 datatable）以及我当前的输出类型有关代码无效。

对于问题 #2，我想我可能没有正确指定要呈现的 datatable 的格式。

知道如何解决这些问题吗？

Answer 1

您应该只为给定的 inputID 定义一次 selectInput。然后你可以根据某些条件更新它。此外，您可以在 renderUI 中输出图或 table。试试这个

#plots a specific contrast
volcanoPlot <- function(selected.df)
{
  plot.df <- selected.df %>% dplyr::mutate(log10.p.value = -log10(p.value))
  plot.df <- cbind(plot.df,purrr::imap(plot.df, ~ paste(.y, .x, sep=": ")) %>%
                     dplyr::as_tibble() %>%
                     tidyr::unite(text, sep="\n"))
  volcano.plot <- plotly::plot_ly(type='scatter',mode="markers",marker=list(size=5,color="gray"),x=plot.df$effect,y=plot.df$log10.p.value,text=plot.df$text,hoverinfo="text",showlegend=F) %>%
    plotly::layout(xaxis=list(title="Effect Size",zeroline=F),yaxis=list(title="-log10(P-value)",zeroline=F))
  return(volcano.plot)
}

output.choices <- c("Contrast Volcano Plot","Contrasts Table")

set.seed(1)
df <- rbind(data.frame(contrast = rep("c1",10000),gene = paste0("g",1:10000), effect = rnorm(10000), p.value = runif(10000,0,1),stringsAsFactors = F),
            data.frame(contrast = rep("c2",10000),gene = paste0("g",1:10000), effect = rnorm(10000), p.value = runif(10000,0,1),stringsAsFactors = F),
            data.frame(contrast = rep("c3",10000),gene = paste0("g",1:10000), effect = rnorm(10000), p.value = runif(10000,0,1),stringsAsFactors = F))

server <- function(input, output, session) {
  
  #selection of contrasts
  output$contrasts <- renderUI({
    req(input$outputType)
    selectInput("contrasts", "Select Contrast", choices = unique(df$contrast), selected = unique(df$contrast)[1], multiple = T)
  })
  
  observeEvent(input$outputType, {
    if(input$outputType == "Contrast Volcano Plot"){
      updateSelectInput(session,"contrasts", choices = unique(df$contrast), selected=unique(df$contrast)[1])
    } else if(input$outputType == "Contrasts Table"){
      updateSelectInput(session,"contrasts", choices = unique(df$contrast), selected=unique(df$contrast) )
    }
    
  })
  
  volcano.plot <- reactive({
    req(input$contrasts)
    volcano.plot.list <- NULL
    selected.df <- df %>% dplyr::filter(contrast == input$contrasts[1])
    volcano.plot <- volcanoPlot(selected.df=selected.df)
    volcano.plot.list <- list(volcano.plot=volcano.plot,contrasts.df=selected.df)
    return(volcano.plot.list)
  })
  
  contrastTable <- reactive({
    req(input$contrasts)
    df %>%  dplyr::filter(contrast %in% input$contrasts)
  })
  
  output$out.plotly <- renderPlotly({
    volcano.plot()$volcano.plot
  })
  
  output$out.table <- renderDT({ contrastTable()})
  
  myoutput <- eventReactive(input$outputType,{
    if(input$outputType == "Contrast Volcano Plot"){
      plotlyOutput("out.plotly")
    } else{
      DTOutput("out.table")
    }      
  })
  
  output$plotrtable <- renderUI(myoutput())
  
}

ui <- fluidPage(
  titlePanel("Shiny Explorer",windowTitle="Shiny Explorer"),
  sidebarLayout(
    sidebarPanel(
      tags$head(
        tags$style(HTML(".multicol {-webkit-column-count: 3; /* Chrome, Safari, Opera */-moz-column-count: 3; /* Firefox */column-count: 3;}")),
        tags$style(type="text/css", "#loadmessage {position: fixed;top: 0px;left: 0px;width: 100%;padding: 5px 0px 5px 0px;text-align: center;font-weight: bold;font-size: 100%;color: #000000;background-color: #CCFF66;z-index: 105;}"),
        tags$style(type="text/css",".shiny-output-error { visibility: hidden; }",".shiny-output-error:before { visibility: hidden; }")),
      conditionalPanel(condition="$('html').hasClass('shiny-busy')",tags$div("In Progress...",id="loadmessage")),
      selectInput("outputType", "Output Type", choices = output.choices),
      uiOutput("contrasts")
    ),
    mainPanel( uiOutput("plotrtable"))
  )
)

shinyApp(ui = ui, server = server)

编辑：

或者，您可以定义两个不同的 selectInput 并根据输出选择仅显示必要的一个。

#plots a specific contrast
volcanoPlot <- function(selected.df)
{
  plot.df <- selected.df %>% dplyr::mutate(log10.p.value = -log10(p.value))
  plot.df <- cbind(plot.df,purrr::imap(plot.df, ~ paste(.y, .x, sep=": ")) %>%
                     dplyr::as_tibble() %>%
                     tidyr::unite(text, sep="\n"))
  volcano.plot <- plotly::plot_ly(type='scatter',mode="markers",marker=list(size=5,color="gray"),x=plot.df$effect,y=plot.df$log10.p.value,text=plot.df$text,hoverinfo="text",showlegend=F) %>%
    plotly::layout(xaxis=list(title="Effect Size",zeroline=F),yaxis=list(title="-log10(P-value)",zeroline=F))
  return(volcano.plot)
}

output.choices <- c("Contrast Volcano Plot","Contrasts Table")

set.seed(1)
df <- rbind(data.frame(contrast = rep("c1",10000),gene = paste0("g",1:10000), effect = rnorm(10000), p.value = runif(10000,0,1),stringsAsFactors = F),
            data.frame(contrast = rep("c2",10000),gene = paste0("g",1:10000), effect = rnorm(10000), p.value = runif(10000,0,1),stringsAsFactors = F),
            data.frame(contrast = rep("c3",10000),gene = paste0("g",1:10000), effect = rnorm(10000), p.value = runif(10000,0,1),stringsAsFactors = F))

server <- function(input, output, session) {
  
  #selection of contrasts
  # output$contrasts <- renderUI({
  #   req(input$outputType)
  #   selectInput("contrasts", "Select Contrast", choices = unique(df$contrast), selected = unique(df$contrast)[1], multiple = F)
  # })
  # output$contrasts2 <- renderUI({
  #   req(input$outputType)
  #   hidden(selectInput("contrasts2", "Select Contrast", choices = unique(df$contrast), selected = unique(df$contrast), multiple = T))
  # })
  
  observeEvent(input$outputType, {
    if(input$outputType == "Contrast Volcano Plot"){
      shinyjs::hide("contrasts2")
      shinyjs::show("contrasts")
      #updateSelectInput(session,"contrasts", choices = unique(df$contrast), selected=unique(df$contrast)[1])
    } else if(input$outputType == "Contrasts Table"){
      shinyjs::hide("contrasts")
      shinyjs::show("contrasts2")
      #updateSelectInput(session,"contrasts", choices = unique(df$contrast), selected=unique(df$contrast) )
    }
    
  })
  
  volcano.plot <- reactive({
    req(input$contrasts)
    volcano.plot.list <- NULL
    selected.df <- df %>% dplyr::filter(contrast == input$contrasts)
    volcano.plot <- volcanoPlot(selected.df=selected.df)
    volcano.plot.list <- list(volcano.plot=volcano.plot,contrasts.df=selected.df)
    return(volcano.plot.list)
  })
  
  contrastTable <- reactive({
    req(input$contrasts2)
    df %>%  dplyr::filter(contrast %in% input$contrasts2)
  })
  
  output$out.plotly <- renderPlotly({
    volcano.plot()$volcano.plot
  })
  
  output$out.table <- renderDT({ contrastTable()})
  
  myoutput <- eventReactive(input$outputType,{
    if(input$outputType == "Contrast Volcano Plot"){
      plotlyOutput("out.plotly")
    } else{
      DTOutput("out.table")
    }      
  })
  
  output$plotrtable <- renderUI(myoutput())
  
}

ui <- fluidPage(
  titlePanel("Shiny Explorer",windowTitle="Shiny Explorer"),
  sidebarLayout(
    sidebarPanel(
      useShinyjs(),
      tags$head(
        tags$style(HTML(".multicol {-webkit-column-count: 3; /* Chrome, Safari, Opera */-moz-column-count: 3; /* Firefox */column-count: 3;}")),
        tags$style(type="text/css", "#loadmessage {position: fixed;top: 0px;left: 0px;width: 100%;padding: 5px 0px 5px 0px;text-align: center;font-weight: bold;font-size: 100%;color: #000000;background-color: #CCFF66;z-index: 105;}"),
        tags$style(type="text/css",".shiny-output-error { visibility: hidden; }",".shiny-output-error:before { visibility: hidden; }")),
      conditionalPanel(condition="$('html').hasClass('shiny-busy')",tags$div("In Progress...",id="loadmessage")),
      selectInput("outputType", "Output Type", choices = output.choices),
      #uiOutput("contrasts"), uiOutput("contrasts2")
      selectInput("contrasts", "Select Contrast", choices = unique(df$contrast), selected = unique(df$contrast)[1], multiple = F),
      hidden(selectInput("contrasts2", "Select Contrast", choices = unique(df$contrast), selected = unique(df$contrast), multiple = T))
    ),
    mainPanel( uiOutput("plotrtable"))
  )
)

shinyApp(ui = ui, server = server)

一个可以显示图形和 table 的 R shiny 应用程序

An R shiny app that can display both a figure and a table

datatable

r

shiny

plotly

reactive