Combining R shiny checkboxGroupInput with other input selections - r

Question

I have these data I want to scatter plot using an R shiny server:
library(dplyr)
library(permute)
set.seed(1)
meta.df <- data.frame(gene_id=paste0("id",1:10),symbol=paste0("n",rep(permute::shuffle(5),2)),stringsAsFactors=F)
clusters.df <- data.frame(cell=paste0("c",1:100),cluster=rep(permute::shuffle(10),10),sample=paste0("s",rep(permute::shuffle(5),20)),stringsAsFactors=F)
mat <- matrix(rnorm(10*100),10,100,dimnames=list(meta.df$gene_id,clusters.df$cell))
tsne.obj <- Rtsne::Rtsne(t(mat))
tsne.df <- as.data.frame(tsne.obj$Y) %>% dplyr::rename(tSNE1=V1,tSNE2=V2) %>% cbind(clusters.df)
samples <- c("all",unique(clusters.df$sample))
samples.choices <- 1:length(samples)
names(samples.choices) <- samples
Since I want to be able to select a specific meta.df$symbol, which is redundant within meta.df$gene_id, each has a selection list, where the second is conditioned on the first.
Since the data are comprised of several samples, I'd like to be able to subset the data by sample in a reactive way, hence I have a sample choice checkbox, with the "all" option that selects all samples (just coz it's easier than checking all boxes).
So here's my shiny code:
server <- function(input, output)
{
chosen.samples <- reactive({
validate(
need(input$samples.choice != "",'Please choose at least one of the sample checkboxes')
)
samples.choice <- input$samples.choice
if("all" %in% samples.choice) samples.choice <- samples[-which(samples == "all")]
samples.choice
})
output$gene_id <- renderUI({
selectInput("gene_id", "Gene ID", choices = unique(dplyr::filter(meta.df,symbol == input$symbol)$gene_id))
})
scatter.plot <- reactive({
if(!is.null(input$symbol) & !is.null(input$gene_id)){
# subset of data
gene.symbol <- input$symbol
gene.id <- input$gene_id
row.idx <- which(rownames(mat) == gene.id)
col.idx <- which(colnames(mat) %in% dplyr::filter(clusters.df,sample %in% chosen.samples())$cell)
gene.df <- suppressWarnings(dplyr::left_join(tsne.df %>% dplyr::filter(sample %in% chosen.samples()),data.frame(cell=colnames(mat)[col.idx],value=mat[row.idx,col.idx],stringsAsFactors=F),by=c("cell"="cell")))
scatter.plot <- plotly::plot_ly(marker=list(size=12),type='scatter',mode="markers",color=~gene.df$value,x=~gene.df$tSNE1,y=~gene.df$tSNE2,showlegend=F) %>%
plotly::layout(xaxis=list(title="tSNE1",zeroline=F,showticklabels=F),yaxis=list(title="tSNE2",zeroline=F,showticklabels=F))
scatter.plot
}
})
output$Embedding <- renderPlot({
scatter.plot()
})
output$save <- downloadHandler(
filename = function() {
paste0(dplyr::filter(meta.df,symbol == input$symbol,gene_id == input$gene_id)$symbol,"_",dplyr::filter(meta.df,symbol == input$symbol,gene_id == input$gene_id)$gene_id,".pdf")
},
content = function(file) {
plotly::export(scatter.plot(),file=file)
}
)
}
ui <- fluidPage(
# App title ----
titlePanel("Results Explorer"),
# Sidebar layout with a input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# select samples
checkboxGroupInput("samples.choice", "Samples",choices = samples.choices,selected=1),
# select gene symbol
selectInput("symbol", "Gene Symbol", choices = unique(meta.df$symbol)),
# select gene id
uiOutput("gene_id"),
# select plot type
selectInput("plot.type", "Plot Type", choices = c("tSNE","PCA")),
# save plot as html
downloadButton('save', 'Save as PDF')
),
# Main panel for displaying outputs ----
mainPanel(
# The plot is called Embedding and will be created in ShinyServer part
plotOutput("Embedding")
)
)
)
shinyApp(ui = ui, server = server)
The problem is that it doesn't seem to actually select the samples, and hence the plot that is displayed has no points.
It works find if I simply eliminate the samples selection code by replacing:
col.idx <- which(colnames(mat) %in% dplyr::filter(clusters.df,sample %in% chosen.samples())$cell)
gene.df <- suppressWarnings(dplyr::left_join(tsne.df %>% dplyr::filter(sample %in% chosen.samples()),data.frame(cell=colnames(mat)[col.idx],value=mat[row.idx,col.idx],stringsAsFactors=F),by=c("cell"="cell")))
with:
col.idx <- which(colnames(mat) %in% dplyr::filter(clusters.df,sample %in% samples[2:3])$cell)
gene.df <- dplyr::left_join(tsne.df %>% dplyr::filter(sample %in% samples[2:3]),data.frame(cell=colnames(mat)[col.idx],value=mat[row.idx,col.idx],stringsAsFactors=F),by=c("cell"="cell"))
I see that in this example the entire data are subsetted in the dat_reac reactive block. I'd expect simply getting the samples to subset by would be enough. Any idea why it doesn't work and how to get it right?

