Saving values during an R shiny session - r

Question

I have a single-cell gene x cell expression data that I'd like to explore using a shiny app. The cells come from samples and are clustered according to a prior clustering run.
Here is a toy example data set:
suppressPackageStartupMessages(library(dplyr))
suppressPackageStartupMessages(library(plotly))
suppressPackageStartupMessages(library(shiny))
set.seed(1)
mat <- matrix(rnorm(1000*1000),nrow=1000,dimnames = list(paste0("gene",1:1000),paste0("cell",1:1000)))
meta.df <- data.frame(cell=colnames(mat),
sample=sample(paste0("sample",1:10),1000,replace=T),
cluster=sample(paste0("cluster",1:5),200,replace=T),
stringsAsFactors = F)
There are two functionalities that I'd like to enable:
View the tSNE 2D embedding of the entire data allowing to choose a gene where the points in the tSNE 2D embedding scatter plot will be colored by its expression values.
Be able to select a specific set of genes and clusters and/or samples on which tSNE will be re-run, and again view this 2D embedding coloring the points according to the expression levels of a chosen gene (in this case obviously the selection options is subsetted to be one of the selected genes).
Here's the tSNE embedding on all the data:
all.data.tsne.df <- data.frame(Rtsne::Rtsne(t(mat))$Y) %>%
rename(tSNE1=X1,tSNE2=X2) %>% cbind(meta.df)
For the second functionality, since one might like to color code many genes using the same tSNE embedding, and since a Rtsne run can take a while to run, I thought I'd save any gene and cell subset tSNE embedding in a list named by the chosen genes and cells, and always check if this subset already exists before running the Rtsne on it.
So at the top of the shiny code I create the options for subsetting samples and clusters and an empty tSNE list:
samples <- c("all",unique(meta.df$sample))
samples.choices <- 1:length(samples)
names(samples.choices) <- samples
clusters <- c("all",unique(meta.df$cluster))
clusters.choices <- 1:length(clusters)
names(clusters.choices) <- clusters
color.vec <- c("lightgray","darkred")
subset.tsne.map <- NULL
Here's my server 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
})
chosen.clusters <- reactive({
validate(
need(input$clusters.choice != "",'Please choose at least one of the cluster checkboxes')
)
clusters.choice <- input$clusters.choice
if("all" %in% clusters.choice) clusters.choice <- clusters[-which(clusters == "all")]
clusters.choice
})
output$gene <- renderUI({
if(input$plotType == "Gene-Subset tSNE"){
selectInput("gene", "Color by Gene", choices = unique(input$subset.genes))
} else{
selectInput("gene", "Color by Gene", choices = rownames(mat))
}
})
scatter.plot <- reactive({
if(!is.null(input$gene)){
row.idx <- which(rownames(mat) == input$gene)
col.idx <- which(colnames(mat) %in% filter(meta.df,cluster %in% chosen.clusters(),sample %in% chosen.samples())$cell)
#col.idx <- which(colnames(mat) %in% filter(meta.df,cluster %in% "cluster4",sample %in% unique(meta.df$sample))$cell)
if(input$plotType != "Gene-Subset tSNE"){
# subset of data
gene.tsne.df <- left_join(all.data.tsne.df %>% filter(cluster %in% chosen.clusters(),sample %in% chosen.samples()),data.frame(cell=colnames(mat)[col.idx],value=mat[row.idx,col.idx]),by=c("cell"="cell"))
scatter.plot <- plot_ly(marker=list(size=6),type='scatter',mode="markers",color=~gene.tsne.df$value,x=~gene.tsne.df$tSNE1,y=~gene.tsne.df$tSNE2,showlegend=F,colors=colorRamp(color.vec)) %>%
layout(xaxis=list(title="tSNE1",zeroline=F,showticklabels=F),yaxis=list(title="tSNE2",zeroline=F,showticklabels=F)) %>%
colorbar(limits=c(min(gene.tsne.df$value,na.rm=T),max(gene.tsne.df$value,na.rm=T)),len=0.4,title="Expression")
break
} else{
subset.genes <- sort(unique(input$subset.genes))
subset.row.idx <- which(rownames(mat) %in% subset.genes)
if(!is.null(subset.tsne.map)){
idx <- which(names(subset.tsne.map) == paste0(paste(subset.row.idx,collapse="_"),":",paste(col.idx,collapse="_")))
if(length(idx) > 0){
subset.tsne.df <- subset.tsne.map[[idx]] %>% mutate(value=mat[row.idx,col.idx])
scatter.plot <- plot_ly(marker=list(size=6),type='scatter',mode="markers",color=~subset.tsne.df$value,x=~subset.tsne.df$tSNE1,y=~subset.tsne.df$tSNE2,showlegend=F,colors=colorRamp(color.vec)) %>%
layout(xaxis=list(title="tSNE1",zeroline=F,showticklabels=F),yaxis=list(title="tSNE2",zeroline=F,showticklabels=F)) %>%
colorbar(limits=c(min(subset.tsne.df$value,na.rm=T),max(subset.tsne.df$value,na.rm=T)),len=0.4,title="Expression")
}
} else{
subset.tsne.df <- data.frame(t(mat[subset.row.idx,col.idx]),cell=colnames(mat)[col.idx]) %>% left_join(meta.df %>% filter(cell %in% colnames(mat)[col.idx]) %>% select(cell,cluster),by=c("cell"="cell"))
tsne.perplexity <- 10*length(subset.row.idx)
while(tsne.perplexity >= 1){
set.seed(1)
tsne.obj <- try(Rtsne::Rtsne(subset.tsne.df %>% select(-cell,-cluster),perplexity=tsne.perplexity),silent=T)
if(class(tsne.obj)[1] != "try-error"){
subset.tsne.df <- cbind(subset.tsne.df,data.frame(tsne.obj$Y) %>% rename(tSNE1=X1,tSNE2=X2))
subset.tsne.map[[length(subset.tsne.map)+1]] <- subset.tsne.df
names(subset.tsne.map)[length(subset.tsne.map)] <- paste0(paste(subset.row.idx,collapse="_"),":",paste(col.idx,collapse="_"))
subset.tsne.df <- subset.tsne.df %>% mutate(value=mat[row.idx,col.idx])
scatter.plot <- plot_ly(marker=list(size=6),type='scatter',mode="markers",color=~subset.tsne.df$value,x=~subset.tsne.df$tSNE1,y=~subset.tsne.df$tSNE2,showlegend=F,colors=colorRamp(color.vec)) %>%
layout(xaxis=list(title="tSNE1",zeroline=F,showticklabels=F),yaxis=list(title="tSNE2",zeroline=F,showticklabels=F)) %>%
colorbar(limits=c(min(subset.tsne.df$value,na.rm=T),max(subset.tsne.df$value,na.rm=T)),len=0.4,title="Expression")
} else{
tsne.perplexity <- tsne.perplexity-2
}
}
}
}
scatter.plot
}
})
output$Embedding <- renderPlotly({
scatter.plot()
})
output$save <- downloadHandler(
filename = function() {
paste0("../shiny/",input$gene,".",input$plotType,".pdf")
},
content = function(file) {
plotly::export(scatter.plot(),file=file)
}
)
}
And here's my UI code:
ui <- fluidPage(
# App title ----
titlePanel("Results Explorer"),
# Sidebar layout with a input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
## custom CSS for 3 column layout (used below for mechanics filter options)
tags$head(
tags$style(HTML(".multicol {-webkit-column-count: 3; /* Chrome, Safari, Opera */-moz-column-count: 3; /* Firefox */column-count: 3;}"))),
## use the css, assuming your long list of vars comes from global.R
wellPanel(tags$div(class="multicol",checkboxGroupInput("samples.choice", "Samples",choices = names(samples.choices),selected="all"))),
wellPanel(tags$div(class="multicol",checkboxGroupInput("clusters.choice", "Clusters",choices = names(clusters.choices),selected="all"))),
# select plot type
selectInput("plotType", "Plot Type", choices = c("tSNE","Gene-Subset tSNE")),
#in case Gene Subset tSNE was chose select the genes
conditionalPanel(condition="input.plotType=='Gene-Subset tSNE'",
selectizeInput(inputId="subset.genes",label="Subset Genes for tSNE",choices=rownames(mat),selected=rownames(mat)[1],multiple=T)),
# select gene
uiOutput("gene"),
# 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
plotlyOutput("Embedding")
)
)
)
shinyApp(ui = ui, server = server)
It doesn't seem to be updating subset.tsne.map and each gene that is selected, even for the same sets of cells and genes, it run Rtsne again.
Is it possible to update subset.tsne.map with previously selected subsets at all? and if so am I doing it correctly?