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:
- A volcano plot, which is a scatter plot of
-log10(df$p.value)
vs.df$effect
- 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:
- If the
label
variable isn't defined inselectizeInput
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. - The list that appears does not allow selecting from it.
- 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)
Comments
Post a Comment