Answer 1

There are two mistakes in your code. The first one is in checkboxGroupInput
Instead of
checkboxGroupInput("samples.choice", "Samples",choices = samples.choices,selected=1)
it should be
checkboxGroupInput("samples.choice", "Samples",choices = names(samples.choices),selected="all")
The second is scatter.plot() is plotly object hence you should use plotly::plotlyOutput("Embedding") and output$Embedding <- plotly::renderPlotly({
scatter.plot()
})
Here is the code with above modification which should work:
server <- function(input, output)
{
chosen.samples <- reactive({
validate(
need(input$samples.choice != "",'Please choose at least one of the sample checkboxes')
)
samples.choice <- input$samples.choice
if("all" %in% samples.choice) samples.choice <- samples[-which(samples == "all")]
samples.choice
})
output$gene_id <- renderUI({
selectInput("gene_id", "Gene ID", choices = unique(dplyr::filter(meta.df,symbol == input$symbol)$gene_id))
})
scatter.plot <- reactive({
if(!is.null(input$symbol) & !is.null(input$gene_id)){
# subset of data
gene.symbol <- input$symbol
gene.id <- input$gene_id
row.idx <- which(rownames(mat) == gene.id)
col.idx <- which(colnames(mat) %in% dplyr::filter(clusters.df,sample %in% chosen.samples())$cell)
gene.df <- suppressWarnings(dplyr::left_join(tsne.df %>% dplyr::filter(sample %in% chosen.samples()),data.frame(cell=colnames(mat)[col.idx],value=mat[row.idx,col.idx],stringsAsFactors=F),by=c("cell"="cell")))
scatter.plot <- plotly::plot_ly(marker=list(size=12),type='scatter',mode="markers",color=~gene.df$value,x=~gene.df$tSNE1,y=~gene.df$tSNE2,showlegend=F) %>%
plotly::layout(xaxis=list(title="tSNE1",zeroline=F,showticklabels=F),yaxis=list(title="tSNE2",zeroline=F,showticklabels=F))
scatter.plot
}
})
output$Embedding <- plotly::renderPlotly({
scatter.plot()
})
output$save <- downloadHandler(
filename = function() {
paste0(dplyr::filter(meta.df,symbol == input$symbol,gene_id == input$gene_id)$symbol,"_",dplyr::filter(meta.df,symbol == input$symbol,gene_id == input$gene_id)$gene_id,".pdf")
},
content = function(file) {
plotly::export(scatter.plot(),file=file)
}
)
}
ui <- fluidPage(
# App title ----
titlePanel("Results Explorer"),
# Sidebar layout with a input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# select samples
checkboxGroupInput("samples.choice", "Samples",choices = names(samples.choices),selected="all"),
# select gene symbol
selectInput("symbol", "Gene Symbol", choices = unique(meta.df$symbol)),
# select gene id
uiOutput("gene_id"),
# select plot type
selectInput("plot.type", "Plot Type", choices = c("tSNE","PCA")),
# save plot as html
downloadButton('save', 'Save as PDF')
),
# Main panel for displaying outputs ----
mainPanel(
# The plot is called Embedding and will be created in ShinyServer part
# plotOutput("Embedding")
plotly::plotlyOutput("Embedding")
)
)
)
shinyApp(ui = ui, server = server)
Hope it helps!