From d32e91a8f08c3a216b7baecae8c9c6a0a62ca64d Mon Sep 17 00:00:00 2001 From: hallvaaw Date: Thu, 20 Oct 2022 13:52:17 +0200 Subject: [PATCH 1/2] update code after running lintr --- global.R | 64 ++--- server.R | 838 +++++++++++++++++++++++++++---------------------------- ui.R | 199 +++++++------ 3 files changed, 542 insertions(+), 559 deletions(-) diff --git a/global.R b/global.R index 8e80ec3..a76694c 100644 --- a/global.R +++ b/global.R @@ -1,22 +1,22 @@ ##################################################################### -# Setting up # +# Setting up # ##################################################################### #updated:Feb102022 # if (!requireNamespace("Shiny", quietly = TRUE)) install.packages("shiny") -# ##Install ArchR,and its dependencies +# ##Install ArchR, and its dependencies # #check for devtools # if (!requireNamespace("devtools", quietly = TRUE)) install.packages("devtools") # #Install ArchR -# if (!requireNamespace("ArchR",quietly = TRUE)) devtools::install_github("GreenleafLab/ArchR",ref="master",repos=BiocManager::repositories()) +# if (!requireNamespace("ArchR", quietly = TRUE)) devtools::install_github("GreenleafLab/ArchR", ref = "master", repos = BiocManager::repositories()) # #Install ArchR dependencies # library(ArchR) # ArchR::installExtraPackages() # #Install presto -# if (!requireNamespace("presto",quietly = TRUE)) devtools::install_github("immunogenomics/presto") +# if (!requireNamespace("presto", quietly = TRUE)) devtools::install_github("immunogenomics/presto") #### -packages <- c("Seurat","shinycssloaders","hexbin","magick", - "gridExtra", "grid","patchwork","shinybusy","ArchR","ggseqlogo") +packages <- c("Seurat", "shinycssloaders", "hexbin", "magick", + "gridExtra", "grid", "patchwork", "shinybusy", "ArchR", "ggseqlogo") ## Now load or install&load all package.check <- lapply( @@ -32,10 +32,10 @@ package.check <- lapply( options(repos = BiocManager::repositories()) ##################################################################### -# Setting up ARCHR +# Setting up ARCHR ##################################################################### #specify desired number of threads , If required -addArchRThreads(threads = 1) +addArchRThreads(threads = 1) #specify genome version. Default hg19 set addArchRGenome("hg19") set.seed(1) @@ -47,7 +47,7 @@ set.seed(1) ##Load the Saved projects folders from ArchR analysis as saved in ArchR full manual using saveArchRProject() function #Load Saved-project folders path e.g 'Save-ArchRProject2'<- loadArchRProject("path/to/your/Save-ArchRProject2"). Save project also after trajectory analysis e.g as Save-ArchRProject5 #Please see ArchR full manual for saveArchRProject() function or use the ArchR.RMD for your analysis provided with the source code which follows the steps illustrated in ArchR full manual. Save-ArchRProject5 -# +# savedArchRProject1 <- loadArchRProject("~/ArchRAnalysis/Save-ProjHeme2/") savedArchRProject2 <- loadArchRProject("~/ArchRAnalysis/Save-ProjHeme3/") savedArchRProject3 <- loadArchRProject("~/ArchRAnalysis/Save-ProjHeme5/") @@ -65,24 +65,24 @@ trajectory_name<-"LymphoidU" cluster_umap <- plotEmbedding( ArchRProj = savedArchRProject1, - baseSize=12, + baseSize = 12, colorBy = "cellColData", name = "Clusters", embedding = "UMAP", rastr = FALSE, - size=0.5, + size = 0.5, - )+ggtitle("Colored by scATAC-seq clusters")+theme(text=element_text(size=12), legend.title = element_text(size = 12),legend.text = element_text(size = 6)) + ) + ggtitle("Colored by scATAC-seq clusters") + theme(text = element_text(size = 12), legend.title = element_text(size = 12), legend.text = element_text(size = 6)) sample_umap <- plotEmbedding( ArchRProj = savedArchRProject1, - baseSize=12, + baseSize = 12, colorBy = "cellColData", name = "Sample", embedding = "UMAP", rastr = FALSE, - size=0.5 -)+ ggtitle("Colored by original identity")+theme(text=element_text(size=12), legend.title = element_text( size = 12),legend.text = element_text(size = 6)) + size = 0.5 +) + ggtitle("Colored by original identity") + theme(text = element_text(size = 12), legend.title = element_text( size = 12), legend.text = element_text(size = 6)) unconstrained_umap <- plotEmbedding( ArchRProj = savedArchRProject1, @@ -90,11 +90,11 @@ unconstrained_umap <- plotEmbedding( reducedDims = "IterativeLSI", colorBy = "cellColData", name = "predictedGroup_Un", - baseSize=12, + baseSize = 12, rastr = FALSE, - size=0.5 - )+ggtitle("UMAP: unconstrained integration")+theme(text=element_text(size=12), legend.title = element_text( size = 12),legend.text = element_text(size = 6)) + size = 0.5 + ) + ggtitle("UMAP: unconstrained integration") + theme(text = element_text(size = 12), legend.title = element_text( size = 12), legend.text = element_text(size = 6)) constrained_umap <- plotEmbedding( ArchRProj = savedArchRProject1, @@ -102,9 +102,9 @@ constrained_umap <- plotEmbedding( colorBy = "cellColData", name = "predictedGroup_Co", rastr = FALSE, - baseSize=12, - size=0.5 -)+ggtitle("UMAP: constrained integration")+theme(text=element_text(size=12), legend.title = element_text( size = 12),legend.text = element_text(size = 6)) + baseSize = 12, + size = 0.5 +) + ggtitle("UMAP: constrained integration") + theme(text = element_text(size = 12), legend.title = element_text( size = 12), legend.text = element_text(size = 6)) constrained_remapped_umap <- plotEmbedding( @@ -112,9 +112,9 @@ constrained_remapped_umap <- plotEmbedding( colorBy = "cellColData", name = "Clusters2", rastr = FALSE, - )+ggtitle("UMAP: Constrained remapped clusters")+theme(text=element_text(size=12), legend.title = element_text( size = 12),legend.text = element_text(size = 6)) + ) + ggtitle("UMAP: Constrained remapped clusters") + theme(text = element_text(size = 12), legend.title = element_text( size = 12), legend.text = element_text(size = 6)) -umaps<-list("Clusters"= cluster_umap,"Sample"= sample_umap,"Unconstrained"=unconstrained_umap,"Constrained"=constrained_umap,"Constrained remap"=constrained_remapped_umap) +umaps <- list("Clusters" = cluster_umap, "Sample" = sample_umap, "Unconstrained" = unconstrained_umap, "Constrained" = constrained_umap, "Constrained remap" = constrained_remapped_umap) ######################################################################## # MarkerGenes ######################################################################## @@ -129,18 +129,18 @@ markersGS <- getMarkerFeatures( bias = c("TSSEnrichment", "log10(nFrags)"), testMethod = "wilcoxon" ) -markerList_p1 <- getMarkers(markersGS, cutOff = "FDR <= 0.1 & Log2FC >= 0.1") +markerList_p1 <- getMarkers(markersGS, cutOff = "FDR < = 0.1 & Log2FC > = 0.1") # Find the all the genes available in the data gene_names <- markerList_p1[[names(markerList_p1)[1]]]$name for (cn in names(markerList_p1)[-1]){ - gene_names <- union(gene_names,markerList_p1[[cn]]$name) + gene_names <- union(gene_names, markerList_p1[[cn]]$name) } ######################################################################## # motifs for feature comparison panel ######################################################################## -motifMatrix_forShiny=getMatrixFromProject( +motifMatrix_forShiny <- getMatrixFromProject( ArchRProj = savedArchRProject3, useMatrix = "MotifMatrix", useSeqnames = NULL, @@ -149,12 +149,12 @@ motifMatrix_forShiny=getMatrixFromProject( threads = getArchRThreads() ) -#motifMatrix_dropdown=sapply(strsplit(motifMatrix_forShiny@NAMES, "_"), "[", 1) - motifMatrix_dropdown=motifMatrix_forShiny@NAMES + + motifMatrix_dropdown <- motifMatrix_forShiny@NAMES #get PWM of motifs and convert them to probability matrix for seqlogo:Utilized function from utils.R of https://github.com/GreenleafLab/ChrAccR -PWMatrixToProbMatrix <- function(x){ - if (class(x) != "PWMatrix") stop("x must be a TFBSTools::PWMatrix object") +PWMatrixToProbMatrix <- function(x) { + if (class(x) != "PWMatrix") stop("x must be a TFBSTools::PWMatrix object") (2^as(x, "matrix"))*TFBSTools::bg(x)/sum(TFBSTools::bg(x)) } @@ -171,7 +171,7 @@ reducedDims <- "IterativeLSI" ######################################################################## # motif footprinting ######################################################################## -motifPositions=getPositions(savedArchRProject3) +motifPositions <- getPositions(savedArchRProject3) ######################################################################## # Heatmap:Trajectory and peak2genelink ######################################################################## @@ -191,5 +191,3 @@ p_peakMatrix_traj <- plotTrajectoryHeatmap(trajPM, pal = paletteContinuous(set = ######################################################################## # End ######################################################################## - - diff --git a/server.R b/server.R index fdd43de..577883f 100644 --- a/server.R +++ b/server.R @@ -2,8 +2,8 @@ #This file contain server file functions for computation.## ########################################################### #updated:Feb102022 -shinyServer <- function(input,output, session){ - #observe_helpers() +shiny_server <- function(input, output, session) { + ########################################################### # UMAPS ## @@ -11,41 +11,39 @@ shinyServer <- function(input,output, session){ #Observe the inputs for UMAPS #Output Handler: Downloads UMAPS - output$download_UMAP1<-downloadHandler( - filename <- function(){ - paste0("UMAP-",input$UMAP1_forComparison,input$plot_choice_download_UMAP1) + output$download_UMAP1 <- downloadHandler( + filename <- function() { + paste0("UMAP-", input$UMAP1_forComparison, input$plot_choice_download_UMAP1) }, - content = function(file){ - if(input$plot_choice_download_UMAP1==".pdf") - {pdf(file = file,onefile=FALSE, width = input$UMAP1_plot_width, height = input$UMAP1_plot_height)} - - else if(input$plot_choice_download_UMAP1==".png") - {png(file = file, width = input$UMAP1_plot_width, height = input$UMAP1_plot_height,units="in",res=1000)} - - else - {tiff(file = file, width = input$UMAP1_plot_width, height = input$UMAP1_plot_height,units="in",res=1000)} - - # grid.arrange(umaps[[input$UMAP1_forComparison]]) # <-Original + content = function(file) { + if (input$plot_choice_download_UMAP1 == ".pdf") { + pdf(file = file, onefile = FALSE, width = input$UMAP1_plot_width, height = input$UMAP1_plot_height) + } else if (input$plot_choice_download_UMAP1 == ".png") { + png(file = file, width = input$UMAP1_plot_width, height = input$UMAP1_plot_height, units = "in", res = 1000) + } else { + tiff(file = file, width = input$UMAP1_plot_width, height = input$UMAP1_plot_height, units = "in", res = 1000) + } + + # grid.arrange(umaps[[input$UMAP1_forComparison]]) # <- Original grid.arrange(umaps[[input$UMAP1_forComparison]]) # <- Modification dev.off() } ) - output$download_UMAP2<-downloadHandler( - filename <- function(){ - paste0("UMAP-",input$UMAP2_forComparison,input$plot_choice_download_UMAP2) + output$download_UMAP2 <- downloadHandler( + filename <- function() { + paste0("UMAP-", input$UMAP2_forComparison, input$plot_choice_download_UMAP2) }, - content = function(file){ - - if(input$plot_choice_download_UMAP2==".pdf") - {pdf(file = file,onefile=FALSE, width = input$UMAP2_plot_width, height = input$UMAP2_plot_height)} - - else if(input$plot_choice_download_UMAP2==".png") - {png(file = file, width = input$UMAP2_plot_width, height = input$UMAP2_plot_height,units="in",res=1000)} - - else - {tiff(file = file, width = input$UMAP2_plot_width, height = input$UMAP2_plot_height,units="in",res=1000)} - + content = function(file) { + + if (input$plot_choice_download_UMAP2 == ".pdf") { + pdf(file = file, onefile = FALSE, width = input$UMAP2_plot_width, height = input$UMAP2_plot_height) + } else if (input$plot_choice_download_UMAP2 == ".png") { + png(file = file, width = input$UMAP2_plot_width, height = input$UMAP2_plot_height, units = "in", res = 1000) + } else { + tiff(file = file, width = input$UMAP2_plot_width, height = input$UMAP2_plot_height, units = "in", res = 1000) + } + grid.arrange(umaps[[input$UMAP2_forComparison]]) # <- Modification dev.off() } @@ -53,77 +51,78 @@ shinyServer <- function(input,output, session){ output$UMAP_plot_1 <- DT::renderDT(NULL) output$UMAP_plot_2 <- DT::renderDT(NULL) - - if (isolate(input$UMAP1_forComparison) == "" || - isolate(input$UMAP2_forComparison) == ""){ - + + if (isolate(input$UMAP1_forComparison) == "" || + isolate(input$UMAP2_forComparison) == "") { + output$UMAP_plot_1 <- renderPlot({ p <- ggplot() + - xlim(c(-5,5)) + ylim(c(-5,5)) + - geom_text(size=20, aes(x = 0, y = 0, label = "Please Supply\nA Valid Gene!")) + theme_void() + xlim(c(-5, 5)) + ylim(c(-5, 5)) + + geom_text(size = 20, aes(x = 0, y = 0, label = "Please Supply\nA Valid Gene!")) + theme_void() print(p) }) - }else{ + } else { # Plots UMAPS - output$UMAP_plot_1<- renderPlot({ - umaps[input$UMAP1_forComparison]},height = 450,width=450) - output$UMAP_plot_2<- renderPlot({ - umaps[input$UMAP2_forComparison]},height = 450,width=450) + output$UMAP_plot_1 <- renderPlot({ + umaps[input$UMAP1_forComparison]}, height = 450, width = 450) + output$UMAP_plot_2 <- renderPlot({ + umaps[input$UMAP2_forComparison]}, height = 450, width = 450) } - + ########################################################### # scATACseq Cluster:Browserview ## -########################################################### +########################################################### # Observe the inputs for ATAC-Seq Explorer observeEvent(input$range_min, { updateSliderInput(session, "range", - value = c(input$range_min,max(input$range))) + value = c(input$range_min, max(input$range))) }) observeEvent(input$range_max, { updateSliderInput(session, "range", - value = c(input$range_min,input$range_max)) + value = c(input$range_min, input$range_max)) }) - observeEvent(input$range , { + observeEvent(input$range, { updateNumericInput(session, "range_min", value = min(input$range)) updateNumericInput(session, "range_max", value = max(input$range)) }, priority = 200) - - # Output Handler:downloads file - output$down<-downloadHandler( - filename <- function(){ - paste0("ArchRBrowser-",input$gene_name,input$plot_choice_download_peakBrowser) + + # Output Handler:downloads file + output$down <- downloadHandler( + filename <- function() { + paste0("ArchRBrowser-", input$gene_name, input$plot_choice_download_peakBrowser) }, - content = function(file){ - - if(input$plot_choice_download_peakBrowser==".pdf") - {pdf(file = file,onefile=FALSE, width = input$plot_width, height = input$plot_height)} - - else if(input$plot_choice_download_peakBrowser==".png") - {png(file = file, width = input$plot_width, height = input$plot_height,units="in",res=1000)} - - else - {tiff(file = file, width = input$plot_width, height = input$plot_height,units="in",res=1000)} - - - p_browser_atacClusters<- plotBrowserTrack( + content = function(file) { + + if (input$plot_choice_download_peakBrowser == ".pdf") { + pdf(file = file, onefile = FALSE, width = input$plot_width, height = input$plot_height) + + } else if (input$plot_choice_download_peakBrowser == ".png") { + png(file = file, width = input$plot_width, height = input$plot_height, units = "in", res = 1000) + + } else { + tiff(file = file, width = input$plot_width, height = input$plot_height, units = "in", res = 1000) + } + + + p_browser_atacClusters <- plotBrowserTrack( ArchRProj = savedArchRProject3, groupBy = isolate(input$group_by), baseSize = 11, facetbaseSize = 11, geneSymbol = isolate(input$gene_name), - upstream = -min(isolate(input$range))*1000, - downstream = max(isolate(input$range))*1000, + upstream = -min(isolate(input$range)) * 1000, + downstream = max(isolate(input$range)) * 1000, tileSize = isolate(input$tile_size), ylim = c(0, isolate(input$ymax)), loops = getCoAccessibility(savedArchRProject3) - + )[[input$gene_name]] - + # grid::grid.draw(p_browser_atacClusters) # <- Orignal grid.arrange(p_browser_atacClusters) # <- modification @@ -131,114 +130,115 @@ shinyServer <- function(input,output, session){ } ) output$browser_atacClusters <- DT::renderDT(NULL) - - ##handles error + + ##handles error restartFN <- observeEvent(input$restartButton, { - if (isolate(input$gene_name) == ""){ + if (isolate(input$gene_name) == "") { output$browser_atacClusters <- renderPlot({ p <- ggplot() + - xlim(c(-5,5)) + ylim(c(-5,5)) + - geom_text(size=20, aes(x = 0, y = 0, label = "Please supply\na valid gene name!")) + theme_void() + xlim(c(-5, 5)) + ylim(c(-5, 5)) + + geom_text(size = 20, aes(x = 0, y = 0, label = "Please supply\na valid gene name!")) + theme_void() print(p) }) - }else{ - - # Plots scATACSeq clusters - output$browser_atacClusters<- renderPlot({ + } else { + + # Plots scATACSeq clusters + output$browser_atacClusters <- renderPlot({ grid::grid.newpage() - p_browser_atacClusters<- plotBrowserTrack( + p_browser_atacClusters <- plotBrowserTrack( ArchRProj = savedArchRProject3, baseSize = 11, facetbaseSize = 11, groupBy = isolate(input$group_by), geneSymbol = isolate(input$gene_name), - upstream = -min(isolate(input$range))*1000, - downstream = max(isolate(input$range))*1000, + upstream = -min(isolate(input$range)) * 1000, + downstream = max(isolate(input$range)) * 1000, tileSize = isolate(input$tile_size), ylim = c(0, isolate(input$ymax)), loops = getCoAccessibility(savedArchRProject3) - + )[[input$gene_name]] - + grid::grid.draw(p_browser_atacClusters) - - },height = 900) + + }, height = 900) } }) - - + + ########################################################### #scATACseq coaccessibility and peak2 genelinks:Browserview## -########################################################### +########################################################### # Observe the inputs for ATAC-Seq Co-accessibility observeEvent(input$range_min_1, { updateSliderInput(session, "range_1", - value = c(input$range_min_1,max(input$range_1))) + value = c(input$range_min_1, max(input$range_1))) }) observeEvent(input$range_max_1, { updateSliderInput(session, "range_1", - value = c(input$range_min_1,input$range_max_1)) + value = c(input$range_min_1, input$range_max_1)) }) - observeEvent(input$range_1 , { + observeEvent(input$range_1, { updateNumericInput(session, "range_min_1", value = min(input$range_1)) updateNumericInput(session, "range_max_1", value = max(input$range_1)) }, priority = 200) - + # Output Handler:downloads file - output$down_1<-downloadHandler( - filename <- function(){ - paste0("ArchRBrowser_rds-",input$gene_name_1,input$plot_choice_download_peak2GeneLink) + output$down_1 <- downloadHandler( + filename <- function() { + paste0("ArchRBrowser_rds-", input$gene_name_1, input$plot_choice_download_peak2GeneLink) }, - content = function(file){ - - if(input$plot_choice_download_peak2GeneLink==".pdf") - {pdf(file = file,onefile=FALSE, width = input$plot_width_1, height = input$plot_height_1)} - - else if(input$plot_choice_download_peak2GeneLink==".png") - {png(file = file, width = input$plot_width_1, height = input$plot_height_1,units="in",res=1000)} - - else - {tiff(file = file, width = input$plot_width_1, height = input$plot_height_1,units="in",res=1000)} - - + content = function(file) { + + if (input$plot_choice_download_peak2GeneLink == ".pdf") { + pdf(file = file, onefile = FALSE, width = input$plot_width_1, height = input$plot_height_1) + + } else if (input$plot_choice_download_peak2GeneLink == ".png") { + png(file = file, width = input$plot_width_1, height = input$plot_height_1, units = "in", res = 1000) + + } else { + tiff(file = file, width = input$plot_width_1, height = input$plot_height_1, units = "in", res = 1000) + } + + p_co_access_peaks <- plotBrowserTrack( ArchRProj = savedArchRProject3, groupBy = "Clusters2", baseSize = 11, facetbaseSize = 11, geneSymbol = isolate(input$gene_name_1), - upstream =-min(isolate(input$range_1))*1000 , + upstream = -min(isolate(input$range_1))*1000 , downstream = max(isolate(input$range_1))*1000, tileSize = isolate(input$tile_size_1), ylim = c(0, isolate(input$ymax_1)), loops = getPeak2GeneLinks(savedArchRProject3) )[[input$gene_name_1]] - + grid.arrange(p_co_access_peaks) # <- Orignal dev.off() } ) output$co_access_peaks <- DT::renderDT(NULL) - - restartFN_2 <- observeEvent(input$restartButton_1,{ - if (isolate(input$gene_name_1) == ""){ + + restartFN_2 <- observeEvent(input$restartButton_1, { + if (isolate(input$gene_name_1) == "") { output$co_access_peaks <- renderPlot({ p <- ggplot() + - xlim(c(-5,5)) + ylim(c(-5,5)) + - geom_text(size=20, aes(x = 0, y = 0, label = "Please Supply\nA Valid Gene!")) + theme_void() + xlim(c(-5, 5)) + ylim(c(-5, 5)) + + geom_text(size = 20, aes(x = 0, y = 0, label = "Please Supply\nA Valid Gene!")) + theme_void() print(p) }) - }else{ - - + } else { + + # Plot from peak2Genelinks and coaccessibility plots output$co_access_peaks <- renderPlot({ grid::grid.newpage() @@ -248,306 +248,288 @@ shinyServer <- function(input,output, session){ baseSize = 11, facetbaseSize = 11, geneSymbol = isolate(input$gene_name_1), - upstream =-min(isolate(input$range_1))*1000 , - downstream = max(isolate(input$range_1))*1000, + upstream = -min(isolate(input$range_1)) * 1000 , + downstream = max(isolate(input$range_1)) * 1000, tileSize = isolate(input$tile_size_1), ylim = c(0, isolate(input$ymax_1)), loops = getPeak2GeneLinks(savedArchRProject3) )[[input$gene_name_1]] grid.arrange(p_co_access_peaks) - },height = 1200) + }, height = 1200) } }) - + ########################################################### #Feature comparison : plot UMAP2 ## -########################################################### +########################################################### #Obtaining pwm matrix - motif_PWMatrix=savedArchRProject3@peakAnnotation@listData[["Motif"]][["motifs"]] + motif_PWMatrix <- savedArchRProject3@peakAnnotation@listData[["Motif"]][["motifs"]] motif_ProbMatrices <- lapply(motif_PWMatrix, PWMatrixToProbMatrix) - motifSummary=readRDS(savedArchRProject3@peakAnnotation@listData[["Motif"]][["Positions"]]) - - - + motifSummary <- readRDS(savedArchRProject3@peakAnnotation@listData[["Motif"]][["Positions"]]) + + + #Provide gene/motif names for drop down observe({ - if(isolate(input$matrix_forComparison)=="MotifMatrix") - { - updateSelectizeInput(session, 'gene_forComparison_1', label = 'Feature Name 1', - choices = sort(motifMatrix_dropdown), - server = TRUE,selected =sort(motifMatrix_dropdown)[1]) - - updateSelectizeInput(session, 'gene_forComparison_2', label = 'Feature Name 2', - choices = sort(motifMatrix_dropdown), - server = TRUE,selected =sort(motifMatrix_dropdown)[2]) - } - else{ - updateSelectizeInput(session, 'gene_forComparison_1', label = 'Feature Name 1', - choices = sort(gene_names), - server = TRUE,sort(gene_names)[1]) - updateSelectizeInput(session, 'gene_forComparison_2', label = 'Feature Name 2', - choices = sort(gene_names), - server = TRUE,sort(gene_names)[2]) + if (isolate(input$matrix_forComparison) == "MotifMatrix") { + updateSelectizeInput(session, "gene_forComparison_1", label = "Feature Name 1", + choices = sort(motifMatrix_dropdown), + server = TRUE, selected = sort(motifMatrix_dropdown)[1]) + + updateSelectizeInput(session, "gene_forComparison_2", label = "Feature Name 2", + choices = sort(motifMatrix_dropdown), + server = TRUE, selected = sort(motifMatrix_dropdown)[2]) + } else { + updateSelectizeInput(session, "gene_forComparison_1", label = "Feature Name 1", + choices = sort(gene_names), + server = TRUE, sort(gene_names)[1]) + updateSelectizeInput(session, "gene_forComparison_2", label = "Feature Name 2", + choices = sort(gene_names), + server = TRUE, sort(gene_names)[2]) } }) - + #change it with the dropdown option for matrix - observeEvent(input$matrix_forComparison,{ - - if(isolate(input$matrix_forComparison)=="MotifMatrix") - { - updateSelectizeInput(session, 'gene_forComparison_1',label = 'Feature Name 1', - choices = sort(motifMatrix_dropdown), - server = TRUE,selected =sort(motifMatrix_dropdown)[1]) - updateSelectizeInput(session, 'gene_forComparison_2',label = 'Feature Name 2', - choices = sort(motifMatrix_dropdown), - server = TRUE,selected =sort(motifMatrix_dropdown)[2]) - } - else{ - updateSelectizeInput(session, 'gene_forComparison_1', label = 'Feature Name 1', - choices = sort(gene_names), - server = TRUE,selected =sort(gene_names)[1]) - updateSelectizeInput(session, 'gene_forComparison_2', label = 'Feature Name 2', - choices = sort(gene_names), - server = TRUE,selected =sort(gene_names)[2]) + observeEvent(input$matrix_forComparison, { + + if (isolate(input$matrix_forComparison) == "MotifMatrix") { + updateSelectizeInput(session, "gene_forComparison_1", label = "Feature Name 1", + choices = sort(motifMatrix_dropdown), + server = TRUE, selected = sort(motifMatrix_dropdown)[1]) + updateSelectizeInput(session, "gene_forComparison_2", label = "Feature Name 2", + choices = sort(motifMatrix_dropdown), + server = TRUE, selected = sort(motifMatrix_dropdown)[2]) + } else { updateSelectizeInput(session, "gene_forComparison_1", label = "Feature Name 1", + choices = sort(gene_names), + server = TRUE, selected = sort(gene_names)[1]) + updateSelectizeInput(session, "gene_forComparison_2", label = "Feature Name 2", + choices = sort(gene_names), + server = TRUE, selected = sort(gene_names)[2]) } - + }) - + # Output Handler : download plots - output$download_feature_comparison<-downloadHandler( - filename <- function(){ - paste0("ArchRBrowser-",input$gene_forComparison_1,"-VS-",input$gene_forComparison_2,input$plot_choice_download_feature_comparison) + output$download_feature_comparison <- downloadHandler( + filename <- function() { + paste0("ArchRBrowser-", input$gene_forComparison_1, "-VS-", input$gene_forComparison_2, input$plot_choice_download_feature_comparison) }, - content = function(file){ - - if(input$plot_choice_download_feature_comparison==".pdf") - {pdf(file = file,onefile=FALSE, width = input$gene_Comparison_plot_width, height = input$gene_Comparison_plot_height)} - - else if(input$plot_choice_download_feature_comparison==".png") - {png(file = file, width = input$gene_Comparison_plot_width, height = input$gene_Comparison_plot_height,units="in",res=1000)} - - else - {tiff(file = file, width = input$gene_Comparison_plot_width, height = input$gene_Comparison_plot_height,units="in",res=1000)} - - if(isolate(input$matrix_forComparison)=="GeneScoreMatrix") - - { - - gene1_plot=plotEmbedding( + content = function(file) { + + if (input$plot_choice_download_feature_comparison == ".pdf") { + pdf(file = file, onefile = FALSE, width = input$gene_Comparison_plot_width, height = input$gene_Comparison_plot_height) + + } else if (input$plot_choice_download_feature_comparison == ".png") { + png(file = file, width = input$gene_Comparison_plot_width, height = input$gene_Comparison_plot_height, units = "in", res = 1000) + } else { + tiff(file = file, width = input$gene_Comparison_plot_width, height = input$gene_Comparison_plot_height, units = "in", res = 1000) + } + + if (isolate(input$matrix_forComparison) == "GeneScoreMatrix") { + + gene1_plot <- plotEmbedding( ArchRProj = savedArchRProject3, colorBy = "GeneScoreMatrix", #continuousSet = "yellowBlue", name = isolate(input$gene_forComparison_1), embedding = "UMAP", imputeWeights = getImputeWeights(savedArchRProject3), - + ) - - gene2_plot=plotEmbedding( + + gene2_plot <- plotEmbedding( ArchRProj = savedArchRProject3, colorBy = "GeneScoreMatrix", #continuousSet = "yellowBlue", name = isolate(input$gene_forComparison_2), embedding = "UMAP", imputeWeights = getImputeWeights(savedArchRProject3), - - )} - - else if(isolate(input$matrix_forComparison)=="GeneIntegrationMatrix") - { - gene1_plot=plotEmbedding( + + )} else if (isolate(input$matrix_forComparison) == "GeneIntegrationMatrix") { + + gene1_plot <- plotEmbedding( ArchRProj = savedArchRProject3, colorBy = "GeneIntegrationMatrix", name = isolate(input$gene_forComparison_1), embedding = "UMAP", imputeWeights = getImputeWeights(savedArchRProject3), - + ) - - gene2_plot=plotEmbedding( + + gene2_plot <- plotEmbedding( ArchRProj = savedArchRProject3, colorBy = "GeneIntegrationMatrix", name = isolate(input$gene_forComparison_2), embedding = "UMAP", imputeWeights = getImputeWeights(savedArchRProject3), - - )} - - else - { - gene1_plot=plotEmbedding( + + )} else { + gene1_plot <- plotEmbedding( ArchRProj = savedArchRProject3, colorBy = "MotifMatrix", - name = getFeatures(savedArchRProject3, - select = paste(isolate(input$gene_forComparison_1), collapse="|"), + name = getFeatures(savedArchRProject3, + select = paste(isolate(input$gene_forComparison_1), collapse = "|"), useMatrix = "MotifMatrix"), embedding = "UMAP", imputeWeights = getImputeWeights(savedArchRProject3))[[2]] #get z-score and deviation plot - - gene2_plot=plotEmbedding( + + gene2_plot <- plotEmbedding( ArchRProj = savedArchRProject3, colorBy = "MotifMatrix", - name = getFeatures(savedArchRProject3, - select = paste(isolate(input$gene_forComparison_2), collapse="|"), + name = getFeatures(savedArchRProject3, + select = paste(isolate(input$gene_forComparison_2), collapse = "|"), useMatrix = "MotifMatrix"), embedding = "UMAP", imputeWeights = getImputeWeights(savedArchRProject3))[[2]] #get z-score and deviation plot - + #get seq logo - motif1=unlist(strsplit(getFeatures(savedArchRProject3, - select = paste(isolate(input$gene_forComparison_1), collapse="|"), - useMatrix = "MotifMatrix")[1],":"))[2] - motif1_seqlogo=ggseqlogo(motif_ProbMatrices[[motif1]],method = 'prob')+ggtitle(motif1) - - motif2=unlist(strsplit(getFeatures(savedArchRProject3, - select = paste(isolate(input$gene_forComparison_2), collapse="|"), - useMatrix = "MotifMatrix")[1],":"))[2] - motif2_seqlogo=ggseqlogo(motif_ProbMatrices[[motif2]],method = 'prob')+ggtitle(motif2) - - - gene1_plot=grid.arrange(gene1_plot,motif1_seqlogo, ncol=1,nrow=2) - gene2_plot=grid.arrange(gene2_plot,motif2_seqlogo, ncol=1,nrow=2) + motif1 <- unlist(strsplit(getFeatures(savedArchRProject3, + select = paste(isolate(input$gene_forComparison_1), collapse = "|"), + useMatrix = "MotifMatrix")[1], ":"))[2] + motif1_seqlogo <- ggseqlogo(motif_ProbMatrices[[motif1]], method = "prob")+ggtitle(motif1) + + motif2 <- unlist(strsplit(getFeatures(savedArchRProject3, + select = paste(isolate(input$gene_forComparison_2), collapse = "|"), + useMatrix = "MotifMatrix")[1], ":"))[2] + motif2_seqlogo <- ggseqlogo(motif_ProbMatrices[[motif2]], method = "prob")+ggtitle(motif2) + + + gene1_plot <- grid.arrange(gene1_plot, motif1_seqlogo, ncol = 1, nrow = 2) + gene2_plot <- grid.arrange(gene2_plot, motif2_seqlogo, ncol = 1, nrow = 2) } - - grid.arrange(gene1_plot,gene2_plot, ncol=2) # <- Orignal - - + + grid.arrange(gene1_plot, gene2_plot, ncol = 2) # <- Orignal + + dev.off() } ) - + # Output Handler : download motif position - output$download_motifPos<-downloadHandler( - filename <- function(){ - paste0("MotifPosition-",input$motif_for_motifPos,".csv") + output$download_motifPos <- downloadHandler( + filename <- function() { + paste0("MotifPosition-", input$motif_for_motifPos, ".csv") }, - content = function(file){ - motif_name_Temp=unlist(strsplit(getFeatures(savedArchRProject3, - select = paste(isolate(input$motif_for_motifPos), collapse="|"), - useMatrix = "MotifMatrix")[1],":"))[2] - - temp=as.data.frame(motifSummary[motif_name_Temp]) + content = function(file) { + motif_name_Temp = unlist(strsplit(getFeatures(savedArchRProject3, + select = paste(isolate(input$motif_for_motifPos), collapse = "|"), + useMatrix = "MotifMatrix")[1], ":"))[2] + + temp = as.data.frame(motifSummary[motif_name_Temp]) write.csv(temp, file) - + } ) - + #get height and width based on motif matrix - getHeight_featComparison<-function() - { - if(isolate(input$matrix_forComparison)=="MotifMatrix") - {return(800)} - else{"auto"} + getHeight_featComparison <- function() { + if (isolate(input$matrix_forComparison) == "MotifMatrix") { + return(800) + } else { + "auto" + } } - - + + output$feature_comparison <- DT::renderDT(NULL) restartFN <- observeEvent(input$gene_to_gene_restartButton, { - if (isolate(input$gene_forComparison_1) == "" || - isolate(input$gene_forComparison_2) == ""){ - + if (isolate(input$gene_forComparison_1) == "" || + isolate(input$gene_forComparison_2) == "") { + output$feature_comparison <- renderPlot({ p <- ggplot() + - xlim(c(-5,5)) + ylim(c(-5,5)) + - geom_text(size=20, aes(x = 0, y = 0, label = "Please Supply\nA Valid Gene!")) + theme_void() + xlim(c(-5, 5)) + ylim(c(-5, 5)) + + geom_text(size = 20, aes(x = 0, y = 0, label = "Please Supply\nA Valid Gene!")) + theme_void() print(p) }) - }else{ + } else { # Plot feature comparison - - output$feature_comparison<- renderPlot({ + + output$feature_comparison <- renderPlot({ grid::grid.newpage() - - if(isolate(input$matrix_forComparison)=="GeneScoreMatrix") - - { - - gene1_plot=plotEmbedding( + + if (isolate(input$matrix_forComparison) == "GeneScoreMatrix") { + + gene1_plot <- plotEmbedding( ArchRProj = savedArchRProject3, colorBy = "GeneScoreMatrix", #continuousSet = "SolarExtra", name = isolate(input$gene_forComparison_1), embedding = "UMAP", imputeWeights = getImputeWeights(savedArchRProject3), - + ) - - gene2_plot=plotEmbedding( + + gene2_plot <- plotEmbedding( ArchRProj = savedArchRProject3, colorBy = "GeneScoreMatrix", #continuousSet = "SolarExtra", name = isolate(input$gene_forComparison_2), embedding = "UMAP", imputeWeights = getImputeWeights(savedArchRProject3), - - )} - - else if(isolate(input$matrix_forComparison)=="GeneIntegrationMatrix") - { - gene1_plot=plotEmbedding( + + )} else if (isolate(input$matrix_forComparison) == "GeneIntegrationMatrix") { + + gene1_plot <- plotEmbedding( ArchRProj = savedArchRProject3, colorBy = "GeneIntegrationMatrix", name = isolate(input$gene_forComparison_1), embedding = "UMAP", imputeWeights = getImputeWeights(savedArchRProject3), - + ) - - gene2_plot=plotEmbedding( + + gene2_plot <- plotEmbedding( ArchRProj = savedArchRProject3, colorBy = "GeneIntegrationMatrix", name = isolate(input$gene_forComparison_2), embedding = "UMAP", imputeWeights = getImputeWeights(savedArchRProject3), - - )} - - else - { - gene1_plot=plotEmbedding( + + )} else { + gene1_plot <- plotEmbedding( ArchRProj = savedArchRProject3, colorBy = "MotifMatrix", - name = getFeatures(savedArchRProject3, - select = paste(isolate(input$gene_forComparison_1), collapse="|"), + name = getFeatures(savedArchRProject3, + select = paste(isolate(input$gene_forComparison_1), collapse = "|"), useMatrix = "MotifMatrix"), embedding = "UMAP", imputeWeights = getImputeWeights(savedArchRProject3))[[2]] #get z-score and deviation plot - - gene2_plot=plotEmbedding( + + gene2_plot <- plotEmbedding( ArchRProj = savedArchRProject3, colorBy = "MotifMatrix", - name = getFeatures(savedArchRProject3, - select = paste(isolate(input$gene_forComparison_2), collapse="|"), + name = getFeatures(savedArchRProject3, + select = paste(isolate(input$gene_forComparison_2), collapse = "|"), useMatrix = "MotifMatrix"), embedding = "UMAP", imputeWeights = getImputeWeights(savedArchRProject3))[[2]] #get z-score and deviation plot - + #get seq logo - motif1=unlist(strsplit(getFeatures(savedArchRProject3, - select = paste(isolate(input$gene_forComparison_1), collapse="|"), - useMatrix = "MotifMatrix")[1],":"))[2] - motif1_seqlogo=ggseqlogo(motif_ProbMatrices[[motif1]],method = 'prob')+ggtitle(motif1) - - motif2=unlist(strsplit(getFeatures(savedArchRProject3, - select = paste(isolate(input$gene_forComparison_2), collapse="|"), - useMatrix = "MotifMatrix")[1],":"))[2] - motif2_seqlogo=ggseqlogo(motif_ProbMatrices[[motif2]],method = 'prob')+ggtitle(motif2) - - - gene1_plot=grid.arrange(gene1_plot,motif1_seqlogo, ncol=1,nrow=2) - gene2_plot=grid.arrange(gene2_plot,motif2_seqlogo, ncol=1,nrow=2) - - - + motif1 <- unlist(strsplit(getFeatures(savedArchRProject3, + select = paste(isolate(input$gene_forComparison_1), collapse = "|"), + useMatrix = "MotifMatrix")[1], ":"))[2] + motif1_seqlogo = ggseqlogo(motif_ProbMatrices[[motif1]], method = "prob")+ggtitle(motif1) + + motif2 <- unlist(strsplit(getFeatures(savedArchRProject3, + select = paste(isolate(input$gene_forComparison_2), collapse = "|"), + useMatrix = "MotifMatrix")[1], ":"))[2] + motif2_seqlogo <- ggseqlogo(motif_ProbMatrices[[motif2]], method = "prob")+ggtitle(motif2) + + + gene1_plot <- grid.arrange(gene1_plot, motif1_seqlogo, ncol = 1, nrow = 2) + gene2_plot <- grid.arrange(gene2_plot, motif2_seqlogo, ncol = 1, nrow = 2) + + + } - - grid.arrange(gene1_plot,gene2_plot, ncol=2) - - },height=getHeight_featComparison()) - + + grid.arrange(gene1_plot, gene2_plot, ncol = 2) + + }, height = getHeight_featComparison()) + } }) @@ -558,58 +540,59 @@ shinyServer <- function(input,output, session){ ##It is due to the fact that Group coverage step of ArchR uses absolute paths instead of relative paths:please see https://github.com/GreenleafLab/ArchR/issues/529 for more details. Please also uncomment motif_Footprinting_panel in section Ui fluid page of file ui.R # Output Handler output$motif_down_1 <- downloadHandler( - filename <- function(){ - paste0("motif-footPrint",input$motifName_input,input$plot_choice_download_motif_down_1) + filename <- function() { + paste0("motif-footPrint", input$motifName_input, input$plot_choice_download_motif_down_1) }, - content = function(file){ + content = function(file) { seFoot <- getFootprints( ArchRProj = savedArchRProject3, positions = motifPositions[input$motifName_input], groupBy = "Clusters2" ) - - if(input$plot_choice_download_motif_down_1==".pdf") - {pdf(file = file,onefile=FALSE, width = input$motif_plot_width_1, height = input$motif_plot_height_1)} - - else if(input$plot_choice_download_motif_down_1==".png") - {png(file = file, width = input$motif_plot_width_1, height = input$motif_plot_height_1,units="in",res=1000)} - - else - {tiff(file = file, width = input$motif_plot_width_1, height = input$motif_plot_height_1,units="in",res=1000)} - + + if (input$plot_choice_download_motif_down_1 == ".pdf") { + pdf(file = file, onefile = FALSE, width = input$motif_plot_width_1, height = input$motif_plot_height_1) + + } else if (input$plot_choice_download_motif_down_1 == ".png") { + png(file = file, width = input$motif_plot_width_1, height = input$motif_plot_height_1, units = "in", res = 1000) + + } else { + tiff(file = file, width = input$motif_plot_width_1, height = input$motif_plot_height_1, units = "in", res = 1000) + } + motif_FP <- plotFootprints( seFoot = seFoot, ArchRProj = savedArchRProject3, normMethod = input$normMethod_Input, plotName = "Footprints-No-Normalization", addDOC = TRUE, - plot=FALSE, + plot = FALSE, smoothWindow = 5, baseSize = 8 ) # grid.draw(motif_FP[[names(motif_FP)]]) # <- Orignal grid.arrange(motif_FP[[names(motif_FP)]]) # <- Modified - dev.off() # <-Modified + dev.off() # <- Modified } ) output$motifPlot <- DT::renderDT(NULL) - restartFN_motifPlot <- observeEvent(input$plotFootprints_button,{ - if (isolate(input$motifName_input) == ""){ + restartFN_motifPlot <- observeEvent(input$plotFootprints_button, { + if (isolate(input$motifName_input) == "") { output$motifPlot <- renderPlot({ p <- ggplot() + - xlim(c(-5,5)) + ylim(c(-5,5)) + - geom_text(size=20, aes(x = 0, y = 0, label = "Please Supply\nA Valid Gene!")) + theme_void() + xlim(c(-5, 5)) + ylim(c(-5, 5)) + + geom_text(size = 20, aes(x = 0, y = 0, label = "Please Supply\nA Valid Gene!")) + theme_void() print(p) }) - }else{ + } else { # Plot motif foot printing - output$motifPlot<- renderPlot({ + output$motifPlot <- renderPlot({ seFoot <- getFootprints( ArchRProj = savedArchRProject3, @@ -624,7 +607,7 @@ shinyServer <- function(input,output, session){ normMethod = input$normMethod_Input, plotName = "Footprints-No-Normalization", addDOC = TRUE, - plot=FALSE, + plot = FALSE, smoothWindow = 5, baseSize = 8 ) @@ -637,143 +620,146 @@ shinyServer <- function(input,output, session){ ########################################################### # HEATMAP trajectories ## -########################################################### +########################################################### output$down_heatmap_traj1 <- downloadHandler( - filename <- function(){ - paste("HEATMAP-trajectories-",input$matrix_forTraj1,input$plot_choice_down_heatmap_traj1,sep="") + filename <- function() { + paste("HEATMAP-trajectories-", input$matrix_forTraj1, input$plot_choice_down_heatmap_traj1, sep = "") }, - content <- function(file){ - - - if(input$plot_choice_down_heatmap_traj1==".pdf") - {pdf(file = file,onefile=FALSE, width = input$matrix_forTraj_width, height = input$matrix_forTraj_height)} - - else if(input$plot_choice_down_heatmap_traj1==".png") - {png(file = file, width = input$matrix_forTraj_width, height = input$matrix_forTraj_height,units="in",res=1000)} - - else - {tiff(file = file, width = input$matrix_forTraj_width, height = input$matrix_forTraj_height,units="in",res=1000)} - - #print(p_peakMatrix_traj@ht_list$PeakMatrix+p_peakMatrix_traj@ht_list$heatmap_annotation_18+p_peakMatrix_traj@layout) - - if (input$matrix_forTraj1 == "GeneScoreMatrix") - {print(p_GeneScore_traj@ht_list[[1]]+p_GeneScore_traj@ht_list[[2]]+p_GeneScore_traj@layout)} - - else if (input$matrix_forTraj1 == "GeneIntegrationMatrix") - {print(p_GIM_traj@ht_list[[1]]+p_GIM_traj@ht_list[[2]]+p_GIM_traj@layout)} - - else if (input$matrix_forTraj1 == "MotifMatrix") - {print(p_motifMatrix_traj@ht_list[[1]]+p_motifMatrix_traj@ht_list[[2]]+p_motifMatrix_traj@layout)} - - else - {print(p_peakMatrix_traj@ht_list[[1]]+p_peakMatrix_traj@ht_list[[2]]+p_peakMatrix_traj@layout)} - + content <- function(file) { + + + if (input$plot_choice_down_heatmap_traj1 == ".pdf") { + pdf(file = file, onefile = FALSE, width = input$matrix_forTraj_width, height = input$matrix_forTraj_height) + + } else if (input$plot_choice_down_heatmap_traj1 == ".png") { + png(file = file, width = input$matrix_forTraj_width, height = input$matrix_forTraj_height, units = "in", res = 1000) + + } else { + tiff(file = file, width = input$matrix_forTraj_width, height = input$matrix_forTraj_height, units = "in", res = 1000) + } + + + if (input$matrix_forTraj1 == "GeneScoreMatrix") { + print(p_GeneScore_traj@ht_list[[1]] + p_GeneScore_traj@ht_list[[2]] + p_GeneScore_traj@layout) + + } else if (input$matrix_forTraj1 == "GeneIntegrationMatrix") { + print(p_GIM_traj@ht_list[[1]] + p_GIM_traj@ht_list[[2]] + p_GIM_traj@layout) + + } else if (input$matrix_forTraj1 == "MotifMatrix") { + print(p_motifMatrix_traj@ht_list[[1]] + p_motifMatrix_traj@ht_list[[2]] + p_motifMatrix_traj@layout) + + } else { + print(p_peakMatrix_traj@ht_list[[1]] + p_peakMatrix_traj@ht_list[[2]] + p_peakMatrix_traj@layout) + } + dev.off() - + }) - + output$down_heatmap_traj2 <- downloadHandler( - filename <- function(){ - paste("HEATMAP-trajectories-",input$matrix_forTraj2,input$plot_choice_down_heatmap_traj2,sep="") + filename <- function() { + paste("HEATMAP-trajectories-", input$matrix_forTraj2, input$plot_choice_down_heatmap_traj2, sep = "") }, - content <- function(file){ - - - if(input$plot_choice_down_heatmap_traj2==".pdf") - {pdf(file = file,onefile=FALSE, width = input$matrix_forTraj_width2, height = input$matrix_forTraj_height2)} - - else if(input$plot_choice_down_heatmap_traj2==".png") - {png(file = file, width = input$matrix_forTraj_width2, height = input$matrix_forTraj_height2,units="in",res=1000)} - - else - {tiff(file = file, width = input$matrix_forTraj_width2, height = input$matrix_forTraj_height2,units="in",res=1000)} - - #print(p_peakMatrix_traj@ht_list$PeakMatrix+p_peakMatrix_traj@ht_list$heatmap_annotation_18+p_peakMatrix_traj@layout) - - if (input$matrix_forTraj2 == "GeneScoreMatrix") - {print(p_GeneScore_traj@ht_list[[1]]+p_GeneScore_traj@ht_list[[2]]+p_GeneScore_traj@layout)} - - else if (input$matrix_forTraj2 == "GeneIntegrationMatrix") - {print(p_GIM_traj@ht_list[[1]]+p_GIM_traj@ht_list[[2]]+p_GIM_traj@layout)} - - else if (input$matrix_forTraj2 == "MotifMatrix") - {print(p_motifMatrix_traj@ht_list[[1]]+p_motifMatrix_traj@ht_list[[2]]+p_motifMatrix_traj@layout)} - - else - {print(p_peakMatrix_traj@ht_list[[1]]+p_peakMatrix_traj@ht_list[[2]]+p_peakMatrix_traj@layout)} - + content <- function(file) { + + + if (input$plot_choice_down_heatmap_traj2 == ".pdf") { + pdf(file = file, onefile = FALSE, width = input$matrix_forTraj_width2, height = input$matrix_forTraj_height2) + + } else if (input$plot_choice_down_heatmap_traj2 == ".png") { + png(file = file, width = input$matrix_forTraj_width2, height = input$matrix_forTraj_height2, units = "in", res = 1000) + + } else { + tiff(file = file, width = input$matrix_forTraj_width2, height = input$matrix_forTraj_height2, units = "in", res = 1000) + } + + if (input$matrix_forTraj2 == "GeneScoreMatrix") { + print(p_GeneScore_traj@ht_list[[1]] + p_GeneScore_traj@ht_list[[2]] + p_GeneScore_traj@layout) + + } else if (input$matrix_forTraj2 == "GeneIntegrationMatrix") { + print(p_GIM_traj@ht_list[[1]] + p_GIM_traj@ht_list[[2]] + p_GIM_traj@layout) + + } else if (input$matrix_forTraj2 == "MotifMatrix") { + print(p_motifMatrix_traj@ht_list[[1]] + p_motifMatrix_traj@ht_list[[2]] + p_motifMatrix_traj@layout) + + } else { + print(p_peakMatrix_traj@ht_list[[1]] + p_peakMatrix_traj@ht_list[[2]] + p_peakMatrix_traj@layout) + } + dev.off() - + }) - - + + output$traj_heatmap1 <- DT::renderDT(NULL) output$traj_heatmap2 <- DT::renderDT(NULL) restartFN <- observeEvent(input$plotheat_traj_button, { - + output$traj_heatmap1 <- renderPlot({ - - if (input$matrix_forTraj1 == "GeneScoreMatrix") + + if (input$matrix_forTraj1 == "GeneScoreMatrix") {p_GeneScore_traj} - - else if (input$matrix_forTraj1 == "GeneIntegrationMatrix") + + else if (input$matrix_forTraj1 == "GeneIntegrationMatrix") {p_GIM_traj} - - else if (input$matrix_forTraj1 == "MotifMatrix") + + else if (input$matrix_forTraj1 == "MotifMatrix") {p_motifMatrix_traj} - + else {p_peakMatrix_traj} - - },height = 600,width = 500) - + + }, height = 600, width = 500) + output$traj_heatmap2 <- renderPlot({ - - if (input$matrix_forTraj2 == "GeneScoreMatrix") + + if (input$matrix_forTraj2 == "GeneScoreMatrix") {p_GeneScore_traj} - - else if (input$matrix_forTraj2 == "GeneIntegrationMatrix") + + else if (input$matrix_forTraj2 == "GeneIntegrationMatrix") {p_GIM_traj} - - else if (input$matrix_forTraj2 == "MotifMatrix") + + else if (input$matrix_forTraj2 == "MotifMatrix") {p_motifMatrix_traj} - + else {p_peakMatrix_traj} - },height = 600,width=500) + }, height = 600, width = 500) }) ########################################################### # HEATMAP _INTEGRATED_peakto gene link plot ## - ########################################################### - + ########################################################### + # Plot of Heatmap of Peak To Gene Links in section 15.3.2 - + output$heatmap_p2g <- downloadHandler( - filename <- function(){ - paste0("HEATMAP-peak2genelinks",input$plot_choice_down_heatmap_p2g) + filename <- function() { + paste0("HEATMAP-peak2genelinks", input$plot_choice_down_heatmap_p2g) }, - content=function(file) { - - if(input$plot_choice_down_heatmap_p2g==".pdf") - {pdf(file = file,onefile=FALSE, width = input$p2g_plot_width_1, height = input$p2g_plot_height_1)} - - else if(input$plot_choice_down_heatmap_p2g==".png") - {png(file = file, width = input$p2g_plot_width_1, height = input$p2g_plot_height_1,units="in",res=1000)} - - else - {tiff(file = file, width = input$p2g_plot_width_1, height = input$p2g_plot_height_1,units="in",res=1000)} - - print(p_heatmap_peak_to_gene@ht_list[[1]]+p_heatmap_peak_to_gene@ht_list[[2]]+p_heatmap_peak_to_gene@layout) + content = function(file) { + + if (input$plot_choice_down_heatmap_p2g == ".pdf") { + pdf(file = file, onefile = FALSE, width = input$p2g_plot_width_1, height = input$p2g_plot_height_1) + + } else if (input$plot_choice_down_heatmap_p2g == ".png") { + png(file = file, width = input$p2g_plot_width_1, height = input$p2g_plot_height_1, units = "in", res = 1000) + + } else { + tiff(file = file, width = input$p2g_plot_width_1, height = input$p2g_plot_height_1, units = "in", res = 1000) + } + + print(p_heatmap_peak_to_gene@ht_list[[1]] + p_heatmap_peak_to_gene@ht_list[[2]] + p_heatmap_peak_to_gene@layout) dev.off() } ) output$heatmap_peak_to_gene <- DT::renderDT(NULL) restartFN <- observeEvent(input$heatmap_peak2gl, { - output$heatmap_peak_to_gene <- renderPlot({p_heatmap_peak_to_gene},height = 800,width=1000) + output$heatmap_peak_to_gene <- renderPlot({ + p_heatmap_peak_to_gene}, height = 800, width = 1000) }) } ########################################################### # END OF FILE ## -########################################################### +########################################################### diff --git a/ui.R b/ui.R index 9d265f0..b386e31 100644 --- a/ui.R +++ b/ui.R @@ -5,75 +5,75 @@ ########################################################### # Umap plotting ## ########################################################### -umap_panel <- tabPanel(id="umap_panel", - +umap_panel <- tabPanel(id = "umap_panel", + titlePanel(h5("scClusters")), sidebarPanel( titlePanel(h5('UMAP Name', align = 'center')), width = 3, h4(''), hr(style = "border-color: grey"), - + selectizeInput( 'UMAP1_forComparison', label = 'UMAP 1', - choices = c("Sample","Clusters","Unconstrained","Constrained","Constrained remap"), + choices = c("Sample", "Clusters", "Unconstrained", "Constrained", "Constrained remap"), selected = "Clusters" ), - + selectizeInput( 'UMAP2_forComparison', label = 'UMAP 2', - choices = c("Clusters","Sample","Unconstrained","Constrained","Constrained remap"), + choices = c("Clusters", "Sample", "Unconstrained", "Constrained", "Constrained remap"), selected = "Sample" ), - + hr(style = "border-color: grey"), - - splitLayout(cellWidths = c("30%","30%","40%"), + + splitLayout(cellWidths = c("30%", "30%", "40%"), numericInput("UMAP1_plot_width", "Width", min = 0, max = 250, value = 8), numericInput("UMAP1_plot_height", "Height", min = 0, max = 250, value = 12), selectizeInput( 'plot_choice_download_UMAP1', label = "Format", - choices = c(".pdf",".png",".tiff"), - selected = ".pdf"), + choices = c(".pdf", ".png", ".tiff"), + selected = ".pdf"), tags$head(tags$style(HTML(" .shiny-split-layout > div { overflow: visible;}"))) ), - + downloadButton(outputId = "download_UMAP1", label = "Download UMAP 1"), - + hr(style = "border-color: grey"), - - splitLayout(cellWidths = c("30%","30%","40%"), + + splitLayout(cellWidths = c("30%", "30%", "40%"), numericInput("UMAP2_plot_width", "Width", min = 0, max = 250, value = 8), numericInput("UMAP2_plot_height", "Height", min = 0, max = 250, value = 12), selectizeInput( 'plot_choice_download_UMAP2', label = "Format", - choices = c(".pdf",".png",".tiff"), - selected = ".pdf"), + choices = c(".pdf", ".png", ".tiff"), + selected = ".pdf"), tags$head(tags$style(HTML(" .shiny-split-layout > div { overflow: visible;}"))) ), downloadButton(outputId = "download_UMAP2", label = "Download UMAP 2"), - + ), mainPanel( - - + + fluidRow(h5("Dimension Reduction scClusters UMAPs" )), fluidRow(helpText("Users can view and compare side-by-side UMAPs' representing identified scATAC-seq clusters, origin of sample, unconstrained and constrained integration with scRNA-seq datasets, and integrated remapped clusters.", style = "font-family: 'Helvetica Now Display Bold'; font-si20pt"), ), fluidRow( - column(6,plotOutput("UMAP_plot_1")), ##%>% withSpinner(color="#0dc5c1") - column(6,plotOutput("UMAP_plot_2")) + column(6, plotOutput("UMAP_plot_1")), ##%>% withSpinner(color="#0dc5c1") + column(6, plotOutput("UMAP_plot_2")) ) ) ) @@ -82,16 +82,16 @@ mainPanel( ########################################################### scATACbrowser_panel <- tabPanel( - + titlePanel(h5("scATAC-seq peak browser")), - + sidebarPanel( titlePanel(h5('Gene Name', align = 'center')), width = 3, h4(''), hr(style = "border-color: grey"), actionButton(inputId = "restartButton", label = "Plot Track", icon = icon("play-circle")), - + selectizeInput( 'gene_name', label = 'Gene Name', @@ -101,37 +101,37 @@ scATACbrowser_panel <- tabPanel( selectizeInput( 'group_by', label = 'Group By', - choices = c('Clusters','Sample'), + choices = c('Clusters', 'Sample'), selected = 'Clusters' ), - sliderInput("range", "Distance From Center (kb):", min = -250, max = 250, value = c(-50,50)), - splitLayout(cellWidths = c("50%","50%"), + sliderInput("range", "Distance From Center (kb):", min = -250, max = 250, value = c(-50, 50)), + splitLayout(cellWidths = c("50%", "50%"), numericInput("range_min", "Distance (-kb):", min = -250, max = 250, value = -50), numericInput("range_max", "Distance (+kb):", min = -250, max = 250, value = 50) ), - splitLayout(cellWidths = c("50%","50%"), + splitLayout(cellWidths = c("50%", "50%"), numericInput("tile_size", "TileSize:", min = 10, max = 5000, value = 250), - numericInput("ymax", "Y-Max (0,1):", min = 0, max = 1, value = 0.99) + numericInput("ymax", "Y-Max (0, 1):", min = 0, max = 1, value = 0.99) ), - + hr(style = "border-color: grey"), - splitLayout(cellWidths = c("30%","30%","40%"), + splitLayout(cellWidths = c("30%", "30%", "40%"), numericInput("plot_width", "Width", min = 0, max = 250, value = 8), numericInput("plot_height", "Height", min = 0, max = 250, value = 12), selectizeInput( 'plot_choice_download_peakBrowser', label = "Format", - choices = c(".pdf",".png",".tiff"), - selected = ".pdf"), + choices = c(".pdf", ".png", ".tiff"), + selected = ".pdf"), tags$head(tags$style(HTML(" .shiny-split-layout > div { overflow: visible;}"))) ), downloadButton(outputId = "down", label = "Download"), - + ), - + mainPanel(fluidRow(h5("Peak browser of scATAC-seq clusters" )), fluidRow(helpText("Users can view and compare the single-cell chromatin accessibility data in scalable peak browser view along with co-accessibility of peaks on scATAC-seq modality.", style = "font-family: 'Helvetica Now Display Bold'; font-si20pt"), @@ -146,7 +146,7 @@ scATACbrowser_panel <- tabPanel( peak2gl_panel <- tabPanel( - + titlePanel(h5("Peak2GeneLinks")), sidebarPanel( titlePanel(h5('Gene Name', align = 'center')), @@ -154,7 +154,7 @@ peak2gl_panel <- tabPanel( h4(''), hr(style = "border-color: grey"), actionButton(inputId = "restartButton_1", label = "Plot Track", icon = icon("play-circle")), - + selectizeInput( 'gene_name_1', label = 'Gene Name', @@ -162,41 +162,41 @@ peak2gl_panel <- tabPanel( selected = sort(gene_names)[1] ), - sliderInput("range_1", "Distance From Center (kb):", min = -250, max = 250, value = c(-50,50)), - splitLayout(cellWidths = c("50%","50%"), + sliderInput("range_1", "Distance From Center (kb):", min = -250, max = 250, value = c(-50, 50)), + splitLayout(cellWidths = c("50%", "50%"), numericInput("range_min_1", "Distance (-kb):", min = -250, max = 250, value = -50), numericInput("range_max_1", "Distance (+kb):", min = -250, max = 250, value = 50) ), - splitLayout(cellWidths = c("50%","50%"), + splitLayout(cellWidths = c("50%", "50%"), numericInput("tile_size_1", "TileSize:", min = 10, max = 5000, value = 250), - numericInput("ymax_1", "Y-Max (0,1):", min = 0, max = 1, value = 0.99) + numericInput("ymax_1", "Y-Max (0, 1):", min = 0, max = 1, value = 0.99) ), - + hr(style = "border-color: grey"), - splitLayout(cellWidths = c("30%","30%","40%"), + splitLayout(cellWidths = c("30%", "30%", "40%"), numericInput("plot_width_1", "Width", min = 0, max = 250, value = 8), numericInput("plot_height_1", "Height", min = 0, max = 250, value = 12), selectizeInput( 'plot_choice_download_peak2GeneLink', label = "Format", - choices = c(".pdf",".png",".tiff"), - selected = ".pdf"), + choices = c(".pdf", ".png", ".tiff"), + selected = ".pdf"), tags$head(tags$style(HTML(" .shiny-split-layout > div { overflow: visible;}"))) ), - + downloadButton(outputId = "down_1", label = "Download"), - + ), - + mainPanel (fluidRow(h5("Browser view of Peak2GeneLinks" )), fluidRow(helpText("User can visualize genome accessibility tracks of marker genes with peak co-accessibility", style = "font-family: 'Helvetica Now Display Bold'; font-si20pt"), ), - plotOutput("co_access_peaks") + plotOutput("co_access_peaks") ) ) @@ -204,7 +204,7 @@ peak2gl_panel <- tabPanel( # Feature comparison:UMAP plot ## ########################################################### feature_comparison_panel <- tabPanel( - + titlePanel(h5("Feature of interest UMAPs")), sidebarPanel( titlePanel(h5('Feature Name', align = 'center')), @@ -212,14 +212,14 @@ feature_comparison_panel <- tabPanel( h4(''), hr(style = "border-color: grey"), actionButton(inputId = "gene_to_gene_restartButton", label = "Plot", icon = icon("play-circle")), - + selectizeInput( 'matrix_forComparison', label = 'Matrix Type', - choices = c("GeneScoreMatrix","GeneIntegrationMatrix","MotifMatrix"), + choices = c("GeneScoreMatrix", "GeneIntegrationMatrix", "MotifMatrix"), selected = "GeneScoreMatrix" ), - + selectizeInput( 'gene_forComparison_1', label = 'Feature Name 1', @@ -232,22 +232,22 @@ feature_comparison_panel <- tabPanel( choices = "", selected = NULL ), - + hr(style = "border-color: grey"), - splitLayout(cellWidths = c("30%","30%","40%"), + splitLayout(cellWidths = c("30%", "30%", "40%"), numericInput("gene_Comparison_plot_width", "Width", min = 0, max = 250, value = 8), numericInput("gene_Comparison_plot_height", "Height", min = 0, max = 250, value = 12), selectizeInput( 'plot_choice_download_feature_comparison', label = "Format", - choices = c(".pdf",".png",".tiff"), - selected = ".pdf"), + choices = c(".pdf", ".png", ".tiff"), + selected = ".pdf"), tags$head(tags$style(HTML(" .shiny-split-layout > div { overflow: visible;}"))) ), downloadButton(outputId = "download_feature_comparison", label = "Download"), - + hr(style = "border-color: grey"), selectizeInput( 'motif_for_motifPos', @@ -256,16 +256,16 @@ feature_comparison_panel <- tabPanel( selected = sort(motifMatrix_dropdown)[1] ), downloadButton(outputId = "download_motifPos", label = "Download"), - + ), - + mainPanel ( fluidRow(h5("Feature of interest : Dimensionality Reduction UMAPs" )), fluidRow(helpText("Users can view and compare side-by-side UMAPs representing features of interest in GeneScoreMatrix, GeneIntegrationMatrix or MotifMatrix with a representative sequence logo. Download list of Motif Positions. ", style = "font-family: 'Helvetica Now Display Bold'; font-si20pt"), ), - + plotOutput("feature_comparison")) ) @@ -293,18 +293,18 @@ motif_Footprinting_panel<- tabPanel( selectizeInput( 'normMethod_Input', label = 'Normalization Method', - choices = c('None','Divide',"Subtract"), + choices = c('None', 'Divide', "Subtract"), selected = 'Subtract' ), - splitLayout(cellWidths = c("30%","30%","40"), + splitLayout(cellWidths = c("30%", "30%", "40"), numericInput("motif_plot_width_1", "Width", min = 0, max = 250, value = 8), numericInput("motif_plot_height_1", "Height", min = 0, max = 250, value = 12), selectizeInput( 'plot_choice_download_motif_down_1', label = "Format", - choices = c(".pdf",".png",".tiff"), - selected = ".pdf"), + choices = c(".pdf", ".png", ".tiff"), + selected = ".pdf"), tags$head(tags$style(HTML(" .shiny-split-layout > div { overflow: visible;}"))) @@ -334,56 +334,56 @@ traj_heatmap_panel <- tabPanel( h4(''), hr(style = "border-color: grey"), actionButton(inputId = "plotheat_traj_button", label = "Plot Heatmaps", icon = icon("play-circle")), - + selectizeInput( 'matrix_forTraj1', label = 'Matrix Type', - choices = c("GeneScoreMatrix","GeneIntegrationMatrix","MotifMatrix","PeakMatrix"), + choices = c("GeneScoreMatrix", "GeneIntegrationMatrix", "MotifMatrix", "PeakMatrix"), selected = "GeneScoreMatrix" ), - - splitLayout(cellWidths = c("30%","30%","40%"), + + splitLayout(cellWidths = c("30%", "30%", "40%"), numericInput("matrix_forTraj_width", "Width", min = 0, max = 250, value = 8), numericInput("matrix_forTraj_height", "Height", min = 0, max = 250, value = 12), selectizeInput( 'plot_choice_down_heatmap_traj1', label = "Format", - choices = c(".pdf",".png",".tiff"), - selected = ".pdf"), + choices = c(".pdf", ".png", ".tiff"), + selected = ".pdf"), tags$head(tags$style(HTML(" .shiny-split-layout > div { overflow: visible;}"))) ), - + downloadButton(outputId = "down_heatmap_traj1", label = "Download"), - + hr(style = "border-color: grey"), - + selectizeInput( 'matrix_forTraj2', label = 'Matrix Type', - choices = c("GeneScoreMatrix","GeneIntegrationMatrix","MotifMatrix","PeakMatrix"), + choices = c("GeneScoreMatrix", "GeneIntegrationMatrix", "MotifMatrix", "PeakMatrix"), selected = "GeneIntegrationMatrix" ), - - splitLayout(cellWidths = c("30%","30%","40%"), + + splitLayout(cellWidths = c("30%", "30%", "40%"), numericInput("matrix_forTraj_width2", "Width", min = 0, max = 250, value = 8), numericInput("matrix_forTraj_height2", "Height", min = 0, max = 250, value = 12), selectizeInput( 'plot_choice_down_heatmap_traj2', label = "Format", - choices = c(".pdf",".png",".tiff"), - selected = ".pdf"), + choices = c(".pdf", ".png", ".tiff"), + selected = ".pdf"), tags$head(tags$style(HTML(" .shiny-split-layout > div { overflow: visible;}"))) ), downloadButton(outputId = "down_heatmap_traj2", label = "Download"), - + #downloadButton(outputId = "download_UMAP11", label = "Download UMAP 1"), - + ), - + mainPanel( fluidRow(h5("ArchR defined trajectory heatmaps" )), @@ -392,10 +392,10 @@ traj_heatmap_panel <- tabPanel( fluidRow( column(5, plotOutput("traj_heatmap1")), - column(2,offset=0), + column(2, offset = 0), column(5, plotOutput("traj_heatmap2")), - + ) ) ) @@ -411,38 +411,38 @@ peak2GLheatmap_panel <- tabPanel( h4(''), hr(style = "border-color: grey"), actionButton(inputId = "heatmap_peak2gl", label = "Plot Heatmap", icon = icon("play-circle")), - + hr(style = "border-color: grey"), - splitLayout(cellWidths = c("30%","30%","40%"), - + splitLayout(cellWidths = c("30%", "30%", "40%"), + numericInput("p2g_plot_width_1", "Width", min = 0, max = 250, value = 8), numericInput("p2g_plot_height_1", "Height", min = 0, max = 250, value = 12), selectizeInput( 'plot_choice_down_heatmap_p2g', label = "Format", - choices = c(".pdf",".png",".tiff"), - selected = ".pdf"), + choices = c(".pdf", ".png", ".tiff"), + selected = ".pdf"), tags$head(tags$style(HTML(" .shiny-split-layout > div { overflow: visible;}"))) ), downloadButton(outputId = "heatmap_p2g", label = "Download"), - + ), mainPanel( - + fluidRow(h5("Peak2GeneLinks heatmaps" )), fluidRow(helpText("Users can view Peak2GeneLinks identified across the dataset with ArchR. ", style = "font-family: 'Helvetica Now Display Bold'; font-si20pt"), ), fluidRow( - column(1,offset=2), + column(1, offset = 2), column(10, plotOutput("heatmap_peak_to_gene")), ) ) ) -#Users can view and compare putative cis-regulatory elements based on correlated peak +#Users can view and compare putative cis-regulatory elements based on correlated peak #accessibility and gene expression heatmaps ########################################################### # about ## @@ -459,7 +459,7 @@ about_panel <- tabPanel( tags$h3("Scope"), tags$p(HTML("ShinyArchR.UiO is a user-friendly, integrative open-source Shiny-based web app using R programming for visualization of massive single-cell chromatin accessibility data (scATAC-seq) based on ArchR (Corces et al., 2021).")), tags$h3("Approach"), - + tags$p(HTML(" The ArchR objects saved in folders along with HDF5 formatted Arrow files are used for input in ShinyArchR.UiO.")), tags$h5("Data Visualization of ShinyArchR.UiO:"), tags$ul( @@ -471,7 +471,7 @@ about_panel <- tabPanel( ) ), - + # About us . tabPanel( @@ -488,8 +488,8 @@ ui <- shinyUI(fluidPage( # Use this function somewhere in UI #add_busy_spinner(spin = "cube-grid", color = "#CCCCCC", onstart = TRUE, height = "65px", width = "65px"), add_busy_spinner(spin = "radar", color = "#CCCCCC", onstart = TRUE, height = "55px", width = "55px"), - -navbarPage( + +navbarPage( umap_panel, scATACbrowser_panel, peak2gl_panel, @@ -499,7 +499,7 @@ navbarPage( peak2GLheatmap_panel, about_panel, # Application title. - title ="ShinyArchR.UiO", + title = "ShinyArchR.UiO", tags$head(tags$style(".shiny-output-error{color: grey;}"))###showing error in grey color ), @@ -512,4 +512,3 @@ tags$footer(HTML("

Webpage generated with