在 renderUI 中使用 shiny 的 selectizeInput 和 updateSelectizeInput

Question

我的基本 shiny app 示例有一个 data.frame 20,000 个基因，每个基因都有一个效应和 p.value 数值：

set.seed(1)
df <- data.frame(gene = paste0("g",1:20000), effect = rnorm(20000), p.value = runif(20000,1,0), stringsAsFactors = F)

我的 app 有两个输出选项要显示：

火山图，它是 -log10(df$p.value) 与 df$effect
与选项 1 相同，但允许用户 select 多个基因在火山图中以红色突出显示

而且我希望基因列表（从 select 开始）仅在选项 1 由用户 select 编辑时出现。

在 server 中有一个 renderUI 而在 selectInput 中 choices 参数包含所有 20,000 个基因太慢了，所以我跟着 this tutorial 使用 selectizeInput 和 updateSelectizeInput.

下面是我的 app 代码，我在其中定义了 ui 中的 selectizeInput 和 server 中的 updateSelectizeInput。

它不符合我的要求：

如果 label 变量未在 selectizeInput 中定义，则会抛出错误：Error in dots_list(...) : argument "label" is missing, with no default。但是，如果我确实定义了它，那么默认情况下会出现该框，而不是以用户 selecting 选项 2 为条件。
显示的列表不允许从中 selecting。
我的应用程序不显示渲染图。

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

volcanoPlot <- function(df,selected.gene.set=NULL)
{
  plot.df <- 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"))
  if(!is.null(selected.gene.set)){
    plot.df$group <- "unselected"
    plot.df$group[which(plot.df$gene %in% selected.gene.set)] <- "selected"
    plot.df$group <- factor(plot.df$group,levels=c("unselected","selected"))
    volcano.plot <- plotly::plot_ly(type='scatter',mode="markers",marker=list(size=5),color=plot.df$group,colors=c("lightgray","darkred"),x=plot.df$effect,y=plot.df$log10.p.value,text=plot.df$text,hoverinfo="text",showlegend=F) %>%
      plotly::layout(xaxis=list(title="Effect",zeroline=F),yaxis=list(title="-log10(P-value)",zeroline=F))
  } else{
    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",zeroline=F),yaxis=list(title="-log10(P-value)",zeroline=F))
  }
  return(volcano.plot)
}

output.choices <- c("","Volcano Plot","Highlighted Gene Set Volcano Plot")
set.seed(1)
df <- data.frame(gene = paste0("g",1:20000), effect = rnorm(20000), p.value = runif(20000,0,1), stringsAsFactors = F)

server <- function(input, output, session)
{
  output$selected.gene.set <- renderUI({
    req(input$outputType == "Highlighted Gene Set Volcano Plot")
    updateSelectizeInput(session,"selected.gene.set","Select Genes to Highlight",choices=unique(df$gene),multiple=T)
  })

  volcano.plot <- reactive({
    req(input$outputType)
    if(input$outputType == "Volcano Plot"){
      volcano.plot <- volcanoPlot(df=df)
    } else{
      req(input$selected.gene.set)
      volcano.plot <- volcanoPlot(df=df,selected.gene.set=input$selected.gene.set)
    }
    return(volcano.plot)
  })

  output$out.plotly <- plotly::renderPlotly({
    volcano.plot()$volcano.plot
  })
}

ui <- fluidPage(
  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),
      selectizeInput(inputId='selected.gene.set',label="Select Genes to Highlight",choices=NULL)
    ),
    mainPanel(
      plotly::plotlyOutput("out.plotly")
    )
  )
)

shinyApp(ui = ui, server = server)

Answer 1

数据：

set.seed(1)
df <- data.frame(gene = paste0("g",1:20000), effect = rnorm(20000), p.value = runif(20000,0,1), stringsAsFactors = F)


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

volcanoPlot <- function(plot.df,selected.gene.set=NULL)
{
  plot.df <- plot.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"))
  if(!is.null(selected.gene.set)){
    plot.df$group <- "unselected"
    plot.df$group[which(plot.df$gene %in% selected.gene.set)] <- "selected"
    plot.df$group <- factor(plot.df$group,levels=c("unselected","selected"))
    volcano.plot <- plotly::plot_ly(type='scatter',mode="markers",marker=list(size=5),color=plot.df$group,colors=c("lightgray","darkred"),x=plot.df$effect,y=plot.df$log10.p.value,text=plot.df$text,hoverinfo="text",showlegend=F) %>%
      plotly::layout(xaxis=list(title="Effect",zeroline=F),yaxis=list(title="-log10(P-value)",zeroline=F))
  } else{
    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",zeroline=F),yaxis=list(title="-log10(P-value)",zeroline=F))
  }
  return(volcano.plot)
}

output.choices <- c("","Volcano Plot","Highlighted Gene Set Volcano Plot")

server <- function(input, output, session)
{
  observeEvent(input$outputType,{
    if(req(input$outputType == "Highlighted Gene Set Volcano Plot"))
      updateSelectizeInput(session,"selected.gene.set","Select Genes to Highlight",choices=unique(df$gene),server=T)
  })
  
  volcano.plot <- reactive({
    req(input$outputType)
    if(input$outputType == "Volcano Plot"){
      v.plot <- volcanoPlot(plot.df=df)
    } else{
      req(input$selected.gene.set)
      v.plot <- volcanoPlot(plot.df=df,selected.gene.set=input$selected.gene.set)
    }
    return(v.plot)
  })

  output$out.plotly <- plotly::renderPlotly({
    volcano.plot()
  })
}

ui <- fluidPage(
  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),
      conditionalPanel(condition = "input.outputType=='Highlighted Gene Set Volcano Plot'",selectizeInput(inputId="selected.gene.set",label=NULL,multiple=T,choices=NULL))
    ),
    mainPanel(
      plotly::plotlyOutput("out.plotly")
    )
  )
)

shinyApp(ui = ui, server = server)

在 renderUI 中使用 shiny 的 selectizeInput 和 updateSelectizeInput

Working with shiny's selectizeInput and updateSelectizeInput inside renderUI

r

shiny

plotly

selectize.js

renderui