R/writer.R
In SGDDNB/ShinyCell: Shiny Interactive Web Apps for Single-Cell Data
Defines functions
wrUIga
wrUIend
wrUImain
wrUIsingle
wrUIload
wrSVend
wrSVmain
wrSVfix
wrSVload
wrLib
Documented in
wrLib
wrSVend
wrSVfix
wrSVload
wrSVmain
wrUIend
wrUIga
wrUIload
wrUImain
wrUIsingle
#' Write code for loading libraries
#'
#' @param lib vector of libraries
#'
#' @rdname wrLib
#' @export wrLib
#'
wrLib <- function(lib) {
oup = ""
for(iLib in lib){
oup = paste0(oup, "library(", iLib, ") \n")
}
glue::glue(paste0(oup, "\n"))
}
#' Write code for loading objects for server.R
#'
#' @param prefix file prefix
#'
#' @rdname wrSVload
#' @export wrSVload
#'
wrSVload <- function(prefix) {
glue::glue('{prefix}conf = readRDS("{prefix}conf.rds")\n',
'{prefix}def = readRDS("{prefix}def.rds")\n',
'{prefix}gene = readRDS("{prefix}gene.rds")\n',
'{prefix}meta = readRDS("{prefix}meta.rds")\n',
'\n\n\n\n')
}
#' Write code for fixed portion of server.R
#'
#' @rdname wrSVfix
#' @export wrSVfix
#'
wrSVfix <- function() {
glue::glue('### Useful stuff \n',
'# Colour palette \n',
'cList = list(c("grey85","#FFF7EC","#FEE8C8","#FDD49E","#FDBB84", \n',
' "#FC8D59","#EF6548","#D7301F","#B30000","#7F0000"), \n',
' c("#4575B4","#74ADD1","#ABD9E9","#E0F3F8","#FFFFBF", \n',
' "#FEE090","#FDAE61","#F46D43","#D73027")[c(1,1:9,9)], \n',
' c("#FDE725","#AADC32","#5DC863","#27AD81","#21908C", \n',
' "#2C728E","#3B528B","#472D7B","#440154")) \n',
'names(cList) = c("White-Red", "Blue-Yellow-Red", "Yellow-Green-Purple") \n',
' \n',
'# Panel sizes \n',
'pList = c("400px", "600px", "800px") \n',
'names(pList) = c("Small", "Medium", "Large") \n',
'pList2 = c("500px", "700px", "900px") \n',
'names(pList2) = c("Small", "Medium", "Large") \n',
'pList3 = c("600px", "800px", "1000px") \n',
'names(pList3) = c("Small", "Medium", "Large") \n',
'sList = c(18,24,30) \n',
'names(sList) = c("Small", "Medium", "Large") \n',
'lList = c(5,6,7) \n',
'names(lList) = c("Small", "Medium", "Large") \n',
' \n',
'# Function to extract legend \n',
'g_legend <- function(a.gplot){{ \n',
' tmp <- ggplot_gtable(ggplot_build(a.gplot)) \n',
' leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box") \n',
' legend <- tmp$grobs[[leg]] \n',
' legend \n',
'}} \n',
' \n',
'# Plot theme \n',
'sctheme <- function(base_size = 24, XYval = TRUE, Xang = 0, XjusH = 0.5){{ \n',
' oupTheme = theme( \n',
' text = element_text(size = base_size, family = "Helvetica"), \n',
' panel.background = element_rect(fill = "white", colour = NA), \n',
' axis.line = element_line(colour = "black"), \n',
' axis.ticks = element_line(colour = "black", size = base_size / 20), \n',
' axis.title = element_text(face = "bold"), \n',
' axis.text = element_text(size = base_size), \n',
' axis.text.x = element_text(angle = Xang, hjust = XjusH), \n',
' legend.position = "bottom", \n',
' legend.key = element_rect(colour = NA, fill = NA) \n',
' ) \n',
' if(!XYval){{ \n',
' oupTheme = oupTheme + theme( \n',
' axis.text.x = element_blank(), axis.ticks.x = element_blank(), \n',
' axis.text.y = element_blank(), axis.ticks.y = element_blank()) \n',
' }} \n',
' return(oupTheme) \n',
'}} \n',
' \n',
'### Common plotting functions \n',
'# Plot cell information on dimred \n',
'scDRcell <- function(inpConf, inpMeta, inpdrX, inpdrY, inp1, inpsub1, inpsub2, \n',
' inpsiz, inpcol, inpord, inpfsz, inpasp, inptxt, inplab){{ \n',
' if(is.null(inpsub1)){{inpsub1 = inpConf$UI[1]}} \n',
' # Prepare ggData \n',
' ggData = inpMeta[, c(inpConf[UI == inpdrX]$ID, inpConf[UI == inpdrY]$ID, \n',
' inpConf[UI == inp1]$ID, inpConf[UI == inpsub1]$ID), \n',
' with = FALSE] \n',
' colnames(ggData) = c("X", "Y", "val", "sub") \n',
' rat = (max(ggData$X) - min(ggData$X)) / (max(ggData$Y) - min(ggData$Y)) \n',
' bgCells = FALSE \n',
' if(length(inpsub2) != 0 & length(inpsub2) != nlevels(ggData$sub)){{ \n',
' bgCells = TRUE \n',
' ggData2 = ggData[!sub %in% inpsub2] \n',
' ggData = ggData[sub %in% inpsub2] \n',
' }} \n',
' if(inpord == "Max-1st"){{ \n',
' ggData = ggData[order(val)] \n',
' }} else if(inpord == "Min-1st"){{ \n',
' ggData = ggData[order(-val)] \n',
' }} else if(inpord == "Random"){{ \n',
' ggData = ggData[sample(nrow(ggData))] \n',
' }} \n',
' \n',
' # Do factoring if required \n',
' if(!is.na(inpConf[UI == inp1]$fCL)){{ \n',
' ggCol = strsplit(inpConf[UI == inp1]$fCL, "\\\\|")[[1]] \n',
' names(ggCol) = levels(ggData$val) \n',
' ggLvl = levels(ggData$val)[levels(ggData$val) %in% unique(ggData$val)] \n',
' ggData$val = factor(ggData$val, levels = ggLvl) \n',
' ggCol = ggCol[ggLvl] \n',
' }} \n',
' \n',
' # Actual ggplot \n',
' ggOut = ggplot(ggData, aes(X, Y, color = val)) \n',
' if(bgCells){{ \n',
' ggOut = ggOut + \n',
' geom_point(data = ggData2, color = "snow2", size = inpsiz, shape = 16) \n',
' }} \n',
' ggOut = ggOut + \n',
' geom_point(size = inpsiz, shape = 16) + xlab(inpdrX) + ylab(inpdrY) + \n',
' sctheme(base_size = sList[inpfsz], XYval = inptxt) \n',
' if(is.na(inpConf[UI == inp1]$fCL)){{ \n',
' ggOut = ggOut + scale_color_gradientn("", colours = cList[[inpcol]]) + \n',
' guides(color = guide_colorbar(barwidth = 15)) \n',
' }} else {{ \n',
' sListX = min(nchar(paste0(levels(ggData$val), collapse = "")), 200) \n',
' sListX = 0.75 * (sList - (1.5 * floor(sListX/50))) \n',
' ggOut = ggOut + scale_color_manual("", values = ggCol) + \n',
' guides(color = guide_legend(override.aes = list(size = 5), \n',
' nrow = inpConf[UI == inp1]$fRow)) + \n',
' theme(legend.text = element_text(size = sListX[inpfsz])) \n',
' if(inplab){{ \n',
' ggData3 = ggData[, .(X = mean(X), Y = mean(Y)), by = "val"] \n',
' lListX = min(nchar(paste0(ggData3$val, collapse = "")), 200) \n',
' lListX = lList - (0.25 * floor(lListX/50)) \n',
' ggOut = ggOut + \n',
' geom_text_repel(data = ggData3, aes(X, Y, label = val), \n',
' color = "grey10", bg.color = "grey95", bg.r = 0.15, \n',
' size = lListX[inpfsz], seed = 42) \n',
' }} \n',
' }} \n',
' if(inpasp == "Square") {{ \n',
' ggOut = ggOut + coord_fixed(ratio = rat) \n',
' }} else if(inpasp == "Fixed") {{ \n',
' ggOut = ggOut + coord_fixed() \n',
' }} \n',
' return(ggOut) \n',
'}} \n',
' \n',
'scDRnum <- function(inpConf, inpMeta, inp1, inp2, inpsub1, inpsub2, \n',
' inpH5, inpGene, inpsplt){{ \n',
' if(is.null(inpsub1)){{inpsub1 = inpConf$UI[1]}} \n',
' # Prepare ggData \n',
' ggData = inpMeta[, c(inpConf[UI == inp1]$ID, inpConf[UI == inpsub1]$ID), \n',
' with = FALSE] \n',
' colnames(ggData) = c("group", "sub") \n',
' h5file <- H5File$new(inpH5, mode = "r") \n',
' h5data <- h5file[["grp"]][["data"]] \n',
' ggData$val2 = h5data$read(args = list(inpGene[inp2], quote(expr=))) \n',
' ggData[val2 < 0]$val2 = 0 \n',
' h5file$close_all() \n',
' if(length(inpsub2) != 0 & length(inpsub2) != nlevels(ggData$sub)){{ \n',
' ggData = ggData[sub %in% inpsub2] \n',
' }} \n',
' \n',
' # Split inp1 if necessary \n',
' if(is.na(inpConf[UI == inp1]$fCL)){{ \n',
' if(inpsplt == "Quartile"){{nBk = 4}} \n',
' if(inpsplt == "Decile"){{nBk = 10}} \n',
' ggData$group = cut(ggData$group, breaks = nBk) \n',
' }} \n',
' \n',
' # Actual data.table \n',
' ggData$express = FALSE \n',
' ggData[val2 > 0]$express = TRUE \n',
' ggData1 = ggData[express == TRUE, .(nExpress = .N), by = "group"] \n',
' ggData = ggData[, .(nCells = .N), by = "group"] \n',
' ggData = ggData1[ggData, on = "group"] \n',
' ggData = ggData[, c("group", "nCells", "nExpress"), with = FALSE] \n',
' ggData[is.na(nExpress)]$nExpress = 0 \n',
' ggData$pctExpress = 100 * ggData$nExpress / ggData$nCells \n',
' ggData = ggData[order(group)] \n',
' colnames(ggData)[3] = paste0(colnames(ggData)[3], "_", inp2) \n',
' return(ggData) \n',
'}} \n',
'# Plot gene expression on dimred \n',
'scDRgene <- function(inpConf, inpMeta, inpdrX, inpdrY, inp1, inpsub1, inpsub2, \n',
' inpH5, inpGene, \n',
' inpsiz, inpcol, inpord, inpfsz, inpasp, inptxt){{ \n',
' if(is.null(inpsub1)){{inpsub1 = inpConf$UI[1]}} \n',
' # Prepare ggData \n',
' ggData = inpMeta[, c(inpConf[UI == inpdrX]$ID, inpConf[UI == inpdrY]$ID, \n',
' inpConf[UI == inpsub1]$ID), \n',
' with = FALSE] \n',
' colnames(ggData) = c("X", "Y", "sub") \n',
' rat = (max(ggData$X) - min(ggData$X)) / (max(ggData$Y) - min(ggData$Y)) \n',
' \n',
' h5file <- H5File$new(inpH5, mode = "r") \n',
' h5data <- h5file[["grp"]][["data"]] \n',
' ggData$val = h5data$read(args = list(inpGene[inp1], quote(expr=))) \n',
' ggData[val < 0]$val = 0 \n',
' h5file$close_all() \n',
' bgCells = FALSE \n',
' if(length(inpsub2) != 0 & length(inpsub2) != nlevels(ggData$sub)){{ \n',
' bgCells = TRUE \n',
' ggData2 = ggData[!sub %in% inpsub2] \n',
' ggData = ggData[sub %in% inpsub2] \n',
' }} \n',
' if(inpord == "Max-1st"){{ \n',
' ggData = ggData[order(val)] \n',
' }} else if(inpord == "Min-1st"){{ \n',
' ggData = ggData[order(-val)] \n',
' }} else if(inpord == "Random"){{ \n',
' ggData = ggData[sample(nrow(ggData))] \n',
' }} \n',
' \n',
' # Actual ggplot \n',
' ggOut = ggplot(ggData, aes(X, Y, color = val)) \n',
' if(bgCells){{ \n',
' ggOut = ggOut + \n',
' geom_point(data = ggData2, color = "snow2", size = inpsiz, shape = 16) \n',
' }} \n',
' ggOut = ggOut + \n',
' geom_point(size = inpsiz, shape = 16) + xlab(inpdrX) + ylab(inpdrY) + \n',
' sctheme(base_size = sList[inpfsz], XYval = inptxt) + \n',
' scale_color_gradientn(inp1, colours = cList[[inpcol]]) + \n',
' guides(color = guide_colorbar(barwidth = 15)) \n',
' if(inpasp == "Square") {{ \n',
' ggOut = ggOut + coord_fixed(ratio = rat) \n',
' }} else if(inpasp == "Fixed") {{ \n',
' ggOut = ggOut + coord_fixed() \n',
' }} \n',
' return(ggOut) \n',
'}} \n',
' \n',
'# Plot gene coexpression on dimred \n',
'bilinear <- function(x,y,xy,Q11,Q21,Q12,Q22){{ \n',
' oup = (xy-x)*(xy-y)*Q11 + x*(xy-y)*Q21 + (xy-x)*y*Q12 + x*y*Q22 \n',
' oup = oup / (xy*xy) \n',
' return(oup) \n',
'}} \n',
'scDRcoex <- function(inpConf, inpMeta, inpdrX, inpdrY, inp1, inp2, \n',
' inpsub1, inpsub2, inpH5, inpGene, \n',
' inpsiz, inpcol, inpord, inpfsz, inpasp, inptxt){{ \n',
' if(is.null(inpsub1)){{inpsub1 = inpConf$UI[1]}} \n',
' # Prepare ggData \n',
' ggData = inpMeta[, c(inpConf[UI == inpdrX]$ID, inpConf[UI == inpdrY]$ID, \n',
' inpConf[UI == inpsub1]$ID), \n',
' with = FALSE] \n',
' colnames(ggData) = c("X", "Y", "sub") \n',
' rat = (max(ggData$X) - min(ggData$X)) / (max(ggData$Y) - min(ggData$Y)) \n',
' \n',
' h5file <- H5File$new(inpH5, mode = "r") \n',
' h5data <- h5file[["grp"]][["data"]] \n',
' ggData$val1 = h5data$read(args = list(inpGene[inp1], quote(expr=))) \n',
' ggData[val1 < 0]$val1 = 0 \n',
' ggData$val2 = h5data$read(args = list(inpGene[inp2], quote(expr=))) \n',
' ggData[val2 < 0]$val2 = 0 \n',
' h5file$close_all() \n',
' bgCells = FALSE \n',
' if(length(inpsub2) != 0 & length(inpsub2) != nlevels(ggData$sub)){{ \n',
' bgCells = TRUE \n',
' ggData2 = ggData[!sub %in% inpsub2] \n',
' ggData = ggData[sub %in% inpsub2] \n',
' }} \n',
' \n',
' # Generate coex color palette \n',
' cInp = strsplit(inpcol, "; ")[[1]] \n',
' if(cInp[1] == "Red (Gene1)"){{ \n',
' c10 = c(255,0,0) \n',
' }} else if(cInp[1] == "Orange (Gene1)"){{ \n',
' c10 = c(255,140,0) \n',
' }} else {{ \n',
' c10 = c(0,255,0) \n',
' }} \n',
' if(cInp[2] == "Green (Gene2)"){{ \n',
' c01 = c(0,255,0) \n',
' }} else {{ \n',
' c01 = c(0,0,255) \n',
' }} \n',
' c00 = c(217,217,217) ; c11 = c10 + c01 \n',
' nGrid = 16; nPad = 2; nTot = nGrid + nPad * 2 \n',
' gg = data.table(v1 = rep(0:nTot,nTot+1), v2 = sort(rep(0:nTot,nTot+1))) \n',
' gg$vv1 = gg$v1 - nPad ; gg[vv1 < 0]$vv1 = 0; gg[vv1 > nGrid]$vv1 = nGrid \n',
' gg$vv2 = gg$v2 - nPad ; gg[vv2 < 0]$vv2 = 0; gg[vv2 > nGrid]$vv2 = nGrid \n',
' gg$cR = bilinear(gg$vv1, gg$vv2, nGrid, c00[1], c10[1], c01[1], c11[1]) \n',
' gg$cG = bilinear(gg$vv1, gg$vv2, nGrid, c00[2], c10[2], c01[2], c11[2]) \n',
' gg$cB = bilinear(gg$vv1, gg$vv2, nGrid, c00[3], c10[3], c01[3], c11[3]) \n',
' gg$cMix = rgb(gg$cR, gg$cG, gg$cB, maxColorValue = 255) \n',
' gg = gg[, c("v1", "v2", "cMix")] \n',
' \n',
' # Map colours \n',
' ggData$v1 = round(nTot * ggData$val1 / max(ggData$val1)) \n',
' ggData$v2 = round(nTot * ggData$val2 / max(ggData$val2)) \n',
' ggData$v0 = ggData$v1 + ggData$v2 \n',
' ggData = gg[ggData, on = c("v1", "v2")] \n',
' if(inpord == "Max-1st"){{ \n',
' ggData = ggData[order(v0)] \n',
' }} else if(inpord == "Min-1st"){{ \n',
' ggData = ggData[order(-v0)] \n',
' }} else if(inpord == "Random"){{ \n',
' ggData = ggData[sample(nrow(ggData))] \n',
' }} \n',
' \n',
' # Actual ggplot \n',
' ggOut = ggplot(ggData, aes(X, Y)) \n',
' if(bgCells){{ \n',
' ggOut = ggOut + \n',
' geom_point(data = ggData2, color = "snow2", size = inpsiz, shape = 16) \n',
' }} \n',
' ggOut = ggOut + \n',
' geom_point(size = inpsiz, shape = 16, color = ggData$cMix) + \n',
' xlab(inpdrX) + ylab(inpdrY) + \n',
' sctheme(base_size = sList[inpfsz], XYval = inptxt) + \n',
' scale_color_gradientn(inp1, colours = cList[[1]]) + \n',
' guides(color = guide_colorbar(barwidth = 15)) \n',
' if(inpasp == "Square") {{ \n',
' ggOut = ggOut + coord_fixed(ratio = rat) \n',
' }} else if(inpasp == "Fixed") {{ \n',
' ggOut = ggOut + coord_fixed() \n',
' }} \n',
' return(ggOut) \n',
'}} \n',
' \n',
'scDRcoexLeg <- function(inp1, inp2, inpcol, inpfsz){{ \n',
' # Generate coex color palette \n',
' cInp = strsplit(inpcol, "; ")[[1]] \n',
' if(cInp[1] == "Red (Gene1)"){{ \n',
' c10 = c(255,0,0) \n',
' }} else if(cInp[1] == "Orange (Gene1)"){{ \n',
' c10 = c(255,140,0) \n',
' }} else {{ \n',
' c10 = c(0,255,0) \n',
' }} \n',
' if(cInp[2] == "Green (Gene2)"){{ \n',
' c01 = c(0,255,0) \n',
' }} else {{ \n',
' c01 = c(0,0,255) \n',
' }} \n',
' c00 = c(217,217,217) ; c11 = c10 + c01 \n',
' nGrid = 16; nPad = 2; nTot = nGrid + nPad * 2 \n',
' gg = data.table(v1 = rep(0:nTot,nTot+1), v2 = sort(rep(0:nTot,nTot+1))) \n',
' gg$vv1 = gg$v1 - nPad ; gg[vv1 < 0]$vv1 = 0; gg[vv1 > nGrid]$vv1 = nGrid \n',
' gg$vv2 = gg$v2 - nPad ; gg[vv2 < 0]$vv2 = 0; gg[vv2 > nGrid]$vv2 = nGrid \n',
' gg$cR = bilinear(gg$vv1, gg$vv2, nGrid, c00[1], c10[1], c01[1], c11[1]) \n',
' gg$cG = bilinear(gg$vv1, gg$vv2, nGrid, c00[2], c10[2], c01[2], c11[2]) \n',
' gg$cB = bilinear(gg$vv1, gg$vv2, nGrid, c00[3], c10[3], c01[3], c11[3]) \n',
' gg$cMix = rgb(gg$cR, gg$cG, gg$cB, maxColorValue = 255) \n',
' gg = gg[, c("v1", "v2", "cMix")] \n',
' \n',
' # Actual ggplot \n',
' ggOut = ggplot(gg, aes(v1, v2)) + \n',
' geom_tile(fill = gg$cMix) + \n',
' xlab(inp1) + ylab(inp2) + coord_fixed(ratio = 1) + \n',
' scale_x_continuous(breaks = c(0, nTot), label = c("low", "high")) + \n',
' scale_y_continuous(breaks = c(0, nTot), label = c("low", "high")) + \n',
' sctheme(base_size = sList[inpfsz], XYval = TRUE) \n',
' return(ggOut) \n',
'}} \n',
' \n',
'scDRcoexNum <- function(inpConf, inpMeta, inp1, inp2, \n',
' inpsub1, inpsub2, inpH5, inpGene){{ \n',
' if(is.null(inpsub1)){{inpsub1 = inpConf$UI[1]}} \n',
' # Prepare ggData \n',
' ggData = inpMeta[, c(inpConf[UI == inpsub1]$ID), with = FALSE] \n',
' colnames(ggData) = c("sub") \n',
' h5file <- H5File$new(inpH5, mode = "r") \n',
' h5data <- h5file[["grp"]][["data"]] \n',
' ggData$val1 = h5data$read(args = list(inpGene[inp1], quote(expr=))) \n',
' ggData[val1 < 0]$val1 = 0 \n',
' ggData$val2 = h5data$read(args = list(inpGene[inp2], quote(expr=))) \n',
' ggData[val2 < 0]$val2 = 0 \n',
' h5file$close_all() \n',
' if(length(inpsub2) != 0 & length(inpsub2) != nlevels(ggData$sub)){{ \n',
' ggData = ggData[sub %in% inpsub2] \n',
' }} \n',
' \n',
' # Actual data.table \n',
' ggData$express = "none" \n',
' ggData[val1 > 0]$express = inp1 \n',
' ggData[val2 > 0]$express = inp2 \n',
' ggData[val1 > 0 & val2 > 0]$express = "both" \n',
' ggData$express = factor(ggData$express, levels = unique(c("both", inp1, inp2, "none"))) \n',
' ggData = ggData[, .(nCells = .N), by = "express"] \n',
' ggData$percent = 100 * ggData$nCells / sum(ggData$nCells) \n',
' ggData = ggData[order(express)] \n',
' colnames(ggData)[1] = "expression > 0" \n',
' return(ggData) \n',
'}} \n',
' \n',
'# Plot violin / boxplot \n',
'scVioBox <- function(inpConf, inpMeta, inp1, inp2, \n',
' inpsub1, inpsub2, inpH5, inpGene, \n',
' inptyp, inppts, inpsiz, inpfsz){{ \n',
' if(is.null(inpsub1)){{inpsub1 = inpConf$UI[1]}} \n',
' # Prepare ggData \n',
' ggData = inpMeta[, c(inpConf[UI == inp1]$ID, inpConf[UI == inpsub1]$ID), \n',
' with = FALSE] \n',
' colnames(ggData) = c("X", "sub") \n',
' \n',
' # Load in either cell meta or gene expr\n',
' if(inp2 %in% inpConf$UI){{ \n',
' ggData$val = inpMeta[[inpConf[UI == inp2]$ID]] \n',
' }} else {{ \n',
' h5file <- H5File$new(inpH5, mode = "r") \n',
' h5data <- h5file[["grp"]][["data"]] \n',
' ggData$val = h5data$read(args = list(inpGene[inp2], quote(expr=))) \n',
' ggData[val < 0]$val = 0 \n',
' set.seed(42) \n',
' tmpNoise = rnorm(length(ggData$val)) * diff(range(ggData$val)) / 1000 \n',
' ggData$val = ggData$val + tmpNoise \n',
' h5file$close_all() \n',
' }} \n',
' if(length(inpsub2) != 0 & length(inpsub2) != nlevels(ggData$sub)){{ \n',
' ggData = ggData[sub %in% inpsub2] \n',
' }} \n',
' \n',
' # Do factoring \n',
' ggCol = strsplit(inpConf[UI == inp1]$fCL, "\\\\|")[[1]] \n',
' names(ggCol) = levels(ggData$X) \n',
' ggLvl = levels(ggData$X)[levels(ggData$X) %in% unique(ggData$X)] \n',
' ggData$X = factor(ggData$X, levels = ggLvl) \n',
' ggCol = ggCol[ggLvl] \n',
' \n',
' # Actual ggplot \n',
' if(inptyp == "violin"){{ \n',
' ggOut = ggplot(ggData, aes(X, val, fill = X)) + geom_violin(scale = "width") \n',
' }} else {{ \n',
' ggOut = ggplot(ggData, aes(X, val, fill = X)) + geom_boxplot() \n',
' }} \n',
' if(inppts){{ \n',
' ggOut = ggOut + geom_jitter(size = inpsiz, shape = 16) \n',
' }} \n',
' ggOut = ggOut + xlab(inp1) + ylab(inp2) + \n',
' sctheme(base_size = sList[inpfsz], Xang = 45, XjusH = 1) + \n',
' scale_fill_manual("", values = ggCol) +\n',
' theme(legend.position = "none")\n',
' return(ggOut) \n',
'}} \n',
' \n',
'# Plot proportion plot \n',
'scProp <- function(inpConf, inpMeta, inp1, inp2, inpsub1, inpsub2, \n',
' inptyp, inpflp, inpfsz){{ \n',
' if(is.null(inpsub1)){{inpsub1 = inpConf$UI[1]}} \n',
' # Prepare ggData \n',
' ggData = inpMeta[, c(inpConf[UI == inp1]$ID, inpConf[UI == inp2]$ID, \n',
' inpConf[UI == inpsub1]$ID), \n',
' with = FALSE] \n',
' colnames(ggData) = c("X", "grp", "sub") \n',
' if(length(inpsub2) != 0 & length(inpsub2) != nlevels(ggData$sub)){{ \n',
' ggData = ggData[sub %in% inpsub2] \n',
' }} \n',
' ggData = ggData[, .(nCells = .N), by = c("X", "grp")] \n',
' ggData = ggData[, {{tot = sum(nCells) \n',
' .SD[,.(pctCells = 100 * sum(nCells) / tot, \n',
' nCells = nCells), by = "grp"]}}, by = "X"] \n',
' \n',
' # Do factoring \n',
' ggCol = strsplit(inpConf[UI == inp2]$fCL, "\\\\|")[[1]] \n',
' names(ggCol) = levels(ggData$grp) \n',
' ggLvl = levels(ggData$grp)[levels(ggData$grp) %in% unique(ggData$grp)] \n',
' ggData$grp = factor(ggData$grp, levels = ggLvl) \n',
' ggCol = ggCol[ggLvl] \n',
' \n',
' # Actual ggplot \n',
' if(inptyp == "Proportion"){{ \n',
' ggOut = ggplot(ggData, aes(X, pctCells, fill = grp)) + \n',
' geom_col() + ylab("Cell Proportion (%)") \n',
' }} else {{ \n',
' ggOut = ggplot(ggData, aes(X, nCells, fill = grp)) + \n',
' geom_col() + ylab("Number of Cells") \n',
' }} \n',
' if(inpflp){{ \n',
' ggOut = ggOut + coord_flip() \n',
' }} \n',
' ggOut = ggOut + xlab(inp1) + \n',
' sctheme(base_size = sList[inpfsz], Xang = 45, XjusH = 1) + \n',
' scale_fill_manual("", values = ggCol) + \n',
' theme(legend.position = "right") \n',
' return(ggOut) \n',
'}} \n',
' \n',
'# Get gene list \n',
'scGeneList <- function(inp, inpGene){{ \n',
' geneList = data.table(gene = unique(trimws(strsplit(inp, ",|;|\n")[[1]])), \n',
' present = TRUE) \n',
' geneList[!gene %in% names(inpGene)]$present = FALSE \n',
' return(geneList) \n',
'}} \n',
' \n',
'# Plot gene expression bubbleplot / heatmap \n',
'scBubbHeat <- function(inpConf, inpMeta, inp, inpGrp, inpPlt, \n',
' inpsub1, inpsub2, inpH5, inpGene, inpScl, inpRow, inpCol, \n',
' inpcols, inpfsz, save = FALSE){{ \n',
' if(is.null(inpsub1)){{inpsub1 = inpConf$UI[1]}} \n',
' # Identify genes that are in our dataset \n',
' geneList = scGeneList(inp, inpGene) \n',
' geneList = geneList[present == TRUE] \n',
' shiny::validate(need(nrow(geneList) <= 50, "More than 50 genes to plot! Please reduce the gene list!")) \n',
' shiny::validate(need(nrow(geneList) > 1, "Please input at least 2 genes to plot!")) \n',
' \n',
' # Prepare ggData \n',
' h5file <- H5File$new(inpH5, mode = "r") \n',
' h5data <- h5file[["grp"]][["data"]] \n',
' ggData = data.table() \n',
' for(iGene in geneList$gene){{ \n',
' tmp = inpMeta[, c("sampleID", inpConf[UI == inpsub1]$ID), with = FALSE] \n',
' colnames(tmp) = c("sampleID", "sub") \n',
' tmp$grpBy = inpMeta[[inpConf[UI == inpGrp]$ID]] \n',
' tmp$geneName = iGene \n',
' tmp$val = h5data$read(args = list(inpGene[iGene], quote(expr=))) \n',
' ggData = rbindlist(list(ggData, tmp)) \n',
' }} \n',
' h5file$close_all() \n',
' if(length(inpsub2) != 0 & length(inpsub2) != nlevels(ggData$sub)){{ \n',
' ggData = ggData[sub %in% inpsub2] \n',
' }} \n',
' shiny::validate(need(uniqueN(ggData$grpBy) > 1, "Only 1 group present, unable to plot!")) \n',
' \n',
' # Aggregate \n',
' ggData$val = expm1(ggData$val) \n',
' ggData = ggData[, .(val = mean(val), prop = sum(val>0) / length(sampleID)), \n',
' by = c("geneName", "grpBy")] \n',
' ggData$val = log1p(ggData$val) \n',
' \n',
' # Scale if required \n',
' colRange = range(ggData$val) \n',
' if(inpScl){{ \n',
' ggData[, val:= scale(val), keyby = "geneName"] \n',
' colRange = c(-max(abs(range(ggData$val))), max(abs(range(ggData$val)))) \n',
' }} \n',
' \n',
' # hclust row/col if necessary \n',
' ggMat = dcast.data.table(ggData, geneName~grpBy, value.var = "val") \n',
' tmp = ggMat$geneName \n',
' ggMat = as.matrix(ggMat[, -1]) \n',
' rownames(ggMat) = tmp \n',
' if(inpRow){{ \n',
' hcRow = dendro_data(as.dendrogram(hclust(dist(ggMat)))) \n',
' ggRow = ggplot() + coord_flip() + \n',
' geom_segment(data = hcRow$segments, aes(x=x,y=y,xend=xend,yend=yend)) + \n',
' scale_y_continuous(breaks = rep(0, uniqueN(ggData$grpBy)), \n',
' labels = unique(ggData$grpBy), expand = c(0, 0)) + \n',
' scale_x_continuous(breaks = seq_along(hcRow$labels$label), \n',
' labels = hcRow$labels$label, expand = c(0, 0.5)) + \n',
' sctheme(base_size = sList[inpfsz]) + \n',
' theme(axis.title = element_blank(), axis.line = element_blank(), \n',
' axis.ticks = element_blank(), axis.text.y = element_blank(), \n',
' axis.text.x = element_text(color="white", angle = 45, hjust = 1)) \n',
' ggData$geneName = factor(ggData$geneName, levels = hcRow$labels$label) \n',
' }} else {{ \n',
' ggData$geneName = factor(ggData$geneName, levels = rev(geneList$gene)) \n',
' }} \n',
' if(inpCol){{ \n',
' hcCol = dendro_data(as.dendrogram(hclust(dist(t(ggMat))))) \n',
' ggCol = ggplot() + \n',
' geom_segment(data = hcCol$segments, aes(x=x,y=y,xend=xend,yend=yend)) + \n',
' scale_x_continuous(breaks = seq_along(hcCol$labels$label), \n',
' labels = hcCol$labels$label, expand = c(0.05, 0)) + \n',
' scale_y_continuous(breaks = rep(0, uniqueN(ggData$geneName)), \n',
' labels = unique(ggData$geneName), expand=c(0,0)) + \n',
' sctheme(base_size = sList[inpfsz], Xang = 45, XjusH = 1) + \n',
' theme(axis.title = element_blank(), axis.line = element_blank(), \n',
' axis.ticks = element_blank(), axis.text.x = element_blank(), \n',
' axis.text.y = element_text(color = "white")) \n',
' ggData$grpBy = factor(ggData$grpBy, levels = hcCol$labels$label) \n',
' }} \n',
' \n',
' # Actual plot according to plottype \n',
' if(inpPlt == "Bubbleplot"){{ \n',
' # Bubbleplot \n',
' ggOut = ggplot(ggData, aes(grpBy, geneName, color = val, size = prop)) + \n',
' geom_point() + \n',
' sctheme(base_size = sList[inpfsz], Xang = 45, XjusH = 1) + \n',
' scale_x_discrete(expand = c(0.05, 0)) + \n',
' scale_y_discrete(expand = c(0, 0.5)) + \n',
' scale_size_continuous("proportion", range = c(0, 8), \n',
' limits = c(0, 1), breaks = c(0.00,0.25,0.50,0.75,1.00)) + \n',
' scale_color_gradientn("expression", limits = colRange, colours = cList[[inpcols]]) + \n',
' guides(color = guide_colorbar(barwidth = 15)) + \n',
' theme(axis.title = element_blank(), legend.box = "vertical") \n',
' }} else {{ \n',
' # Heatmap \n',
' ggOut = ggplot(ggData, aes(grpBy, geneName, fill = val)) + \n',
' geom_tile() + \n',
' sctheme(base_size = sList[inpfsz], Xang = 45, XjusH = 1) + \n',
' scale_x_discrete(expand = c(0.05, 0)) + \n',
' scale_y_discrete(expand = c(0, 0.5)) + \n',
' scale_fill_gradientn("expression", limits = colRange, colours = cList[[inpcols]]) + \n',
' guides(fill = guide_colorbar(barwidth = 15)) + \n',
' theme(axis.title = element_blank()) \n',
' }} \n',
' \n',
' # Final tidy \n',
' ggLeg = g_legend(ggOut) \n',
' ggOut = ggOut + theme(legend.position = "none") \n',
' if(!save){{ \n',
' if(inpRow & inpCol){{ggOut = \n',
' grid.arrange(ggOut, ggLeg, ggCol, ggRow, widths = c(7,1), heights = c(1,7,2), \n',
' layout_matrix = rbind(c(3,NA),c(1,4),c(2,NA))) \n',
' }} else if(inpRow){{ggOut = \n',
' grid.arrange(ggOut, ggLeg, ggRow, widths = c(7,1), heights = c(7,2), \n',
' layout_matrix = rbind(c(1,3),c(2,NA))) \n',
' }} else if(inpCol){{ggOut = \n',
' grid.arrange(ggOut, ggLeg, ggCol, heights = c(1,7,2), \n',
' layout_matrix = rbind(c(3),c(1),c(2))) \n',
' }} else {{ggOut = \n',
' grid.arrange(ggOut, ggLeg, heights = c(7,2), \n',
' layout_matrix = rbind(c(1),c(2))) \n',
' }} \n',
' }} else {{ \n',
' if(inpRow & inpCol){{ggOut = \n',
' arrangeGrob(ggOut, ggLeg, ggCol, ggRow, widths = c(7,1), heights = c(1,7,2), \n',
' layout_matrix = rbind(c(3,NA),c(1,4),c(2,NA))) \n',
' }} else if(inpRow){{ggOut = \n',
' arrangeGrob(ggOut, ggLeg, ggRow, widths = c(7,1), heights = c(7,2), \n',
' layout_matrix = rbind(c(1,3),c(2,NA))) \n',
' }} else if(inpCol){{ggOut = \n',
' arrangeGrob(ggOut, ggLeg, ggCol, heights = c(1,7,2), \n',
' layout_matrix = rbind(c(3),c(1),c(2))) \n',
' }} else {{ggOut = \n',
' arrangeGrob(ggOut, ggLeg, heights = c(7,2), \n',
' layout_matrix = rbind(c(1),c(2))) \n',
' }} \n',
' }} \n',
' return(ggOut) \n',
'}} \n',
' \n',
' \n',
' \n',
' \n',
' \n',
'### Start server code \n',
'shinyServer(function(input, output, session) {{ \n',
' ### For all tags and Server-side selectize \n',
' observe_helpers() \n',
' \n')
}
#' Write code for main block of server.R
#'
#' @param prefix file prefix
#'
#' @rdname wrSVmain
#' @export wrSVmain
#'
wrSVmain <- function(prefix, subst = "") {
glue::glue('optCrt="{{ option_create: function(data,escape) {{return(\'<div class=\\"create\\"><strong>\' + \'</strong></div>\');}} }}" \n',
' updateSelectizeInput(session, "{prefix}a1inp2", choices = names({prefix}gene), server = TRUE, \n',
' selected = {prefix}def$gene1, options = list( \n',
' maxOptions = 7, create = TRUE, persist = TRUE, render = I(optCrt))) \n',
' updateSelectizeInput(session, "{prefix}a3inp1", choices = names({prefix}gene), server = TRUE, \n',
' selected = {prefix}def$gene1, options = list( \n',
' maxOptions = 7, create = TRUE, persist = TRUE, render = I(optCrt))) \n',
' updateSelectizeInput(session, "{prefix}a3inp2", choices = names({prefix}gene), server = TRUE, \n',
' selected = {prefix}def$gene2, options = list( \n',
' maxOptions = 7, create = TRUE, persist = TRUE, render = I(optCrt))) \n',
' updateSelectizeInput(session, "{prefix}b2inp1", choices = names({prefix}gene), server = TRUE, \n',
' selected = {prefix}def$gene1, options = list( \n',
' maxOptions = 7, create = TRUE, persist = TRUE, render = I(optCrt))) \n',
' updateSelectizeInput(session, "{prefix}b2inp2", choices = names({prefix}gene), server = TRUE, \n',
' selected = {prefix}def$gene2, options = list( \n',
' maxOptions = 7, create = TRUE, persist = TRUE, render = I(optCrt))) \n',
' updateSelectizeInput(session, "{prefix}c1inp2", server = TRUE, \n',
' choices = c({prefix}conf[is.na(fID)]$UI,names({prefix}gene)), \n',
' selected = {prefix}conf[is.na(fID)]$UI[1], options = list( \n',
' maxOptions = length({prefix}conf[is.na(fID)]$UI) + 3, \n',
' create = TRUE, persist = TRUE, render = I(optCrt))) \n',
' \n',
' \n',
' ### Plots for tab a1 \n',
'{subst} output${prefix}a1sub1.ui <- renderUI({{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}a1sub1]$fID, "\\\\|")[[1]] \n',
'{subst} checkboxGroupInput("{prefix}a1sub2", "Select which cells to show", inline = TRUE, \n',
'{subst} choices = sub, selected = sub) \n',
'{subst} }}) \n',
'{subst} observeEvent(input${prefix}a1sub1non, {{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}a1sub1]$fID, "\\\\|")[[1]] \n',
'{subst} updateCheckboxGroupInput(session, inputId = "{prefix}a1sub2", label = "Select which cells to show", \n',
'{subst} choices = sub, selected = NULL, inline = TRUE) \n',
'{subst} }}) \n',
'{subst} observeEvent(input${prefix}a1sub1all, {{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}a1sub1]$fID, "\\\\|")[[1]] \n',
'{subst} updateCheckboxGroupInput(session, inputId = "{prefix}a1sub2", label = "Select which cells to show", \n',
'{subst} choices = sub, selected = sub, inline = TRUE) \n',
'{subst} }}) \n',
' output${prefix}a1oup1 <- renderPlot({{ \n',
' scDRcell({prefix}conf, {prefix}meta, input${prefix}a1drX, input${prefix}a1drY, input${prefix}a1inp1, \n',
' input${prefix}a1sub1, input${prefix}a1sub2, \n',
' input${prefix}a1siz, input${prefix}a1col1, input${prefix}a1ord1, \n',
' input${prefix}a1fsz, input${prefix}a1asp, input${prefix}a1txt, input${prefix}a1lab1) \n',
' }}) \n',
' output${prefix}a1oup1.ui <- renderUI({{ \n',
' plotOutput("{prefix}a1oup1", height = pList[input${prefix}a1psz]) \n',
' }}) \n',
' output${prefix}a1oup1.pdf <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}a1drX,"_",input${prefix}a1drY,"_", \n',
' input${prefix}a1inp1,".pdf") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "pdf", height = input${prefix}a1oup1.h, width = input${prefix}a1oup1.w, useDingbats = FALSE, \n',
' plot = scDRcell({prefix}conf, {prefix}meta, input${prefix}a1drX, input${prefix}a1drY, input${prefix}a1inp1, \n',
' input${prefix}a1sub1, input${prefix}a1sub2, \n',
' input${prefix}a1siz, input${prefix}a1col1, input${prefix}a1ord1, \n',
' input${prefix}a1fsz, input${prefix}a1asp, input${prefix}a1txt, input${prefix}a1lab1) ) \n',
' }}) \n',
' output${prefix}a1oup1.png <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}a1drX,"_",input${prefix}a1drY,"_", \n',
' input${prefix}a1inp1,".png") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "png", height = input${prefix}a1oup1.h, width = input${prefix}a1oup1.w, \n',
' plot = scDRcell({prefix}conf, {prefix}meta, input${prefix}a1drX, input${prefix}a1drY, input${prefix}a1inp1, \n',
' input${prefix}a1sub1, input${prefix}a1sub2, \n',
' input${prefix}a1siz, input${prefix}a1col1, input${prefix}a1ord1, \n',
' input${prefix}a1fsz, input${prefix}a1asp, input${prefix}a1txt, input${prefix}a1lab1) ) \n',
' }}) \n',
' output${prefix}a1.dt <- renderDataTable({{ \n',
' ggData = scDRnum({prefix}conf, {prefix}meta, input${prefix}a1inp1, input${prefix}a1inp2, \n',
' input${prefix}a1sub1, input${prefix}a1sub2, \n',
' "{prefix}gexpr.h5", {prefix}gene, input${prefix}a1splt) \n',
' datatable(ggData, rownames = FALSE, extensions = "Buttons", \n',
' options = list(pageLength = -1, dom = "tB", buttons = c("copy", "csv", "excel"))) %>% \n',
' formatRound(columns = c("pctExpress"), digits = 2) \n',
' }}) \n',
' \n',
' output${prefix}a1oup2 <- renderPlot({{ \n',
' scDRgene({prefix}conf, {prefix}meta, input${prefix}a1drX, input${prefix}a1drY, input${prefix}a1inp2, \n',
' input${prefix}a1sub1, input${prefix}a1sub2, \n',
' "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}a1siz, input${prefix}a1col2, input${prefix}a1ord2, \n',
' input${prefix}a1fsz, input${prefix}a1asp, input${prefix}a1txt) \n',
' }}) \n',
' output${prefix}a1oup2.ui <- renderUI({{ \n',
' plotOutput("{prefix}a1oup2", height = pList[input${prefix}a1psz]) \n',
' }}) \n',
' output${prefix}a1oup2.pdf <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}a1drX,"_",input${prefix}a1drY,"_", \n',
' input${prefix}a1inp2,".pdf") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "pdf", height = input${prefix}a1oup2.h, width = input${prefix}a1oup2.w, useDingbats = FALSE, \n',
' plot = scDRgene({prefix}conf, {prefix}meta, input${prefix}a1drX, input${prefix}a1drY, input${prefix}a1inp2, \n',
' input${prefix}a1sub1, input${prefix}a1sub2, \n',
' "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}a1siz, input${prefix}a1col2, input${prefix}a1ord2, \n',
' input${prefix}a1fsz, input${prefix}a1asp, input${prefix}a1txt) ) \n',
' }}) \n',
' output${prefix}a1oup2.png <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}a1drX,"_",input${prefix}a1drY,"_", \n',
' input${prefix}a1inp2,".png") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "png", height = input${prefix}a1oup2.h, width = input${prefix}a1oup2.w, \n',
' plot = scDRgene({prefix}conf, {prefix}meta, input${prefix}a1drX, input${prefix}a1drY, input${prefix}a1inp2, \n',
' input${prefix}a1sub1, input${prefix}a1sub2, \n',
' "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}a1siz, input${prefix}a1col2, input${prefix}a1ord2, \n',
' input${prefix}a1fsz, input${prefix}a1asp, input${prefix}a1txt) ) \n',
' }}) \n',
' \n',
' \n',
' ### Plots for tab a2 \n',
'{subst} output${prefix}a2sub1.ui <- renderUI({{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}a2sub1]$fID, "\\\\|")[[1]] \n',
'{subst} checkboxGroupInput("{prefix}a2sub2", "Select which cells to show", inline = TRUE, \n',
'{subst} choices = sub, selected = sub) \n',
'{subst} }}) \n',
'{subst} observeEvent(input${prefix}a2sub1non, {{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}a2sub1]$fID, "\\\\|")[[1]] \n',
'{subst} updateCheckboxGroupInput(session, inputId = "{prefix}a2sub2", label = "Select which cells to show", \n',
'{subst} choices = sub, selected = NULL, inline = TRUE) \n',
'{subst} }}) \n',
'{subst} observeEvent(input${prefix}a2sub1all, {{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}a2sub1]$fID, "\\\\|")[[1]] \n',
'{subst} updateCheckboxGroupInput(session, inputId = "{prefix}a2sub2", label = "Select which cells to show", \n',
'{subst} choices = sub, selected = sub, inline = TRUE) \n',
'{subst} }}) \n',
' output${prefix}a2oup1 <- renderPlot({{ \n',
' scDRcell({prefix}conf, {prefix}meta, input${prefix}a2drX, input${prefix}a2drY, input${prefix}a2inp1, \n',
' input${prefix}a2sub1, input${prefix}a2sub2, \n',
' input${prefix}a2siz, input${prefix}a2col1, input${prefix}a2ord1, \n',
' input${prefix}a2fsz, input${prefix}a2asp, input${prefix}a2txt, input${prefix}a2lab1) \n',
' }}) \n',
' output${prefix}a2oup1.ui <- renderUI({{ \n',
' plotOutput("{prefix}a2oup1", height = pList[input${prefix}a2psz]) \n',
' }}) \n',
' output${prefix}a2oup1.pdf <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}a2drX,"_",input${prefix}a2drY,"_", \n',
' input${prefix}a2inp1,".pdf") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "pdf", height = input${prefix}a2oup1.h, width = input${prefix}a2oup1.w, useDingbats = FALSE, \n',
' plot = scDRcell({prefix}conf, {prefix}meta, input${prefix}a2drX, input${prefix}a2drY, input${prefix}a2inp1, \n',
' input${prefix}a2sub1, input${prefix}a2sub2, \n',
' input${prefix}a2siz, input${prefix}a2col1, input${prefix}a2ord1, \n',
' input${prefix}a2fsz, input${prefix}a2asp, input${prefix}a2txt, input${prefix}a2lab1) ) \n',
' }}) \n',
' output${prefix}a2oup1.png <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}a2drX,"_",input${prefix}a2drY,"_", \n',
' input${prefix}a2inp1,".png") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "png", height = input${prefix}a2oup1.h, width = input${prefix}a2oup1.w, \n',
' plot = scDRcell({prefix}conf, {prefix}meta, input${prefix}a2drX, input${prefix}a2drY, input${prefix}a2inp1, \n',
' input${prefix}a2sub1, input${prefix}a2sub2, \n',
' input${prefix}a2siz, input${prefix}a2col1, input${prefix}a2ord1, \n',
' input${prefix}a2fsz, input${prefix}a2asp, input${prefix}a2txt, input${prefix}a2lab1) ) \n',
' }}) \n',
' \n',
' output${prefix}a2oup2 <- renderPlot({{ \n',
' scDRcell({prefix}conf, {prefix}meta, input${prefix}a2drX, input${prefix}a2drY, input${prefix}a2inp2, \n',
' input${prefix}a2sub1, input${prefix}a2sub2, \n',
' input${prefix}a2siz, input${prefix}a2col2, input${prefix}a2ord2, \n',
' input${prefix}a2fsz, input${prefix}a2asp, input${prefix}a2txt, input${prefix}a2lab2) \n',
' }}) \n',
' output${prefix}a2oup2.ui <- renderUI({{ \n',
' plotOutput("{prefix}a2oup2", height = pList[input${prefix}a2psz]) \n',
' }}) \n',
' output${prefix}a2oup2.pdf <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}a2drX,"_",input${prefix}a2drY,"_", \n',
' input${prefix}a2inp2,".pdf") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "pdf", height = input${prefix}a2oup2.h, width = input${prefix}a2oup2.w, useDingbats = FALSE, \n',
' plot = scDRcell({prefix}conf, {prefix}meta, input${prefix}a2drX, input${prefix}a2drY, input${prefix}a2inp2, \n',
' input${prefix}a2sub1, input${prefix}a2sub2, \n',
' input${prefix}a2siz, input${prefix}a2col2, input${prefix}a2ord2, \n',
' input${prefix}a2fsz, input${prefix}a2asp, input${prefix}a2txt, input${prefix}a2lab2) ) \n',
' }}) \n',
' output${prefix}a2oup2.png <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}a2drX,"_",input${prefix}a2drY,"_", \n',
' input${prefix}a2inp2,".png") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "png", height = input${prefix}a2oup2.h, width = input${prefix}a2oup2.w, \n',
' plot = scDRcell({prefix}conf, {prefix}meta, input${prefix}a2drX, input${prefix}a2drY, input${prefix}a2inp2, \n',
' input${prefix}a2sub1, input${prefix}a2sub2, \n',
' input${prefix}a2siz, input${prefix}a2col2, input${prefix}a2ord2, \n',
' input${prefix}a2fsz, input${prefix}a2asp, input${prefix}a2txt, input${prefix}a2lab2) ) \n',
' }}) \n',
' \n',
' \n',
' ### Plots for tab a3 \n',
'{subst} output${prefix}a3sub1.ui <- renderUI({{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}a3sub1]$fID, "\\\\|")[[1]] \n',
'{subst} checkboxGroupInput("{prefix}a3sub2", "Select which cells to show", inline = TRUE, \n',
'{subst} choices = sub, selected = sub) \n',
'{subst} }}) \n',
'{subst} observeEvent(input${prefix}a3sub1non, {{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}a3sub1]$fID, "\\\\|")[[1]] \n',
'{subst} updateCheckboxGroupInput(session, inputId = "{prefix}a3sub2", label = "Select which cells to show", \n',
'{subst} choices = sub, selected = NULL, inline = TRUE) \n',
'{subst} }}) \n',
'{subst} observeEvent(input${prefix}a3sub1all, {{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}a3sub1]$fID, "\\\\|")[[1]] \n',
'{subst} updateCheckboxGroupInput(session, inputId = "{prefix}a3sub2", label = "Select which cells to show", \n',
'{subst} choices = sub, selected = sub, inline = TRUE) \n',
'{subst} }}) \n',
' output${prefix}a3oup1 <- renderPlot({{ \n',
' scDRgene({prefix}conf, {prefix}meta, input${prefix}a3drX, input${prefix}a3drY, input${prefix}a3inp1, \n',
' input${prefix}a3sub1, input${prefix}a3sub2, \n',
' "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}a3siz, input${prefix}a3col1, input${prefix}a3ord1, \n',
' input${prefix}a3fsz, input${prefix}a3asp, input${prefix}a3txt) \n',
' }}) \n',
' output${prefix}a3oup1.ui <- renderUI({{ \n',
' plotOutput("{prefix}a3oup1", height = pList[input${prefix}a3psz]) \n',
' }}) \n',
' output${prefix}a3oup1.pdf <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}a3drX,"_",input${prefix}a3drY,"_", \n',
' input${prefix}a3inp1,".pdf") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "pdf", height = input${prefix}a3oup1.h, width = input${prefix}a3oup1.w, useDingbats = FALSE, \n',
' plot = scDRgene({prefix}conf, {prefix}meta, input${prefix}a3drX, input${prefix}a3drY, input${prefix}a3inp1, \n',
' input${prefix}a3sub1, input${prefix}a3sub2, \n',
' "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}a3siz, input${prefix}a3col1, input${prefix}a3ord1, \n',
' input${prefix}a3fsz, input${prefix}a3asp, input${prefix}a3txt) ) \n',
' }}) \n',
' output${prefix}a3oup1.png <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}a3drX,"_",input${prefix}a3drY,"_", \n',
' input${prefix}a3inp1,".png") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "png", height = input${prefix}a3oup1.h, width = input${prefix}a3oup1.w, \n',
' plot = scDRgene({prefix}conf, {prefix}meta, input${prefix}a3drX, input${prefix}a3drY, input${prefix}a3inp1, \n',
' input${prefix}a3sub1, input${prefix}a3sub2, \n',
' "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}a3siz, input${prefix}a3col1, input${prefix}a3ord1, \n',
' input${prefix}a3fsz, input${prefix}a3asp, input${prefix}a3txt) ) \n',
' }}) \n',
' \n',
' output${prefix}a3oup2 <- renderPlot({{ \n',
' scDRgene({prefix}conf, {prefix}meta, input${prefix}a3drX, input${prefix}a3drY, input${prefix}a3inp2, \n',
' input${prefix}a3sub1, input${prefix}a3sub2, \n',
' "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}a3siz, input${prefix}a3col2, input${prefix}a3ord2, \n',
' input${prefix}a3fsz, input${prefix}a3asp, input${prefix}a3txt) \n',
' }}) \n',
' output${prefix}a3oup2.ui <- renderUI({{ \n',
' plotOutput("{prefix}a3oup2", height = pList[input${prefix}a3psz]) \n',
' }}) \n',
' output${prefix}a3oup2.pdf <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}a3drX,"_",input${prefix}a3drY,"_", \n',
' input${prefix}a3inp2,".pdf") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "pdf", height = input${prefix}a3oup2.h, width = input${prefix}a3oup2.w, useDingbats = FALSE, \n',
' plot = scDRgene({prefix}conf, {prefix}meta, input${prefix}a3drX, input${prefix}a3drY, input${prefix}a3inp2, \n',
' input${prefix}a3sub1, input${prefix}a3sub2, \n',
' "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}a3siz, input${prefix}a3col2, input${prefix}a3ord2, \n',
' input${prefix}a3fsz, input${prefix}a3asp, input${prefix}a3txt) ) \n',
' }}) \n',
' output${prefix}a3oup2.png <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}a3drX,"_",input${prefix}a3drY,"_", \n',
' input${prefix}a3inp2,".png") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "png", height = input${prefix}a3oup2.h, width = input${prefix}a3oup2.w, \n',
' plot = scDRgene({prefix}conf, {prefix}meta, input${prefix}a3drX, input${prefix}a3drY, input${prefix}a3inp2, \n',
' input${prefix}a3sub1, input${prefix}a3sub2, \n',
' "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}a3siz, input${prefix}a3col2, input${prefix}a3ord2, \n',
' input${prefix}a3fsz, input${prefix}a3asp, input${prefix}a3txt) ) \n',
' }}) \n',
' \n',
' \n',
' ### Plots for tab b2 \n',
'{subst} output${prefix}b2sub1.ui <- renderUI({{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}b2sub1]$fID, "\\\\|")[[1]] \n',
'{subst} checkboxGroupInput("{prefix}b2sub2", "Select which cells to show", inline = TRUE, \n',
'{subst} choices = sub, selected = sub) \n',
'{subst} }}) \n',
'{subst} observeEvent(input${prefix}b2sub1non, {{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}b2sub1]$fID, "\\\\|")[[1]] \n',
'{subst} updateCheckboxGroupInput(session, inputId = "{prefix}b2sub2", label = "Select which cells to show", \n',
'{subst} choices = sub, selected = NULL, inline = TRUE) \n',
'{subst} }}) \n',
'{subst} observeEvent(input${prefix}b2sub1all, {{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}b2sub1]$fID, "\\\\|")[[1]] \n',
'{subst} updateCheckboxGroupInput(session, inputId = "{prefix}b2sub2", label = "Select which cells to show", \n',
'{subst} choices = sub, selected = sub, inline = TRUE) \n',
'{subst} }}) \n',
' output${prefix}b2oup1 <- renderPlot({{ \n',
' scDRcoex({prefix}conf, {prefix}meta, input${prefix}b2drX, input${prefix}b2drY, \n',
' input${prefix}b2inp1, input${prefix}b2inp2, input${prefix}b2sub1, input${prefix}b2sub2, \n',
' "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}b2siz, input${prefix}b2col1, input${prefix}b2ord1, \n',
' input${prefix}b2fsz, input${prefix}b2asp, input${prefix}b2txt) \n',
' }}) \n',
' output${prefix}b2oup1.ui <- renderUI({{ \n',
' plotOutput("{prefix}b2oup1", height = pList2[input${prefix}b2psz]) \n',
' }}) \n',
' output${prefix}b2oup1.pdf <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}b2drX,"_",input${prefix}b2drY,"_", \n',
' input${prefix}b2inp1,"_",input${prefix}b2inp2,".pdf") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "pdf", height = input${prefix}b2oup1.h, width = input${prefix}b2oup1.w, useDingbats = FALSE, \n',
' plot = scDRcoex({prefix}conf, {prefix}meta, input${prefix}b2drX, input${prefix}b2drY, \n',
' input${prefix}b2inp1, input${prefix}b2inp2, input${prefix}b2sub1, input${prefix}b2sub2, \n',
' "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}b2siz, input${prefix}b2col1, input${prefix}b2ord1, \n',
' input${prefix}b2fsz, input${prefix}b2asp, input${prefix}b2txt) ) \n',
' }}) \n',
' output${prefix}b2oup1.png <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}b2drX,"_",input${prefix}b2drY,"_", \n',
' input${prefix}b2inp1,"_",input${prefix}b2inp2,".png") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "png", height = input${prefix}b2oup1.h, width = input${prefix}b2oup1.w, \n',
' plot = scDRcoex({prefix}conf, {prefix}meta, input${prefix}b2drX, input${prefix}b2drY, \n',
' input${prefix}b2inp1, input${prefix}b2inp2, input${prefix}b2sub1, input${prefix}b2sub2, \n',
' "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}b2siz, input${prefix}b2col1, input${prefix}b2ord1, \n',
' input${prefix}b2fsz, input${prefix}b2asp, input${prefix}b2txt) ) \n',
' }}) \n',
' output${prefix}b2oup2 <- renderPlot({{ \n',
' scDRcoexLeg(input${prefix}b2inp1, input${prefix}b2inp2, input${prefix}b2col1, input${prefix}b2fsz) \n',
' }}) \n',
' output${prefix}b2oup2.ui <- renderUI({{ \n',
' plotOutput("{prefix}b2oup2", height = "300px") \n',
' }}) \n',
' output${prefix}b2oup2.pdf <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}b2drX,"_",input${prefix}b2drY,"_", \n',
' input${prefix}b2inp1,"_",input${prefix}b2inp2,"_leg.pdf") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "pdf", height = 3, width = 4, useDingbats = FALSE, \n',
' plot = scDRcoexLeg(input${prefix}b2inp1, input${prefix}b2inp2, input${prefix}b2col1, input${prefix}b2fsz) ) \n',
' }}) \n',
' output${prefix}b2oup2.png <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}b2drX,"_",input${prefix}b2drY,"_", \n',
' input${prefix}b2inp1,"_",input${prefix}b2inp2,"_leg.png") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "png", height = 3, width = 4, \n',
' plot = scDRcoexLeg(input${prefix}b2inp1, input${prefix}b2inp2, input${prefix}b2col1, input${prefix}b2fsz) ) \n',
' }}) \n',
' output${prefix}b2.dt <- renderDataTable({{ \n',
' ggData = scDRcoexNum({prefix}conf, {prefix}meta, input${prefix}b2inp1, input${prefix}b2inp2, \n',
' input${prefix}b2sub1, input${prefix}b2sub2, "{prefix}gexpr.h5", {prefix}gene) \n',
' datatable(ggData, rownames = FALSE, extensions = "Buttons", \n',
' options = list(pageLength = -1, dom = "tB", buttons = c("copy", "csv", "excel"))) %>% \n',
' formatRound(columns = c("percent"), digits = 2) \n',
' }}) \n',
' \n',
' \n',
' ### Plots for tab c1 \n',
'{subst} output${prefix}c1sub1.ui <- renderUI({{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}c1sub1]$fID, "\\\\|")[[1]] \n',
'{subst} checkboxGroupInput("{prefix}c1sub2", "Select which cells to show", inline = TRUE, \n',
'{subst} choices = sub, selected = sub) \n',
'{subst} }}) \n',
'{subst} observeEvent(input${prefix}c1sub1non, {{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}c1sub1]$fID, "\\\\|")[[1]] \n',
'{subst} updateCheckboxGroupInput(session, inputId = "{prefix}c1sub2", label = "Select which cells to show", \n',
'{subst} choices = sub, selected = NULL, inline = TRUE) \n',
'{subst} }}) \n',
'{subst} observeEvent(input${prefix}c1sub1all, {{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}c1sub1]$fID, "\\\\|")[[1]] \n',
'{subst} updateCheckboxGroupInput(session, inputId = "{prefix}c1sub2", label = "Select which cells to show", \n',
'{subst} choices = sub, selected = sub, inline = TRUE) \n',
'{subst} }}) \n',
' output${prefix}c1oup <- renderPlot({{ \n',
' scVioBox({prefix}conf, {prefix}meta, input${prefix}c1inp1, input${prefix}c1inp2, \n',
' input${prefix}c1sub1, input${prefix}c1sub2, \n',
' "{prefix}gexpr.h5", {prefix}gene, input${prefix}c1typ, input${prefix}c1pts, \n',
' input${prefix}c1siz, input${prefix}c1fsz) \n',
' }}) \n',
' output${prefix}c1oup.ui <- renderUI({{ \n',
' plotOutput("{prefix}c1oup", height = pList2[input${prefix}c1psz]) \n',
' }}) \n',
' output${prefix}c1oup.pdf <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}c1typ,"_",input${prefix}c1inp1,"_", \n',
' input${prefix}c1inp2,".pdf") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "pdf", height = input${prefix}c1oup.h, width = input${prefix}c1oup.w, useDingbats = FALSE, \n',
' plot = scVioBox({prefix}conf, {prefix}meta, input${prefix}c1inp1, input${prefix}c1inp2, \n',
' input${prefix}c1sub1, input${prefix}c1sub2, \n',
' "{prefix}gexpr.h5", {prefix}gene, input${prefix}c1typ, input${prefix}c1pts, \n',
' input${prefix}c1siz, input${prefix}c1fsz) ) \n',
' }}) \n',
' output${prefix}c1oup.png <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}c1typ,"_",input${prefix}c1inp1,"_", \n',
' input${prefix}c1inp2,".png") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "png", height = input${prefix}c1oup.h, width = input${prefix}c1oup.w, \n',
' plot = scVioBox({prefix}conf, {prefix}meta, input${prefix}c1inp1, input${prefix}c1inp2, \n',
' input${prefix}c1sub1, input${prefix}c1sub2, \n',
' "{prefix}gexpr.h5", {prefix}gene, input${prefix}c1typ, input${prefix}c1pts, \n',
' input${prefix}c1siz, input${prefix}c1fsz) ) \n',
' }}) \n',
' \n',
' \n',
'### Plots for tab c2 \n',
'{subst} output${prefix}c2sub1.ui <- renderUI({{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}c2sub1]$fID, "\\\\|")[[1]] \n',
'{subst} checkboxGroupInput("{prefix}c2sub2", "Select which cells to show", inline = TRUE, \n',
'{subst} choices = sub, selected = sub) \n',
'{subst} }}) \n',
'{subst} observeEvent(input${prefix}c2sub1non, {{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}c2sub1]$fID, "\\\\|")[[1]] \n',
'{subst} updateCheckboxGroupInput(session, inputId = "{prefix}c2sub2", label = "Select which cells to show", \n',
'{subst} choices = sub, selected = NULL, inline = TRUE) \n',
'{subst} }}) \n',
'{subst} observeEvent(input${prefix}c2sub1all, {{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}c2sub1]$fID, "\\\\|")[[1]] \n',
'{subst} updateCheckboxGroupInput(session, inputId = "{prefix}c2sub2", label = "Select which cells to show", \n',
'{subst} choices = sub, selected = sub, inline = TRUE) \n',
'{subst} }}) \n',
'output${prefix}c2oup <- renderPlot({{ \n',
' scProp({prefix}conf, {prefix}meta, input${prefix}c2inp1, input${prefix}c2inp2, \n',
' input${prefix}c2sub1, input${prefix}c2sub2, \n',
' input${prefix}c2typ, input${prefix}c2flp, input${prefix}c2fsz) \n',
'}}) \n',
'output${prefix}c2oup.ui <- renderUI({{ \n',
' plotOutput("{prefix}c2oup", height = pList2[input${prefix}c2psz]) \n',
'}}) \n',
'output${prefix}c2oup.pdf <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}c2typ,"_",input${prefix}c2inp1,"_", \n',
' input${prefix}c2inp2,".pdf") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "pdf", height = input${prefix}c2oup.h, width = input${prefix}c2oup.w, useDingbats = FALSE, \n',
' plot = scProp({prefix}conf, {prefix}meta, input${prefix}c2inp1, input${prefix}c2inp2, \n',
' input${prefix}c2sub1, input${prefix}c2sub2, \n',
' input${prefix}c2typ, input${prefix}c2flp, input${prefix}c2fsz) ) \n',
' }}) \n',
'output${prefix}c2oup.png <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}c2typ,"_",input${prefix}c2inp1,"_", \n',
' input${prefix}c2inp2,".png") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "png", height = input${prefix}c2oup.h, width = input${prefix}c2oup.w, \n',
' plot = scProp({prefix}conf, {prefix}meta, input${prefix}c2inp1, input${prefix}c2inp2, \n',
' input${prefix}c2sub1, input${prefix}c2sub2, \n',
' input${prefix}c2typ, input${prefix}c2flp, input${prefix}c2fsz) ) \n',
' }}) \n',
' \n',
' \n',
' ### Plots for tab d1 \n',
'{subst} output${prefix}d1sub1.ui <- renderUI({{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}d1sub1]$fID, "\\\\|")[[1]] \n',
'{subst} checkboxGroupInput("{prefix}d1sub2", "Select which cells to show", inline = TRUE, \n',
'{subst} choices = sub, selected = sub) \n',
'{subst} }}) \n',
'{subst} observeEvent(input${prefix}d1sub1non, {{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}d1sub1]$fID, "\\\\|")[[1]] \n',
'{subst} updateCheckboxGroupInput(session, inputId = "{prefix}d1sub2", label = "Select which cells to show", \n',
'{subst} choices = sub, selected = NULL, inline = TRUE) \n',
'{subst} }}) \n',
'{subst} observeEvent(input${prefix}d1sub1all, {{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}d1sub1]$fID, "\\\\|")[[1]] \n',
'{subst} updateCheckboxGroupInput(session, inputId = "{prefix}d1sub2", label = "Select which cells to show", \n',
'{subst} choices = sub, selected = sub, inline = TRUE) \n',
'{subst} }}) \n',
' output${prefix}d1oupTxt <- renderUI({{ \n',
' geneList = scGeneList(input${prefix}d1inp, {prefix}gene) \n',
' if(nrow(geneList) > 50){{ \n',
' HTML("More than 50 input genes! Please reduce the gene list!") \n',
' }} else {{ \n',
' oup = paste0(nrow(geneList[present == TRUE]), " genes OK and will be plotted") \n',
' if(nrow(geneList[present == FALSE]) > 0){{ \n',
' oup = paste0(oup, "<br/>", \n',
' nrow(geneList[present == FALSE]), " genes not found (", \n',
' paste0(geneList[present == FALSE]$gene, collapse = ", "), ")") \n',
' }} \n',
' HTML(oup) \n',
' }} \n',
' }}) \n',
' output${prefix}d1oup <- renderPlot({{ \n',
' scBubbHeat({prefix}conf, {prefix}meta, input${prefix}d1inp, input${prefix}d1grp, input${prefix}d1plt, \n',
' input${prefix}d1sub1, input${prefix}d1sub2, "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}d1scl, input${prefix}d1row, input${prefix}d1col, \n',
' input${prefix}d1cols, input${prefix}d1fsz) \n',
' }}) \n',
' output${prefix}d1oup.ui <- renderUI({{ \n',
' plotOutput("{prefix}d1oup", height = pList3[input${prefix}d1psz]) \n',
' }}) \n',
' output${prefix}d1oup.pdf <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}d1plt,"_",input${prefix}d1grp,".pdf") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "pdf", height = input${prefix}d1oup.h, width = input${prefix}d1oup.w, \n',
' plot = scBubbHeat({prefix}conf, {prefix}meta, input${prefix}d1inp, input${prefix}d1grp, input${prefix}d1plt, \n',
' input${prefix}d1sub1, input${prefix}d1sub2, "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}d1scl, input${prefix}d1row, input${prefix}d1col, \n',
' input${prefix}d1cols, input${prefix}d1fsz, save = TRUE) ) \n',
' }}) \n',
' output${prefix}d1oup.png <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}d1plt,"_",input${prefix}d1grp,".png") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "png", height = input${prefix}d1oup.h, width = input${prefix}d1oup.w, \n',
' plot = scBubbHeat({prefix}conf, {prefix}meta, input${prefix}d1inp, input${prefix}d1grp, input${prefix}d1plt, \n',
' input${prefix}d1sub1, input${prefix}d1sub2, "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}d1scl, input${prefix}d1row, input${prefix}d1col, \n',
' input${prefix}d1cols, input${prefix}d1fsz, save = TRUE) ) \n',
' }}) \n',
' \n',
' \n',
' \n')
}
#' Write code for final portion of server.R
#'
#' @rdname wrSVend
#' @export wrSVend
#'
wrSVend <- function() {
glue::glue(' \n',
' \n',
'}}) \n',
' \n',
' \n',
' \n',
' \n')
}
#' Write code for loading objects for ui.R
#'
#' @param prefix file prefix
#'
#' @rdname wrUIload
#' @export wrUIload
#'
wrUIload <- function(prefix) {
glue::glue('{prefix}conf = readRDS("{prefix}conf.rds")\n',
'{prefix}def = readRDS("{prefix}def.rds")\n',
'\n\n\n\n')
}
#' Write code for front portion of ui.R
#'
#' @param title shiny app title
#' @param ganalytics Google analytics tracking ID (e.g. "UA-123456789-0")
#'
#' @rdname wrUIsingle
#' @export wrUIsingle
#'
wrUIsingle <- function(title, ganalytics) {
if(!is.na(ganalytics)){
ga = 'tags$head(includeHTML(("google-analytics.html"))),'
} else {
ga = ''
}
glue::glue('### Start server code \n',
'shinyUI(fluidPage( \n',
'### HTML formatting of error messages \n',
'{ga} \n',
'tags$head(tags$style(HTML(".shiny-output-error-validation {{color: red; font-weight: bold;}}"))), \n',
'list(tags$style(HTML(".navbar-default .navbar-nav {{ font-weight: bold; font-size: 16px; }}"))), \n',
' \n',
' \n',
'### Page title \n',
'titlePanel("{title}"), \n',
'navbarPage( \n',
' NULL, \n',
' \n')
}
#' Write code for main block of ui.R
#'
#' @param prefix file prefix
#'
#' @rdname wrUImain
#' @export wrUImain
#'
wrUImain <- function(prefix, subst = "", ptsiz = "1.25") {
glue::glue(' ### Tab1.a1: cellInfo vs geneExpr on dimRed \n',
' tabPanel( \n',
' HTML("CellInfo vs GeneExpr"), \n',
' h4("Cell information vs gene expression on reduced dimensions"), \n',
' "In this tab, users can visualise both cell information and gene ", \n',
' "expression side-by-side on low-dimensional representions.", \n',
' br(),br(), \n',
' fluidRow( \n',
' column( \n',
' 3, h4("Dimension Reduction"), \n',
' fluidRow( \n',
' column( \n',
' 12, selectInput("{prefix}a1drX", "X-axis:", choices = {prefix}conf[dimred == TRUE]$UI, \n',
' selected = {prefix}def$dimred[1]), \n',
' selectInput("{prefix}a1drY", "Y-axis:", choices = {prefix}conf[dimred == TRUE]$UI, \n',
' selected = {prefix}def$dimred[2])) \n',
' ) \n',
' ), # End of column (6 space) \n',
' column( \n',
' 3{subst}, actionButton("{prefix}a1togL", "Toggle to subset cells"), \n',
'{subst} conditionalPanel( \n',
'{subst} condition = "input.{prefix}a1togL % 2 == 1", \n',
'{subst} selectInput("{prefix}a1sub1", "Cell information to subset:", \n',
'{subst} choices = {prefix}conf[grp == TRUE]$UI, \n',
'{subst} selected = {prefix}def$grp1), \n',
'{subst} uiOutput("{prefix}a1sub1.ui"), \n',
'{subst} actionButton("{prefix}a1sub1all", "Select all groups", class = "btn btn-primary"), \n',
'{subst} actionButton("{prefix}a1sub1non", "Deselect all groups", class = "btn btn-primary") \n',
'{subst} ) \n',
' ), # End of column (6 space) \n',
' column( \n',
' 6, actionButton("{prefix}a1tog0", "Toggle graphics controls"), \n',
' conditionalPanel( \n',
' condition = "input.{prefix}a1tog0 % 2 == 1", \n',
' fluidRow( \n',
' column( \n',
' 6, sliderInput("{prefix}a1siz", "Point size:", \n',
' min = 0, max = 4, value = {ptsiz}, step = 0.25), \n',
' radioButtons("{prefix}a1psz", "Plot size:", \n',
' choices = c("Small", "Medium", "Large"), \n',
' selected = "Medium", inline = TRUE), \n',
' radioButtons("{prefix}a1fsz", "Font size:", \n',
' choices = c("Small", "Medium", "Large"), \n',
' selected = "Medium", inline = TRUE) \n',
' ), \n',
' column( \n',
' 6, radioButtons("{prefix}a1asp", "Aspect ratio:", \n',
' choices = c("Square", "Fixed", "Free"), \n',
' selected = "Square", inline = TRUE), \n',
' checkboxInput("{prefix}a1txt", "Show axis text", value = FALSE) \n',
' ) \n',
' ) \n',
' ) \n',
' ) # End of column (6 space) \n',
' ), # End of fluidRow (4 space) \n',
' fluidRow( \n',
' column( \n',
' 6, style="border-right: 2px solid black", h4("Cell information"), \n',
' fluidRow( \n',
' column( \n',
' 6, selectInput("{prefix}a1inp1", "Cell information:", \n',
' choices = {prefix}conf$UI, \n',
' selected = {prefix}def$meta1) %>% \n',
' helper(type = "inline", size = "m", fade = TRUE, \n',
' title = "Cell information to colour cells by", \n',
' content = c("Select cell information to colour cells", \n',
' "- Categorical covariates have a fixed colour palette", \n',
' paste0("- Continuous covariates are coloured in a ", \n',
' "Blue-Yellow-Red colour scheme, which can be ", \n',
' "changed in the plot controls"))) \n',
' ), \n',
' column( \n',
' 6, actionButton("{prefix}a1tog1", "Toggle plot controls"), \n',
' conditionalPanel( \n',
' condition = "input.{prefix}a1tog1 % 2 == 1", \n',
' radioButtons("{prefix}a1col1", "Colour (Continuous data):", \n',
' choices = c("White-Red","Blue-Yellow-Red","Yellow-Green-Purple"), \n',
' selected = "Blue-Yellow-Red"), \n',
' radioButtons("{prefix}a1ord1", "Plot order:", \n',
' choices = c("Max-1st", "Min-1st", "Original", "Random"), \n',
' selected = "Original", inline = TRUE), \n',
' checkboxInput("{prefix}a1lab1", "Show cell info labels", value = TRUE) \n',
' ) \n',
' ) \n',
' ), \n',
' fluidRow(column(12, uiOutput("{prefix}a1oup1.ui"))), \n',
' downloadButton("{prefix}a1oup1.pdf", "Download PDF"), \n',
' downloadButton("{prefix}a1oup1.png", "Download PNG"), br(), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}a1oup1.h", "PDF / PNG height:", width = "138px", \n',
' min = 4, max = 20, value = 6, step = 0.5)), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}a1oup1.w", "PDF / PNG width:", width = "138px", \n',
' min = 4, max = 20, value = 8, step = 0.5)), br(), \n',
' actionButton("{prefix}a1tog9", "Toggle to show cell numbers / statistics"), \n',
' conditionalPanel( \n',
' condition = "input.{prefix}a1tog9 % 2 == 1", \n',
' h4("Cell numbers / statistics"), \n',
' radioButtons("{prefix}a1splt", "Split continuous cell info into:", \n',
' choices = c("Quartile", "Decile"), \n',
' selected = "Decile", inline = TRUE), \n',
' dataTableOutput("{prefix}a1.dt") \n',
' ) \n',
' ), # End of column (6 space) \n',
' column( \n',
' 6, h4("Gene expression"), \n',
' fluidRow( \n',
' column( \n',
' 6, selectInput("{prefix}a1inp2", "Gene name:", choices=NULL) %>% \n',
' helper(type = "inline", size = "m", fade = TRUE, \n',
' title = "Gene expression to colour cells by", \n',
' content = c("Select gene to colour cells by gene expression", \n',
' paste0("- Gene expression are coloured in a ", \n',
' "White-Red colour scheme which can be ", \n',
' "changed in the plot controls"))) \n',
' ), \n',
' column( \n',
' 6, actionButton("{prefix}a1tog2", "Toggle plot controls"), \n',
' conditionalPanel( \n',
' condition = "input.{prefix}a1tog2 % 2 == 1", \n',
' radioButtons("{prefix}a1col2", "Colour:", \n',
' choices = c("White-Red","Blue-Yellow-Red","Yellow-Green-Purple"), \n',
' selected = "White-Red"), \n',
' radioButtons("{prefix}a1ord2", "Plot order:", \n',
' choices = c("Max-1st", "Min-1st", "Original", "Random"), \n',
' selected = "Max-1st", inline = TRUE) \n',
' ) \n',
' ) \n',
' ) , \n',
' fluidRow(column(12, uiOutput("{prefix}a1oup2.ui"))), \n',
' downloadButton("{prefix}a1oup2.pdf", "Download PDF"), \n',
' downloadButton("{prefix}a1oup2.png", "Download PNG"), br(), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}a1oup2.h", "PDF / PNG height:", width = "138px", \n',
' min = 4, max = 20, value = 6, step = 0.5)), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}a1oup2.w", "PDF / PNG width:", width = "138px", \n',
' min = 4, max = 20, value = 8, step = 0.5)) \n',
' ) # End of column (6 space) \n',
' ) # End of fluidRow (4 space) \n',
' ), # End of tab (2 space) \n',
' \n',
' ### Tab1.a2: cellInfo vs cellInfo on dimRed \n',
' tabPanel( \n',
' HTML("CellInfo vs CellInfo"), \n',
' h4("Cell information vs cell information on dimension reduction"), \n',
' "In this tab, users can visualise two cell informations side-by-side ", \n',
' "on low-dimensional representions.", \n',
' br(),br(), \n',
' fluidRow( \n',
' column( \n',
' 3, h4("Dimension Reduction"), \n',
' fluidRow( \n',
' column( \n',
' 12, selectInput("{prefix}a2drX", "X-axis:", choices = {prefix}conf[dimred == TRUE]$UI, \n',
' selected = {prefix}def$dimred[1]), \n',
' selectInput("{prefix}a2drY", "Y-axis:", choices = {prefix}conf[dimred == TRUE]$UI, \n',
' selected = {prefix}def$dimred[2])) \n',
' ) \n',
' ), # End of column (6 space) \n',
' column( \n',
' 3{subst}, actionButton("{prefix}a2togL", "Toggle to subset cells"), \n',
'{subst} conditionalPanel( \n',
'{subst} condition = "input.{prefix}a2togL % 2 == 1", \n',
'{subst} selectInput("{prefix}a2sub1", "Cell information to subset:", \n',
'{subst} choices = {prefix}conf[grp == TRUE]$UI, \n',
'{subst} selected = {prefix}def$grp1), \n',
'{subst} uiOutput("{prefix}a2sub1.ui"), \n',
'{subst} actionButton("{prefix}a2sub1all", "Select all groups", class = "btn btn-primary"), \n',
'{subst} actionButton("{prefix}a2sub1non", "Deselect all groups", class = "btn btn-primary") \n',
'{subst} ) \n',
' ), # End of column (6 space) \n',
' column( \n',
' 6, actionButton("{prefix}a2tog0", "Toggle graphics controls"), \n',
' conditionalPanel( \n',
' condition = "input.{prefix}a2tog0 % 2 == 1", \n',
' fluidRow( \n',
' column( \n',
' 6, sliderInput("{prefix}a2siz", "Point size:", \n',
' min = 0, max = 4, value = {ptsiz}, step = 0.25), \n',
' radioButtons("{prefix}a2psz", "Plot size:", \n',
' choices = c("Small", "Medium", "Large"), \n',
' selected = "Medium", inline = TRUE), \n',
' radioButtons("{prefix}a2fsz", "Font size:", \n',
' choices = c("Small", "Medium", "Large"), \n',
' selected = "Medium", inline = TRUE) \n',
' ), \n',
' column( \n',
' 6, radioButtons("{prefix}a2asp", "Aspect ratio:", \n',
' choices = c("Square", "Fixed", "Free"), \n',
' selected = "Square", inline = TRUE), \n',
' checkboxInput("{prefix}a2txt", "Show axis text", value = FALSE) \n',
' ) \n',
' ) \n',
' ) \n',
' ) # End of column (6 space) \n',
' ), # End of fluidRow (4 space) \n',
' fluidRow( \n',
' column( \n',
' 6, style="border-right: 2px solid black", h4("Cell information 1"), \n',
' fluidRow( \n',
' column( \n',
' 6, selectInput("{prefix}a2inp1", "Cell information:", \n',
' choices = {prefix}conf$UI, \n',
' selected = {prefix}def$meta1) %>% \n',
' helper(type = "inline", size = "m", fade = TRUE, \n',
' title = "Cell information to colour cells by", \n',
' content = c("Select cell information to colour cells", \n',
' "- Categorical covariates have a fixed colour palette", \n',
' paste0("- Continuous covariates are coloured in a ", \n',
' "Blue-Yellow-Red colour scheme, which can be ", \n',
' "changed in the plot controls"))) \n',
' ), \n',
' column( \n',
' 6, actionButton("{prefix}a2tog1", "Toggle plot controls"), \n',
' conditionalPanel( \n',
' condition = "input.{prefix}a2tog1 % 2 == 1", \n',
' radioButtons("{prefix}a2col1", "Colour (Continuous data):", \n',
' choices = c("White-Red", "Blue-Yellow-Red", \n',
' "Yellow-Green-Purple"), \n',
' selected = "Blue-Yellow-Red"), \n',
' radioButtons("{prefix}a2ord1", "Plot order:", \n',
' choices = c("Max-1st", "Min-1st", "Original", "Random"), \n',
' selected = "Original", inline = TRUE), \n',
' checkboxInput("{prefix}a2lab1", "Show cell info labels", value = TRUE) \n',
' ) \n',
' ) \n',
' ), \n',
' fluidRow(column(12, uiOutput("{prefix}a2oup1.ui"))), \n',
' downloadButton("{prefix}a2oup1.pdf", "Download PDF"), \n',
' downloadButton("{prefix}a2oup1.png", "Download PNG"), br(), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}a2oup1.h", "PDF / PNG height:", width = "138px", \n',
' min = 4, max = 20, value = 6, step = 0.5)), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}a2oup1.w", "PDF / PNG width:", width = "138px", \n',
' min = 4, max = 20, value = 8, step = 0.5)) \n',
' ), # End of column (6 space) \n',
' column( \n',
' 6, h4("Cell information 2"), \n',
' fluidRow( \n',
' column( \n',
' 6, selectInput("{prefix}a2inp2", "Cell information:", \n',
' choices = {prefix}conf$UI, \n',
' selected = {prefix}def$meta2) %>% \n',
' helper(type = "inline", size = "m", fade = TRUE, \n',
' title = "Cell information to colour cells by", \n',
' content = c("Select cell information to colour cells", \n',
' "- Categorical covariates have a fixed colour palette", \n',
' paste0("- Continuous covariates are coloured in a ", \n',
' "Blue-Yellow-Red colour scheme, which can be ", \n',
' "changed in the plot controls"))) \n',
' ), \n',
' column( \n',
' 6, actionButton("{prefix}a2tog2", "Toggle plot controls"), \n',
' conditionalPanel( \n',
' condition = "input.{prefix}a2tog2 % 2 == 1", \n',
' radioButtons("{prefix}a2col2", "Colour (Continuous data):", \n',
' choices = c("White-Red", "Blue-Yellow-Red", \n',
' "Yellow-Green-Purple"), \n',
' selected = "Blue-Yellow-Red"), \n',
' radioButtons("{prefix}a2ord2", "Plot order:", \n',
' choices = c("Max-1st", "Min-1st", "Original", "Random"), \n',
' selected = "Original", inline = TRUE), \n',
' checkboxInput("{prefix}a2lab2", "Show cell info labels", value = TRUE) \n',
' ) \n',
' ) \n',
' ), \n',
' fluidRow(column(12, uiOutput("{prefix}a2oup2.ui"))), \n',
' downloadButton("{prefix}a2oup2.pdf", "Download PDF"), \n',
' downloadButton("{prefix}a2oup2.png", "Download PNG"), br(), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}a2oup2.h", "PDF / PNG height:", width = "138px", \n',
' min = 4, max = 20, value = 6, step = 0.5)), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}a2oup2.w", "PDF / PNG width:", width = "138px", \n',
' min = 4, max = 20, value = 8, step = 0.5)) \n',
' ) # End of column (6 space) \n',
' ) # End of fluidRow (4 space) \n',
' ), # End of tab (2 space) \n',
' \n',
' ### Tab1.a3: geneExpr vs geneExpr on dimRed \n',
' tabPanel( \n',
' HTML("GeneExpr vs GeneExpr"), \n',
' h4("Gene expression vs gene expression on dimension reduction"), \n',
' "In this tab, users can visualise two gene expressions side-by-side ", \n',
' "on low-dimensional representions.", \n',
' br(),br(), \n',
' fluidRow( \n',
' column( \n',
' 3, h4("Dimension Reduction"), \n',
' fluidRow( \n',
' column( \n',
' 12, selectInput("{prefix}a3drX", "X-axis:", choices = {prefix}conf[dimred == TRUE]$UI, \n',
' selected = {prefix}def$dimred[1]), \n',
' selectInput("{prefix}a3drY", "Y-axis:", choices = {prefix}conf[dimred == TRUE]$UI, \n',
' selected = {prefix}def$dimred[2])) \n',
' ) \n',
' ), # End of column (6 space) \n',
' column( \n',
' 3{subst}, actionButton("{prefix}a3togL", "Toggle to subset cells"), \n',
'{subst} conditionalPanel( \n',
'{subst} condition = "input.{prefix}a3togL % 2 == 1", \n',
'{subst} selectInput("{prefix}a3sub1", "Cell information to subset:", \n',
'{subst} choices = {prefix}conf[grp == TRUE]$UI, \n',
'{subst} selected = {prefix}def$grp1), \n',
'{subst} uiOutput("{prefix}a3sub1.ui"), \n',
'{subst} actionButton("{prefix}a3sub1all", "Select all groups", class = "btn btn-primary"), \n',
'{subst} actionButton("{prefix}a3sub1non", "Deselect all groups", class = "btn btn-primary") \n',
'{subst} ) \n',
' ), # End of column (6 space) \n',
' column( \n',
' 6, actionButton("{prefix}a3tog0", "Toggle graphics controls"), \n',
' conditionalPanel( \n',
' condition = "input.{prefix}a3tog0 % 2 == 1", \n',
' fluidRow( \n',
' column( \n',
' 6, sliderInput("{prefix}a3siz", "Point size:", \n',
' min = 0, max = 4, value = {ptsiz}, step = 0.25), \n',
' radioButtons("{prefix}a3psz", "Plot size:", \n',
' choices = c("Small", "Medium", "Large"), \n',
' selected = "Medium", inline = TRUE), \n',
' radioButtons("{prefix}a3fsz", "Font size:", \n',
' choices = c("Small", "Medium", "Large"), \n',
' selected = "Medium", inline = TRUE) \n',
' ), \n',
' column( \n',
' 6, radioButtons("{prefix}a3asp", "Aspect ratio:", \n',
' choices = c("Square", "Fixed", "Free"), \n',
' selected = "Square", inline = TRUE), \n',
' checkboxInput("{prefix}a3txt", "Show axis text", value = FALSE) \n',
' ) \n',
' ) \n',
' ) \n',
' ) # End of column (6 space) \n',
' ), # End of fluidRow (4 space) \n',
' fluidRow( \n',
' column( \n',
' 6, style="border-right: 2px solid black", h4("Gene expression 1"), \n',
' fluidRow( \n',
' column( \n',
' 6, selectInput("{prefix}a3inp1", "Gene name:", choices=NULL) %>% \n',
' helper(type = "inline", size = "m", fade = TRUE, \n',
' title = "Gene expression to colour cells by", \n',
' content = c("Select gene to colour cells by gene expression", \n',
' paste0("- Gene expression are coloured in a ", \n',
' "White-Red colour scheme which can be ", \n',
' "changed in the plot controls"))) \n',
' ), \n',
' column( \n',
' 6, actionButton("{prefix}a3tog1", "Toggle plot controls"), \n',
' conditionalPanel( \n',
' condition = "input.{prefix}a3tog1 % 2 == 1", \n',
' radioButtons("{prefix}a3col1", "Colour:", \n',
' choices = c("White-Red", "Blue-Yellow-Red", \n',
' "Yellow-Green-Purple"), \n',
' selected = "White-Red"), \n',
' radioButtons("{prefix}a3ord1", "Plot order:", \n',
' choices = c("Max-1st", "Min-1st", "Original", "Random"), \n',
' selected = "Max-1st", inline = TRUE) \n',
' ) \n',
' ) \n',
' ), \n',
' fluidRow(column(12, uiOutput("{prefix}a3oup1.ui"))), \n',
' downloadButton("{prefix}a3oup1.pdf", "Download PDF"), \n',
' downloadButton("{prefix}a3oup1.png", "Download PNG"), br(), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}a3oup1.h", "PDF / PNG height:", width = "138px", \n',
' min = 4, max = 20, value = 6, step = 0.5)), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}a3oup1.w", "PDF / PNG width:", width = "138px", \n',
' min = 4, max = 20, value = 8, step = 0.5)) \n',
' ), # End of column (6 space) \n',
' column( \n',
' 6, h4("Gene expression 2"), \n',
' fluidRow( \n',
' column( \n',
' 6, selectInput("{prefix}a3inp2", "Gene name:", choices=NULL) %>% \n',
' helper(type = "inline", size = "m", fade = TRUE, \n',
' title = "Gene expression to colour cells by", \n',
' content = c("Select gene to colour cells by gene expression", \n',
' paste0("- Gene expression are coloured in a ", \n',
' "White-Red colour scheme which can be ", \n',
' "changed in the plot controls"))) \n',
' ), \n',
' column( \n',
' 6, actionButton("{prefix}a3tog2", "Toggle plot controls"), \n',
' conditionalPanel( \n',
' condition = "input.{prefix}a3tog2 % 2 == 1", \n',
' radioButtons("{prefix}a3col2", "Colour:", \n',
' choices = c("White-Red", "Blue-Yellow-Red", \n',
' "Yellow-Green-Purple"), \n',
' selected = "White-Red"), \n',
' radioButtons("{prefix}a3ord2", "Plot order:", \n',
' choices = c("Max-1st", "Min-1st", "Original", "Random"), \n',
' selected = "Max-1st", inline = TRUE) \n',
' ) \n',
' ) \n',
' ), \n',
' fluidRow(column(12, uiOutput("{prefix}a3oup2.ui"))), \n',
' downloadButton("{prefix}a3oup2.pdf", "Download PDF"), \n',
' downloadButton("{prefix}a3oup2.png", "Download PNG"), br(), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}a3oup2.h", "PDF / PNG height:", width = "138px", \n',
' min = 4, max = 20, value = 6, step = 0.5)), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}a3oup2.w", "PDF / PNG width:", width = "138px", \n',
' min = 4, max = 20, value = 8, step = 0.5)) \n',
' ) # End of column (6 space) \n',
' ) # End of fluidRow (4 space) \n',
' ), # End of tab (2 space) \n',
' \n',
' ### Tab1.b2: Gene coexpression plot \n',
' tabPanel( \n',
' HTML("Gene coexpression"), \n',
' h4("Coexpression of two genes on reduced dimensions"), \n',
' "In this tab, users can visualise the coexpression of two genes ", \n',
' "on low-dimensional representions.", \n',
' br(),br(), \n',
' fluidRow( \n',
' column( \n',
' 3, h4("Dimension Reduction"), \n',
' fluidRow( \n',
' column( \n',
' 12, selectInput("{prefix}b2drX", "X-axis:", choices = {prefix}conf[dimred == TRUE]$UI, \n',
' selected = {prefix}def$dimred[1]), \n',
' selectInput("{prefix}b2drY", "Y-axis:", choices = {prefix}conf[dimred == TRUE]$UI, \n',
' selected = {prefix}def$dimred[2])) \n',
' ) \n',
' ), # End of column (6 space) \n',
' column( \n',
' 3{subst}, actionButton("{prefix}b2togL", "Toggle to subset cells"), \n',
'{subst} conditionalPanel( \n',
'{subst} condition = "input.{prefix}b2togL % 2 == 1", \n',
'{subst} selectInput("{prefix}b2sub1", "Cell information to subset:", \n',
'{subst} choices = {prefix}conf[grp == TRUE]$UI, \n',
'{subst} selected = {prefix}def$grp1), \n',
'{subst} uiOutput("{prefix}b2sub1.ui"), \n',
'{subst} actionButton("{prefix}b2sub1all", "Select all groups", class = "btn btn-primary"), \n',
'{subst} actionButton("{prefix}b2sub1non", "Deselect all groups", class = "btn btn-primary") \n',
'{subst} ) \n',
' ), # End of column (6 space) \n',
' column( \n',
' 6, actionButton("{prefix}b2tog0", "Toggle graphics controls"), \n',
' conditionalPanel( \n',
' condition = "input.{prefix}b2tog0 % 2 == 1", \n',
' fluidRow( \n',
' column( \n',
' 6, sliderInput("{prefix}b2siz", "Point size:", \n',
' min = 0, max = 4, value = {ptsiz}, step = 0.25), \n',
' radioButtons("{prefix}b2psz", "Plot size:", \n',
' choices = c("Small", "Medium", "Large"), \n',
' selected = "Medium", inline = TRUE), \n',
' radioButtons("{prefix}b2fsz", "Font size:", \n',
' choices = c("Small", "Medium", "Large"), \n',
' selected = "Medium", inline = TRUE) \n',
' ), \n',
' column( \n',
' 6, radioButtons("{prefix}b2asp", "Aspect ratio:", \n',
' choices = c("Square", "Fixed", "Free"), \n',
' selected = "Square", inline = TRUE), \n',
' checkboxInput("{prefix}b2txt", "Show axis text", value = FALSE) \n',
' ) \n',
' ) \n',
' ) \n',
' ) # End of column (6 space) \n',
' ), # End of fluidRow (4 space) \n',
' fluidRow( \n',
' column( \n',
' 3, style="border-right: 2px solid black", h4("Gene Expression"), \n',
' selectInput("{prefix}b2inp1", "Gene 1:", choices=NULL) %>% \n',
' helper(type = "inline", size = "m", fade = TRUE, \n',
' title = "Gene expression to colour cells by", \n',
' content = c("Select gene to colour cells by gene expression", \n',
' paste0("- Gene expression are coloured in a ", \n',
' "White-Red colour scheme which can be ", \n',
' "changed in the plot controls"))), \n',
' selectInput("{prefix}b2inp2", "Gene 2:", choices=NULL) %>% \n',
' helper(type = "inline", size = "m", fade = TRUE, \n',
' title = "Gene expression to colour cells by", \n',
' content = c("Select gene to colour cells by gene expression", \n',
' paste0("- Gene expression are coloured in a ", \n',
' "White-Blue colour scheme which can be ", \n',
' "changed in the plot controls"))), \n',
' actionButton("{prefix}b2tog1", "Toggle plot controls"), \n',
' conditionalPanel( \n',
' condition = "input.{prefix}b2tog1 % 2 == 1", \n',
' radioButtons("{prefix}b2col1", "Colour:", \n',
' choices = c("Red (Gene1); Blue (Gene2)", \n',
' "Orange (Gene1); Blue (Gene2)", \n',
' "Red (Gene1); Green (Gene2)", \n',
' "Green (Gene1); Blue (Gene2)"), \n',
' selected = "Red (Gene1); Blue (Gene2)"), \n',
' radioButtons("{prefix}b2ord1", "Plot order:", \n',
' choices = c("Max-1st", "Min-1st", "Original", "Random"), \n',
' selected = "Max-1st", inline = TRUE) \n',
' ) \n',
' ), # End of column (6 space) \n',
' column( \n',
' 6, style="border-right: 2px solid black", \n',
' uiOutput("{prefix}b2oup1.ui"), \n',
' downloadButton("{prefix}b2oup1.pdf", "Download PDF"), \n',
' downloadButton("{prefix}b2oup1.png", "Download PNG"), br(), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}b2oup1.h", "PDF / PNG height:", width = "138px", \n',
' min = 4, max = 20, value = 8, step = 0.5)), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}b2oup1.w", "PDF / PNG width:", width = "138px", \n',
' min = 4, max = 20, value = 10, step = 0.5)) \n',
' ), # End of column (6 space) \n',
' column( \n',
' 3, uiOutput("{prefix}b2oup2.ui"), \n',
' downloadButton("{prefix}b2oup2.pdf", "Download PDF"), \n',
' downloadButton("{prefix}b2oup2.png", "Download PNG"), \n',
' br(), h4("Cell numbers"), \n',
' dataTableOutput("{prefix}b2.dt") \n',
' ) # End of column (6 space) \n',
' ) # End of fluidRow (4 space) \n',
' ), # End of tab (2 space) \n',
' \n',
' ### Tab1.c1: violinplot / boxplot \n',
' tabPanel( \n',
' HTML("Violinplot / Boxplot"), \n',
' h4("Cell information / gene expression violin plot / box plot"), \n',
' "In this tab, users can visualise the gene expression or continuous cell information ", \n',
' "(e.g. Number of UMIs / module score) across groups of cells (e.g. libary / clusters).", \n',
' br(),br(), \n',
' fluidRow( \n',
' column( \n',
' 3, style="border-right: 2px solid black", \n',
' selectInput("{prefix}c1inp1", "Cell information (X-axis):", \n',
' choices = {prefix}conf[grp == TRUE]$UI, \n',
' selected = {prefix}def$grp1) %>% \n',
' helper(type = "inline", size = "m", fade = TRUE, \n',
' title = "Cell information to group cells by", \n',
' content = c("Select categorical cell information to group cells by", \n',
' "- Single cells are grouped by this categorical covariate", \n',
' "- Plotted as the X-axis of the violin plot / box plot")), \n',
' selectInput("{prefix}c1inp2", "Cell Info / Gene name (Y-axis):", choices=NULL) %>% \n',
' helper(type = "inline", size = "m", fade = TRUE, \n',
' title = "Cell Info / Gene to plot", \n',
' content = c("Select cell info / gene to plot on Y-axis", \n',
' "- Can be continuous cell information (e.g. nUMIs / scores)", \n',
' "- Can also be gene expression")), \n',
' radioButtons("{prefix}c1typ", "Plot type:", \n',
' choices = c("violin", "boxplot"), \n',
' selected = "violin", inline = TRUE), \n',
' checkboxInput("{prefix}c1pts", "Show data points", value = FALSE), \n',
'{subst} actionButton("{prefix}c1togL", "Toggle to subset cells"), \n',
'{subst} conditionalPanel( \n',
'{subst} condition = "input.{prefix}c1togL % 2 == 1", \n',
'{subst} selectInput("{prefix}c1sub1", "Cell information to subset:", \n',
'{subst} choices = {prefix}conf[grp == TRUE]$UI, \n',
'{subst} selected = {prefix}def$grp1), \n',
'{subst} uiOutput("{prefix}c1sub1.ui"), \n',
'{subst} actionButton("{prefix}c1sub1all", "Select all groups", class = "btn btn-primary"), \n',
'{subst} actionButton("{prefix}c1sub1non", "Deselect all groups", class = "btn btn-primary") \n',
'{subst} ), br(), br(), \n',
' actionButton("{prefix}c1tog", "Toggle graphics controls"), \n',
' conditionalPanel( \n',
' condition = "input.{prefix}c1tog % 2 == 1", \n',
' sliderInput("{prefix}c1siz", "Data point size:", \n',
' min = 0, max = 4, value = {ptsiz}, step = 0.25), \n',
' radioButtons("{prefix}c1psz", "Plot size:", \n',
' choices = c("Small", "Medium", "Large"), \n',
' selected = "Medium", inline = TRUE), \n',
' radioButtons("{prefix}c1fsz", "Font size:", \n',
' choices = c("Small", "Medium", "Large"), \n',
' selected = "Medium", inline = TRUE)) \n',
' ), # End of column (6 space) \n',
' column(9, uiOutput("{prefix}c1oup.ui"), \n',
' downloadButton("{prefix}c1oup.pdf", "Download PDF"), \n',
' downloadButton("{prefix}c1oup.png", "Download PNG"), br(), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}c1oup.h", "PDF / PNG height:", width = "138px", \n',
' min = 4, max = 20, value = 8, step = 0.5)), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}c1oup.w", "PDF / PNG width:", width = "138px", \n',
' min = 4, max = 20, value = 10, step = 0.5)) \n',
' ) # End of column (6 space) \n',
' ) # End of fluidRow (4 space) \n',
' ), # End of tab (2 space) \n',
' \n',
'### Tab1.c2: Proportion plot \n',
'tabPanel( \n',
' HTML("Proportion plot"), \n',
' h4("Proportion / cell numbers across different cell information"), \n',
' "In this tab, users can visualise the composition of single cells based on one discrete ", \n',
' "cell information across another discrete cell information. ", \n',
' "Usage examples include the library or cellcycle composition across clusters.", \n',
' br(),br(), \n',
' fluidRow( \n',
' column( \n',
' 3, style="border-right: 2px solid black", \n',
' selectInput("{prefix}c2inp1", "Cell information to plot (X-axis):", \n',
' choices = {prefix}conf[grp == TRUE]$UI, \n',
' selected = {prefix}def$grp2) %>% \n',
' helper(type = "inline", size = "m", fade = TRUE, \n',
' title = "Cell information to plot cells by", \n',
' content = c("Select categorical cell information to plot cells by", \n',
' "- Plotted as the X-axis of the proportion plot")), \n',
' selectInput("{prefix}c2inp2", "Cell information to group / colour by:", \n',
' choices = {prefix}conf[grp == TRUE]$UI, \n',
' selected = {prefix}def$grp1) %>% \n',
' helper(type = "inline", size = "m", fade = TRUE, \n',
' title = "Cell information to group / colour cells by", \n',
' content = c("Select categorical cell information to group / colour cells by", \n',
' "- Proportion / cell numbers are shown in different colours")), \n',
' radioButtons("{prefix}c2typ", "Plot value:", \n',
' choices = c("Proportion", "CellNumbers"), \n',
' selected = "Proportion", inline = TRUE), \n',
' checkboxInput("{prefix}c2flp", "Flip X/Y", value = FALSE), \n',
'{subst} actionButton("{prefix}c2togL", "Toggle to subset cells"), \n',
'{subst} conditionalPanel( \n',
'{subst} condition = "input.{prefix}c2togL % 2 == 1", \n',
'{subst} selectInput("{prefix}c2sub1", "Cell information to subset:", \n',
'{subst} choices = {prefix}conf[grp == TRUE]$UI, \n',
'{subst} selected = {prefix}def$grp1), \n',
'{subst} uiOutput("{prefix}c2sub1.ui"), \n',
'{subst} actionButton("{prefix}c2sub1all", "Select all groups", class = "btn btn-primary"), \n',
'{subst} actionButton("{prefix}c2sub1non", "Deselect all groups", class = "btn btn-primary") \n',
'{subst} ), br(), br(), \n',
' actionButton("{prefix}c2tog", "Toggle graphics controls"), \n',
' conditionalPanel( \n',
' condition = "input.{prefix}c2tog % 2 == 1", \n',
' radioButtons("{prefix}c2psz", "Plot size:", \n',
' choices = c("Small", "Medium", "Large"), \n',
' selected = "Medium", inline = TRUE), \n',
' radioButtons("{prefix}c2fsz", "Font size:", \n',
' choices = c("Small", "Medium", "Large"), \n',
' selected = "Medium", inline = TRUE)) \n',
' ), # End of column (6 space) \n',
' column(9, uiOutput("{prefix}c2oup.ui"), \n',
' downloadButton("{prefix}c2oup.pdf", "Download PDF"), \n',
' downloadButton("{prefix}c2oup.png", "Download PNG"), br(), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}c2oup.h", "PDF / PNG height:", width = "138px", \n',
' min = 4, max = 20, value = 8, step = 0.5)), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}c2oup.w", "PDF / PNG width:", width = "138px", \n',
' min = 4, max = 20, value = 10, step = 0.5)) \n',
' ) # End of column (6 space) \n',
' ) # End of fluidRow (4 space) \n',
'), # End of tab (2 space) \n',
' \n',
' ### Tab1.d1: Multiple gene expr \n',
' tabPanel( \n',
' HTML("Bubbleplot / Heatmap"), \n',
' h4("Gene expression bubbleplot / heatmap"), \n',
' "In this tab, users can visualise the gene expression patterns of ", \n',
' "multiple genes grouped by categorical cell information (e.g. library / cluster).", br(), \n',
' "The normalised expression are averaged, log-transformed and then plotted.", \n',
' br(),br(), \n',
' fluidRow( \n',
' column( \n',
' 3, style="border-right: 2px solid black", \n',
' textAreaInput("{prefix}d1inp", HTML("List of gene names <br /> \n',
' (Max 50 genes, separated <br /> \n',
' by , or ; or newline):"), \n',
' height = "200px", \n',
' value = paste0({prefix}def$genes, collapse = ", ")) %>% \n',
' helper(type = "inline", size = "m", fade = TRUE, \n',
' title = "List of genes to plot on bubbleplot / heatmap", \n',
' content = c("Input genes to plot", \n',
' "- Maximum 50 genes (due to ploting space limitations)", \n',
' "- Genes should be separated by comma, semicolon or newline")), \n',
' selectInput("{prefix}d1grp", "Group by:", \n',
' choices = {prefix}conf[grp == TRUE]$UI, \n',
' selected = {prefix}conf[grp == TRUE]$UI[1]) %>% \n',
' helper(type = "inline", size = "m", fade = TRUE, \n',
' title = "Cell information to group cells by", \n',
' content = c("Select categorical cell information to group cells by", \n',
' "- Single cells are grouped by this categorical covariate", \n',
' "- Plotted as the X-axis of the bubbleplot / heatmap")), \n',
' radioButtons("{prefix}d1plt", "Plot type:", \n',
' choices = c("Bubbleplot", "Heatmap"), \n',
' selected = "Bubbleplot", inline = TRUE), \n',
' checkboxInput("{prefix}d1scl", "Scale gene expression", value = TRUE), \n',
' checkboxInput("{prefix}d1row", "Cluster rows (genes)", value = TRUE), \n',
' checkboxInput("{prefix}d1col", "Cluster columns (samples)", value = FALSE), \n',
' br(), \n',
'{subst} actionButton("{prefix}d1togL", "Toggle to subset cells"), \n',
'{subst} conditionalPanel( \n',
'{subst} condition = "input.{prefix}d1togL % 2 == 1", \n',
'{subst} selectInput("{prefix}d1sub1", "Cell information to subset:", \n',
'{subst} choices = {prefix}conf[grp == TRUE]$UI, \n',
'{subst} selected = {prefix}def$grp1), \n',
'{subst} uiOutput("{prefix}d1sub1.ui"), \n',
'{subst} actionButton("{prefix}d1sub1all", "Select all groups", class = "btn btn-primary"), \n',
'{subst} actionButton("{prefix}d1sub1non", "Deselect all groups", class = "btn btn-primary") \n',
'{subst} ), br(), br(), \n',
' actionButton("{prefix}d1tog", "Toggle graphics controls"), \n',
' conditionalPanel( \n',
' condition = "input.{prefix}d1tog % 2 == 1", \n',
' radioButtons("{prefix}d1cols", "Colour scheme:", \n',
' choices = c("White-Red", "Blue-Yellow-Red", \n',
' "Yellow-Green-Purple"), \n',
' selected = "Blue-Yellow-Red"), \n',
' radioButtons("{prefix}d1psz", "Plot size:", \n',
' choices = c("Small", "Medium", "Large"), \n',
' selected = "Medium", inline = TRUE), \n',
' radioButtons("{prefix}d1fsz", "Font size:", \n',
' choices = c("Small", "Medium", "Large"), \n',
' selected = "Medium", inline = TRUE)) \n',
' ), # End of column (6 space) \n',
' column(9, h4(htmlOutput("{prefix}d1oupTxt")), \n',
' uiOutput("{prefix}d1oup.ui"), \n',
' downloadButton("{prefix}d1oup.pdf", "Download PDF"), \n',
' downloadButton("{prefix}d1oup.png", "Download PNG"), br(), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}d1oup.h", "PDF / PNG height:", width = "138px", \n',
' min = 4, max = 20, value = 10, step = 0.5)), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}d1oup.w", "PDF / PNG width:", width = "138px", \n',
' min = 4, max = 20, value = 10, step = 0.5)) \n',
' ) # End of column (6 space) \n',
' ) # End of fluidRow (4 space) \n',
' ) # End of tab (2 space) \n',
' \n')
}
#' Write code for final portion of ui.R
#'
#' @param footnote shiny app footnote
#'
#' @rdname wrUIend
#' @export wrUIend
#'
wrUIend <- function(footnote) {
if(is.list(footnote)){
f1 = ''; f2 = ''; f3 = ''; f4 = ''; f5 = ''; f6 = ''; f7 = ''; f8 = ''
if(!is.null(footnote$author)){ f1 = paste0('"',footnote$author,' ",')}
if(!is.null(footnote$title)){ f2 = paste0('"',footnote$title,' ",')}
if(!is.null(footnote$journal)){f3 = paste0('em("',footnote$journal,' "),')}
if(!is.null(footnote$volume)){ f4 = paste0('strong("',footnote$volume,', "),')}
if(!is.null(footnote$page)){ f5 = paste0('"',footnote$page,' ",')}
if(!is.null(footnote$year)){ f6 = paste0('"(',footnote$year,') ",')}
if(!is.null(footnote$doi)){ f7 = paste0('"doi: ',footnote$doi,' ",')}
if(!is.null(footnote$link)){ f8 = paste0('a("[Link]", href = "',footnote$link,'", target="_blank"),')}
f0 = paste0('strong("Reference: "),', f1, f2, f3, f4, f5, f6, f7, f8,
'style = "font-size: 125%;"')
} else {
f0 = paste0('"', footnote[[1]], '", style = "font-size: 125%;"')
}
glue::glue(' \n',
' \n',
'br(), \n',
'p({f0}), \n',
'p(em("This webpage was made using "), a("ShinyCell", \n',
' href = "https://github.com/SGDDNB/ShinyCell",target="_blank")), \n',
'br(),br(),br(),br(),br() \n',
'))) \n',
' \n',
' \n',
' \n',
' \n')
}
#' Write code for google-analytics.html
#'
#' @param gaID Google analytics tracking ID (e.g. "UA-123456789-0")
#'
#' @rdname wrUIga
#' @export wrUIga
#'
wrUIga <- function(gaID) {
glue::glue('<!-- Global site tag (gtag.js) - Google Analytics --> \n',
' <script async src="https://www.googletagmanager.com/gtag/js?id={gaID}"></script> \n',
' <script> \n',
' window.dataLayer = window.dataLayer || []; \n',
'function gtag(){{dataLayer.push(arguments);}} \n',
'gtag(\'js\', new Date()); \n',
' \n',
'gtag(\'config\', \'{gaID}\'); \n',
'</script> \n')
}
SGDDNB/ShinyCell documentation built on Jan. 25, 2024, 3:19 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions wrUIga wrUIend wrUImain wrUIsingle wrUIload wrSVend wrSVmain wrSVfix wrSVload wrLib
Documented in wrLib wrSVend wrSVfix wrSVload wrSVmain wrUIend wrUIga wrUIload wrUImain wrUIsingle
#' Write code for loading libraries
#'
#' @param lib vector of libraries
#'
#' @rdname wrLib
#' @export wrLib
#'
wrLib <- function(lib) {
oup = ""
for(iLib in lib){
oup = paste0(oup, "library(", iLib, ") \n")
}
glue::glue(paste0(oup, "\n"))
}
#' Write code for loading objects for server.R
#'
#' @param prefix file prefix
#'
#' @rdname wrSVload
#' @export wrSVload
#'
wrSVload <- function(prefix) {
glue::glue('{prefix}conf = readRDS("{prefix}conf.rds")\n',
'{prefix}def = readRDS("{prefix}def.rds")\n',
'{prefix}gene = readRDS("{prefix}gene.rds")\n',
'{prefix}meta = readRDS("{prefix}meta.rds")\n',
'\n\n\n\n')
}
#' Write code for fixed portion of server.R
#'
#' @rdname wrSVfix
#' @export wrSVfix
#'
wrSVfix <- function() {
glue::glue('### Useful stuff \n',
'# Colour palette \n',
'cList = list(c("grey85","#FFF7EC","#FEE8C8","#FDD49E","#FDBB84", \n',
' "#FC8D59","#EF6548","#D7301F","#B30000","#7F0000"), \n',
' c("#4575B4","#74ADD1","#ABD9E9","#E0F3F8","#FFFFBF", \n',
' "#FEE090","#FDAE61","#F46D43","#D73027")[c(1,1:9,9)], \n',
' c("#FDE725","#AADC32","#5DC863","#27AD81","#21908C", \n',
' "#2C728E","#3B528B","#472D7B","#440154")) \n',
'names(cList) = c("White-Red", "Blue-Yellow-Red", "Yellow-Green-Purple") \n',
' \n',
'# Panel sizes \n',
'pList = c("400px", "600px", "800px") \n',
'names(pList) = c("Small", "Medium", "Large") \n',
'pList2 = c("500px", "700px", "900px") \n',
'names(pList2) = c("Small", "Medium", "Large") \n',
'pList3 = c("600px", "800px", "1000px") \n',
'names(pList3) = c("Small", "Medium", "Large") \n',
'sList = c(18,24,30) \n',
'names(sList) = c("Small", "Medium", "Large") \n',
'lList = c(5,6,7) \n',
'names(lList) = c("Small", "Medium", "Large") \n',
' \n',
'# Function to extract legend \n',
'g_legend <- function(a.gplot){{ \n',
' tmp <- ggplot_gtable(ggplot_build(a.gplot)) \n',
' leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box") \n',
' legend <- tmp$grobs[[leg]] \n',
' legend \n',
'}} \n',
' \n',
'# Plot theme \n',
'sctheme <- function(base_size = 24, XYval = TRUE, Xang = 0, XjusH = 0.5){{ \n',
' oupTheme = theme( \n',
' text = element_text(size = base_size, family = "Helvetica"), \n',
' panel.background = element_rect(fill = "white", colour = NA), \n',
' axis.line = element_line(colour = "black"), \n',
' axis.ticks = element_line(colour = "black", size = base_size / 20), \n',
' axis.title = element_text(face = "bold"), \n',
' axis.text = element_text(size = base_size), \n',
' axis.text.x = element_text(angle = Xang, hjust = XjusH), \n',
' legend.position = "bottom", \n',
' legend.key = element_rect(colour = NA, fill = NA) \n',
' ) \n',
' if(!XYval){{ \n',
' oupTheme = oupTheme + theme( \n',
' axis.text.x = element_blank(), axis.ticks.x = element_blank(), \n',
' axis.text.y = element_blank(), axis.ticks.y = element_blank()) \n',
' }} \n',
' return(oupTheme) \n',
'}} \n',
' \n',
'### Common plotting functions \n',
'# Plot cell information on dimred \n',
'scDRcell <- function(inpConf, inpMeta, inpdrX, inpdrY, inp1, inpsub1, inpsub2, \n',
' inpsiz, inpcol, inpord, inpfsz, inpasp, inptxt, inplab){{ \n',
' if(is.null(inpsub1)){{inpsub1 = inpConf$UI[1]}} \n',
' # Prepare ggData \n',
' ggData = inpMeta[, c(inpConf[UI == inpdrX]$ID, inpConf[UI == inpdrY]$ID, \n',
' inpConf[UI == inp1]$ID, inpConf[UI == inpsub1]$ID), \n',
' with = FALSE] \n',
' colnames(ggData) = c("X", "Y", "val", "sub") \n',
' rat = (max(ggData$X) - min(ggData$X)) / (max(ggData$Y) - min(ggData$Y)) \n',
' bgCells = FALSE \n',
' if(length(inpsub2) != 0 & length(inpsub2) != nlevels(ggData$sub)){{ \n',
' bgCells = TRUE \n',
' ggData2 = ggData[!sub %in% inpsub2] \n',
' ggData = ggData[sub %in% inpsub2] \n',
' }} \n',
' if(inpord == "Max-1st"){{ \n',
' ggData = ggData[order(val)] \n',
' }} else if(inpord == "Min-1st"){{ \n',
' ggData = ggData[order(-val)] \n',
' }} else if(inpord == "Random"){{ \n',
' ggData = ggData[sample(nrow(ggData))] \n',
' }} \n',
' \n',
' # Do factoring if required \n',
' if(!is.na(inpConf[UI == inp1]$fCL)){{ \n',
' ggCol = strsplit(inpConf[UI == inp1]$fCL, "\\\\|")[[1]] \n',
' names(ggCol) = levels(ggData$val) \n',
' ggLvl = levels(ggData$val)[levels(ggData$val) %in% unique(ggData$val)] \n',
' ggData$val = factor(ggData$val, levels = ggLvl) \n',
' ggCol = ggCol[ggLvl] \n',
' }} \n',
' \n',
' # Actual ggplot \n',
' ggOut = ggplot(ggData, aes(X, Y, color = val)) \n',
' if(bgCells){{ \n',
' ggOut = ggOut + \n',
' geom_point(data = ggData2, color = "snow2", size = inpsiz, shape = 16) \n',
' }} \n',
' ggOut = ggOut + \n',
' geom_point(size = inpsiz, shape = 16) + xlab(inpdrX) + ylab(inpdrY) + \n',
' sctheme(base_size = sList[inpfsz], XYval = inptxt) \n',
' if(is.na(inpConf[UI == inp1]$fCL)){{ \n',
' ggOut = ggOut + scale_color_gradientn("", colours = cList[[inpcol]]) + \n',
' guides(color = guide_colorbar(barwidth = 15)) \n',
' }} else {{ \n',
' sListX = min(nchar(paste0(levels(ggData$val), collapse = "")), 200) \n',
' sListX = 0.75 * (sList - (1.5 * floor(sListX/50))) \n',
' ggOut = ggOut + scale_color_manual("", values = ggCol) + \n',
' guides(color = guide_legend(override.aes = list(size = 5), \n',
' nrow = inpConf[UI == inp1]$fRow)) + \n',
' theme(legend.text = element_text(size = sListX[inpfsz])) \n',
' if(inplab){{ \n',
' ggData3 = ggData[, .(X = mean(X), Y = mean(Y)), by = "val"] \n',
' lListX = min(nchar(paste0(ggData3$val, collapse = "")), 200) \n',
' lListX = lList - (0.25 * floor(lListX/50)) \n',
' ggOut = ggOut + \n',
' geom_text_repel(data = ggData3, aes(X, Y, label = val), \n',
' color = "grey10", bg.color = "grey95", bg.r = 0.15, \n',
' size = lListX[inpfsz], seed = 42) \n',
' }} \n',
' }} \n',
' if(inpasp == "Square") {{ \n',
' ggOut = ggOut + coord_fixed(ratio = rat) \n',
' }} else if(inpasp == "Fixed") {{ \n',
' ggOut = ggOut + coord_fixed() \n',
' }} \n',
' return(ggOut) \n',
'}} \n',
' \n',
'scDRnum <- function(inpConf, inpMeta, inp1, inp2, inpsub1, inpsub2, \n',
' inpH5, inpGene, inpsplt){{ \n',
' if(is.null(inpsub1)){{inpsub1 = inpConf$UI[1]}} \n',
' # Prepare ggData \n',
' ggData = inpMeta[, c(inpConf[UI == inp1]$ID, inpConf[UI == inpsub1]$ID), \n',
' with = FALSE] \n',
' colnames(ggData) = c("group", "sub") \n',
' h5file <- H5File$new(inpH5, mode = "r") \n',
' h5data <- h5file[["grp"]][["data"]] \n',
' ggData$val2 = h5data$read(args = list(inpGene[inp2], quote(expr=))) \n',
' ggData[val2 < 0]$val2 = 0 \n',
' h5file$close_all() \n',
' if(length(inpsub2) != 0 & length(inpsub2) != nlevels(ggData$sub)){{ \n',
' ggData = ggData[sub %in% inpsub2] \n',
' }} \n',
' \n',
' # Split inp1 if necessary \n',
' if(is.na(inpConf[UI == inp1]$fCL)){{ \n',
' if(inpsplt == "Quartile"){{nBk = 4}} \n',
' if(inpsplt == "Decile"){{nBk = 10}} \n',
' ggData$group = cut(ggData$group, breaks = nBk) \n',
' }} \n',
' \n',
' # Actual data.table \n',
' ggData$express = FALSE \n',
' ggData[val2 > 0]$express = TRUE \n',
' ggData1 = ggData[express == TRUE, .(nExpress = .N), by = "group"] \n',
' ggData = ggData[, .(nCells = .N), by = "group"] \n',
' ggData = ggData1[ggData, on = "group"] \n',
' ggData = ggData[, c("group", "nCells", "nExpress"), with = FALSE] \n',
' ggData[is.na(nExpress)]$nExpress = 0 \n',
' ggData$pctExpress = 100 * ggData$nExpress / ggData$nCells \n',
' ggData = ggData[order(group)] \n',
' colnames(ggData)[3] = paste0(colnames(ggData)[3], "_", inp2) \n',
' return(ggData) \n',
'}} \n',
'# Plot gene expression on dimred \n',
'scDRgene <- function(inpConf, inpMeta, inpdrX, inpdrY, inp1, inpsub1, inpsub2, \n',
' inpH5, inpGene, \n',
' inpsiz, inpcol, inpord, inpfsz, inpasp, inptxt){{ \n',
' if(is.null(inpsub1)){{inpsub1 = inpConf$UI[1]}} \n',
' # Prepare ggData \n',
' ggData = inpMeta[, c(inpConf[UI == inpdrX]$ID, inpConf[UI == inpdrY]$ID, \n',
' inpConf[UI == inpsub1]$ID), \n',
' with = FALSE] \n',
' colnames(ggData) = c("X", "Y", "sub") \n',
' rat = (max(ggData$X) - min(ggData$X)) / (max(ggData$Y) - min(ggData$Y)) \n',
' \n',
' h5file <- H5File$new(inpH5, mode = "r") \n',
' h5data <- h5file[["grp"]][["data"]] \n',
' ggData$val = h5data$read(args = list(inpGene[inp1], quote(expr=))) \n',
' ggData[val < 0]$val = 0 \n',
' h5file$close_all() \n',
' bgCells = FALSE \n',
' if(length(inpsub2) != 0 & length(inpsub2) != nlevels(ggData$sub)){{ \n',
' bgCells = TRUE \n',
' ggData2 = ggData[!sub %in% inpsub2] \n',
' ggData = ggData[sub %in% inpsub2] \n',
' }} \n',
' if(inpord == "Max-1st"){{ \n',
' ggData = ggData[order(val)] \n',
' }} else if(inpord == "Min-1st"){{ \n',
' ggData = ggData[order(-val)] \n',
' }} else if(inpord == "Random"){{ \n',
' ggData = ggData[sample(nrow(ggData))] \n',
' }} \n',
' \n',
' # Actual ggplot \n',
' ggOut = ggplot(ggData, aes(X, Y, color = val)) \n',
' if(bgCells){{ \n',
' ggOut = ggOut + \n',
' geom_point(data = ggData2, color = "snow2", size = inpsiz, shape = 16) \n',
' }} \n',
' ggOut = ggOut + \n',
' geom_point(size = inpsiz, shape = 16) + xlab(inpdrX) + ylab(inpdrY) + \n',
' sctheme(base_size = sList[inpfsz], XYval = inptxt) + \n',
' scale_color_gradientn(inp1, colours = cList[[inpcol]]) + \n',
' guides(color = guide_colorbar(barwidth = 15)) \n',
' if(inpasp == "Square") {{ \n',
' ggOut = ggOut + coord_fixed(ratio = rat) \n',
' }} else if(inpasp == "Fixed") {{ \n',
' ggOut = ggOut + coord_fixed() \n',
' }} \n',
' return(ggOut) \n',
'}} \n',
' \n',
'# Plot gene coexpression on dimred \n',
'bilinear <- function(x,y,xy,Q11,Q21,Q12,Q22){{ \n',
' oup = (xy-x)*(xy-y)*Q11 + x*(xy-y)*Q21 + (xy-x)*y*Q12 + x*y*Q22 \n',
' oup = oup / (xy*xy) \n',
' return(oup) \n',
'}} \n',
'scDRcoex <- function(inpConf, inpMeta, inpdrX, inpdrY, inp1, inp2, \n',
' inpsub1, inpsub2, inpH5, inpGene, \n',
' inpsiz, inpcol, inpord, inpfsz, inpasp, inptxt){{ \n',
' if(is.null(inpsub1)){{inpsub1 = inpConf$UI[1]}} \n',
' # Prepare ggData \n',
' ggData = inpMeta[, c(inpConf[UI == inpdrX]$ID, inpConf[UI == inpdrY]$ID, \n',
' inpConf[UI == inpsub1]$ID), \n',
' with = FALSE] \n',
' colnames(ggData) = c("X", "Y", "sub") \n',
' rat = (max(ggData$X) - min(ggData$X)) / (max(ggData$Y) - min(ggData$Y)) \n',
' \n',
' h5file <- H5File$new(inpH5, mode = "r") \n',
' h5data <- h5file[["grp"]][["data"]] \n',
' ggData$val1 = h5data$read(args = list(inpGene[inp1], quote(expr=))) \n',
' ggData[val1 < 0]$val1 = 0 \n',
' ggData$val2 = h5data$read(args = list(inpGene[inp2], quote(expr=))) \n',
' ggData[val2 < 0]$val2 = 0 \n',
' h5file$close_all() \n',
' bgCells = FALSE \n',
' if(length(inpsub2) != 0 & length(inpsub2) != nlevels(ggData$sub)){{ \n',
' bgCells = TRUE \n',
' ggData2 = ggData[!sub %in% inpsub2] \n',
' ggData = ggData[sub %in% inpsub2] \n',
' }} \n',
' \n',
' # Generate coex color palette \n',
' cInp = strsplit(inpcol, "; ")[[1]] \n',
' if(cInp[1] == "Red (Gene1)"){{ \n',
' c10 = c(255,0,0) \n',
' }} else if(cInp[1] == "Orange (Gene1)"){{ \n',
' c10 = c(255,140,0) \n',
' }} else {{ \n',
' c10 = c(0,255,0) \n',
' }} \n',
' if(cInp[2] == "Green (Gene2)"){{ \n',
' c01 = c(0,255,0) \n',
' }} else {{ \n',
' c01 = c(0,0,255) \n',
' }} \n',
' c00 = c(217,217,217) ; c11 = c10 + c01 \n',
' nGrid = 16; nPad = 2; nTot = nGrid + nPad * 2 \n',
' gg = data.table(v1 = rep(0:nTot,nTot+1), v2 = sort(rep(0:nTot,nTot+1))) \n',
' gg$vv1 = gg$v1 - nPad ; gg[vv1 < 0]$vv1 = 0; gg[vv1 > nGrid]$vv1 = nGrid \n',
' gg$vv2 = gg$v2 - nPad ; gg[vv2 < 0]$vv2 = 0; gg[vv2 > nGrid]$vv2 = nGrid \n',
' gg$cR = bilinear(gg$vv1, gg$vv2, nGrid, c00[1], c10[1], c01[1], c11[1]) \n',
' gg$cG = bilinear(gg$vv1, gg$vv2, nGrid, c00[2], c10[2], c01[2], c11[2]) \n',
' gg$cB = bilinear(gg$vv1, gg$vv2, nGrid, c00[3], c10[3], c01[3], c11[3]) \n',
' gg$cMix = rgb(gg$cR, gg$cG, gg$cB, maxColorValue = 255) \n',
' gg = gg[, c("v1", "v2", "cMix")] \n',
' \n',
' # Map colours \n',
' ggData$v1 = round(nTot * ggData$val1 / max(ggData$val1)) \n',
' ggData$v2 = round(nTot * ggData$val2 / max(ggData$val2)) \n',
' ggData$v0 = ggData$v1 + ggData$v2 \n',
' ggData = gg[ggData, on = c("v1", "v2")] \n',
' if(inpord == "Max-1st"){{ \n',
' ggData = ggData[order(v0)] \n',
' }} else if(inpord == "Min-1st"){{ \n',
' ggData = ggData[order(-v0)] \n',
' }} else if(inpord == "Random"){{ \n',
' ggData = ggData[sample(nrow(ggData))] \n',
' }} \n',
' \n',
' # Actual ggplot \n',
' ggOut = ggplot(ggData, aes(X, Y)) \n',
' if(bgCells){{ \n',
' ggOut = ggOut + \n',
' geom_point(data = ggData2, color = "snow2", size = inpsiz, shape = 16) \n',
' }} \n',
' ggOut = ggOut + \n',
' geom_point(size = inpsiz, shape = 16, color = ggData$cMix) + \n',
' xlab(inpdrX) + ylab(inpdrY) + \n',
' sctheme(base_size = sList[inpfsz], XYval = inptxt) + \n',
' scale_color_gradientn(inp1, colours = cList[[1]]) + \n',
' guides(color = guide_colorbar(barwidth = 15)) \n',
' if(inpasp == "Square") {{ \n',
' ggOut = ggOut + coord_fixed(ratio = rat) \n',
' }} else if(inpasp == "Fixed") {{ \n',
' ggOut = ggOut + coord_fixed() \n',
' }} \n',
' return(ggOut) \n',
'}} \n',
' \n',
'scDRcoexLeg <- function(inp1, inp2, inpcol, inpfsz){{ \n',
' # Generate coex color palette \n',
' cInp = strsplit(inpcol, "; ")[[1]] \n',
' if(cInp[1] == "Red (Gene1)"){{ \n',
' c10 = c(255,0,0) \n',
' }} else if(cInp[1] == "Orange (Gene1)"){{ \n',
' c10 = c(255,140,0) \n',
' }} else {{ \n',
' c10 = c(0,255,0) \n',
' }} \n',
' if(cInp[2] == "Green (Gene2)"){{ \n',
' c01 = c(0,255,0) \n',
' }} else {{ \n',
' c01 = c(0,0,255) \n',
' }} \n',
' c00 = c(217,217,217) ; c11 = c10 + c01 \n',
' nGrid = 16; nPad = 2; nTot = nGrid + nPad * 2 \n',
' gg = data.table(v1 = rep(0:nTot,nTot+1), v2 = sort(rep(0:nTot,nTot+1))) \n',
' gg$vv1 = gg$v1 - nPad ; gg[vv1 < 0]$vv1 = 0; gg[vv1 > nGrid]$vv1 = nGrid \n',
' gg$vv2 = gg$v2 - nPad ; gg[vv2 < 0]$vv2 = 0; gg[vv2 > nGrid]$vv2 = nGrid \n',
' gg$cR = bilinear(gg$vv1, gg$vv2, nGrid, c00[1], c10[1], c01[1], c11[1]) \n',
' gg$cG = bilinear(gg$vv1, gg$vv2, nGrid, c00[2], c10[2], c01[2], c11[2]) \n',
' gg$cB = bilinear(gg$vv1, gg$vv2, nGrid, c00[3], c10[3], c01[3], c11[3]) \n',
' gg$cMix = rgb(gg$cR, gg$cG, gg$cB, maxColorValue = 255) \n',
' gg = gg[, c("v1", "v2", "cMix")] \n',
' \n',
' # Actual ggplot \n',
' ggOut = ggplot(gg, aes(v1, v2)) + \n',
' geom_tile(fill = gg$cMix) + \n',
' xlab(inp1) + ylab(inp2) + coord_fixed(ratio = 1) + \n',
' scale_x_continuous(breaks = c(0, nTot), label = c("low", "high")) + \n',
' scale_y_continuous(breaks = c(0, nTot), label = c("low", "high")) + \n',
' sctheme(base_size = sList[inpfsz], XYval = TRUE) \n',
' return(ggOut) \n',
'}} \n',
' \n',
'scDRcoexNum <- function(inpConf, inpMeta, inp1, inp2, \n',
' inpsub1, inpsub2, inpH5, inpGene){{ \n',
' if(is.null(inpsub1)){{inpsub1 = inpConf$UI[1]}} \n',
' # Prepare ggData \n',
' ggData = inpMeta[, c(inpConf[UI == inpsub1]$ID), with = FALSE] \n',
' colnames(ggData) = c("sub") \n',
' h5file <- H5File$new(inpH5, mode = "r") \n',
' h5data <- h5file[["grp"]][["data"]] \n',
' ggData$val1 = h5data$read(args = list(inpGene[inp1], quote(expr=))) \n',
' ggData[val1 < 0]$val1 = 0 \n',
' ggData$val2 = h5data$read(args = list(inpGene[inp2], quote(expr=))) \n',
' ggData[val2 < 0]$val2 = 0 \n',
' h5file$close_all() \n',
' if(length(inpsub2) != 0 & length(inpsub2) != nlevels(ggData$sub)){{ \n',
' ggData = ggData[sub %in% inpsub2] \n',
' }} \n',
' \n',
' # Actual data.table \n',
' ggData$express = "none" \n',
' ggData[val1 > 0]$express = inp1 \n',
' ggData[val2 > 0]$express = inp2 \n',
' ggData[val1 > 0 & val2 > 0]$express = "both" \n',
' ggData$express = factor(ggData$express, levels = unique(c("both", inp1, inp2, "none"))) \n',
' ggData = ggData[, .(nCells = .N), by = "express"] \n',
' ggData$percent = 100 * ggData$nCells / sum(ggData$nCells) \n',
' ggData = ggData[order(express)] \n',
' colnames(ggData)[1] = "expression > 0" \n',
' return(ggData) \n',
'}} \n',
' \n',
'# Plot violin / boxplot \n',
'scVioBox <- function(inpConf, inpMeta, inp1, inp2, \n',
' inpsub1, inpsub2, inpH5, inpGene, \n',
' inptyp, inppts, inpsiz, inpfsz){{ \n',
' if(is.null(inpsub1)){{inpsub1 = inpConf$UI[1]}} \n',
' # Prepare ggData \n',
' ggData = inpMeta[, c(inpConf[UI == inp1]$ID, inpConf[UI == inpsub1]$ID), \n',
' with = FALSE] \n',
' colnames(ggData) = c("X", "sub") \n',
' \n',
' # Load in either cell meta or gene expr\n',
' if(inp2 %in% inpConf$UI){{ \n',
' ggData$val = inpMeta[[inpConf[UI == inp2]$ID]] \n',
' }} else {{ \n',
' h5file <- H5File$new(inpH5, mode = "r") \n',
' h5data <- h5file[["grp"]][["data"]] \n',
' ggData$val = h5data$read(args = list(inpGene[inp2], quote(expr=))) \n',
' ggData[val < 0]$val = 0 \n',
' set.seed(42) \n',
' tmpNoise = rnorm(length(ggData$val)) * diff(range(ggData$val)) / 1000 \n',
' ggData$val = ggData$val + tmpNoise \n',
' h5file$close_all() \n',
' }} \n',
' if(length(inpsub2) != 0 & length(inpsub2) != nlevels(ggData$sub)){{ \n',
' ggData = ggData[sub %in% inpsub2] \n',
' }} \n',
' \n',
' # Do factoring \n',
' ggCol = strsplit(inpConf[UI == inp1]$fCL, "\\\\|")[[1]] \n',
' names(ggCol) = levels(ggData$X) \n',
' ggLvl = levels(ggData$X)[levels(ggData$X) %in% unique(ggData$X)] \n',
' ggData$X = factor(ggData$X, levels = ggLvl) \n',
' ggCol = ggCol[ggLvl] \n',
' \n',
' # Actual ggplot \n',
' if(inptyp == "violin"){{ \n',
' ggOut = ggplot(ggData, aes(X, val, fill = X)) + geom_violin(scale = "width") \n',
' }} else {{ \n',
' ggOut = ggplot(ggData, aes(X, val, fill = X)) + geom_boxplot() \n',
' }} \n',
' if(inppts){{ \n',
' ggOut = ggOut + geom_jitter(size = inpsiz, shape = 16) \n',
' }} \n',
' ggOut = ggOut + xlab(inp1) + ylab(inp2) + \n',
' sctheme(base_size = sList[inpfsz], Xang = 45, XjusH = 1) + \n',
' scale_fill_manual("", values = ggCol) +\n',
' theme(legend.position = "none")\n',
' return(ggOut) \n',
'}} \n',
' \n',
'# Plot proportion plot \n',
'scProp <- function(inpConf, inpMeta, inp1, inp2, inpsub1, inpsub2, \n',
' inptyp, inpflp, inpfsz){{ \n',
' if(is.null(inpsub1)){{inpsub1 = inpConf$UI[1]}} \n',
' # Prepare ggData \n',
' ggData = inpMeta[, c(inpConf[UI == inp1]$ID, inpConf[UI == inp2]$ID, \n',
' inpConf[UI == inpsub1]$ID), \n',
' with = FALSE] \n',
' colnames(ggData) = c("X", "grp", "sub") \n',
' if(length(inpsub2) != 0 & length(inpsub2) != nlevels(ggData$sub)){{ \n',
' ggData = ggData[sub %in% inpsub2] \n',
' }} \n',
' ggData = ggData[, .(nCells = .N), by = c("X", "grp")] \n',
' ggData = ggData[, {{tot = sum(nCells) \n',
' .SD[,.(pctCells = 100 * sum(nCells) / tot, \n',
' nCells = nCells), by = "grp"]}}, by = "X"] \n',
' \n',
' # Do factoring \n',
' ggCol = strsplit(inpConf[UI == inp2]$fCL, "\\\\|")[[1]] \n',
' names(ggCol) = levels(ggData$grp) \n',
' ggLvl = levels(ggData$grp)[levels(ggData$grp) %in% unique(ggData$grp)] \n',
' ggData$grp = factor(ggData$grp, levels = ggLvl) \n',
' ggCol = ggCol[ggLvl] \n',
' \n',
' # Actual ggplot \n',
' if(inptyp == "Proportion"){{ \n',
' ggOut = ggplot(ggData, aes(X, pctCells, fill = grp)) + \n',
' geom_col() + ylab("Cell Proportion (%)") \n',
' }} else {{ \n',
' ggOut = ggplot(ggData, aes(X, nCells, fill = grp)) + \n',
' geom_col() + ylab("Number of Cells") \n',
' }} \n',
' if(inpflp){{ \n',
' ggOut = ggOut + coord_flip() \n',
' }} \n',
' ggOut = ggOut + xlab(inp1) + \n',
' sctheme(base_size = sList[inpfsz], Xang = 45, XjusH = 1) + \n',
' scale_fill_manual("", values = ggCol) + \n',
' theme(legend.position = "right") \n',
' return(ggOut) \n',
'}} \n',
' \n',
'# Get gene list \n',
'scGeneList <- function(inp, inpGene){{ \n',
' geneList = data.table(gene = unique(trimws(strsplit(inp, ",|;|\n")[[1]])), \n',
' present = TRUE) \n',
' geneList[!gene %in% names(inpGene)]$present = FALSE \n',
' return(geneList) \n',
'}} \n',
' \n',
'# Plot gene expression bubbleplot / heatmap \n',
'scBubbHeat <- function(inpConf, inpMeta, inp, inpGrp, inpPlt, \n',
' inpsub1, inpsub2, inpH5, inpGene, inpScl, inpRow, inpCol, \n',
' inpcols, inpfsz, save = FALSE){{ \n',
' if(is.null(inpsub1)){{inpsub1 = inpConf$UI[1]}} \n',
' # Identify genes that are in our dataset \n',
' geneList = scGeneList(inp, inpGene) \n',
' geneList = geneList[present == TRUE] \n',
' shiny::validate(need(nrow(geneList) <= 50, "More than 50 genes to plot! Please reduce the gene list!")) \n',
' shiny::validate(need(nrow(geneList) > 1, "Please input at least 2 genes to plot!")) \n',
' \n',
' # Prepare ggData \n',
' h5file <- H5File$new(inpH5, mode = "r") \n',
' h5data <- h5file[["grp"]][["data"]] \n',
' ggData = data.table() \n',
' for(iGene in geneList$gene){{ \n',
' tmp = inpMeta[, c("sampleID", inpConf[UI == inpsub1]$ID), with = FALSE] \n',
' colnames(tmp) = c("sampleID", "sub") \n',
' tmp$grpBy = inpMeta[[inpConf[UI == inpGrp]$ID]] \n',
' tmp$geneName = iGene \n',
' tmp$val = h5data$read(args = list(inpGene[iGene], quote(expr=))) \n',
' ggData = rbindlist(list(ggData, tmp)) \n',
' }} \n',
' h5file$close_all() \n',
' if(length(inpsub2) != 0 & length(inpsub2) != nlevels(ggData$sub)){{ \n',
' ggData = ggData[sub %in% inpsub2] \n',
' }} \n',
' shiny::validate(need(uniqueN(ggData$grpBy) > 1, "Only 1 group present, unable to plot!")) \n',
' \n',
' # Aggregate \n',
' ggData$val = expm1(ggData$val) \n',
' ggData = ggData[, .(val = mean(val), prop = sum(val>0) / length(sampleID)), \n',
' by = c("geneName", "grpBy")] \n',
' ggData$val = log1p(ggData$val) \n',
' \n',
' # Scale if required \n',
' colRange = range(ggData$val) \n',
' if(inpScl){{ \n',
' ggData[, val:= scale(val), keyby = "geneName"] \n',
' colRange = c(-max(abs(range(ggData$val))), max(abs(range(ggData$val)))) \n',
' }} \n',
' \n',
' # hclust row/col if necessary \n',
' ggMat = dcast.data.table(ggData, geneName~grpBy, value.var = "val") \n',
' tmp = ggMat$geneName \n',
' ggMat = as.matrix(ggMat[, -1]) \n',
' rownames(ggMat) = tmp \n',
' if(inpRow){{ \n',
' hcRow = dendro_data(as.dendrogram(hclust(dist(ggMat)))) \n',
' ggRow = ggplot() + coord_flip() + \n',
' geom_segment(data = hcRow$segments, aes(x=x,y=y,xend=xend,yend=yend)) + \n',
' scale_y_continuous(breaks = rep(0, uniqueN(ggData$grpBy)), \n',
' labels = unique(ggData$grpBy), expand = c(0, 0)) + \n',
' scale_x_continuous(breaks = seq_along(hcRow$labels$label), \n',
' labels = hcRow$labels$label, expand = c(0, 0.5)) + \n',
' sctheme(base_size = sList[inpfsz]) + \n',
' theme(axis.title = element_blank(), axis.line = element_blank(), \n',
' axis.ticks = element_blank(), axis.text.y = element_blank(), \n',
' axis.text.x = element_text(color="white", angle = 45, hjust = 1)) \n',
' ggData$geneName = factor(ggData$geneName, levels = hcRow$labels$label) \n',
' }} else {{ \n',
' ggData$geneName = factor(ggData$geneName, levels = rev(geneList$gene)) \n',
' }} \n',
' if(inpCol){{ \n',
' hcCol = dendro_data(as.dendrogram(hclust(dist(t(ggMat))))) \n',
' ggCol = ggplot() + \n',
' geom_segment(data = hcCol$segments, aes(x=x,y=y,xend=xend,yend=yend)) + \n',
' scale_x_continuous(breaks = seq_along(hcCol$labels$label), \n',
' labels = hcCol$labels$label, expand = c(0.05, 0)) + \n',
' scale_y_continuous(breaks = rep(0, uniqueN(ggData$geneName)), \n',
' labels = unique(ggData$geneName), expand=c(0,0)) + \n',
' sctheme(base_size = sList[inpfsz], Xang = 45, XjusH = 1) + \n',
' theme(axis.title = element_blank(), axis.line = element_blank(), \n',
' axis.ticks = element_blank(), axis.text.x = element_blank(), \n',
' axis.text.y = element_text(color = "white")) \n',
' ggData$grpBy = factor(ggData$grpBy, levels = hcCol$labels$label) \n',
' }} \n',
' \n',
' # Actual plot according to plottype \n',
' if(inpPlt == "Bubbleplot"){{ \n',
' # Bubbleplot \n',
' ggOut = ggplot(ggData, aes(grpBy, geneName, color = val, size = prop)) + \n',
' geom_point() + \n',
' sctheme(base_size = sList[inpfsz], Xang = 45, XjusH = 1) + \n',
' scale_x_discrete(expand = c(0.05, 0)) + \n',
' scale_y_discrete(expand = c(0, 0.5)) + \n',
' scale_size_continuous("proportion", range = c(0, 8), \n',
' limits = c(0, 1), breaks = c(0.00,0.25,0.50,0.75,1.00)) + \n',
' scale_color_gradientn("expression", limits = colRange, colours = cList[[inpcols]]) + \n',
' guides(color = guide_colorbar(barwidth = 15)) + \n',
' theme(axis.title = element_blank(), legend.box = "vertical") \n',
' }} else {{ \n',
' # Heatmap \n',
' ggOut = ggplot(ggData, aes(grpBy, geneName, fill = val)) + \n',
' geom_tile() + \n',
' sctheme(base_size = sList[inpfsz], Xang = 45, XjusH = 1) + \n',
' scale_x_discrete(expand = c(0.05, 0)) + \n',
' scale_y_discrete(expand = c(0, 0.5)) + \n',
' scale_fill_gradientn("expression", limits = colRange, colours = cList[[inpcols]]) + \n',
' guides(fill = guide_colorbar(barwidth = 15)) + \n',
' theme(axis.title = element_blank()) \n',
' }} \n',
' \n',
' # Final tidy \n',
' ggLeg = g_legend(ggOut) \n',
' ggOut = ggOut + theme(legend.position = "none") \n',
' if(!save){{ \n',
' if(inpRow & inpCol){{ggOut = \n',
' grid.arrange(ggOut, ggLeg, ggCol, ggRow, widths = c(7,1), heights = c(1,7,2), \n',
' layout_matrix = rbind(c(3,NA),c(1,4),c(2,NA))) \n',
' }} else if(inpRow){{ggOut = \n',
' grid.arrange(ggOut, ggLeg, ggRow, widths = c(7,1), heights = c(7,2), \n',
' layout_matrix = rbind(c(1,3),c(2,NA))) \n',
' }} else if(inpCol){{ggOut = \n',
' grid.arrange(ggOut, ggLeg, ggCol, heights = c(1,7,2), \n',
' layout_matrix = rbind(c(3),c(1),c(2))) \n',
' }} else {{ggOut = \n',
' grid.arrange(ggOut, ggLeg, heights = c(7,2), \n',
' layout_matrix = rbind(c(1),c(2))) \n',
' }} \n',
' }} else {{ \n',
' if(inpRow & inpCol){{ggOut = \n',
' arrangeGrob(ggOut, ggLeg, ggCol, ggRow, widths = c(7,1), heights = c(1,7,2), \n',
' layout_matrix = rbind(c(3,NA),c(1,4),c(2,NA))) \n',
' }} else if(inpRow){{ggOut = \n',
' arrangeGrob(ggOut, ggLeg, ggRow, widths = c(7,1), heights = c(7,2), \n',
' layout_matrix = rbind(c(1,3),c(2,NA))) \n',
' }} else if(inpCol){{ggOut = \n',
' arrangeGrob(ggOut, ggLeg, ggCol, heights = c(1,7,2), \n',
' layout_matrix = rbind(c(3),c(1),c(2))) \n',
' }} else {{ggOut = \n',
' arrangeGrob(ggOut, ggLeg, heights = c(7,2), \n',
' layout_matrix = rbind(c(1),c(2))) \n',
' }} \n',
' }} \n',
' return(ggOut) \n',
'}} \n',
' \n',
' \n',
' \n',
' \n',
' \n',
'### Start server code \n',
'shinyServer(function(input, output, session) {{ \n',
' ### For all tags and Server-side selectize \n',
' observe_helpers() \n',
' \n')
}
#' Write code for main block of server.R
#'
#' @param prefix file prefix
#'
#' @rdname wrSVmain
#' @export wrSVmain
#'
wrSVmain <- function(prefix, subst = "") {
glue::glue('optCrt="{{ option_create: function(data,escape) {{return(\'<div class=\\"create\\"><strong>\' + \'</strong></div>\');}} }}" \n',
' updateSelectizeInput(session, "{prefix}a1inp2", choices = names({prefix}gene), server = TRUE, \n',
' selected = {prefix}def$gene1, options = list( \n',
' maxOptions = 7, create = TRUE, persist = TRUE, render = I(optCrt))) \n',
' updateSelectizeInput(session, "{prefix}a3inp1", choices = names({prefix}gene), server = TRUE, \n',
' selected = {prefix}def$gene1, options = list( \n',
' maxOptions = 7, create = TRUE, persist = TRUE, render = I(optCrt))) \n',
' updateSelectizeInput(session, "{prefix}a3inp2", choices = names({prefix}gene), server = TRUE, \n',
' selected = {prefix}def$gene2, options = list( \n',
' maxOptions = 7, create = TRUE, persist = TRUE, render = I(optCrt))) \n',
' updateSelectizeInput(session, "{prefix}b2inp1", choices = names({prefix}gene), server = TRUE, \n',
' selected = {prefix}def$gene1, options = list( \n',
' maxOptions = 7, create = TRUE, persist = TRUE, render = I(optCrt))) \n',
' updateSelectizeInput(session, "{prefix}b2inp2", choices = names({prefix}gene), server = TRUE, \n',
' selected = {prefix}def$gene2, options = list( \n',
' maxOptions = 7, create = TRUE, persist = TRUE, render = I(optCrt))) \n',
' updateSelectizeInput(session, "{prefix}c1inp2", server = TRUE, \n',
' choices = c({prefix}conf[is.na(fID)]$UI,names({prefix}gene)), \n',
' selected = {prefix}conf[is.na(fID)]$UI[1], options = list( \n',
' maxOptions = length({prefix}conf[is.na(fID)]$UI) + 3, \n',
' create = TRUE, persist = TRUE, render = I(optCrt))) \n',
' \n',
' \n',
' ### Plots for tab a1 \n',
'{subst} output${prefix}a1sub1.ui <- renderUI({{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}a1sub1]$fID, "\\\\|")[[1]] \n',
'{subst} checkboxGroupInput("{prefix}a1sub2", "Select which cells to show", inline = TRUE, \n',
'{subst} choices = sub, selected = sub) \n',
'{subst} }}) \n',
'{subst} observeEvent(input${prefix}a1sub1non, {{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}a1sub1]$fID, "\\\\|")[[1]] \n',
'{subst} updateCheckboxGroupInput(session, inputId = "{prefix}a1sub2", label = "Select which cells to show", \n',
'{subst} choices = sub, selected = NULL, inline = TRUE) \n',
'{subst} }}) \n',
'{subst} observeEvent(input${prefix}a1sub1all, {{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}a1sub1]$fID, "\\\\|")[[1]] \n',
'{subst} updateCheckboxGroupInput(session, inputId = "{prefix}a1sub2", label = "Select which cells to show", \n',
'{subst} choices = sub, selected = sub, inline = TRUE) \n',
'{subst} }}) \n',
' output${prefix}a1oup1 <- renderPlot({{ \n',
' scDRcell({prefix}conf, {prefix}meta, input${prefix}a1drX, input${prefix}a1drY, input${prefix}a1inp1, \n',
' input${prefix}a1sub1, input${prefix}a1sub2, \n',
' input${prefix}a1siz, input${prefix}a1col1, input${prefix}a1ord1, \n',
' input${prefix}a1fsz, input${prefix}a1asp, input${prefix}a1txt, input${prefix}a1lab1) \n',
' }}) \n',
' output${prefix}a1oup1.ui <- renderUI({{ \n',
' plotOutput("{prefix}a1oup1", height = pList[input${prefix}a1psz]) \n',
' }}) \n',
' output${prefix}a1oup1.pdf <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}a1drX,"_",input${prefix}a1drY,"_", \n',
' input${prefix}a1inp1,".pdf") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "pdf", height = input${prefix}a1oup1.h, width = input${prefix}a1oup1.w, useDingbats = FALSE, \n',
' plot = scDRcell({prefix}conf, {prefix}meta, input${prefix}a1drX, input${prefix}a1drY, input${prefix}a1inp1, \n',
' input${prefix}a1sub1, input${prefix}a1sub2, \n',
' input${prefix}a1siz, input${prefix}a1col1, input${prefix}a1ord1, \n',
' input${prefix}a1fsz, input${prefix}a1asp, input${prefix}a1txt, input${prefix}a1lab1) ) \n',
' }}) \n',
' output${prefix}a1oup1.png <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}a1drX,"_",input${prefix}a1drY,"_", \n',
' input${prefix}a1inp1,".png") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "png", height = input${prefix}a1oup1.h, width = input${prefix}a1oup1.w, \n',
' plot = scDRcell({prefix}conf, {prefix}meta, input${prefix}a1drX, input${prefix}a1drY, input${prefix}a1inp1, \n',
' input${prefix}a1sub1, input${prefix}a1sub2, \n',
' input${prefix}a1siz, input${prefix}a1col1, input${prefix}a1ord1, \n',
' input${prefix}a1fsz, input${prefix}a1asp, input${prefix}a1txt, input${prefix}a1lab1) ) \n',
' }}) \n',
' output${prefix}a1.dt <- renderDataTable({{ \n',
' ggData = scDRnum({prefix}conf, {prefix}meta, input${prefix}a1inp1, input${prefix}a1inp2, \n',
' input${prefix}a1sub1, input${prefix}a1sub2, \n',
' "{prefix}gexpr.h5", {prefix}gene, input${prefix}a1splt) \n',
' datatable(ggData, rownames = FALSE, extensions = "Buttons", \n',
' options = list(pageLength = -1, dom = "tB", buttons = c("copy", "csv", "excel"))) %>% \n',
' formatRound(columns = c("pctExpress"), digits = 2) \n',
' }}) \n',
' \n',
' output${prefix}a1oup2 <- renderPlot({{ \n',
' scDRgene({prefix}conf, {prefix}meta, input${prefix}a1drX, input${prefix}a1drY, input${prefix}a1inp2, \n',
' input${prefix}a1sub1, input${prefix}a1sub2, \n',
' "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}a1siz, input${prefix}a1col2, input${prefix}a1ord2, \n',
' input${prefix}a1fsz, input${prefix}a1asp, input${prefix}a1txt) \n',
' }}) \n',
' output${prefix}a1oup2.ui <- renderUI({{ \n',
' plotOutput("{prefix}a1oup2", height = pList[input${prefix}a1psz]) \n',
' }}) \n',
' output${prefix}a1oup2.pdf <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}a1drX,"_",input${prefix}a1drY,"_", \n',
' input${prefix}a1inp2,".pdf") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "pdf", height = input${prefix}a1oup2.h, width = input${prefix}a1oup2.w, useDingbats = FALSE, \n',
' plot = scDRgene({prefix}conf, {prefix}meta, input${prefix}a1drX, input${prefix}a1drY, input${prefix}a1inp2, \n',
' input${prefix}a1sub1, input${prefix}a1sub2, \n',
' "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}a1siz, input${prefix}a1col2, input${prefix}a1ord2, \n',
' input${prefix}a1fsz, input${prefix}a1asp, input${prefix}a1txt) ) \n',
' }}) \n',
' output${prefix}a1oup2.png <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}a1drX,"_",input${prefix}a1drY,"_", \n',
' input${prefix}a1inp2,".png") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "png", height = input${prefix}a1oup2.h, width = input${prefix}a1oup2.w, \n',
' plot = scDRgene({prefix}conf, {prefix}meta, input${prefix}a1drX, input${prefix}a1drY, input${prefix}a1inp2, \n',
' input${prefix}a1sub1, input${prefix}a1sub2, \n',
' "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}a1siz, input${prefix}a1col2, input${prefix}a1ord2, \n',
' input${prefix}a1fsz, input${prefix}a1asp, input${prefix}a1txt) ) \n',
' }}) \n',
' \n',
' \n',
' ### Plots for tab a2 \n',
'{subst} output${prefix}a2sub1.ui <- renderUI({{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}a2sub1]$fID, "\\\\|")[[1]] \n',
'{subst} checkboxGroupInput("{prefix}a2sub2", "Select which cells to show", inline = TRUE, \n',
'{subst} choices = sub, selected = sub) \n',
'{subst} }}) \n',
'{subst} observeEvent(input${prefix}a2sub1non, {{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}a2sub1]$fID, "\\\\|")[[1]] \n',
'{subst} updateCheckboxGroupInput(session, inputId = "{prefix}a2sub2", label = "Select which cells to show", \n',
'{subst} choices = sub, selected = NULL, inline = TRUE) \n',
'{subst} }}) \n',
'{subst} observeEvent(input${prefix}a2sub1all, {{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}a2sub1]$fID, "\\\\|")[[1]] \n',
'{subst} updateCheckboxGroupInput(session, inputId = "{prefix}a2sub2", label = "Select which cells to show", \n',
'{subst} choices = sub, selected = sub, inline = TRUE) \n',
'{subst} }}) \n',
' output${prefix}a2oup1 <- renderPlot({{ \n',
' scDRcell({prefix}conf, {prefix}meta, input${prefix}a2drX, input${prefix}a2drY, input${prefix}a2inp1, \n',
' input${prefix}a2sub1, input${prefix}a2sub2, \n',
' input${prefix}a2siz, input${prefix}a2col1, input${prefix}a2ord1, \n',
' input${prefix}a2fsz, input${prefix}a2asp, input${prefix}a2txt, input${prefix}a2lab1) \n',
' }}) \n',
' output${prefix}a2oup1.ui <- renderUI({{ \n',
' plotOutput("{prefix}a2oup1", height = pList[input${prefix}a2psz]) \n',
' }}) \n',
' output${prefix}a2oup1.pdf <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}a2drX,"_",input${prefix}a2drY,"_", \n',
' input${prefix}a2inp1,".pdf") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "pdf", height = input${prefix}a2oup1.h, width = input${prefix}a2oup1.w, useDingbats = FALSE, \n',
' plot = scDRcell({prefix}conf, {prefix}meta, input${prefix}a2drX, input${prefix}a2drY, input${prefix}a2inp1, \n',
' input${prefix}a2sub1, input${prefix}a2sub2, \n',
' input${prefix}a2siz, input${prefix}a2col1, input${prefix}a2ord1, \n',
' input${prefix}a2fsz, input${prefix}a2asp, input${prefix}a2txt, input${prefix}a2lab1) ) \n',
' }}) \n',
' output${prefix}a2oup1.png <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}a2drX,"_",input${prefix}a2drY,"_", \n',
' input${prefix}a2inp1,".png") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "png", height = input${prefix}a2oup1.h, width = input${prefix}a2oup1.w, \n',
' plot = scDRcell({prefix}conf, {prefix}meta, input${prefix}a2drX, input${prefix}a2drY, input${prefix}a2inp1, \n',
' input${prefix}a2sub1, input${prefix}a2sub2, \n',
' input${prefix}a2siz, input${prefix}a2col1, input${prefix}a2ord1, \n',
' input${prefix}a2fsz, input${prefix}a2asp, input${prefix}a2txt, input${prefix}a2lab1) ) \n',
' }}) \n',
' \n',
' output${prefix}a2oup2 <- renderPlot({{ \n',
' scDRcell({prefix}conf, {prefix}meta, input${prefix}a2drX, input${prefix}a2drY, input${prefix}a2inp2, \n',
' input${prefix}a2sub1, input${prefix}a2sub2, \n',
' input${prefix}a2siz, input${prefix}a2col2, input${prefix}a2ord2, \n',
' input${prefix}a2fsz, input${prefix}a2asp, input${prefix}a2txt, input${prefix}a2lab2) \n',
' }}) \n',
' output${prefix}a2oup2.ui <- renderUI({{ \n',
' plotOutput("{prefix}a2oup2", height = pList[input${prefix}a2psz]) \n',
' }}) \n',
' output${prefix}a2oup2.pdf <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}a2drX,"_",input${prefix}a2drY,"_", \n',
' input${prefix}a2inp2,".pdf") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "pdf", height = input${prefix}a2oup2.h, width = input${prefix}a2oup2.w, useDingbats = FALSE, \n',
' plot = scDRcell({prefix}conf, {prefix}meta, input${prefix}a2drX, input${prefix}a2drY, input${prefix}a2inp2, \n',
' input${prefix}a2sub1, input${prefix}a2sub2, \n',
' input${prefix}a2siz, input${prefix}a2col2, input${prefix}a2ord2, \n',
' input${prefix}a2fsz, input${prefix}a2asp, input${prefix}a2txt, input${prefix}a2lab2) ) \n',
' }}) \n',
' output${prefix}a2oup2.png <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}a2drX,"_",input${prefix}a2drY,"_", \n',
' input${prefix}a2inp2,".png") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "png", height = input${prefix}a2oup2.h, width = input${prefix}a2oup2.w, \n',
' plot = scDRcell({prefix}conf, {prefix}meta, input${prefix}a2drX, input${prefix}a2drY, input${prefix}a2inp2, \n',
' input${prefix}a2sub1, input${prefix}a2sub2, \n',
' input${prefix}a2siz, input${prefix}a2col2, input${prefix}a2ord2, \n',
' input${prefix}a2fsz, input${prefix}a2asp, input${prefix}a2txt, input${prefix}a2lab2) ) \n',
' }}) \n',
' \n',
' \n',
' ### Plots for tab a3 \n',
'{subst} output${prefix}a3sub1.ui <- renderUI({{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}a3sub1]$fID, "\\\\|")[[1]] \n',
'{subst} checkboxGroupInput("{prefix}a3sub2", "Select which cells to show", inline = TRUE, \n',
'{subst} choices = sub, selected = sub) \n',
'{subst} }}) \n',
'{subst} observeEvent(input${prefix}a3sub1non, {{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}a3sub1]$fID, "\\\\|")[[1]] \n',
'{subst} updateCheckboxGroupInput(session, inputId = "{prefix}a3sub2", label = "Select which cells to show", \n',
'{subst} choices = sub, selected = NULL, inline = TRUE) \n',
'{subst} }}) \n',
'{subst} observeEvent(input${prefix}a3sub1all, {{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}a3sub1]$fID, "\\\\|")[[1]] \n',
'{subst} updateCheckboxGroupInput(session, inputId = "{prefix}a3sub2", label = "Select which cells to show", \n',
'{subst} choices = sub, selected = sub, inline = TRUE) \n',
'{subst} }}) \n',
' output${prefix}a3oup1 <- renderPlot({{ \n',
' scDRgene({prefix}conf, {prefix}meta, input${prefix}a3drX, input${prefix}a3drY, input${prefix}a3inp1, \n',
' input${prefix}a3sub1, input${prefix}a3sub2, \n',
' "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}a3siz, input${prefix}a3col1, input${prefix}a3ord1, \n',
' input${prefix}a3fsz, input${prefix}a3asp, input${prefix}a3txt) \n',
' }}) \n',
' output${prefix}a3oup1.ui <- renderUI({{ \n',
' plotOutput("{prefix}a3oup1", height = pList[input${prefix}a3psz]) \n',
' }}) \n',
' output${prefix}a3oup1.pdf <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}a3drX,"_",input${prefix}a3drY,"_", \n',
' input${prefix}a3inp1,".pdf") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "pdf", height = input${prefix}a3oup1.h, width = input${prefix}a3oup1.w, useDingbats = FALSE, \n',
' plot = scDRgene({prefix}conf, {prefix}meta, input${prefix}a3drX, input${prefix}a3drY, input${prefix}a3inp1, \n',
' input${prefix}a3sub1, input${prefix}a3sub2, \n',
' "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}a3siz, input${prefix}a3col1, input${prefix}a3ord1, \n',
' input${prefix}a3fsz, input${prefix}a3asp, input${prefix}a3txt) ) \n',
' }}) \n',
' output${prefix}a3oup1.png <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}a3drX,"_",input${prefix}a3drY,"_", \n',
' input${prefix}a3inp1,".png") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "png", height = input${prefix}a3oup1.h, width = input${prefix}a3oup1.w, \n',
' plot = scDRgene({prefix}conf, {prefix}meta, input${prefix}a3drX, input${prefix}a3drY, input${prefix}a3inp1, \n',
' input${prefix}a3sub1, input${prefix}a3sub2, \n',
' "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}a3siz, input${prefix}a3col1, input${prefix}a3ord1, \n',
' input${prefix}a3fsz, input${prefix}a3asp, input${prefix}a3txt) ) \n',
' }}) \n',
' \n',
' output${prefix}a3oup2 <- renderPlot({{ \n',
' scDRgene({prefix}conf, {prefix}meta, input${prefix}a3drX, input${prefix}a3drY, input${prefix}a3inp2, \n',
' input${prefix}a3sub1, input${prefix}a3sub2, \n',
' "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}a3siz, input${prefix}a3col2, input${prefix}a3ord2, \n',
' input${prefix}a3fsz, input${prefix}a3asp, input${prefix}a3txt) \n',
' }}) \n',
' output${prefix}a3oup2.ui <- renderUI({{ \n',
' plotOutput("{prefix}a3oup2", height = pList[input${prefix}a3psz]) \n',
' }}) \n',
' output${prefix}a3oup2.pdf <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}a3drX,"_",input${prefix}a3drY,"_", \n',
' input${prefix}a3inp2,".pdf") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "pdf", height = input${prefix}a3oup2.h, width = input${prefix}a3oup2.w, useDingbats = FALSE, \n',
' plot = scDRgene({prefix}conf, {prefix}meta, input${prefix}a3drX, input${prefix}a3drY, input${prefix}a3inp2, \n',
' input${prefix}a3sub1, input${prefix}a3sub2, \n',
' "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}a3siz, input${prefix}a3col2, input${prefix}a3ord2, \n',
' input${prefix}a3fsz, input${prefix}a3asp, input${prefix}a3txt) ) \n',
' }}) \n',
' output${prefix}a3oup2.png <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}a3drX,"_",input${prefix}a3drY,"_", \n',
' input${prefix}a3inp2,".png") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "png", height = input${prefix}a3oup2.h, width = input${prefix}a3oup2.w, \n',
' plot = scDRgene({prefix}conf, {prefix}meta, input${prefix}a3drX, input${prefix}a3drY, input${prefix}a3inp2, \n',
' input${prefix}a3sub1, input${prefix}a3sub2, \n',
' "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}a3siz, input${prefix}a3col2, input${prefix}a3ord2, \n',
' input${prefix}a3fsz, input${prefix}a3asp, input${prefix}a3txt) ) \n',
' }}) \n',
' \n',
' \n',
' ### Plots for tab b2 \n',
'{subst} output${prefix}b2sub1.ui <- renderUI({{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}b2sub1]$fID, "\\\\|")[[1]] \n',
'{subst} checkboxGroupInput("{prefix}b2sub2", "Select which cells to show", inline = TRUE, \n',
'{subst} choices = sub, selected = sub) \n',
'{subst} }}) \n',
'{subst} observeEvent(input${prefix}b2sub1non, {{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}b2sub1]$fID, "\\\\|")[[1]] \n',
'{subst} updateCheckboxGroupInput(session, inputId = "{prefix}b2sub2", label = "Select which cells to show", \n',
'{subst} choices = sub, selected = NULL, inline = TRUE) \n',
'{subst} }}) \n',
'{subst} observeEvent(input${prefix}b2sub1all, {{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}b2sub1]$fID, "\\\\|")[[1]] \n',
'{subst} updateCheckboxGroupInput(session, inputId = "{prefix}b2sub2", label = "Select which cells to show", \n',
'{subst} choices = sub, selected = sub, inline = TRUE) \n',
'{subst} }}) \n',
' output${prefix}b2oup1 <- renderPlot({{ \n',
' scDRcoex({prefix}conf, {prefix}meta, input${prefix}b2drX, input${prefix}b2drY, \n',
' input${prefix}b2inp1, input${prefix}b2inp2, input${prefix}b2sub1, input${prefix}b2sub2, \n',
' "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}b2siz, input${prefix}b2col1, input${prefix}b2ord1, \n',
' input${prefix}b2fsz, input${prefix}b2asp, input${prefix}b2txt) \n',
' }}) \n',
' output${prefix}b2oup1.ui <- renderUI({{ \n',
' plotOutput("{prefix}b2oup1", height = pList2[input${prefix}b2psz]) \n',
' }}) \n',
' output${prefix}b2oup1.pdf <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}b2drX,"_",input${prefix}b2drY,"_", \n',
' input${prefix}b2inp1,"_",input${prefix}b2inp2,".pdf") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "pdf", height = input${prefix}b2oup1.h, width = input${prefix}b2oup1.w, useDingbats = FALSE, \n',
' plot = scDRcoex({prefix}conf, {prefix}meta, input${prefix}b2drX, input${prefix}b2drY, \n',
' input${prefix}b2inp1, input${prefix}b2inp2, input${prefix}b2sub1, input${prefix}b2sub2, \n',
' "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}b2siz, input${prefix}b2col1, input${prefix}b2ord1, \n',
' input${prefix}b2fsz, input${prefix}b2asp, input${prefix}b2txt) ) \n',
' }}) \n',
' output${prefix}b2oup1.png <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}b2drX,"_",input${prefix}b2drY,"_", \n',
' input${prefix}b2inp1,"_",input${prefix}b2inp2,".png") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "png", height = input${prefix}b2oup1.h, width = input${prefix}b2oup1.w, \n',
' plot = scDRcoex({prefix}conf, {prefix}meta, input${prefix}b2drX, input${prefix}b2drY, \n',
' input${prefix}b2inp1, input${prefix}b2inp2, input${prefix}b2sub1, input${prefix}b2sub2, \n',
' "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}b2siz, input${prefix}b2col1, input${prefix}b2ord1, \n',
' input${prefix}b2fsz, input${prefix}b2asp, input${prefix}b2txt) ) \n',
' }}) \n',
' output${prefix}b2oup2 <- renderPlot({{ \n',
' scDRcoexLeg(input${prefix}b2inp1, input${prefix}b2inp2, input${prefix}b2col1, input${prefix}b2fsz) \n',
' }}) \n',
' output${prefix}b2oup2.ui <- renderUI({{ \n',
' plotOutput("{prefix}b2oup2", height = "300px") \n',
' }}) \n',
' output${prefix}b2oup2.pdf <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}b2drX,"_",input${prefix}b2drY,"_", \n',
' input${prefix}b2inp1,"_",input${prefix}b2inp2,"_leg.pdf") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "pdf", height = 3, width = 4, useDingbats = FALSE, \n',
' plot = scDRcoexLeg(input${prefix}b2inp1, input${prefix}b2inp2, input${prefix}b2col1, input${prefix}b2fsz) ) \n',
' }}) \n',
' output${prefix}b2oup2.png <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}b2drX,"_",input${prefix}b2drY,"_", \n',
' input${prefix}b2inp1,"_",input${prefix}b2inp2,"_leg.png") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "png", height = 3, width = 4, \n',
' plot = scDRcoexLeg(input${prefix}b2inp1, input${prefix}b2inp2, input${prefix}b2col1, input${prefix}b2fsz) ) \n',
' }}) \n',
' output${prefix}b2.dt <- renderDataTable({{ \n',
' ggData = scDRcoexNum({prefix}conf, {prefix}meta, input${prefix}b2inp1, input${prefix}b2inp2, \n',
' input${prefix}b2sub1, input${prefix}b2sub2, "{prefix}gexpr.h5", {prefix}gene) \n',
' datatable(ggData, rownames = FALSE, extensions = "Buttons", \n',
' options = list(pageLength = -1, dom = "tB", buttons = c("copy", "csv", "excel"))) %>% \n',
' formatRound(columns = c("percent"), digits = 2) \n',
' }}) \n',
' \n',
' \n',
' ### Plots for tab c1 \n',
'{subst} output${prefix}c1sub1.ui <- renderUI({{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}c1sub1]$fID, "\\\\|")[[1]] \n',
'{subst} checkboxGroupInput("{prefix}c1sub2", "Select which cells to show", inline = TRUE, \n',
'{subst} choices = sub, selected = sub) \n',
'{subst} }}) \n',
'{subst} observeEvent(input${prefix}c1sub1non, {{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}c1sub1]$fID, "\\\\|")[[1]] \n',
'{subst} updateCheckboxGroupInput(session, inputId = "{prefix}c1sub2", label = "Select which cells to show", \n',
'{subst} choices = sub, selected = NULL, inline = TRUE) \n',
'{subst} }}) \n',
'{subst} observeEvent(input${prefix}c1sub1all, {{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}c1sub1]$fID, "\\\\|")[[1]] \n',
'{subst} updateCheckboxGroupInput(session, inputId = "{prefix}c1sub2", label = "Select which cells to show", \n',
'{subst} choices = sub, selected = sub, inline = TRUE) \n',
'{subst} }}) \n',
' output${prefix}c1oup <- renderPlot({{ \n',
' scVioBox({prefix}conf, {prefix}meta, input${prefix}c1inp1, input${prefix}c1inp2, \n',
' input${prefix}c1sub1, input${prefix}c1sub2, \n',
' "{prefix}gexpr.h5", {prefix}gene, input${prefix}c1typ, input${prefix}c1pts, \n',
' input${prefix}c1siz, input${prefix}c1fsz) \n',
' }}) \n',
' output${prefix}c1oup.ui <- renderUI({{ \n',
' plotOutput("{prefix}c1oup", height = pList2[input${prefix}c1psz]) \n',
' }}) \n',
' output${prefix}c1oup.pdf <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}c1typ,"_",input${prefix}c1inp1,"_", \n',
' input${prefix}c1inp2,".pdf") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "pdf", height = input${prefix}c1oup.h, width = input${prefix}c1oup.w, useDingbats = FALSE, \n',
' plot = scVioBox({prefix}conf, {prefix}meta, input${prefix}c1inp1, input${prefix}c1inp2, \n',
' input${prefix}c1sub1, input${prefix}c1sub2, \n',
' "{prefix}gexpr.h5", {prefix}gene, input${prefix}c1typ, input${prefix}c1pts, \n',
' input${prefix}c1siz, input${prefix}c1fsz) ) \n',
' }}) \n',
' output${prefix}c1oup.png <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}c1typ,"_",input${prefix}c1inp1,"_", \n',
' input${prefix}c1inp2,".png") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "png", height = input${prefix}c1oup.h, width = input${prefix}c1oup.w, \n',
' plot = scVioBox({prefix}conf, {prefix}meta, input${prefix}c1inp1, input${prefix}c1inp2, \n',
' input${prefix}c1sub1, input${prefix}c1sub2, \n',
' "{prefix}gexpr.h5", {prefix}gene, input${prefix}c1typ, input${prefix}c1pts, \n',
' input${prefix}c1siz, input${prefix}c1fsz) ) \n',
' }}) \n',
' \n',
' \n',
'### Plots for tab c2 \n',
'{subst} output${prefix}c2sub1.ui <- renderUI({{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}c2sub1]$fID, "\\\\|")[[1]] \n',
'{subst} checkboxGroupInput("{prefix}c2sub2", "Select which cells to show", inline = TRUE, \n',
'{subst} choices = sub, selected = sub) \n',
'{subst} }}) \n',
'{subst} observeEvent(input${prefix}c2sub1non, {{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}c2sub1]$fID, "\\\\|")[[1]] \n',
'{subst} updateCheckboxGroupInput(session, inputId = "{prefix}c2sub2", label = "Select which cells to show", \n',
'{subst} choices = sub, selected = NULL, inline = TRUE) \n',
'{subst} }}) \n',
'{subst} observeEvent(input${prefix}c2sub1all, {{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}c2sub1]$fID, "\\\\|")[[1]] \n',
'{subst} updateCheckboxGroupInput(session, inputId = "{prefix}c2sub2", label = "Select which cells to show", \n',
'{subst} choices = sub, selected = sub, inline = TRUE) \n',
'{subst} }}) \n',
'output${prefix}c2oup <- renderPlot({{ \n',
' scProp({prefix}conf, {prefix}meta, input${prefix}c2inp1, input${prefix}c2inp2, \n',
' input${prefix}c2sub1, input${prefix}c2sub2, \n',
' input${prefix}c2typ, input${prefix}c2flp, input${prefix}c2fsz) \n',
'}}) \n',
'output${prefix}c2oup.ui <- renderUI({{ \n',
' plotOutput("{prefix}c2oup", height = pList2[input${prefix}c2psz]) \n',
'}}) \n',
'output${prefix}c2oup.pdf <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}c2typ,"_",input${prefix}c2inp1,"_", \n',
' input${prefix}c2inp2,".pdf") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "pdf", height = input${prefix}c2oup.h, width = input${prefix}c2oup.w, useDingbats = FALSE, \n',
' plot = scProp({prefix}conf, {prefix}meta, input${prefix}c2inp1, input${prefix}c2inp2, \n',
' input${prefix}c2sub1, input${prefix}c2sub2, \n',
' input${prefix}c2typ, input${prefix}c2flp, input${prefix}c2fsz) ) \n',
' }}) \n',
'output${prefix}c2oup.png <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}c2typ,"_",input${prefix}c2inp1,"_", \n',
' input${prefix}c2inp2,".png") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "png", height = input${prefix}c2oup.h, width = input${prefix}c2oup.w, \n',
' plot = scProp({prefix}conf, {prefix}meta, input${prefix}c2inp1, input${prefix}c2inp2, \n',
' input${prefix}c2sub1, input${prefix}c2sub2, \n',
' input${prefix}c2typ, input${prefix}c2flp, input${prefix}c2fsz) ) \n',
' }}) \n',
' \n',
' \n',
' ### Plots for tab d1 \n',
'{subst} output${prefix}d1sub1.ui <- renderUI({{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}d1sub1]$fID, "\\\\|")[[1]] \n',
'{subst} checkboxGroupInput("{prefix}d1sub2", "Select which cells to show", inline = TRUE, \n',
'{subst} choices = sub, selected = sub) \n',
'{subst} }}) \n',
'{subst} observeEvent(input${prefix}d1sub1non, {{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}d1sub1]$fID, "\\\\|")[[1]] \n',
'{subst} updateCheckboxGroupInput(session, inputId = "{prefix}d1sub2", label = "Select which cells to show", \n',
'{subst} choices = sub, selected = NULL, inline = TRUE) \n',
'{subst} }}) \n',
'{subst} observeEvent(input${prefix}d1sub1all, {{ \n',
'{subst} sub = strsplit({prefix}conf[UI == input${prefix}d1sub1]$fID, "\\\\|")[[1]] \n',
'{subst} updateCheckboxGroupInput(session, inputId = "{prefix}d1sub2", label = "Select which cells to show", \n',
'{subst} choices = sub, selected = sub, inline = TRUE) \n',
'{subst} }}) \n',
' output${prefix}d1oupTxt <- renderUI({{ \n',
' geneList = scGeneList(input${prefix}d1inp, {prefix}gene) \n',
' if(nrow(geneList) > 50){{ \n',
' HTML("More than 50 input genes! Please reduce the gene list!") \n',
' }} else {{ \n',
' oup = paste0(nrow(geneList[present == TRUE]), " genes OK and will be plotted") \n',
' if(nrow(geneList[present == FALSE]) > 0){{ \n',
' oup = paste0(oup, "<br/>", \n',
' nrow(geneList[present == FALSE]), " genes not found (", \n',
' paste0(geneList[present == FALSE]$gene, collapse = ", "), ")") \n',
' }} \n',
' HTML(oup) \n',
' }} \n',
' }}) \n',
' output${prefix}d1oup <- renderPlot({{ \n',
' scBubbHeat({prefix}conf, {prefix}meta, input${prefix}d1inp, input${prefix}d1grp, input${prefix}d1plt, \n',
' input${prefix}d1sub1, input${prefix}d1sub2, "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}d1scl, input${prefix}d1row, input${prefix}d1col, \n',
' input${prefix}d1cols, input${prefix}d1fsz) \n',
' }}) \n',
' output${prefix}d1oup.ui <- renderUI({{ \n',
' plotOutput("{prefix}d1oup", height = pList3[input${prefix}d1psz]) \n',
' }}) \n',
' output${prefix}d1oup.pdf <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}d1plt,"_",input${prefix}d1grp,".pdf") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "pdf", height = input${prefix}d1oup.h, width = input${prefix}d1oup.w, \n',
' plot = scBubbHeat({prefix}conf, {prefix}meta, input${prefix}d1inp, input${prefix}d1grp, input${prefix}d1plt, \n',
' input${prefix}d1sub1, input${prefix}d1sub2, "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}d1scl, input${prefix}d1row, input${prefix}d1col, \n',
' input${prefix}d1cols, input${prefix}d1fsz, save = TRUE) ) \n',
' }}) \n',
' output${prefix}d1oup.png <- downloadHandler( \n',
' filename = function() {{ paste0("{prefix}",input${prefix}d1plt,"_",input${prefix}d1grp,".png") }}, \n',
' content = function(file) {{ ggsave( \n',
' file, device = "png", height = input${prefix}d1oup.h, width = input${prefix}d1oup.w, \n',
' plot = scBubbHeat({prefix}conf, {prefix}meta, input${prefix}d1inp, input${prefix}d1grp, input${prefix}d1plt, \n',
' input${prefix}d1sub1, input${prefix}d1sub2, "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}d1scl, input${prefix}d1row, input${prefix}d1col, \n',
' input${prefix}d1cols, input${prefix}d1fsz, save = TRUE) ) \n',
' }}) \n',
' \n',
' \n',
' \n')
}
#' Write code for final portion of server.R
#'
#' @rdname wrSVend
#' @export wrSVend
#'
wrSVend <- function() {
glue::glue(' \n',
' \n',
'}}) \n',
' \n',
' \n',
' \n',
' \n')
}
#' Write code for loading objects for ui.R
#'
#' @param prefix file prefix
#'
#' @rdname wrUIload
#' @export wrUIload
#'
wrUIload <- function(prefix) {
glue::glue('{prefix}conf = readRDS("{prefix}conf.rds")\n',
'{prefix}def = readRDS("{prefix}def.rds")\n',
'\n\n\n\n')
}
#' Write code for front portion of ui.R
#'
#' @param title shiny app title
#' @param ganalytics Google analytics tracking ID (e.g. "UA-123456789-0")
#'
#' @rdname wrUIsingle
#' @export wrUIsingle
#'
wrUIsingle <- function(title, ganalytics) {
if(!is.na(ganalytics)){
ga = 'tags$head(includeHTML(("google-analytics.html"))),'
} else {
ga = ''
}
glue::glue('### Start server code \n',
'shinyUI(fluidPage( \n',
'### HTML formatting of error messages \n',
'{ga} \n',
'tags$head(tags$style(HTML(".shiny-output-error-validation {{color: red; font-weight: bold;}}"))), \n',
'list(tags$style(HTML(".navbar-default .navbar-nav {{ font-weight: bold; font-size: 16px; }}"))), \n',
' \n',
' \n',
'### Page title \n',
'titlePanel("{title}"), \n',
'navbarPage( \n',
' NULL, \n',
' \n')
}
#' Write code for main block of ui.R
#'
#' @param prefix file prefix
#'
#' @rdname wrUImain
#' @export wrUImain
#'
wrUImain <- function(prefix, subst = "", ptsiz = "1.25") {
glue::glue(' ### Tab1.a1: cellInfo vs geneExpr on dimRed \n',
' tabPanel( \n',
' HTML("CellInfo vs GeneExpr"), \n',
' h4("Cell information vs gene expression on reduced dimensions"), \n',
' "In this tab, users can visualise both cell information and gene ", \n',
' "expression side-by-side on low-dimensional representions.", \n',
' br(),br(), \n',
' fluidRow( \n',
' column( \n',
' 3, h4("Dimension Reduction"), \n',
' fluidRow( \n',
' column( \n',
' 12, selectInput("{prefix}a1drX", "X-axis:", choices = {prefix}conf[dimred == TRUE]$UI, \n',
' selected = {prefix}def$dimred[1]), \n',
' selectInput("{prefix}a1drY", "Y-axis:", choices = {prefix}conf[dimred == TRUE]$UI, \n',
' selected = {prefix}def$dimred[2])) \n',
' ) \n',
' ), # End of column (6 space) \n',
' column( \n',
' 3{subst}, actionButton("{prefix}a1togL", "Toggle to subset cells"), \n',
'{subst} conditionalPanel( \n',
'{subst} condition = "input.{prefix}a1togL % 2 == 1", \n',
'{subst} selectInput("{prefix}a1sub1", "Cell information to subset:", \n',
'{subst} choices = {prefix}conf[grp == TRUE]$UI, \n',
'{subst} selected = {prefix}def$grp1), \n',
'{subst} uiOutput("{prefix}a1sub1.ui"), \n',
'{subst} actionButton("{prefix}a1sub1all", "Select all groups", class = "btn btn-primary"), \n',
'{subst} actionButton("{prefix}a1sub1non", "Deselect all groups", class = "btn btn-primary") \n',
'{subst} ) \n',
' ), # End of column (6 space) \n',
' column( \n',
' 6, actionButton("{prefix}a1tog0", "Toggle graphics controls"), \n',
' conditionalPanel( \n',
' condition = "input.{prefix}a1tog0 % 2 == 1", \n',
' fluidRow( \n',
' column( \n',
' 6, sliderInput("{prefix}a1siz", "Point size:", \n',
' min = 0, max = 4, value = {ptsiz}, step = 0.25), \n',
' radioButtons("{prefix}a1psz", "Plot size:", \n',
' choices = c("Small", "Medium", "Large"), \n',
' selected = "Medium", inline = TRUE), \n',
' radioButtons("{prefix}a1fsz", "Font size:", \n',
' choices = c("Small", "Medium", "Large"), \n',
' selected = "Medium", inline = TRUE) \n',
' ), \n',
' column( \n',
' 6, radioButtons("{prefix}a1asp", "Aspect ratio:", \n',
' choices = c("Square", "Fixed", "Free"), \n',
' selected = "Square", inline = TRUE), \n',
' checkboxInput("{prefix}a1txt", "Show axis text", value = FALSE) \n',
' ) \n',
' ) \n',
' ) \n',
' ) # End of column (6 space) \n',
' ), # End of fluidRow (4 space) \n',
' fluidRow( \n',
' column( \n',
' 6, style="border-right: 2px solid black", h4("Cell information"), \n',
' fluidRow( \n',
' column( \n',
' 6, selectInput("{prefix}a1inp1", "Cell information:", \n',
' choices = {prefix}conf$UI, \n',
' selected = {prefix}def$meta1) %>% \n',
' helper(type = "inline", size = "m", fade = TRUE, \n',
' title = "Cell information to colour cells by", \n',
' content = c("Select cell information to colour cells", \n',
' "- Categorical covariates have a fixed colour palette", \n',
' paste0("- Continuous covariates are coloured in a ", \n',
' "Blue-Yellow-Red colour scheme, which can be ", \n',
' "changed in the plot controls"))) \n',
' ), \n',
' column( \n',
' 6, actionButton("{prefix}a1tog1", "Toggle plot controls"), \n',
' conditionalPanel( \n',
' condition = "input.{prefix}a1tog1 % 2 == 1", \n',
' radioButtons("{prefix}a1col1", "Colour (Continuous data):", \n',
' choices = c("White-Red","Blue-Yellow-Red","Yellow-Green-Purple"), \n',
' selected = "Blue-Yellow-Red"), \n',
' radioButtons("{prefix}a1ord1", "Plot order:", \n',
' choices = c("Max-1st", "Min-1st", "Original", "Random"), \n',
' selected = "Original", inline = TRUE), \n',
' checkboxInput("{prefix}a1lab1", "Show cell info labels", value = TRUE) \n',
' ) \n',
' ) \n',
' ), \n',
' fluidRow(column(12, uiOutput("{prefix}a1oup1.ui"))), \n',
' downloadButton("{prefix}a1oup1.pdf", "Download PDF"), \n',
' downloadButton("{prefix}a1oup1.png", "Download PNG"), br(), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}a1oup1.h", "PDF / PNG height:", width = "138px", \n',
' min = 4, max = 20, value = 6, step = 0.5)), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}a1oup1.w", "PDF / PNG width:", width = "138px", \n',
' min = 4, max = 20, value = 8, step = 0.5)), br(), \n',
' actionButton("{prefix}a1tog9", "Toggle to show cell numbers / statistics"), \n',
' conditionalPanel( \n',
' condition = "input.{prefix}a1tog9 % 2 == 1", \n',
' h4("Cell numbers / statistics"), \n',
' radioButtons("{prefix}a1splt", "Split continuous cell info into:", \n',
' choices = c("Quartile", "Decile"), \n',
' selected = "Decile", inline = TRUE), \n',
' dataTableOutput("{prefix}a1.dt") \n',
' ) \n',
' ), # End of column (6 space) \n',
' column( \n',
' 6, h4("Gene expression"), \n',
' fluidRow( \n',
' column( \n',
' 6, selectInput("{prefix}a1inp2", "Gene name:", choices=NULL) %>% \n',
' helper(type = "inline", size = "m", fade = TRUE, \n',
' title = "Gene expression to colour cells by", \n',
' content = c("Select gene to colour cells by gene expression", \n',
' paste0("- Gene expression are coloured in a ", \n',
' "White-Red colour scheme which can be ", \n',
' "changed in the plot controls"))) \n',
' ), \n',
' column( \n',
' 6, actionButton("{prefix}a1tog2", "Toggle plot controls"), \n',
' conditionalPanel( \n',
' condition = "input.{prefix}a1tog2 % 2 == 1", \n',
' radioButtons("{prefix}a1col2", "Colour:", \n',
' choices = c("White-Red","Blue-Yellow-Red","Yellow-Green-Purple"), \n',
' selected = "White-Red"), \n',
' radioButtons("{prefix}a1ord2", "Plot order:", \n',
' choices = c("Max-1st", "Min-1st", "Original", "Random"), \n',
' selected = "Max-1st", inline = TRUE) \n',
' ) \n',
' ) \n',
' ) , \n',
' fluidRow(column(12, uiOutput("{prefix}a1oup2.ui"))), \n',
' downloadButton("{prefix}a1oup2.pdf", "Download PDF"), \n',
' downloadButton("{prefix}a1oup2.png", "Download PNG"), br(), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}a1oup2.h", "PDF / PNG height:", width = "138px", \n',
' min = 4, max = 20, value = 6, step = 0.5)), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}a1oup2.w", "PDF / PNG width:", width = "138px", \n',
' min = 4, max = 20, value = 8, step = 0.5)) \n',
' ) # End of column (6 space) \n',
' ) # End of fluidRow (4 space) \n',
' ), # End of tab (2 space) \n',
' \n',
' ### Tab1.a2: cellInfo vs cellInfo on dimRed \n',
' tabPanel( \n',
' HTML("CellInfo vs CellInfo"), \n',
' h4("Cell information vs cell information on dimension reduction"), \n',
' "In this tab, users can visualise two cell informations side-by-side ", \n',
' "on low-dimensional representions.", \n',
' br(),br(), \n',
' fluidRow( \n',
' column( \n',
' 3, h4("Dimension Reduction"), \n',
' fluidRow( \n',
' column( \n',
' 12, selectInput("{prefix}a2drX", "X-axis:", choices = {prefix}conf[dimred == TRUE]$UI, \n',
' selected = {prefix}def$dimred[1]), \n',
' selectInput("{prefix}a2drY", "Y-axis:", choices = {prefix}conf[dimred == TRUE]$UI, \n',
' selected = {prefix}def$dimred[2])) \n',
' ) \n',
' ), # End of column (6 space) \n',
' column( \n',
' 3{subst}, actionButton("{prefix}a2togL", "Toggle to subset cells"), \n',
'{subst} conditionalPanel( \n',
'{subst} condition = "input.{prefix}a2togL % 2 == 1", \n',
'{subst} selectInput("{prefix}a2sub1", "Cell information to subset:", \n',
'{subst} choices = {prefix}conf[grp == TRUE]$UI, \n',
'{subst} selected = {prefix}def$grp1), \n',
'{subst} uiOutput("{prefix}a2sub1.ui"), \n',
'{subst} actionButton("{prefix}a2sub1all", "Select all groups", class = "btn btn-primary"), \n',
'{subst} actionButton("{prefix}a2sub1non", "Deselect all groups", class = "btn btn-primary") \n',
'{subst} ) \n',
' ), # End of column (6 space) \n',
' column( \n',
' 6, actionButton("{prefix}a2tog0", "Toggle graphics controls"), \n',
' conditionalPanel( \n',
' condition = "input.{prefix}a2tog0 % 2 == 1", \n',
' fluidRow( \n',
' column( \n',
' 6, sliderInput("{prefix}a2siz", "Point size:", \n',
' min = 0, max = 4, value = {ptsiz}, step = 0.25), \n',
' radioButtons("{prefix}a2psz", "Plot size:", \n',
' choices = c("Small", "Medium", "Large"), \n',
' selected = "Medium", inline = TRUE), \n',
' radioButtons("{prefix}a2fsz", "Font size:", \n',
' choices = c("Small", "Medium", "Large"), \n',
' selected = "Medium", inline = TRUE) \n',
' ), \n',
' column( \n',
' 6, radioButtons("{prefix}a2asp", "Aspect ratio:", \n',
' choices = c("Square", "Fixed", "Free"), \n',
' selected = "Square", inline = TRUE), \n',
' checkboxInput("{prefix}a2txt", "Show axis text", value = FALSE) \n',
' ) \n',
' ) \n',
' ) \n',
' ) # End of column (6 space) \n',
' ), # End of fluidRow (4 space) \n',
' fluidRow( \n',
' column( \n',
' 6, style="border-right: 2px solid black", h4("Cell information 1"), \n',
' fluidRow( \n',
' column( \n',
' 6, selectInput("{prefix}a2inp1", "Cell information:", \n',
' choices = {prefix}conf$UI, \n',
' selected = {prefix}def$meta1) %>% \n',
' helper(type = "inline", size = "m", fade = TRUE, \n',
' title = "Cell information to colour cells by", \n',
' content = c("Select cell information to colour cells", \n',
' "- Categorical covariates have a fixed colour palette", \n',
' paste0("- Continuous covariates are coloured in a ", \n',
' "Blue-Yellow-Red colour scheme, which can be ", \n',
' "changed in the plot controls"))) \n',
' ), \n',
' column( \n',
' 6, actionButton("{prefix}a2tog1", "Toggle plot controls"), \n',
' conditionalPanel( \n',
' condition = "input.{prefix}a2tog1 % 2 == 1", \n',
' radioButtons("{prefix}a2col1", "Colour (Continuous data):", \n',
' choices = c("White-Red", "Blue-Yellow-Red", \n',
' "Yellow-Green-Purple"), \n',
' selected = "Blue-Yellow-Red"), \n',
' radioButtons("{prefix}a2ord1", "Plot order:", \n',
' choices = c("Max-1st", "Min-1st", "Original", "Random"), \n',
' selected = "Original", inline = TRUE), \n',
' checkboxInput("{prefix}a2lab1", "Show cell info labels", value = TRUE) \n',
' ) \n',
' ) \n',
' ), \n',
' fluidRow(column(12, uiOutput("{prefix}a2oup1.ui"))), \n',
' downloadButton("{prefix}a2oup1.pdf", "Download PDF"), \n',
' downloadButton("{prefix}a2oup1.png", "Download PNG"), br(), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}a2oup1.h", "PDF / PNG height:", width = "138px", \n',
' min = 4, max = 20, value = 6, step = 0.5)), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}a2oup1.w", "PDF / PNG width:", width = "138px", \n',
' min = 4, max = 20, value = 8, step = 0.5)) \n',
' ), # End of column (6 space) \n',
' column( \n',
' 6, h4("Cell information 2"), \n',
' fluidRow( \n',
' column( \n',
' 6, selectInput("{prefix}a2inp2", "Cell information:", \n',
' choices = {prefix}conf$UI, \n',
' selected = {prefix}def$meta2) %>% \n',
' helper(type = "inline", size = "m", fade = TRUE, \n',
' title = "Cell information to colour cells by", \n',
' content = c("Select cell information to colour cells", \n',
' "- Categorical covariates have a fixed colour palette", \n',
' paste0("- Continuous covariates are coloured in a ", \n',
' "Blue-Yellow-Red colour scheme, which can be ", \n',
' "changed in the plot controls"))) \n',
' ), \n',
' column( \n',
' 6, actionButton("{prefix}a2tog2", "Toggle plot controls"), \n',
' conditionalPanel( \n',
' condition = "input.{prefix}a2tog2 % 2 == 1", \n',
' radioButtons("{prefix}a2col2", "Colour (Continuous data):", \n',
' choices = c("White-Red", "Blue-Yellow-Red", \n',
' "Yellow-Green-Purple"), \n',
' selected = "Blue-Yellow-Red"), \n',
' radioButtons("{prefix}a2ord2", "Plot order:", \n',
' choices = c("Max-1st", "Min-1st", "Original", "Random"), \n',
' selected = "Original", inline = TRUE), \n',
' checkboxInput("{prefix}a2lab2", "Show cell info labels", value = TRUE) \n',
' ) \n',
' ) \n',
' ), \n',
' fluidRow(column(12, uiOutput("{prefix}a2oup2.ui"))), \n',
' downloadButton("{prefix}a2oup2.pdf", "Download PDF"), \n',
' downloadButton("{prefix}a2oup2.png", "Download PNG"), br(), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}a2oup2.h", "PDF / PNG height:", width = "138px", \n',
' min = 4, max = 20, value = 6, step = 0.5)), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}a2oup2.w", "PDF / PNG width:", width = "138px", \n',
' min = 4, max = 20, value = 8, step = 0.5)) \n',
' ) # End of column (6 space) \n',
' ) # End of fluidRow (4 space) \n',
' ), # End of tab (2 space) \n',
' \n',
' ### Tab1.a3: geneExpr vs geneExpr on dimRed \n',
' tabPanel( \n',
' HTML("GeneExpr vs GeneExpr"), \n',
' h4("Gene expression vs gene expression on dimension reduction"), \n',
' "In this tab, users can visualise two gene expressions side-by-side ", \n',
' "on low-dimensional representions.", \n',
' br(),br(), \n',
' fluidRow( \n',
' column( \n',
' 3, h4("Dimension Reduction"), \n',
' fluidRow( \n',
' column( \n',
' 12, selectInput("{prefix}a3drX", "X-axis:", choices = {prefix}conf[dimred == TRUE]$UI, \n',
' selected = {prefix}def$dimred[1]), \n',
' selectInput("{prefix}a3drY", "Y-axis:", choices = {prefix}conf[dimred == TRUE]$UI, \n',
' selected = {prefix}def$dimred[2])) \n',
' ) \n',
' ), # End of column (6 space) \n',
' column( \n',
' 3{subst}, actionButton("{prefix}a3togL", "Toggle to subset cells"), \n',
'{subst} conditionalPanel( \n',
'{subst} condition = "input.{prefix}a3togL % 2 == 1", \n',
'{subst} selectInput("{prefix}a3sub1", "Cell information to subset:", \n',
'{subst} choices = {prefix}conf[grp == TRUE]$UI, \n',
'{subst} selected = {prefix}def$grp1), \n',
'{subst} uiOutput("{prefix}a3sub1.ui"), \n',
'{subst} actionButton("{prefix}a3sub1all", "Select all groups", class = "btn btn-primary"), \n',
'{subst} actionButton("{prefix}a3sub1non", "Deselect all groups", class = "btn btn-primary") \n',
'{subst} ) \n',
' ), # End of column (6 space) \n',
' column( \n',
' 6, actionButton("{prefix}a3tog0", "Toggle graphics controls"), \n',
' conditionalPanel( \n',
' condition = "input.{prefix}a3tog0 % 2 == 1", \n',
' fluidRow( \n',
' column( \n',
' 6, sliderInput("{prefix}a3siz", "Point size:", \n',
' min = 0, max = 4, value = {ptsiz}, step = 0.25), \n',
' radioButtons("{prefix}a3psz", "Plot size:", \n',
' choices = c("Small", "Medium", "Large"), \n',
' selected = "Medium", inline = TRUE), \n',
' radioButtons("{prefix}a3fsz", "Font size:", \n',
' choices = c("Small", "Medium", "Large"), \n',
' selected = "Medium", inline = TRUE) \n',
' ), \n',
' column( \n',
' 6, radioButtons("{prefix}a3asp", "Aspect ratio:", \n',
' choices = c("Square", "Fixed", "Free"), \n',
' selected = "Square", inline = TRUE), \n',
' checkboxInput("{prefix}a3txt", "Show axis text", value = FALSE) \n',
' ) \n',
' ) \n',
' ) \n',
' ) # End of column (6 space) \n',
' ), # End of fluidRow (4 space) \n',
' fluidRow( \n',
' column( \n',
' 6, style="border-right: 2px solid black", h4("Gene expression 1"), \n',
' fluidRow( \n',
' column( \n',
' 6, selectInput("{prefix}a3inp1", "Gene name:", choices=NULL) %>% \n',
' helper(type = "inline", size = "m", fade = TRUE, \n',
' title = "Gene expression to colour cells by", \n',
' content = c("Select gene to colour cells by gene expression", \n',
' paste0("- Gene expression are coloured in a ", \n',
' "White-Red colour scheme which can be ", \n',
' "changed in the plot controls"))) \n',
' ), \n',
' column( \n',
' 6, actionButton("{prefix}a3tog1", "Toggle plot controls"), \n',
' conditionalPanel( \n',
' condition = "input.{prefix}a3tog1 % 2 == 1", \n',
' radioButtons("{prefix}a3col1", "Colour:", \n',
' choices = c("White-Red", "Blue-Yellow-Red", \n',
' "Yellow-Green-Purple"), \n',
' selected = "White-Red"), \n',
' radioButtons("{prefix}a3ord1", "Plot order:", \n',
' choices = c("Max-1st", "Min-1st", "Original", "Random"), \n',
' selected = "Max-1st", inline = TRUE) \n',
' ) \n',
' ) \n',
' ), \n',
' fluidRow(column(12, uiOutput("{prefix}a3oup1.ui"))), \n',
' downloadButton("{prefix}a3oup1.pdf", "Download PDF"), \n',
' downloadButton("{prefix}a3oup1.png", "Download PNG"), br(), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}a3oup1.h", "PDF / PNG height:", width = "138px", \n',
' min = 4, max = 20, value = 6, step = 0.5)), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}a3oup1.w", "PDF / PNG width:", width = "138px", \n',
' min = 4, max = 20, value = 8, step = 0.5)) \n',
' ), # End of column (6 space) \n',
' column( \n',
' 6, h4("Gene expression 2"), \n',
' fluidRow( \n',
' column( \n',
' 6, selectInput("{prefix}a3inp2", "Gene name:", choices=NULL) %>% \n',
' helper(type = "inline", size = "m", fade = TRUE, \n',
' title = "Gene expression to colour cells by", \n',
' content = c("Select gene to colour cells by gene expression", \n',
' paste0("- Gene expression are coloured in a ", \n',
' "White-Red colour scheme which can be ", \n',
' "changed in the plot controls"))) \n',
' ), \n',
' column( \n',
' 6, actionButton("{prefix}a3tog2", "Toggle plot controls"), \n',
' conditionalPanel( \n',
' condition = "input.{prefix}a3tog2 % 2 == 1", \n',
' radioButtons("{prefix}a3col2", "Colour:", \n',
' choices = c("White-Red", "Blue-Yellow-Red", \n',
' "Yellow-Green-Purple"), \n',
' selected = "White-Red"), \n',
' radioButtons("{prefix}a3ord2", "Plot order:", \n',
' choices = c("Max-1st", "Min-1st", "Original", "Random"), \n',
' selected = "Max-1st", inline = TRUE) \n',
' ) \n',
' ) \n',
' ), \n',
' fluidRow(column(12, uiOutput("{prefix}a3oup2.ui"))), \n',
' downloadButton("{prefix}a3oup2.pdf", "Download PDF"), \n',
' downloadButton("{prefix}a3oup2.png", "Download PNG"), br(), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}a3oup2.h", "PDF / PNG height:", width = "138px", \n',
' min = 4, max = 20, value = 6, step = 0.5)), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}a3oup2.w", "PDF / PNG width:", width = "138px", \n',
' min = 4, max = 20, value = 8, step = 0.5)) \n',
' ) # End of column (6 space) \n',
' ) # End of fluidRow (4 space) \n',
' ), # End of tab (2 space) \n',
' \n',
' ### Tab1.b2: Gene coexpression plot \n',
' tabPanel( \n',
' HTML("Gene coexpression"), \n',
' h4("Coexpression of two genes on reduced dimensions"), \n',
' "In this tab, users can visualise the coexpression of two genes ", \n',
' "on low-dimensional representions.", \n',
' br(),br(), \n',
' fluidRow( \n',
' column( \n',
' 3, h4("Dimension Reduction"), \n',
' fluidRow( \n',
' column( \n',
' 12, selectInput("{prefix}b2drX", "X-axis:", choices = {prefix}conf[dimred == TRUE]$UI, \n',
' selected = {prefix}def$dimred[1]), \n',
' selectInput("{prefix}b2drY", "Y-axis:", choices = {prefix}conf[dimred == TRUE]$UI, \n',
' selected = {prefix}def$dimred[2])) \n',
' ) \n',
' ), # End of column (6 space) \n',
' column( \n',
' 3{subst}, actionButton("{prefix}b2togL", "Toggle to subset cells"), \n',
'{subst} conditionalPanel( \n',
'{subst} condition = "input.{prefix}b2togL % 2 == 1", \n',
'{subst} selectInput("{prefix}b2sub1", "Cell information to subset:", \n',
'{subst} choices = {prefix}conf[grp == TRUE]$UI, \n',
'{subst} selected = {prefix}def$grp1), \n',
'{subst} uiOutput("{prefix}b2sub1.ui"), \n',
'{subst} actionButton("{prefix}b2sub1all", "Select all groups", class = "btn btn-primary"), \n',
'{subst} actionButton("{prefix}b2sub1non", "Deselect all groups", class = "btn btn-primary") \n',
'{subst} ) \n',
' ), # End of column (6 space) \n',
' column( \n',
' 6, actionButton("{prefix}b2tog0", "Toggle graphics controls"), \n',
' conditionalPanel( \n',
' condition = "input.{prefix}b2tog0 % 2 == 1", \n',
' fluidRow( \n',
' column( \n',
' 6, sliderInput("{prefix}b2siz", "Point size:", \n',
' min = 0, max = 4, value = {ptsiz}, step = 0.25), \n',
' radioButtons("{prefix}b2psz", "Plot size:", \n',
' choices = c("Small", "Medium", "Large"), \n',
' selected = "Medium", inline = TRUE), \n',
' radioButtons("{prefix}b2fsz", "Font size:", \n',
' choices = c("Small", "Medium", "Large"), \n',
' selected = "Medium", inline = TRUE) \n',
' ), \n',
' column( \n',
' 6, radioButtons("{prefix}b2asp", "Aspect ratio:", \n',
' choices = c("Square", "Fixed", "Free"), \n',
' selected = "Square", inline = TRUE), \n',
' checkboxInput("{prefix}b2txt", "Show axis text", value = FALSE) \n',
' ) \n',
' ) \n',
' ) \n',
' ) # End of column (6 space) \n',
' ), # End of fluidRow (4 space) \n',
' fluidRow( \n',
' column( \n',
' 3, style="border-right: 2px solid black", h4("Gene Expression"), \n',
' selectInput("{prefix}b2inp1", "Gene 1:", choices=NULL) %>% \n',
' helper(type = "inline", size = "m", fade = TRUE, \n',
' title = "Gene expression to colour cells by", \n',
' content = c("Select gene to colour cells by gene expression", \n',
' paste0("- Gene expression are coloured in a ", \n',
' "White-Red colour scheme which can be ", \n',
' "changed in the plot controls"))), \n',
' selectInput("{prefix}b2inp2", "Gene 2:", choices=NULL) %>% \n',
' helper(type = "inline", size = "m", fade = TRUE, \n',
' title = "Gene expression to colour cells by", \n',
' content = c("Select gene to colour cells by gene expression", \n',
' paste0("- Gene expression are coloured in a ", \n',
' "White-Blue colour scheme which can be ", \n',
' "changed in the plot controls"))), \n',
' actionButton("{prefix}b2tog1", "Toggle plot controls"), \n',
' conditionalPanel( \n',
' condition = "input.{prefix}b2tog1 % 2 == 1", \n',
' radioButtons("{prefix}b2col1", "Colour:", \n',
' choices = c("Red (Gene1); Blue (Gene2)", \n',
' "Orange (Gene1); Blue (Gene2)", \n',
' "Red (Gene1); Green (Gene2)", \n',
' "Green (Gene1); Blue (Gene2)"), \n',
' selected = "Red (Gene1); Blue (Gene2)"), \n',
' radioButtons("{prefix}b2ord1", "Plot order:", \n',
' choices = c("Max-1st", "Min-1st", "Original", "Random"), \n',
' selected = "Max-1st", inline = TRUE) \n',
' ) \n',
' ), # End of column (6 space) \n',
' column( \n',
' 6, style="border-right: 2px solid black", \n',
' uiOutput("{prefix}b2oup1.ui"), \n',
' downloadButton("{prefix}b2oup1.pdf", "Download PDF"), \n',
' downloadButton("{prefix}b2oup1.png", "Download PNG"), br(), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}b2oup1.h", "PDF / PNG height:", width = "138px", \n',
' min = 4, max = 20, value = 8, step = 0.5)), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}b2oup1.w", "PDF / PNG width:", width = "138px", \n',
' min = 4, max = 20, value = 10, step = 0.5)) \n',
' ), # End of column (6 space) \n',
' column( \n',
' 3, uiOutput("{prefix}b2oup2.ui"), \n',
' downloadButton("{prefix}b2oup2.pdf", "Download PDF"), \n',
' downloadButton("{prefix}b2oup2.png", "Download PNG"), \n',
' br(), h4("Cell numbers"), \n',
' dataTableOutput("{prefix}b2.dt") \n',
' ) # End of column (6 space) \n',
' ) # End of fluidRow (4 space) \n',
' ), # End of tab (2 space) \n',
' \n',
' ### Tab1.c1: violinplot / boxplot \n',
' tabPanel( \n',
' HTML("Violinplot / Boxplot"), \n',
' h4("Cell information / gene expression violin plot / box plot"), \n',
' "In this tab, users can visualise the gene expression or continuous cell information ", \n',
' "(e.g. Number of UMIs / module score) across groups of cells (e.g. libary / clusters).", \n',
' br(),br(), \n',
' fluidRow( \n',
' column( \n',
' 3, style="border-right: 2px solid black", \n',
' selectInput("{prefix}c1inp1", "Cell information (X-axis):", \n',
' choices = {prefix}conf[grp == TRUE]$UI, \n',
' selected = {prefix}def$grp1) %>% \n',
' helper(type = "inline", size = "m", fade = TRUE, \n',
' title = "Cell information to group cells by", \n',
' content = c("Select categorical cell information to group cells by", \n',
' "- Single cells are grouped by this categorical covariate", \n',
' "- Plotted as the X-axis of the violin plot / box plot")), \n',
' selectInput("{prefix}c1inp2", "Cell Info / Gene name (Y-axis):", choices=NULL) %>% \n',
' helper(type = "inline", size = "m", fade = TRUE, \n',
' title = "Cell Info / Gene to plot", \n',
' content = c("Select cell info / gene to plot on Y-axis", \n',
' "- Can be continuous cell information (e.g. nUMIs / scores)", \n',
' "- Can also be gene expression")), \n',
' radioButtons("{prefix}c1typ", "Plot type:", \n',
' choices = c("violin", "boxplot"), \n',
' selected = "violin", inline = TRUE), \n',
' checkboxInput("{prefix}c1pts", "Show data points", value = FALSE), \n',
'{subst} actionButton("{prefix}c1togL", "Toggle to subset cells"), \n',
'{subst} conditionalPanel( \n',
'{subst} condition = "input.{prefix}c1togL % 2 == 1", \n',
'{subst} selectInput("{prefix}c1sub1", "Cell information to subset:", \n',
'{subst} choices = {prefix}conf[grp == TRUE]$UI, \n',
'{subst} selected = {prefix}def$grp1), \n',
'{subst} uiOutput("{prefix}c1sub1.ui"), \n',
'{subst} actionButton("{prefix}c1sub1all", "Select all groups", class = "btn btn-primary"), \n',
'{subst} actionButton("{prefix}c1sub1non", "Deselect all groups", class = "btn btn-primary") \n',
'{subst} ), br(), br(), \n',
' actionButton("{prefix}c1tog", "Toggle graphics controls"), \n',
' conditionalPanel( \n',
' condition = "input.{prefix}c1tog % 2 == 1", \n',
' sliderInput("{prefix}c1siz", "Data point size:", \n',
' min = 0, max = 4, value = {ptsiz}, step = 0.25), \n',
' radioButtons("{prefix}c1psz", "Plot size:", \n',
' choices = c("Small", "Medium", "Large"), \n',
' selected = "Medium", inline = TRUE), \n',
' radioButtons("{prefix}c1fsz", "Font size:", \n',
' choices = c("Small", "Medium", "Large"), \n',
' selected = "Medium", inline = TRUE)) \n',
' ), # End of column (6 space) \n',
' column(9, uiOutput("{prefix}c1oup.ui"), \n',
' downloadButton("{prefix}c1oup.pdf", "Download PDF"), \n',
' downloadButton("{prefix}c1oup.png", "Download PNG"), br(), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}c1oup.h", "PDF / PNG height:", width = "138px", \n',
' min = 4, max = 20, value = 8, step = 0.5)), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}c1oup.w", "PDF / PNG width:", width = "138px", \n',
' min = 4, max = 20, value = 10, step = 0.5)) \n',
' ) # End of column (6 space) \n',
' ) # End of fluidRow (4 space) \n',
' ), # End of tab (2 space) \n',
' \n',
'### Tab1.c2: Proportion plot \n',
'tabPanel( \n',
' HTML("Proportion plot"), \n',
' h4("Proportion / cell numbers across different cell information"), \n',
' "In this tab, users can visualise the composition of single cells based on one discrete ", \n',
' "cell information across another discrete cell information. ", \n',
' "Usage examples include the library or cellcycle composition across clusters.", \n',
' br(),br(), \n',
' fluidRow( \n',
' column( \n',
' 3, style="border-right: 2px solid black", \n',
' selectInput("{prefix}c2inp1", "Cell information to plot (X-axis):", \n',
' choices = {prefix}conf[grp == TRUE]$UI, \n',
' selected = {prefix}def$grp2) %>% \n',
' helper(type = "inline", size = "m", fade = TRUE, \n',
' title = "Cell information to plot cells by", \n',
' content = c("Select categorical cell information to plot cells by", \n',
' "- Plotted as the X-axis of the proportion plot")), \n',
' selectInput("{prefix}c2inp2", "Cell information to group / colour by:", \n',
' choices = {prefix}conf[grp == TRUE]$UI, \n',
' selected = {prefix}def$grp1) %>% \n',
' helper(type = "inline", size = "m", fade = TRUE, \n',
' title = "Cell information to group / colour cells by", \n',
' content = c("Select categorical cell information to group / colour cells by", \n',
' "- Proportion / cell numbers are shown in different colours")), \n',
' radioButtons("{prefix}c2typ", "Plot value:", \n',
' choices = c("Proportion", "CellNumbers"), \n',
' selected = "Proportion", inline = TRUE), \n',
' checkboxInput("{prefix}c2flp", "Flip X/Y", value = FALSE), \n',
'{subst} actionButton("{prefix}c2togL", "Toggle to subset cells"), \n',
'{subst} conditionalPanel( \n',
'{subst} condition = "input.{prefix}c2togL % 2 == 1", \n',
'{subst} selectInput("{prefix}c2sub1", "Cell information to subset:", \n',
'{subst} choices = {prefix}conf[grp == TRUE]$UI, \n',
'{subst} selected = {prefix}def$grp1), \n',
'{subst} uiOutput("{prefix}c2sub1.ui"), \n',
'{subst} actionButton("{prefix}c2sub1all", "Select all groups", class = "btn btn-primary"), \n',
'{subst} actionButton("{prefix}c2sub1non", "Deselect all groups", class = "btn btn-primary") \n',
'{subst} ), br(), br(), \n',
' actionButton("{prefix}c2tog", "Toggle graphics controls"), \n',
' conditionalPanel( \n',
' condition = "input.{prefix}c2tog % 2 == 1", \n',
' radioButtons("{prefix}c2psz", "Plot size:", \n',
' choices = c("Small", "Medium", "Large"), \n',
' selected = "Medium", inline = TRUE), \n',
' radioButtons("{prefix}c2fsz", "Font size:", \n',
' choices = c("Small", "Medium", "Large"), \n',
' selected = "Medium", inline = TRUE)) \n',
' ), # End of column (6 space) \n',
' column(9, uiOutput("{prefix}c2oup.ui"), \n',
' downloadButton("{prefix}c2oup.pdf", "Download PDF"), \n',
' downloadButton("{prefix}c2oup.png", "Download PNG"), br(), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}c2oup.h", "PDF / PNG height:", width = "138px", \n',
' min = 4, max = 20, value = 8, step = 0.5)), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}c2oup.w", "PDF / PNG width:", width = "138px", \n',
' min = 4, max = 20, value = 10, step = 0.5)) \n',
' ) # End of column (6 space) \n',
' ) # End of fluidRow (4 space) \n',
'), # End of tab (2 space) \n',
' \n',
' ### Tab1.d1: Multiple gene expr \n',
' tabPanel( \n',
' HTML("Bubbleplot / Heatmap"), \n',
' h4("Gene expression bubbleplot / heatmap"), \n',
' "In this tab, users can visualise the gene expression patterns of ", \n',
' "multiple genes grouped by categorical cell information (e.g. library / cluster).", br(), \n',
' "The normalised expression are averaged, log-transformed and then plotted.", \n',
' br(),br(), \n',
' fluidRow( \n',
' column( \n',
' 3, style="border-right: 2px solid black", \n',
' textAreaInput("{prefix}d1inp", HTML("List of gene names <br /> \n',
' (Max 50 genes, separated <br /> \n',
' by , or ; or newline):"), \n',
' height = "200px", \n',
' value = paste0({prefix}def$genes, collapse = ", ")) %>% \n',
' helper(type = "inline", size = "m", fade = TRUE, \n',
' title = "List of genes to plot on bubbleplot / heatmap", \n',
' content = c("Input genes to plot", \n',
' "- Maximum 50 genes (due to ploting space limitations)", \n',
' "- Genes should be separated by comma, semicolon or newline")), \n',
' selectInput("{prefix}d1grp", "Group by:", \n',
' choices = {prefix}conf[grp == TRUE]$UI, \n',
' selected = {prefix}conf[grp == TRUE]$UI[1]) %>% \n',
' helper(type = "inline", size = "m", fade = TRUE, \n',
' title = "Cell information to group cells by", \n',
' content = c("Select categorical cell information to group cells by", \n',
' "- Single cells are grouped by this categorical covariate", \n',
' "- Plotted as the X-axis of the bubbleplot / heatmap")), \n',
' radioButtons("{prefix}d1plt", "Plot type:", \n',
' choices = c("Bubbleplot", "Heatmap"), \n',
' selected = "Bubbleplot", inline = TRUE), \n',
' checkboxInput("{prefix}d1scl", "Scale gene expression", value = TRUE), \n',
' checkboxInput("{prefix}d1row", "Cluster rows (genes)", value = TRUE), \n',
' checkboxInput("{prefix}d1col", "Cluster columns (samples)", value = FALSE), \n',
' br(), \n',
'{subst} actionButton("{prefix}d1togL", "Toggle to subset cells"), \n',
'{subst} conditionalPanel( \n',
'{subst} condition = "input.{prefix}d1togL % 2 == 1", \n',
'{subst} selectInput("{prefix}d1sub1", "Cell information to subset:", \n',
'{subst} choices = {prefix}conf[grp == TRUE]$UI, \n',
'{subst} selected = {prefix}def$grp1), \n',
'{subst} uiOutput("{prefix}d1sub1.ui"), \n',
'{subst} actionButton("{prefix}d1sub1all", "Select all groups", class = "btn btn-primary"), \n',
'{subst} actionButton("{prefix}d1sub1non", "Deselect all groups", class = "btn btn-primary") \n',
'{subst} ), br(), br(), \n',
' actionButton("{prefix}d1tog", "Toggle graphics controls"), \n',
' conditionalPanel( \n',
' condition = "input.{prefix}d1tog % 2 == 1", \n',
' radioButtons("{prefix}d1cols", "Colour scheme:", \n',
' choices = c("White-Red", "Blue-Yellow-Red", \n',
' "Yellow-Green-Purple"), \n',
' selected = "Blue-Yellow-Red"), \n',
' radioButtons("{prefix}d1psz", "Plot size:", \n',
' choices = c("Small", "Medium", "Large"), \n',
' selected = "Medium", inline = TRUE), \n',
' radioButtons("{prefix}d1fsz", "Font size:", \n',
' choices = c("Small", "Medium", "Large"), \n',
' selected = "Medium", inline = TRUE)) \n',
' ), # End of column (6 space) \n',
' column(9, h4(htmlOutput("{prefix}d1oupTxt")), \n',
' uiOutput("{prefix}d1oup.ui"), \n',
' downloadButton("{prefix}d1oup.pdf", "Download PDF"), \n',
' downloadButton("{prefix}d1oup.png", "Download PNG"), br(), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}d1oup.h", "PDF / PNG height:", width = "138px", \n',
' min = 4, max = 20, value = 10, step = 0.5)), \n',
' div(style="display:inline-block", \n',
' numericInput("{prefix}d1oup.w", "PDF / PNG width:", width = "138px", \n',
' min = 4, max = 20, value = 10, step = 0.5)) \n',
' ) # End of column (6 space) \n',
' ) # End of fluidRow (4 space) \n',
' ) # End of tab (2 space) \n',
' \n')
}
#' Write code for final portion of ui.R
#'
#' @param footnote shiny app footnote
#'
#' @rdname wrUIend
#' @export wrUIend
#'
wrUIend <- function(footnote) {
if(is.list(footnote)){
f1 = ''; f2 = ''; f3 = ''; f4 = ''; f5 = ''; f6 = ''; f7 = ''; f8 = ''
if(!is.null(footnote$author)){ f1 = paste0('"',footnote$author,' ",')}
if(!is.null(footnote$title)){ f2 = paste0('"',footnote$title,' ",')}
if(!is.null(footnote$journal)){f3 = paste0('em("',footnote$journal,' "),')}
if(!is.null(footnote$volume)){ f4 = paste0('strong("',footnote$volume,', "),')}
if(!is.null(footnote$page)){ f5 = paste0('"',footnote$page,' ",')}
if(!is.null(footnote$year)){ f6 = paste0('"(',footnote$year,') ",')}
if(!is.null(footnote$doi)){ f7 = paste0('"doi: ',footnote$doi,' ",')}
if(!is.null(footnote$link)){ f8 = paste0('a("[Link]", href = "',footnote$link,'", target="_blank"),')}
f0 = paste0('strong("Reference: "),', f1, f2, f3, f4, f5, f6, f7, f8,
'style = "font-size: 125%;"')
} else {
f0 = paste0('"', footnote[[1]], '", style = "font-size: 125%;"')
}
glue::glue(' \n',
' \n',
'br(), \n',
'p({f0}), \n',
'p(em("This webpage was made using "), a("ShinyCell", \n',
' href = "https://github.com/SGDDNB/ShinyCell",target="_blank")), \n',
'br(),br(),br(),br(),br() \n',
'))) \n',
' \n',
' \n',
' \n',
' \n')
}
#' Write code for google-analytics.html
#'
#' @param gaID Google analytics tracking ID (e.g. "UA-123456789-0")
#'
#' @rdname wrUIga
#' @export wrUIga
#'
wrUIga <- function(gaID) {
glue::glue('<!-- Global site tag (gtag.js) - Google Analytics --> \n',
' <script async src="https://www.googletagmanager.com/gtag/js?id={gaID}"></script> \n',
' <script> \n',
' window.dataLayer = window.dataLayer || []; \n',
'function gtag(){{dataLayer.push(arguments);}} \n',
'gtag(\'js\', new Date()); \n',
' \n',
'gtag(\'config\', \'{gaID}\'); \n',
'</script> \n')
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.