Hi, thanks for your reply. This is what I have written for the app locally.
library(shiny)
library(ggplot2)
library(utils)
library(base)
library(shinyWidgets)
library(dqshiny)
fonts <- list("Liberation Sans")
# Function to capitalize user-typed inputs
# Takes "gene" as input and returning "Gene"
capgene <- function(gene){
gene <- paste0(tolower(substring(gene, 1, 1)), tolower(substring(gene, 2)))
paste0(toupper(substring(gene, 1, 1)), substring(gene, 2))
}
# Grep, wrapped in a function to pre-set options
format.grep <- function(gg){
grep(substr(capgene(gg), 1, 3), dict$GENES, value = T, ignore.case = T)
}
# Function to draw feature plots from user-defined variables
simpleFeaturePlot <- function(gene = "Rbfox3",
color.use = 'red',
threshold = 0,
pt.size = 1,
to.include = "MSMO",
scale = 900){
# Identify which data sets were user-selected and add the plotting coordinates to "frame" variable
# If no data sets selected, return empty plot & exit function
if('MSMO' %in% to.include){
frame <- rbind(frame, MSMO.frame)
}
if('GSMO' %in% to.include){
frame <- rbind(frame, GSMO.frame)
}
if(length(to.include) == 0){d <- ggplot() + theme_classic() +
annotate("text", size = 12, fontface = 2,
color = color.use, x = 0, y = 0, label = "No Data Selected")
return(d)
}
# Translate gene to caps format (Gene, not gene or GENE)
gene <- capgene(gene)
# Build named list of data filehandles from vector of included datasets
fh <- lapply(to.include, FUN = function(sm) as.character(dict[which(dict$GENES == gene), paste(sm, sep = "_")]))
names(fh) <- paste(to.include, sep = "_")# Extract relevant gene from staged data files for each sample
for(sm in to.include){
data <- c(data, readRDS(paste0(sm, "/staged/", fh[[paste(sm, sep = '_')]]))[gene, ])
}
# Set background & highlight colors
colors <- c(grey(level = 0.7, alpha = 0.7), color.use)
names(colors) <- c('None', paste0(gene))
# Get Plotting Coordinates
frame <- cbind(frame,
as.data.frame(matrix(data = 0,
nrow = nrow(frame),
ncol = 1)))
#adjust if umap
colnames(frame) <- c('umap_1', 'umap_2', 'Plot.Status')
# Identify cells with expression of target gene
positive_cells <- names(data[data > threshold])
frame[which(rownames(frame) %in% positive_cells), 'Plot.Status'] <- paste0(gene)
# Divide coordinate data to plot negatives (first) below positives (second)
frame1 <- frame[which(frame[, 'Plot.Status'] == 0), ]
frame2 <- frame[which(frame[, 'Plot.Status'] != 0), ]
# Plot it. Return ggplot object & exit function, change to umap
d <- ggplot(mapping = aes(x = umap_1, y = umap_2)) +
geom_point(data = frame1, color = colors[1], size = pt.size) +
geom_point(data = frame2, aes(color = Plot.Status), size = pt.size, show.legend = F) +
scale_colour_manual(values = colors) + theme_classic() +
annotate("text", size = 6, fontface = 2, color = color.use, x = (min(frame$umap_1)+abs(0.1*min(frame$umap_1))), y = max(frame$umap_2), label = gene)
return(d)
}
# Pre-Load mapping coordinates and dictionaries. Establish placeholders for plotting variables
# This speeds up response time to user inputs
# Could be moved into the previous function for improved memory management if needed
GSMO.frame <- readRDS('GSMO/GSMO_xy.rds')
MSMO.frame <- readRDS('MSMO/MSMO_xy.rds')
dict <- readRDS('consensus_dict.rds')
frame <- c()
data <- c()
# Define UI. Shinythemes is an EASY way to pre-format color schemes & box styles.
# If making changes, BE CAREFUL to clean up commas when adding/removing panel elements
ui <- fluidPage(width = 8, theme = shinythemes::shinytheme("slate"),
# Application title
titlePanel("GSMO vs MSMO viewer"),
# Sidebar layouts
sidebarLayout(
# Panel to take gene inputs from user
sidebarPanel(
div(class = "panel panel-warning",
style = "box-shadow: 5px 5px 15px -5px rgba(0, 0, 0, 0.3);",
strong(div(class = "panel-heading", "Gene Options")),
# Which gene to plot
div(class = "panel-body",
strong(textInput("gene", "Gene", value = 'Rbfox3')),
#textInput(inputId = "gene" this means variable, label = "Gene Name", value = 'Mki67'),
# What threshold to use for calling positive values
sliderInput("threshold", "Expression Threshold (nUMI)",
min = 0.00,
max = 5.00,
step = 0.25,
value = 1),
selectInput("color", "Gene Color:",
c('Cyan' = "#00aeef", 'Sky Blue' = "#41b6e6", 'Teal' = "#487f84",
'Kelly Green' = "#348338", 'Sea Green' = "#006c5b", 'Olive' = "#5c8118",
'Orange' = "#c35413", 'Red' = "#da291c", 'Magenta' = "#c6007e",
'Purple' = "#6558b1", 'Grape' = "#6d2077"), selected = "#c35413")
))
, # Check box for data set selection, warning panel means the text is bold header is orange.
div(class = "panel panel-warning",
style = "box-shadow: 5px 5px 15px -5px rgba(0, 0, 0, 0.3);",
strong(div(class = "panel-heading", "Dataset Selection")),
checkboxGroupButtons(inputId = "dataset", label ="",
choiceNames = c("GSMO", "MSMO"),
choiceValues = c("GSMO", "MSMO"),
selected = c("GSMO"), justified = T, individual =T, status = "danger")),
#one or the other cannot overlay the umaps
# Panel to adjust graphical parameters (for figure generation)
div(class = "panel panel-info",
style = "box-shadow: 5px 5px 15px -5px rgba(0, 0, 0, 0.3);")
,
sliderInput("point.size",
"Point Size",
min = 0.00,
max = 2.00,
step = 0.2,
value = 0.8),
# Button to download user-generated graphics in .pdf format
downloadButton('downloadPlot', "Download as pdf")
),
# Format the graphics output in the main panel
mainPanel(plotOutput("plot", width = '90%'))
)
)
# Define server logic/ making two new functions one for WT and one for the tumor
# This is required to allow each plot to scale independently with screen size
# The plot takes it's width from the clientData output, which is specified by the plotOutput function in the UI chunk
server <- function(input, output, session) {
plotInput = function(){
simpleFeaturePlot(gene = input$gene,
color.use = as.character(input$color),
threshold = as.numeric(input$threshold),
pt.size = as.numeric(input$point.size),
to.include = input$dataset,
scale = session$clientData$output_plot_width)
}
output$plot <- renderPlot({
validate(
need(expr = (capgene(input$gene) %in% format.grep(input$gene)), message = c(paste0(input$gene, ' not found!'),
'Did you mean: ',
paste(format.grep(input$gene))))
)
plotInput()
}, height = function() {
session$clientData$output_plot_width*0.9
})
download.plotInput = function(){
simpleFeaturePlot(gene = input$gene,
color.use = as.character(input$color),
threshold = as.numeric(input$threshold),
# pt.size = as.numeric(input$point.size),
to.include = input$dataset)
}
output$downloadPlot <- downloadHandler(
filename = function() { paste0(input$gene, '.pdf') },
content = function(file) {
ggsave(file, plot = download.plotInput(), width = 10, height = 10, device = "pdf")
}
)
}
# Run the application
shinyApp(ui = ui, server = server)