rshinyplotlyselectize.jsrenderui

Working with shiny's selectizeInput and updateSelectizeInput inside renderUI

My basic shiny app example has a data.frame of 20,000 genes, each with an effect and p.value numerical values:

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

And my app has two output options to display:

  1. A volcano plot, which is a scatter plot of -log10(df$p.value) vs. df$effect
  2. The same as option 1, but allowing the user to select multiple genes to be highlighted in red in the volcano plot

And I'd like the list of genes (to select from) only to appear if option 1 was selected by the user.

Having a renderUI within in the server where in the selectInput the choices argument has all 20,000 genes is too slow, so I followed this tutorial using selectizeInput and updateSelectizeInput.

Below is my app code, where I'm defining the selectizeInput within the ui and the updateSelectizeInput within the server.

It doesn't do what I want:

  1. If the label variable isn't defined in selectizeInput it throws the error: Error in dots_list(...) : argument "label" is missing, with no default. But if I do define it, that box appears by default rather than conditioned on the user selecting option 2.
  2. The list that appears does not allow selecting from it.
  3. My app doesn't display the rendered plot.
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)
Solution

  • data:

    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)