From 14e2c00ccbf4d0d6cfed04e0ea4ec0cecd71d962 Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Wed, 19 Oct 2022 21:26:45 -0500 Subject: [PATCH 001/162] integrating ShinyArchR to main codebase --- R/AllClasses.R | 6 +- R/AnnotationGenome.R | 18 +- R/ArchRBrowser.R | 165 +++++++ R/GroupExport.R | 143 ++++++ R/HiddenUtils.R | 2 +- R/RasterUMAPs.R | 247 ++++++++++ R/VisualizeData.R | 326 +++++++++++++ R/exportShinyArchR.R | 284 +++++++++++ R/mainUMAPs.R | 126 +++++ Shiny/app.R | 6 + Shiny/global.R | 79 ++++ Shiny/server.R | 1065 ++++++++++++++++++++++++++++++++++++++++++ Shiny/ui.R | 179 +++++++ 13 files changed, 2642 insertions(+), 4 deletions(-) create mode 100644 R/RasterUMAPs.R create mode 100644 R/exportShinyArchR.R create mode 100644 R/mainUMAPs.R create mode 100644 Shiny/app.R create mode 100644 Shiny/global.R create mode 100644 Shiny/server.R create mode 100644 Shiny/ui.R diff --git a/R/AllClasses.R b/R/AllClasses.R index 27c7eb5b..32519f1c 100644 --- a/R/AllClasses.R +++ b/R/AllClasses.R @@ -402,12 +402,13 @@ loadArchRProject <- function( path = "./", force = FALSE, showLogo = TRUE + Shiny = FALSE ){ .validInput(input = path, name = "path", valid = "character") .validInput(input = force, name = "force", valid = "boolean") .validInput(input = showLogo, name = "showLogo", valid = "boolean") - + .validInput(input = Shiny, name = "Shiny", valid = "boolean") path2Proj <- file.path(path, "Save-ArchR-Project.rds") if(!file.exists(path2Proj)){ @@ -418,6 +419,7 @@ loadArchRProject <- function( outputDir <- getOutputDirectory(ArchRProj) outputDirNew <- normalizePath(path) +if (Shiny == FALSE) { #1. Arrows Paths ArrowFilesNew <- file.path(outputDirNew, "ArrowFiles", basename(ArchRProj@sampleColData$ArrowFiles)) if(!all(file.exists(ArrowFilesNew))){ @@ -500,7 +502,7 @@ loadArchRProject <- function( } } - +} #4. Set Output Directory ArchRProj@projectMetadata$outputDirectory <- outputDirNew diff --git a/R/AnnotationGenome.R b/R/AnnotationGenome.R index 6956ec8f..878a1c20 100644 --- a/R/AnnotationGenome.R +++ b/R/AnnotationGenome.R @@ -376,7 +376,23 @@ createGeneAnnotation <- function( } - +#' Add sequencing lengths to a genomic ranges. +#' +#' This function will group export fragment files for each user-specified +#' group in an ArchRProject and output them under a directory. +#' +#' @param gr A GRanges object. +#' @param genome A BSgenome object. +#' +#' @export +addSeqLengths <- function (gr, genome) { + gr <- ArchR:::.validGRanges(gr) + genome <- validBSgenome(genome) + stopifnot(all(as.character(seqnames(gr)) %in% as.character(seqnames(genome)))) + seqlengths(gr) <- + seqlengths(genome)[as.character(names(seqlengths(gr)))] + return(gr) +} diff --git a/R/ArchRBrowser.R b/R/ArchRBrowser.R index b54180d1..8e2b7880 100644 --- a/R/ArchRBrowser.R +++ b/R/ArchRBrowser.R @@ -648,6 +648,7 @@ ArchRBrowserTrack <- function(...){ #' (i.e. the `BSgenome` object you used) so they may not match other online genome browsers that use different gene annotations. #' #' @param ArchRProj An `ArchRProject` object. +#' @param ShinyArchR Boolean indicating whether to use coverage RLEs or arrow files. Default = FALSE. #' @param region A `GRanges` region that indicates the region to be plotted. If more than one region exists in the `GRanges` object, #' all will be plotted. If no region is supplied, then the `geneSymbol` argument can be used to center the plot window at the #' transcription start site of the supplied gene. @@ -719,6 +720,7 @@ ArchRBrowserTrack <- function(...){ #' @export plotBrowserTrack <- function( ArchRProj = NULL, + ShinyArchR = FALSE, region = NULL, groupBy = "Clusters", useGroups = NULL, @@ -1038,6 +1040,7 @@ plotBrowserTrack <- function( tstart <- Sys.time() } + if(!ShinyArchR){ df <- .groupRegionSumArrows( ArchRProj = ArchRProj, groupBy = groupBy, @@ -1051,6 +1054,20 @@ plotBrowserTrack <- function( verbose = verbose, logFile = logFile ) + } else { + df <- .groupRegionSumCvg( + ArchRProj = ArchRProj, + groupBy = groupBy, + normMethod = normMethod, + useGroups = useGroups, + minCells = minCells, + region = region, + tileSize = tileSize, + threads = threads, + verbose = verbose, + logFile = logFile + ) + } .logThis(split(df, df[,3]), ".bulkTracks df", logFile = logFile) ###################################################### @@ -1329,6 +1346,154 @@ plotBrowserTrack <- function( } +############################################################################## +# Create Average Tracks from Coverage objects +############################################################################## +.groupRegionSumCvg <- function( + ArchRProj = NULL, + useGroups = NULL, + groupBy = NULL, + region = NULL, + tileSize = NULL, + normMethod = NULL, + verbose = FALSE, + minCells = 25, + maxCells = 500, + threads = NULL, + logFile = NULL +){ + + # Group Info + cellGroups <- getCellColData(ArchRProj, groupBy, drop = TRUE) + tabGroups <- table(cellGroups) + + + groupsBySample <- split(cellGroups, getCellColData(ArchRProj, "Sample", drop = TRUE)) + uniqueGroups <- gtools::mixedsort(unique(cellGroups)) + + # Tile Region + regionTiles <- (seq(trunc(start(region) / tileSize), + trunc(end(region) / tileSize) + 1) * tileSize) + 1 + allRegionTilesGR <- GRanges( + seqnames = seqnames(region), + ranges = IRanges(start = regionTiles, width=100) + ) + + cvgObjs = list.files(path = "./coverage", full.names = TRUE) + allCvgGR = c() + for(i in seq_along(cvgObjs)) { + cvgrds <- readRDS(cvgObjs[[i]]) + gr <- GRanges(cvgrds) + allCvgGR = c(allCvgGR, gr) + } + + groupMat <- .safelapply(seq_along(allCvgGR), function(i){ + .logMessage(sprintf("Getting Region From Coverage Objects %s of %s", i, length(allCvgGR)), logFile = logFile) + tryCatch({ + .regionSumCvg( + cvgObj = allCvgGR[[i]], + region = region, + regionTiles = regionTiles, + allRegionTilesGR = allRegionTilesGR, + tileSize = tileSize, + ) + }, error = function(e){ + errorList <- list( + cvgObj = allCvgGR[[i]], + region = region, + regionTiles = regionTiles, + allRegionTilesGR = allRegionTilesGR, + tileSize = tileSize, + ) + }) + }, threads = threads) %>% do.call(cbind, .) + + # Plot DF ------------------------------------------------------------------ + df <- data.frame(which(groupMat > 0, arr.ind=TRUE)) + # df$y stores the non-zero scores. + df$y <- groupMat[cbind(df[,1], df[,2])] + + #Minus 1 Tile Size + dfm1 <- df + dfm1$row <- dfm1$row - 1 + dfm1$y <- 0 + + #Plus 1 Size + dfp1 <- df + dfp1$row <- dfp1$row + 1 + dfp1$y <- 0 + + #Create plot DF + df <- rbind(df, dfm1, dfp1) + df <- df[!duplicated(df[,1:2]),] + df <- df[df$row > 0,] + # df$x are the regionTiles that have a non-zero score. + df$x <- regionTiles[df$row] + #NA from below + df$group <- uniqueGroups[df$col] + + #Add In Ends + dfs <- data.frame( + col = seq_along(uniqueGroups), + row = 1, + y = 0, + x = start(region), + group = uniqueGroups + ) + + dfe <- data.frame( + col = seq_along(uniqueGroups), + row = length(regionTiles), + y = 0, + x = end(region), + group = uniqueGroups + ) + + # Final output + plotDF <- rbind(df,dfs,dfe) + plotDF <- df[order(df$group,df$x),] + plotDF <- df[,c("x", "y", "group")] + + # Normalization + g <- getCellColData(ArchRProj, groupBy, drop = TRUE) + + if(tolower(normMethod) %in% c("readsintss","readsinpromoter", "nfrags")) { + v <- getCellColData(ArchRProj, normMethod, drop = TRUE) + groupNormFactors <- unlist(lapply(split(v, g), sum)) + }else if(tolower(normMethod) == "ncells"){ + groupNormFactors <- table(g) + }else if(tolower(normMethod) == "none"){ + groupNormFactors <- rep(10^4, length(g)) + names(groupNormFactors) <- g + }else{ + stop("Norm Method Not Recognized : ", normMethod) + } + + # Scale with Norm Factors + scaleFactors <- 10^4 / groupNormFactors + matchGroup <- match(paste0(plotDF$group), names(scaleFactors)) + plotDF$y <- plotDF$y * as.vector(scaleFactors[matchGroup]) + + return(plotDF) + +} + +.regionSumCvg <- function( + cvgObj = NULL, + region = NULL, + regionTiles = NULL, + allRegionTilesGR = NULL, + tileSize = NULL, + logFile = NULL +){ + + hits <- findOverlaps(query = allRegionTilesGR, subject = cvgObj) + clusterVector <- cvgObj$score[subjectHits(hits)] + + return(clusterVector) + +} + ####################################################### # Gene Tracks ####################################################### diff --git a/R/GroupExport.R b/R/GroupExport.R index 8b56acb3..b55eb0d2 100644 --- a/R/GroupExport.R +++ b/R/GroupExport.R @@ -564,3 +564,146 @@ getGroupFragments <- function( unlist(outList) } + +#' Export Group Fragment Files from a Project +#' +#' This function will group export fragment files for each user-specified +#' group in an ArchRProject and output them under a directory. +#' +#' @param ArchRProj An `ArchRProject` object. +#' @param groupBy A string that indicates how cells should be grouped. This string corresponds to one of the standard or +#' user-supplied `cellColData` metadata columns (for example, "Clusters"). Cells with the same value annotated in this metadata +#' column will be grouped together and their fragments exported to `outputDirectory`/GroupFragments. +#' @param outDir the directory to output the group fragment files. +#' +#' @examples +#' +#' # Get Test ArchR Project +#' proj <- getTestProject() +#' +#' # Get Group BW +#' frags <- getGroupFragmentsFromProj(proj, groupBy = "Clusters", outDir = "./Shiny/Fragments") +#' +#' @export +.getGroupFragsFromProj <- function(ArchRProj = NULL, + groupBy = NULL, + outDir = file.path("Shiny", "fragments")) { + dir.create(outDir, showWarnings = FALSE) + + # find barcodes of cells in that groupBy. + groups <- getCellColData(ArchRProj, select = groupBy, drop = TRUE) + cells <- ArchRProj$cellNames + cellGroups <- split(cells, groups) + + # outputs unique cell groups/clusters. + clusters <- names(cellGroups) + + + for (cluster in clusters) { + cat("Making fragment file for cluster:", cluster, "\n") + # get GRanges with all fragments for that cluster + cellNames = cellGroups[[cluster]] + fragments <- + getFragmentsFromProject(ArchRProj = ArchRProj, cellNames = cellNames) + fragments <- unlist(fragments, use.names = FALSE) + # filter Fragments + fragments <- + GenomeInfoDb::keepStandardChromosomes(fragments, pruning.mode = "coarse") + saveRDS(fragments, file.path(outDir, paste0(cluster, "_cvg.rds"))) + } +} + +#' Export Cluster Coverage from an ArchRProject +#' +#' This function will group export fragment files for each user-specified +#' group in an ArchRProject and output them under a directory. +#' +#' @param ArchRProj An `ArchRProject` object. +#' @param tileSize The numeric width of the tile/bin in basepairs for plotting ATAC-seq signal tracks. +#' All insertions in a single bin will be summed. +#' @param scaleFactor A numeric scaling factor to weight genes based on the inverse of there length +#' @param groupBy A string that indicates how cells should be grouped. This string corresponds to one of the standard or +#' user-supplied `cellColData` metadata columns (for example, "Clusters"). Cells with the same value annotated in this metadata +#' column will be grouped together and the average signal will be plotted. +#' @param outDir the directory to output the group fragment files. +#' +#' @export +.getClusterCoverage <- function(ArchRProj = NULL, + tileSize = 100, + scaleFactor = 1, + groupBy = "Clusters", + outDir = file.path("Shiny", "coverage")) { + fragfiles = list.files(path = file.path("Shiny", "fragments"), full.names = TRUE) + dir.create(outDir, showWarnings = FALSE) + + # find barcodes of cells in that groupBy. + groups <- getCellColData(ArchRProj, select = groupBy, drop = TRUE) + cells <- ArchRProj$cellNames + cellGroups <- split(cells, groups) + + # outputs unique cell groups/clusters. + clusters <- names(cellGroups) + + chrRegions <- getChromSizes(ArchRProj) + genome <- getGenome(ArchRProj) + + for (file in fragfiles) { + fragments <- readRDS(file) + left <- GRanges(seqnames = seqnames(fragments), + ranges = IRanges(start(fragments), width = 1)) + right <- GRanges(seqnames = seqnames(fragments), + ranges = IRanges(end(fragments), width = 1)) + # call sort() after sortSeqlevels() to sort also the ranges in addition + # to the chromosomes. + insertions <- c(left, right) %>% sortSeqlevels() %>% + sort() + + cluster <- file %>% basename() %>% gsub("_.*", "", .) + # binnedCoverage + message("Creating bins for cluster ",clusters[clusteridx], "...") + bins <- + unlist(slidingWindows(chrRegions, width = tileSize, step = tileSize)) + + message("Counting overlaps for cluster ",clusters[clusteridx], "...") + bins$reads <- + countOverlaps( + bins, + insertions, + maxgap = -1L, + minoverlap = 0L, + type = "any" + ) + addSeqLengths(bins, genome) + + clusterReadsInTSS <- + ArchRProj@cellColData$ReadsInTSS[cells %in% cellGroups$cluster] + + binnedCoverage <- coverage(bins, weight = bins$reads *scaleFactor ) + saveRDS(binnedCoverage, file.path(outDir, paste0(cluster, "_cvg.rds"))) + } + +} + +if(!file.exists(file.path("Shiny"))){ + dir.create("Shiny", showWarnings = FALSE) + message("Shiny folder is created...") +} + +if(!file.exists(file.path("Shiny/inputData"))){ + message("Shiny/inputData folder is created...") + dir.create("Shiny/inputData", showWarnings = FALSE) +} + +set.seed(1) + +if (!file.exists(file.path( + "Save-ArchRProjShiny/Save-ArchRProjShiny-Arrows/" +))) { + stop( + "Please add Save-ArchRProjShiny/Save-ArchRProjShiny-Arrows/ folder into the Shiny/inputData/ path!" + ) +} else{ + ArchRProj <- + ArchR::loadArchRProject("Save-ArchRProjShiny/Save-ArchRProjShiny-Arrows/") + ArchRProj <- addImputeWeights(ArchRProj = ArchRProj) +} diff --git a/R/HiddenUtils.R b/R/HiddenUtils.R index 387db6b6..cb9cb1ee 100644 --- a/R/HiddenUtils.R +++ b/R/HiddenUtils.R @@ -159,7 +159,7 @@ } .quantileCut <- function(x = NULL, lo = 0.025, hi = 0.975, maxIf0 = TRUE){ - q <- quantile(x, probs = c(lo,hi)) + q <- quantile(x, probs = c(lo,hi), na.rm = TRUE) if(q[2] == 0){ if(maxIf0){ q[2] <- max(x) diff --git a/R/RasterUMAPs.R b/R/RasterUMAPs.R new file mode 100644 index 00000000..18ca3d72 --- /dev/null +++ b/R/RasterUMAPs.R @@ -0,0 +1,247 @@ +# rasterUmaps function ----------------------------------------------------------- +#' +#' +#' Create an HDF5 containing the nativeRaster vectors for all features for all feature matrices. +#' This function will be called by exportShinyArchR() +#' +#' @param ArchRProj An `ArchRProject` object loaded in the environment. Can do this using: loadArchRProject("path to ArchRProject/") +#' @param outputDirUmaps Where the HDF5 and the jpgs will be saved. +#' @param threads The number of threads to use for parallel execution. +#' @param verbose A boolean value that determines whether standard output should be printed. +#' @param logFile The path to a file to be used for logging ArchR output. +#' @export +rasterUMAPs <- function( + ArchRProj = NULL, + outputDirUmaps = "Shiny/inputData", + threads = getArchRThreads(), + verbose = TRUE, + logFile = createLogFile("rasterUMAPs") +){ + + ArchR:::.validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) + + if (file.exists(file.path(outputDirUmaps, "plotBlank72.h5"))){ + + file.remove(file.path(outputDirUmaps, "plotBlank72.h5")) + + } + + h5closeAll() + points <- H5Fcreate(name = file.path(outputDirUmaps,"plotBlank72.h5")) + h5createGroup(file.path(outputDirUmaps, "plotBlank72.h5"),"GSM") + h5createGroup(file.path(outputDirUmaps, "plotBlank72.h5"),"GIM") + h5createGroup(file.path(outputDirUmaps, "plotBlank72.h5"),"MM") + + + if(!exists("GSM_umaps_points")){ + + GSM_umaps_points <- ArchR:::.safelapply(1:length(gene_names_GSM), function(x){ + + print(paste0("Creating plots for GSM_umaps_points: ",x,": ",round((x/length(gene_names_GSM))*100,3), "%")) + + gene_plot <- plotEmbeddingShiny( + ArchRProj = ArchRProj, + colorBy = "GeneScoreMatrix", + name = gene_names_GSM[x], + embedding = "UMAP", + embeddingDF = df, + quantCut = c(0.01, 0.95), + imputeWeights = getImputeWeights(ArchRProj = ArchRProj), + plotAs = "points", + rastr = TRUE + ) + + if(!is.null(gene_plot)){ + + gene_plot_blank <- gene_plot[[1]] + theme(axis.title.x = element_blank()) + + theme(axis.title.y = element_blank()) + + theme(axis.title = element_blank()) + + theme(legend.position = "none") + + theme( + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.border = element_blank(), + title=element_blank() + ) + + #save plot without axes etc as a jpg. + ggsave(filename = file.path(outputDirUmaps, "GSM_umaps", paste0(gene_names_GSM[x],"_blank72.jpg")), + plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) + + #read back in that jpg because we need vector in native format + blank_jpg72 <- readJPEG(source = file.path(outputDirUmaps, "GSM_umaps", + paste0(gene_names_GSM[x],"_blank72.jpg")), native = TRUE) + + res = list(list(plot=as.vector(blank_jpg72), min = round(min(gene_plot[[1]]$data$color),1), + max = round(max(gene_plot[[1]]$data$color),1), pal = gene_plot[[2]])) + + return(res) + } + }, threads = threads) + names(GSM_umaps_points) <- gene_names_GSM + }else{ + message("GSM_umaps_points already exists. Skipping the loop...") + } + + if(!exists("GIM_umaps_points")){ + GIM_umaps_points <- ArchR:::.safelapply(1:length(gene_names_GIM), function(x){ + + print(paste0("Creating plots for GIM_umaps_points: ",x,": ",round((x/length(gene_names_GIM))*100,3), "%")) + + gene_plot <- plotEmbeddingShiny( + ArchRProj = ArchRProj, + colorBy = "GeneIntegrationMatrix", + name = gene_names_GIM[x], + embedding = "UMAP", + embeddingDF = df, + quantCut = c(0.01, 0.95), + imputeWeights = getImputeWeights(ArchRProj = ArchRProj), + plotAs = "points", + rastr = TRUE + ) + + if(!is.null(gene_plot)){ + gene_plot_blank <- gene_plot[[1]] + theme(axis.title.x = element_blank()) + + theme(axis.title.y = element_blank()) + + theme(axis.title = element_blank()) + + theme(legend.position = "none") + + theme( + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.border = element_blank(), + title=element_blank() + ) + + #save plot without axes etc as a jpg. + ggsave(filename = file.path(outputDirUmaps, "GIM_umaps", paste0(gene_names_GIM[x],"_blank72.jpg")), + plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) + + #read back in that jpg because we need vector in native format + blank_jpg72 <- readJPEG(source = file.path(outputDirUmaps, "GIM_umaps", + paste0(gene_names_GIM[x],"_blank72.jpg")), native = TRUE) + + + res = list(list(plot=as.vector(blank_jpg72), min = round(min(gene_plot[[1]]$data$color),1), + max = round(max(gene_plot[[1]]$data$color),1), pal = gene_plot[[2]])) + return(res) + } + + }, threads = threads) + names(GIM_umaps_points) <- gene_names_GIM + }else{ + message("GIM_umaps_points already exists. Skipping the loop...") + } + + if(!exists("MM_umaps_points")){ + + MM_umaps_points <- ArchR:::.safelapply(1:length(motif_names), function(x){ + + print(paste0("Creating plots for MM_umaps_points: ",x,": ",round((x/length(motif_names))*100,3), "%")) + + gene_plot <- plotEmbeddingShiny( + ArchRProj = ArchRProj, + colorBy = "MotifMatrix", + name = motif_names[x], + embedding = "UMAP", + embeddingDF = df, + quantCut = c(0.01, 0.95), + imputeWeights = getImputeWeights(ArchRProj = ArchRProj), + plotAs = "points", + rastr = TRUE + ) + + if(!is.null(gene_plot)){ + gene_plot_blank <- gene_plot[[1]] + theme(axis.title.x = element_blank()) + + theme(axis.title.y = element_blank()) + + theme(axis.title = element_blank()) + + theme(legend.position = "none") + + theme( + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.border = element_blank(), + title=element_blank() + ) + + #save plot without axes etc as a jpg + ggsave(filename = file.path(outputDirUmaps, "MM_umaps", paste0(motif_names[x],"_blank72.jpg")), + plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) + + + #read back in that jpg because we need vector in native format + blank_jpg72 <- readJPEG(source = file.path(outputDirUmaps, "MM_umaps", + paste0(motif_names[x],"_blank72.jpg")), native = TRUE) + + res = list(list(plot=as.vector(blank_jpg72), min = round(min(gene_plot[[1]]$data$color),1), + max = round(max(gene_plot[[1]]$data$color),1), pal = gene_plot[[2]])) + + names(res) = motif_names[x] + return(res) + } + }, threads = threads) + names(MM_umaps_points) <- motif_names + }else{ + message("MM_umaps_points already exists. Skipping the loop...") + } + + GSM_umaps_points = GSM_umaps_points[!unlist(lapply(GSM_umaps_points, is.null))] + GIM_umaps_points = GIM_umaps_points[!unlist(lapply(GIM_umaps_points, is.null))] + MM_umaps_points = MM_umaps_points[!unlist(lapply(MM_umaps_points, is.null))] + + GSM_min_max <- data.frame(matrix(NA, 2, length(GSM_umaps_points))) + colnames(GSM_min_max) <- names(GSM_umaps_points)[which(!unlist(lapply(GSM_umaps_points, is.null)))] + rownames(GSM_min_max) <- c("min","max") + + GIM_min_max <- data.frame(matrix(NA, 2, length(GIM_umaps_points))) + colnames(GIM_min_max) <- names(GIM_umaps_points)[which(!unlist(lapply(GIM_umaps_points, is.null)))] + rownames(GIM_min_max) <- c("min","max") + + MM_min_max <- data.frame(matrix(NA, 2, length(MM_umaps_points))) + colnames(MM_min_max) <- names(MM_umaps_points)[which(!unlist(lapply(MM_umaps_points, is.null)))] + rownames(MM_min_max) <- c("min","max") + + for(i in 1:length(GSM_umaps_points)){ + + print(paste0("Getting H5 files for GSM_umaps_points: ",i,": ",round((i/length(GSM_umaps_points))*100,3), "%")) + + h5createDataset(file = points, dataset = paste0("GSM/", gene_names_GSM[i]), dims = c(46656,1), storage.mode = "integer") + h5writeDataset(obj = GSM_umaps_points[[i]][[1]]$plot, h5loc = points, name=paste0("GSM/", gene_names_GSM[i])) + + GSM_min_max[1,i] = GSM_umaps_points[[i]][[1]]$min + GSM_min_max[2,i] = GSM_umaps_points[[i]][[1]]$max + + } + + for(i in 1:length(GIM_umaps_points)){ + + print(paste0("Getting H5 files for GIM_umaps_points: ",i,": ",round((i/length(GIM_umaps_points))*100,3), "%")) + + h5createDataset(file = points, dataset = paste0("GIM/", gene_names_GIM[i]), dims = c(46656,1), storage.mode = "integer") + h5writeDataset(obj = GIM_umaps_points[[i]][[1]]$plot, h5loc = points, name=paste0("GIM/", gene_names_GIM[i])) + + GIM_min_max[1,i] = GIM_umaps_points[[i]][[1]]$min + GIM_min_max[2,i] = GIM_umaps_points[[i]][[1]]$max + + } + + for(i in 1:length(MM_umaps_points)){ + + print(paste0("Getting H5 files for MM_umaps_points: ",i,": ",round((i/length(MM_umaps_points))*100,3), "%")) + h5createDataset(file = points, dataset = paste0("MM/", motif_names[i]), dims = c(46656,1), storage.mode = "integer") + h5writeDataset(obj = MM_umaps_points[[i]][[1]]$plot, h5loc = points, name=paste0("MM/", motif_names[i])) + MM_min_max[1,i] = MM_umaps_points[[i]][[1]]$min + MM_min_max[2,i] = MM_umaps_points[[i]][[1]]$max + + } + + scale <- list(gsm = GSM_min_max, gim = GIM_min_max, mm = MM_min_max) + pal <- list(gsm = GSM_umaps_points[[1]][[1]]$pal, gim = GIM_umaps_points[[1]][[1]]$pal, mm = MM_umaps_points[[1]][[1]]$pal) + + saveRDS(scale, file.path(outputDirUmaps, "scale.rds")) + saveRDS(pal, file.path(outputDirUmaps, "pal.rds")) + + if(exists("GSM_umaps_points")){ rm(GSM_umaps_points) } + if(exists("GIM_umaps_points")){ rm(GIM_umaps_points) } + if(exists("MM_umaps_points")){ rm(MM_umaps_points) } + +} + diff --git a/R/VisualizeData.R b/R/VisualizeData.R index d84d63c6..2917e255 100644 --- a/R/VisualizeData.R +++ b/R/VisualizeData.R @@ -527,6 +527,332 @@ plotEmbedding <- function( } +#' Visualize an Embedding from ArchR Project without Arrow Files. +#' +#' This function will plot an embedding stored in an ArchRProject without Arrow Files. +#' +#' @param ArchRProj An `ArchRProject` object. +#' @param embedding The name of the embedding stored in the `ArchRProject` to be plotted. See `computeEmbedding()` for more information. +#' @param colorBy A string indicating whether points in the plot should be colored by a column in `cellColData` ("cellColData") or by +#' a data matrix in the corresponding ArrowFiles (i.e. "GeneScoreMatrix", "MotifMatrix", "PeakMatrix"). +#' @param name The name of the column in `cellColData` or the featureName/rowname of the data matrix to be used for plotting. +#' For example if colorBy is "cellColData" then `name` refers to a column name in the `cellcoldata` (see `getCellcoldata()`). If `colorBy` +#' is "GeneScoreMatrix" then `name` refers to a gene name which can be listed by `getFeatures(ArchRProj, useMatrix = "GeneScoreMatrix")`. +#' @param log2Norm A boolean value indicating whether a log2 transformation should be performed on the values (if continuous) in plotting. +#' @param imputeWeights The weights to be used for imputing numerical values for each cell as a linear combination of other cells values. +#' See `addImputationWeights()` and `getImutationWeights()` for more information. +#' @param pal A custom palette used to override discreteSet/continuousSet for coloring cells. Typically created using `paletteDiscrete()` or `paletteContinuous()`. +#' To make a custom palette, you must construct this following strict specifications. If the coloring is for discrete data (i.e. "Clusters"), +#' then this palette must be a named vector of colors where each color is named for the corresponding group (e.g. `"C1" = "#F97070"`). If the coloring +#' for continuous data, then it just needs to be a vector of colors. If you are using `pal` in conjuction with `highlightCells`, your palette +#' must be a named vector with two entries, one named for the value of the cells in the `name` column of `cellColData` and the other named +#' "Non.Highlighted". For example, `pal=c("Mono" = "green", "Non.Highlighted" = "lightgrey")` would be used to change the color of cells with the value +#' "Mono" in the `cellColData` column indicated by `name`. Because of this, the cells indicated by `highlightCells` must also match this value in the `name` column. +#' @param size A number indicating the size of the points to plot if `plotAs` is set to "points". +#' @param sampleCells A numeric describing number of cells to use for plot. If using impute weights, this will occur after imputation. +#' @param highlightCells A character vector of cellNames describing which cells to hightlight if using `plotAs = "points"` (default if discrete). +#' The remainder of cells will be colored light gray. +#' @param rastr A boolean value that indicates whether the plot should be rasterized. This does not rasterize lines and labels, just the +#' internal portions of the plot. +#' @param quantCut If this is not `NULL`, a quantile cut is performed to threshold the top and bottom of the distribution of numerical values. +#' This prevents skewed color scales caused by strong outliers. The format of this should be c(x,y) where x is the lower threshold and y is +#' the upper threshold. For example, quantileCut = c(0.025,0.975) will take the 2.5th percentile and 97.5 percentile of values and set +#' values below/above to the value of the 2.5th and 97.5th percentile values respectively. +#' @param discreteSet The name of a discrete palette from `ArchRPalettes` for visualizing `colorBy` in the embedding if a discrete color set is desired. +#' @param continuousSet The name of a continuous palette from `ArchRPalettes` for visualizing `colorBy` in the embedding if a continuous color set is desired. +#' @param randomize A boolean value that indicates whether to randomize points prior to plotting to prevent cells from one cluster being +#' uniformly present at the front of the plot. +#' @param keepAxis A boolean value that indicates whether the x- and y-axis ticks and labels should be plotted. +#' @param baseSize The base font size to use in the plot. +#' @param plotAs A string that indicates whether points ("points") should be plotted or a hexplot ("hex") should be plotted. By default +#' if `colorBy` is numeric, then `plotAs` is set to "hex". +#' @param threads The number of threads to be used for parallel computing. +#' @param logFile The path to a file to be used for logging ArchR output. +#' @param ... Additional parameters to pass to `ggPoint()` or `ggHex()`. +#' +#' @examples +#' +#' #Get Test Project +#' proj <- getTestProject() +#' +#' #Plot UMAP +#' p <- plotEmbedding(proj, name = "Clusters") +#' +#' #PDF +#' plotPDF(p, name = "UMAP-Clusters", ArchRProj = proj) +#' +#' @export +plotEmbeddingShiny <- function( + ArchRProj = NULL, + embedding = "UMAP", + embeddingDF = NULL, + colorBy = "GeneScoreMatrix", + name = "Sample", + log2Norm = NULL, + imputeWeights = if(!grepl("coldata",tolower(colorBy[1]))) getImputeWeights(ArchRProj), + pal = NULL, + size = 0.1, + sampleCells = NULL, + highlightCells = NULL, + rastr = TRUE, + quantCut = c(0.01, 0.99), + discreteSet = NULL, + continuousSet = NULL, + randomize = TRUE, + keepAxis = FALSE, + baseSize = 10, + plotAs = NULL, + threads = getArchRThreads(), + plotParamsx = NULL, + logFile = createLogFile("plotEmbedding") +){ + + ArchR:::.validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) + ArchR:::.validInput(input = embedding, name = "reducedDims", valid = c("character")) + ArchR:::.validInput(input = colorBy, name = "colorBy", valid = c("character")) + ArchR:::.validInput(input = name, name = "name", valid = c("character")) + ArchR:::.validInput(input = log2Norm, name = "log2Norm", valid = c("boolean", "null")) + ArchR:::.validInput(input = imputeWeights, name = "imputeWeights", valid = c("list", "null")) + ArchR:::.validInput(input = pal, name = "pal", valid = c("palette", "null")) + ArchR:::.validInput(input = size, name = "size", valid = c("numeric")) + ArchR:::.validInput(input = sampleCells, name = "sampleCells", valid = c("numeric", "null")) + ArchR:::.validInput(input = highlightCells, name = "highlightCells", valid = c("character", "null")) + ArchR:::.validInput(input = rastr, name = "rastr", valid = c("boolean")) + ArchR:::.validInput(input = quantCut, name = "quantCut", valid = c("numeric", "null")) + ArchR:::.validInput(input = discreteSet, name = "discreteSet", valid = c("character", "null")) + ArchR:::.validInput(input = continuousSet, name = "continuousSet", valid = c("character", "null")) + ArchR:::.validInput(input = randomize, name = "randomize", valid = c("boolean")) + ArchR:::.validInput(input = keepAxis, name = "keepAxis", valid = c("boolean")) + ArchR:::.validInput(input = baseSize, name = "baseSize", valid = c("numeric")) + ArchR:::.validInput(input = plotAs, name = "plotAs", valid = c("character", "null")) + ArchR:::.validInput(input = threads, name = "threads", valid = c("integer")) + ArchR:::.validInput(input = logFile, name = "logFile", valid = c("character")) + + ArchR:::.requirePackage("ggplot2", source = "cran") + + ArchR:::.startLogging(logFile = logFile) + ArchR:::.logThis(mget(names(formals()),sys.frame(sys.nframe())), "Input-Parameters", logFile=logFile) + + + # Get Embedding ------------------------------------------------------------------ + ArchR:::.logMessage("Getting UMAP Embedding", logFile = logFile) + df <- embeddingDF + + if(!all(rownames(df) %in% ArchRProj$cellNames)){ + stop("Not all cells in embedding are present in ArchRProject!") + } + + ArchR:::.logThis(df, name = "Embedding data.frame", logFile = logFile) + if(!is.null(sampleCells)){ + if(sampleCells < nrow(df)){ + if(!is.null(imputeWeights)){ + stop("Cannot sampleCells with imputeWeights not equalt to NULL at this time!") + } + df <- df[sort(sample(seq_len(nrow(df)), sampleCells)), , drop = FALSE] + } + } + + #Parameters + plotParams <- list() + plotParams$x <- df[,1] + plotParams$y <- df[,2] + plotParams$title <- paste0(embedding, " of ", stringr::str_split(colnames(df)[1],pattern="#",simplify=TRUE)[,1]) + plotParams$baseSize <- baseSize + + #Additional Params + plotParams$xlabel <- gsub("_", " ",stringr::str_split(colnames(df)[1],pattern="#",simplify=TRUE)[,2]) + plotParams$ylabel <- gsub("_", " ",stringr::str_split(colnames(df)[2],pattern="#",simplify=TRUE)[,2]) + plotParams$rastr <- rastr + plotParams$size <- size + plotParams$randomize <- randomize + + #Check if Cells To Be Highlighted + if(!is.null(highlightCells)){ + highlightPoints <- match(highlightCells, rownames(df), nomatch = 0) + if(any(highlightPoints==0)){ + stop("highlightCells contain cells not in Embedding cellNames! Please make sure that these match!") + } + } + + #Make Sure ColorBy is valid + if(length(colorBy) > 1){ + stop("colorBy must be of length 1!") + } + + allColorBy <- matrices$allColorBy + + if(tolower(colorBy) %ni% tolower(allColorBy)){ + stop("colorBy must be one of the following :\n", paste0(allColorBy, sep=", ")) + } + colorBy <- allColorBy[match(tolower(colorBy), tolower(allColorBy))] + + ArchR:::.logMessage(paste0("ColorBy = ", colorBy), logFile = logFile) + + suppressMessages(message(logFile)) + + units <- ArchRProj@projectMetadata[["units"]] + + if(is.null(log2Norm) & tolower(colorBy) == "genescorematrix"){ + log2Norm <- TRUE + } + + if(is.null(log2Norm)){ + log2Norm <- FALSE + } + + #get values from pre-saved list + colorMat = tryCatch({ + t(as.matrix(matrices[[colorBy]][name,])) + }, warning = function(warning_condition) { + message(paste("name not seem to exist:", name)) + message(warning_condition) + # Choose a return value in case of warning + return(NULL) + }, error = function(error_condition) { + message(paste("name not seem to exist:", name)) + message(error_condition) + return(NA) + }, finally={ + + }) + + rownames(colorMat)=name + + if(!all(rownames(df) %in% colnames(colorMat))){ + ArchR:::.logMessage("Not all cells in embedding are present in feature matrix. This may be due to using a custom embedding.", logFile = logFile) + stop("Not all cells in embedding are present in feature matrix. This may be due to using a custom embedding.") + } + + colorMat <- colorMat[,rownames(df), drop=FALSE] + + ArchR:::.logThis(colorMat, "colorMat-Before-Impute", logFile = logFile) + + if(!is.null(imputeWeights)){ + if(getArchRVerbose()) message("Imputing Matrix") + colorMat <- imputeMatricesList[[colorBy]][name,] + if(!inherits(colorMat, "matrix")){ + colorMat <- matrix(colorMat, ncol = nrow(df)) + colnames(colorMat) <- rownames(df) + } + } + + ArchR:::.logThis(colorMat, "colorMat-After-Impute", logFile = logFile) + + colorList <- lapply(seq_len(nrow(colorMat)), function(x){ + colorParams <- list() + colorParams$color <- colorMat[x, ] + colorParams$discrete <- FALSE + colorParams$title <- sprintf("%s colored by\n%s : %s", plotParams$title, colorBy, name[x]) + if(tolower(colorBy) == "genescorematrix"){ + colorParams$continuousSet <- "horizonExtra" + }else{ + colorParams$continuousSet <- "solarExtra" + } + if(!is.null(continuousSet)){ + colorParams$continuousSet <- continuousSet + } + if(!is.null(discreteSet)){ + colorParams$discreteSet <- discreteSet + } + if(x == 1){ + ArchR:::.logThis(colorParams, name = "ColorParams 1", logFile = logFile) + } + colorParams + }) + + if(getArchRVerbose()) {message("Plotting Embedding")} + + for(x in 1:length(colorList)){ + + plotParamsx = ArchR:::.mergeParams(colorList[[x]], plotParams) + + + if(getArchRVerbose()) {message(x, " ", appendLF = FALSE)} + + if(plotParamsx$discrete){ + plotParamsx$color <- .myQuantileCut(plotParamsx$color, min(quantCut), max(quantCut), na.rm = TRUE) + } + + if(!plotParamsx$discrete){ + + plotParamsx$color <- .quantileCut(plotParamsx$color, min(quantCut), max(quantCut)) + + plotParamsx$pal <- paletteContinuous(set = plotParamsx$continuousSet) + + if(!is.null(pal)){ + + plotParamsx$pal <- pal + + } + + if(is.null(plotAs)){ + plotAs <- "hexplot" + } + + if(!is.null(log2Norm)){ + if(log2Norm){ + plotParamsx$color <- log2(plotParamsx$color + 1) + plotParamsx$colorTitle <- paste0("Log2(",units," + 1)") + }else{ + plotParamsx$colorTitle <- units + } + } + + if(tolower(plotAs) == "hex" | tolower(plotAs) == "hexplot"){ + + plotParamsx$discrete <- NULL + plotParamsx$continuousSet <- NULL + plotParamsx$rastr <- NULL + plotParamsx$size <- NULL + plotParamsx$randomize <- NULL + + ArchR:::.logThis(plotParamsx, name = paste0("PlotParams-", x), logFile = logFile) + gg <- do.call(ggHex, plotParamsx) + + }else{ + + if(!is.null(highlightCells)){ + plotParamsx$highlightPoints <- highlightPoints + } + + ArchR:::.logThis(plotParamsx, name = paste0("PlotParams-", x), logFile = logFile) + gg <- do.call(ggPoint, plotParamsx) + + } + + }else{ + + if(!is.null(pal)){ + plotParamsx$pal <- pal + } + + if(!is.null(highlightCells)){ + plotParamsx$highlightPoints <- highlightPoints + } + + ArchR:::.logThis(plotParamsx, name = paste0("PlotParams-", x), logFile = logFile) + gg <- do.call(ggPoint, plotParamsx) + + } + + if(!keepAxis){ + gg <- gg + theme(axis.text.x=element_blank(), axis.ticks.x=element_blank(), axis.text.y=element_blank(), axis.ticks.y=element_blank()) + } + + gg + + } + + if(getArchRVerbose()) message("") + + if(length(gg) == 1){ + gg <- gg + } + + ArchR:::.endLogging(logFile = logFile) + + return(list(gg, plotParamsx$pal)) +} #' Visualize Groups from ArchR Project #' diff --git a/R/exportShinyArchR.R b/R/exportShinyArchR.R new file mode 100644 index 00000000..65fa3819 --- /dev/null +++ b/R/exportShinyArchR.R @@ -0,0 +1,284 @@ +#' Export a Shiny App based on ArchRProj +#' +#' Generate all files required for an autonomous Shiny app to display your browser tracks. +#' +#' @param ArchRProj An `ArchRProject` object loaded in the environment. Can do this using: loadArchRProject("path to ArchRProject/") +#' @param outputDir The name of the directory for the Shiny App files. +#' @param groupBy The name of the column in `cellColData` to use for grouping cells together for summarizing. +#' @param tileSize The numeric width of the tile/bin in basepairs for plotting ATAC-seq signal tracks. All insertions in a single bin will be summed. +#' @param threads The number of threads to use for parallel execution. +#' @param verbose A boolean value that determines whether standard output should be printed. +#' @param logFile The path to a file to be used for logging ArchR output. +#' @export +exportShinyArchR <- function(ArchRProj = NULL, + outputDir = "Shiny", + groupBy = "Clusters", + tileSize = 100, + threads = getArchRThreads(), + verbose = TRUE, + logFile = createLogFile("exportShinyArchR")) { + + .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) + .validInput(input = outputDir, name = "outputDir", valid = c("character")) + .validInput(input = groupBy, name = "groupBy", valid = c("character")) + .validInput(input = tileSize, name = "tileSize", valid = c("integer")) + .validInput(input = threads, name = "threads", valid = c("integer")) + .validInput(input = verbose, name = "verbose", valid = c("boolean")) + .validInput(input = logFile, name = "logFile", valid = c("character")) + + .startLogging(logFile=logFile) + .logThis(mget(names(formals()),sys.frame(sys.nframe())), "exportShinyArchR Input-Parameters", logFile = logFile) + + .requirePackage("shiny", installInfo = 'install.packages("shiny")') + .requirePackage("rhandsontable", installInfo = 'install.packages("rhandsontable")') + + # Make directory for Shiny App + if(!dir.exists(outputDir)) { + + dir.create(outputDir) + # if(length(dir(outDir, all.files = TRUE, include.dirs = TRUE, no.. = TRUE)) > 0){ + # stop("Please specify a new or empty directory") + # } + + filesUrl <- c( + "https://raw.githubusercontent.com/paupaiz/ArchR/Shiny_export/R/Shiny/app.R", + "https://raw.githubusercontent.com/paupaiz/ArchR/Shiny_export/R/Shiny/global.R", + "https://raw.githubusercontent.com/paupaiz/ArchR/Shiny_export/R/Shiny/server.R", + "https://raw.githubusercontent.com/paupaiz/ArchR/Shiny_export/R/Shiny/ui.R" + ) + + downloadFiles <- lapply(seq_along(filesUrl), function(x){ + download.file( + url = filesUrl[x], + destfile = file.path(outputDir, basename(filesUrl[x])) + ) + }) + + }else{ + message("Using existing Shiny files...") + } + + # Create a copy of the ArchRProj object + ArchRProjShiny <- ArchRProj + # Add metadata to ArchRProjShiny + if (is.na(paste0("ArchRProj$", groupBy))) { + stop("groupBy is not part of cellColData") + } else if ((any(is.na(paste0("ArchRProj$", groupBy))))) { + stop("incomplete data. some NA observations for groupBy") + } else { + ArchRProjShiny@projectMetadata[["groupBy"]] <- groupBy + } + ArchRProjShiny@projectMetadata[["tileSize"]] <- tileSize + saveArchRProject(ArchRProj = ArchRProj, outputDirectory = "Save-ArchRProjShiny") + + # Create fragment files + .getGroupFragsFromProj(ArchRProj = ArchRProjShiny, groupBy = groupBy, outDir = file.path(outputDir, "fragments")) + + # Create coverage objects + .getClusterCoverage(ArchRProj = ArchRProjShiny, tileSize = tileSize, groupBy = groupBy, outDir = file.path(outputDir, "coverage")) + + ## main umaps ----------------------------------------------------------------- + dir.create("UMAPs") + + units <- tryCatch({ + .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, "/Info/Units"))[1] + },error=function(e){ + "values" + }) + + ArchRProjShiny@projectMetadata[["units"]] <- units + + #need arrowFiles to getFeatures so need to save genes as RDS + gene_names <- getFeatures(ArchRProj = ArchRProj) + saveRDS(gene_names, "./inputData/gene_names.rds") + + umaps <- list() + cluster_umap <- plotEmbedding( + ArchRProj = ArchRProjShiny, + baseSize=12, + colorBy = "cellColData", + name = "Clusters", + embedding = "UMAP", + rastr = FALSE, + 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)) + umaps[["Clusters"]] <- cluster_umap + # saveRDS(cluster_umap, "./UMAPs/cluster_umap.rds") + + sample_umap <- plotEmbedding( + ArchRProj = ArchRProj, + 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)) + umaps[["Sample"]] <- sample_umap + # saveRDS(sample_umap, "./UMAPs/sample_umap.rds") + + constrained_umap <- plotEmbedding( + ArchRProj = ArchRProjShiny, + 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)) + # saveRDS(constrained_umap, "./UMAPs/constrained_umap.rds") + umaps[["Constrained"]] <- constrained_umap + + unconstrained_umap <- plotEmbedding( + ArchRProj = ArchRProjShiny, + embedding = "UMAP", + colorBy = "cellColData", + name = "predictedGroup_Un", + 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)) + # saveRDS(unconstrained_umap, "./UMAPs/unconstrained_umap.rds") + umaps[["unconstrained"]] <- unconstrained_umap + + constrained_remapped_umap <- plotEmbedding( + ArchRProj = ArchRProjShiny, + 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)) + # saveRDS(constrained_remapped_umap, "./UMAPs/constrained_remapped_umap.rds") + umaps[["Constrained remap"]] <- constrained_remapped_umap + + saveRDS(umaps, "./inputData/umaps.rds") + umaps <- readRDS("./inputData/umaps.rds") + + ## colorMats without Impute Weights---------------------------------------------------------------- + + #Get gene and motif names and save as RDS + gene_names_GSM <- getFeatures(ArchRProj = ArchRProj, useMatrix = "GeneScoreMatrix") + saveRDS(gene_names_GSM, file="./inputData/geneNamesGSM.rds") + + gene_names_GIM <- getFeatures(ArchRProj = ArchRProj, useMatrix = "GeneIntegrationMatrix") + saveRDS(gene_names_GIM, file = "./inputData/geneNamesGIM.rds") + + motif_names <- getFeatures(ArchRProj = ArchRProj, useMatrix = "MotifMatrix") %>% + gsub(".*:", "", .) %>% unique(.) + saveRDS(motif_names, "./inputData/markerListMM.rds") + + matrices <- list() + #GSM colorMat + colorMatGSM <- Matrix(.getMatrixValues( + ArchRProj = ArchRProj, + name = gene_names_GSM, + matrixName = "GeneScoreMatrix", + log2Norm = FALSE, + threads = threads, + ), sparse = TRUE) + matrices$"GeneScoreMatrix" <- colorMatGSM + + #GIM + colorMatGIM <- Matrix(.getMatrixValues( + ArchRProj = ArchRProj, + name = getFeatures(ArchRProj = ArchRProj, useMatrix = "GeneIntegrationMatrix"), + matrixName = "GeneIntegrationMatrix", + log2Norm = FALSE, + threads = threads + ),sparse = TRUE) + matrices$"GeneIntegrationMatrix" <- colorMatGIM + + #colorMatMM has 1740 rows because in name = getFeatures() returns the 870 z: + the 870 deviations: + colorMatMM <- Matrix(.getMatrixValues( + ArchRProj = ArchRProj, + #name = getFeatures(ArchRProj, "MotifMatrix") + name = paste0("deviations:", markerListMM), #used deviations: + matrixName = "MotifMatrix", + log2Norm = FALSE, + threads = threads + ), sparse = TRUE) + matrices$"MotifMatrix" <- colorMatMM + + #TODO modify this so it only has the matrices we are actually supporting + matrices$allColorBy=c("colData", "cellColData", .availableArrays(head(getArrowFiles(ArchRProj), 2))) + # shouldn't save rds because it's too hefty for ShinyApps + saveRDS(matrices,"~/tests/raster/inputData/matrices.rds") + matrices <- readRDS("matrices.rds") + + ## Impute Weights ------------------------------------------------------------ + imputeWeights <- getImputeWeights(ArchRProj = ArchRProj) + if(!is.null(imputeWeights)) { + df <- getEmbedding(ArchRProj, embedding = "UMAP", returnDF = TRUE) + + imputeMatricesList <- list() + # colorMats for each colorBy + + # GSM + colorMatGSM <- matrices$"GeneScoreMatrix" + colorMatGSM <- colorMatGSM[,rownames(df), drop=FALSE] + + .logThis(colorMatGSM, "colorMatGSM-Before-Impute", logFile = logFile) + + if(getArchRVerbose()) message("Imputing Matrix") + colorMatGSM_Impute <- imputeMatrix(mat = as.matrix(colorMatGSM), imputeWeights = imputeWeights, logFile = logFile) + if(!inherits(colorMatGSM_Impute, "matrix")){ + colorMatGSM_Impute <- matrix(colorMatGSM_Impute, ncol = nrow(df)) + colnames(colorMatGSM_Impute) <- rownames(df) + } + + .logThis(colorMat_Impute, "colorMatGSM-After-Impute", logFile = logFile) + + imputeMatricesList$"GeneScoreMatrix" <- colorMatGSM_Impute + + # GIM + colorMatGIM <- matrices$"GeneIntegrationMatrix" + colorMatGIM <- colorMatGIM[,rownames(df), drop=FALSE] + + .logThis(colorMatGIM, "colorMatGIM-Before-Impute", logFile = logFile) + + if(getArchRVerbose()) message("Imputing Matrix") + colorMatGIM_Impute <- imputeMatrix(mat = as.matrix(colorMatGIM), imputeWeights = imputeWeights, logFile = logFile) + if(!inherits(colorMatGIM_Impute, "matrix")){ + colorMatGIM_Impute <- matrix(colorMatGIM_Impute, ncol = nrow(df)) + colnames(colorMatGIM_Impute) <- rownames(df) + } + + .logThis(colorMatGIM_Impute, "colorMatGIM-After-Impute", logFile = logFile) + + imputeMatricesList$"GeneIntegrationMatrix" <- colorMatGIM_Impute + + # Motif Matrix + colorMatMM <- matrices$"MotifMatrix" + colorMatMM <- colorMatMM[,rownames(df), drop=FALSE] + + .logThis(colorMatMM, "colorMatMM-Before-Impute", logFile = logFile) + + if(getArchRVerbose()) message("Imputing Matrix") + colorMatMM_Impute <- imputeMatrix(mat = as.matrix(colorMatMM), imputeWeights = imputeWeights, logFile = logFile) + if(!inherits(colorMatMM_Impute, "matrix")){ + colorMatMM_Impute <- matrix(colorMatMM_Impute, ncol = nrow(df)) + colnames(colorMatMM_Impute) <- rownames(df) + } + + .logThis(colorMatMM_Impute, "colorMatMM-After-Impute", logFile = logFile) + + imputeMatricesList$"MotifMatrix" <- colorMatMM_Impute + } + + saveRDS(imputeMatricesList,"~/tests/raster/inputData/imputeMatricesList.rds") + imputeMatricesList <- readRDS("imputeMatricesList.rds") + + ## delete unnecessary files ----------------------------------------------------------------- + unlink("./fragments", recursive = TRUE) + unlink("./ArchRLogs", recursive = TRUE) + + ## ready to launch --------------------------------------------------------------- + message("App created! To launch, + ArchRProj <- loadArchRProject('path to ArchRProject/') and + run shiny::runApp('", outputDir, "') from parent directory") + # runApp("myappdir") +} + + diff --git a/R/mainUMAPs.R b/R/mainUMAPs.R new file mode 100644 index 00000000..c104d0be --- /dev/null +++ b/R/mainUMAPs.R @@ -0,0 +1,126 @@ +# mainUmaps function ----------------------------------------------------------- +#' +#' Create an HDF5, mainUMAPs.h5, containing the nativeRaster vectors for the 5 main UMAPS. +#' This function will be called by exportShinyArchR() +#' +#' @param ArchRProj An `ArchRProject` object loaded in the environment. Can do this using: loadArchRProject("path to ArchRProject/") +#' @param outputDirUmaps Where the HDF5 and the jpgs will be saved. +#' @param threads The number of threads to use for parallel execution. +#' @param verbose A boolean value that determines whether standard output should be printed. +#' @param logFile The path to a file to be used for logging ArchR output. +#' @export +mainUMAPs <- function( + ArchRProj = NULL, + outputDirUmaps = "Shiny/inputData", + threads = getArchRThreads(), + verbose = TRUE, + logFile = createLogFile("mainUMAPs") +){ + + if(!file.exists(file.path(outputDirUmaps, "umaps.rds"))){ + umaps <- list() + + cluster_umap <- plotEmbedding( + ArchRProj = ArchRProj, + baseSize=12, + colorBy = "cellColData", + name = "Clusters", + embedding = "UMAP", + rastr = FALSE, + 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)) + umaps[["Clusters"]] <- cluster_umap + + sample_umap <- plotEmbedding( + ArchRProj = ArchRProj, + 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)) + umaps[["Sample"]] <- sample_umap + + constrained_umap <- plotEmbedding( + ArchRProj = ArchRProjShiny, + 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)) + umaps[["Constrained"]] <- constrained_umap + + unconstrained_umap <- plotEmbedding( + ArchRProj = ArchRProjShiny, + embedding = "UMAP", + colorBy = "cellColData", + name = "predictedGroup_Un", + 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)) + umaps[["Unconstrained"]] <- unconstrained_umap + + constrained_remapped_umap <- plotEmbedding( + ArchRProj = ArchRProjShiny, + 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)) + umaps[["Constrained remap"]] <- constrained_remapped_umap + + saveRDS(umaps, file.path(outputDirUmaps, "umaps.rds")) + } else { + message("umaps already exists...") + umaps <- readRDS(file.path(outputDirUmaps, "umaps.rds")) + } + + h5closeAll() + + points <- H5Fcreate(name = file.path(outputDirUmaps, "mainUMAPs.h5")) + umap_legend <- list() + umap_color <- list() + for(i in 1:length(umaps)){ + + umap_plot <- umaps[i] + + umap_plot[[1]]$labels$title <- NULL + umap_plot_blank <- umap_plot[[1]] + theme(axis.title.x = element_blank()) + + theme(axis.title.y = element_blank()) + + theme(axis.title = element_blank()) + + theme(legend.position = "none") + + theme( + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.border = element_blank(), + title=element_blank() + ) + + #save plot without axes etc as a jpg. + ggsave(filename = file.path(outputDirUmaps, paste0(names(umaps)[i],"_blank72.jpg")), + plot = umap_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) + + #read back in that jpg because we need vector in native format + blank_jpg72 <- readJPEG(source = file.path(outputDirUmaps, paste0(names(umaps)[[i]],"_blank72.jpg")), native = TRUE) + + h5createDataset(file = points, dataset = names(umaps)[i], dims = c(46656,1), storage.mode = "integer") + h5writeDataset(obj = as.vector(blank_jpg72), h5loc = points, name= names(umaps)[i]) + + umap_legend[[i]] <- levels(umap_plot[[1]]$data$color) + names(umap_legend)[[i]] <- names(umap_plot) + + + umap_color[[i]] <- unique(ggplot_build(umap_plot[[1]])$data[[1]][,"colour"]) + names(umap_color)[[i]] <- names(umap_plot) + + } + + saveRDS(umap_color, file.path(outputDirUmaps, "color_umaps.rds")) + saveRDS(umap_legend, file.path(outputDirUmaps, "umap_legend_names.rds")) +} diff --git a/Shiny/app.R b/Shiny/app.R new file mode 100644 index 00000000..8f60aec8 --- /dev/null +++ b/Shiny/app.R @@ -0,0 +1,6 @@ +# Load libraries so they are available +# Run the app through this file. +source("ui.R") +source("server.R") +shinyApp(ui:ui, server:shinyServer) +# http://127.0.0.1:6747 \ No newline at end of file diff --git a/Shiny/global.R b/Shiny/global.R new file mode 100644 index 00000000..df2dcfdd --- /dev/null +++ b/Shiny/global.R @@ -0,0 +1,79 @@ +# Setting up ---------------------------------------------------------------------- + +library(shinycssloaders) +library(hexbin) +library(magick) +library(gridExtra) +library(grid) +library(patchwork) +library(shinybusy) +library(cowplot) +library(ggpubr) +library(farver) +library(rhdf5) +library(plotfunctions) +library(raster) +library(jpeg) +library(ArchR) + + +# specify desired number of threads +addArchRThreads(threads = 1) +# specify genome version. Default hg19 set +addArchRGenome("hg19") +set.seed(1) + +# Load all hidden ArchR functions ------------------------------------------------ +fn <- unclass(lsf.str(envir = asNamespace("ArchR"), all = TRUE)) +for (i in seq_along(fn)) { + tryCatch({ + eval(parse(text = paste0(fn[i], "<-ArchR:::", fn[i]))) + }, error = function(x) { + }) +} + +# UMAP Visualization ------------------------------------------------------------ + +# create a list of dropdown options for umap tab +Umaps_dropdown=c("Clusters","Sample","Unconstrained","Constrained","Constrained remap") +MM_dropdown=readRDS("./inputData/motif_names.rds") +GSM_dropdown=readRDS("./inputData/gene_names_GSM.rds") +GIM_dropdown=readRDS("./inputData/gene_names_GIM.rds") +umap_legend_names = readRDS("./inputData/umap_legend_names.rds") +color_umaps=readRDS("./inputData/color_umaps.rds") + + +# define a function to get the umap for a gene +getUMAPplotWithCol<-function(gene,umapList,scaffoldName,matrixType) +{ + gene_plot=umapList[[gene]] + + p_template1=readRDS(paste("./inputData/",scaffoldName,".rds",sep="")) + p_template1$scales$scales <- gene_plot$scale + + title=paste("UMAP of IterativeLSI colored by\n",matrixType," : ",sep="") + + p_template1$labels$title <- paste0(title, gene) + + return(p_template1) +} + + +# define a function to get the filename for a gene and then call get umap function +getUmap<-function(gene,fileIndexer,folderName,scaffoldName,matrixType) +{ + # getFilename + for(file in names(fileIndexer)) + { + if(gene %in% fileIndexer[[file]]) + { + Umaps_data_subset=readRDS(paste(paste0("./inputData/",folderName),file,sep="/")) + return(getUMAPplotWithCol(gene,Umaps_data_subset,scaffoldName,matrixType)) + } + } +} + +# PlotBrowser ------------------------------------------------------------------ + +# create a list of dropdown options for plotbroswer tab +gene_names=readRDS("./inputData/gene_names.rds") \ No newline at end of file diff --git a/Shiny/server.R b/Shiny/server.R new file mode 100644 index 00000000..cdf905ca --- /dev/null +++ b/Shiny/server.R @@ -0,0 +1,1065 @@ + +shinyServer <- function(input,output, session){ + + + # UMAPS ------------------------------------------------------------------------------------ + + #Output Handler: Downloads UMAPS + output$download_UMAP1<-downloadHandler( + filename <- function(){ + paste0("UMAP-",paste(input$matrix_UMAP1_forComparison,input$UMAP1_forComparison,sep="-"),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)} + + if((input$matrix_UMAP1_forComparison)=="Gene Score Matrix") + { + p_empty <- ggplot() + + xlab("UMAP Dimension 1") + ylab("UMAP Dimension 2") + theme_bw(base_size=10)+ + ggtitle(paste0("UMAP of IterativeLSI colored by \n GeneScoreMatrix: ",input$UMAP1_forComparison)) + + theme( + panel.background = element_rect(fill='transparent'), #transparent panel bg + plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg + panel.grid.major = element_blank(), #remove major gridlines + panel.grid.minor = element_blank(), #remove minor gridlines + legend.background = element_rect(fill='transparent'), #transparent legend bg + legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), + plot.title = element_text(size=16) + ) + + emptyPlot(0,0, axes=FALSE) + legend_plot <- gradientLegend(valRange=c(scale()$gsm[,input$UMAP1_forComparison][1],scale()$gsm[,input$UMAP1_forComparison][2]), + color = color()$gsm, pos=.5, side=1) + + + p <- h5read("./inputData/plotBlank72.h5", paste0("GSM/", input$UMAP1_forComparison)) + temp_jpg <- t(matrix(decode_native(p), nrow = 216)) + + + last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + + draw_plot(p_empty, scale = 0.8) + + draw_text("Log2(+1)", x = 0.35, y = 0.05, size = 12) + + plot1 = print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) + + } + + else if((input$matrix_UMAP1_forComparison)=="Gene Integration Matrix") + { + p_empty <- ggplot() + + xlab("UMAP Dimension 1") + ylab("UMAP Dimension 2") + theme_bw(base_size=10)+ + ggtitle(paste0("UMAP of IterativeLSI colored by \n GeneIntegrationMatrix: ",input$UMAP1_forComparison)) + + theme( + panel.background = element_rect(fill='transparent'), #transparent panel bg + plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg + panel.grid.major = element_blank(), #remove major gridlines + panel.grid.minor = element_blank(), #remove minor gridlines + legend.background = element_rect(fill='transparent'), #transparent legend bg + legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), + plot.title = element_text(size=16) + ) + + emptyPlot(0,0, axes=FALSE) + legend_plot <- gradientLegend(valRange=c(scale()$gim[,input$UMAP1_forComparison][1],scale()$gim[,input$UMAP1_forComparison][2]), + color = color()$gim, pos=.5, side=1) + + p <- h5read("./inputData/plotBlank72.h5", paste0("GIM/", input$UMAP1_forComparison)) + temp_jpg <- t(matrix(decode_native(p), nrow = 216)) + + + last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + + draw_plot(p_empty, scale = 0.8) + + draw_text("Log2(+1)", x = 0.35, y = 0.05, size = 12) + + plot1 = print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) + + + } + + else if((input$matrix_UMAP1_forComparison)=="Motif Matrix") + { + p_empty <- ggplot() + + xlab("UMAP Dimension 1") + ylab("UMAP Dimension 2") + theme_bw(base_size=10)+ + ggtitle(paste0("UMAP of IterativeLSI colored by \n MotifMatrix: ",input$UMAP1_forComparison)) + + theme( + panel.background = element_rect(fill='transparent'), #transparent panel bg + plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg + panel.grid.major = element_blank(), #remove major gridlines + panel.grid.minor = element_blank(), #remove minor gridlines + legend.background = element_rect(fill='transparent'), #transparent legend bg + legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), + plot.title = element_text(size=16) + ) + + emptyPlot(0,0, axes=FALSE) + legend_plot <- gradientLegend(valRange=c(scale()$mm[,input$UMAP1_forComparison][1],scale()$mm[,input$UMAP1_forComparison][2]), + color = color()$mm, pos=.5, side=1) + + p <- h5read("./inputData/plotBlank72.h5", paste0("MM/", input$UMAP1_forComparison)) + + temp_jpg <- t(matrix(decode_native(p), nrow = 216)) + + last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + + draw_plot(p_empty, scale = 0.8) + + draw_text("Log2(+1)", x = 0.35, y = 0.05, size = 12) + + plot1 = print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) + } + + else + { + + + if((input$matrix_UMAP1_forComparison)=="Clusters"){ + + title = "Colored by scATAC-seq clusters" + + } + + if((input$matrix_UMAP1_forComparison)=="Constrained"){ + + title = "UMAP: constrained integration" + + } + + if((input$matrix_UMAP1_forComparison)=="Constrained remap"){ + + title = "UMAP: Constrained remmaped clusters" + + } + + if((input$matrix_UMAP1_forComparison)=="Sample"){ + + title = "Colored by original identity" + + } + + if((input$matrix_UMAP1_forComparison)=="Unconstrained"){ + + title = "UMAP: unconstrained integration" + + } + + p_empty <- ggplot() + + xlab("UMAP Dimension 1") + ylab("UMAP Dimension 2") + theme_bw(base_size=10)+ + ggtitle(title) + + theme( + panel.background = element_rect(fill='transparent'), #transparent panel bg + plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg + panel.grid.major = element_blank(), #remove major gridlines + panel.grid.minor = element_blank(), #remove minor gridlines + legend.background = element_rect(fill='transparent'), #transparent legend bg + legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), + plot.title = element_text(size=16) + ) + + emptyPlot(0,0, axes=FALSE) + + if((input$matrix_UMAP1_forComparison)=="Clusters"){ + + legend('bottom', legend=umap_legend_names$Clusters, + pch=15, col = color_umaps$Clusters, + horiz = FALSE, x.intersp = 1, text.width=0.35, + cex = 0.7, bty="n", ncol = 4) + + + + } + + if((input$matrix_UMAP1_forComparison)=="Sample"){ + legend('bottom', legend=umap_legend_names$Sample, pch=15, + col = color, + horiz = TRUE, x.intersp = 1, text.width=0.6, + cex = 0.7, bty="n") + } + + if((input$matrix_UMAP1_forComparison)=="Constrained"){ + + legend('bottom', legend=umap_legend_names$Constrained, + pch=15, col = color_umaps$Constrained, + horiz = FALSE, x.intersp = 1, text.width=0.35, + cex = 0.5, bty="n", ncol = 5) + + + } + + + if((input$matrix_UMAP1_forComparison)=="Unconstrained"){ + legend('bottom', legend=umap_legend_names$Unconstrained, + pch=15, col = color_umaps$unconstrained, + horiz = FALSE, x.intersp = 1, text.width=0.35, + cex = 0.5, bty="n", ncol = 5) + } + + + if((input$matrix_UMAP1_forComparison)=="Constrained remap"){ + legend('bottom', legend=umap_legend_names$`Constrained remap`, + pch=15, col = color_umaps$`Constrained remap`, + horiz = FALSE, x.intersp = 1, text.width=0.35, + cex = 0.7, bty="n", ncol = 4) + } + + p <- h5read("./inputData/mainUMAPs.h5", input$matrix_UMAP1_forComparison) + temp_jpg <- t(matrix(decode_native(p), nrow = 216)) + + last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.7) + + draw_plot(p_empty, scale = 0.7) + + draw_text("color", x = 0.1, y = 0.135, size = 12) + + plot1 = print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) + } + + + grid.arrange(plot1) + dev.off() + } + ) + + output$download_UMAP2<-downloadHandler( + filename <- function(){ + paste0("UMAP-",paste(input$matrix_UMAP2_forComparison,input$UMAP2_forComparison,sep="-"),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)} + + + + + if((input$matrix_UMAP2_forComparison)=="Gene Score Matrix") + { + p_empty <- ggplot() + + xlab("UMAP Dimension 1") + ylab("UMAP Dimension 2") + theme_bw(base_size=10)+ + ggtitle(paste0("UMAP of IterativeLSI colored by \n GeneScoreMatrix: ",input$UMAP1_forComparison)) + + theme( + panel.background = element_rect(fill='transparent'), #transparent panel bg + plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg + panel.grid.major = element_blank(), #remove major gridlines + panel.grid.minor = element_blank(), #remove minor gridlines + legend.background = element_rect(fill='transparent'), #transparent legend bg + legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), + plot.title = element_text(size=16) + ) + + emptyPlot(0,0, axes=FALSE) + legend_plot <- gradientLegend(valRange=c(scale()$gsm[,input$UMAP1_forComparison][1],scale()$gsm[,input$UMAP1_forComparison][2]), + color = color()$gsm, pos=.5, side=1) + + + p <- h5read("./inputData/plotBlank72.h5", paste0("GSM/", input$UMAP1_forComparison)) + temp_jpg <- t(matrix(decode_native(p), nrow = 216)) + + + last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + + draw_plot(p_empty, scale = 0.8) + + draw_text("Log2(+1)", x = 0.35, y = 0.05, size = 12) + + plot2 = print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) + + } + + else if((input$matrix_UMAP2_forComparison)=="Gene Integration Matrix") + { + p_empty <- ggplot() + + xlab("UMAP Dimension 1") + ylab("UMAP Dimension 2") + theme_bw(base_size=10)+ + ggtitle(paste0("UMAP of IterativeLSI colored by \n GeneIntegrationMatrix: ",input$UMAP1_forComparison)) + + theme( + panel.background = element_rect(fill='transparent'), #transparent panel bg + plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg + panel.grid.major = element_blank(), #remove major gridlines + panel.grid.minor = element_blank(), #remove minor gridlines + legend.background = element_rect(fill='transparent'), #transparent legend bg + legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), + plot.title = element_text(size=16) + ) + + emptyPlot(0,0, axes=FALSE) + legend_plot <- gradientLegend(valRange=c(scale()$gim[,input$UMAP1_forComparison][1],scale()$gim[,input$UMAP1_forComparison][2]), + color = color()$gim, pos=.5, side=1) + + p <- h5read("./inputData/plotBlank72.h5", paste0("GIM/", input$UMAP1_forComparison)) + temp_jpg <- t(matrix(decode_native(p), nrow = 216)) + + + last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + + draw_plot(p_empty, scale = 0.8) + + draw_text("Log2(+1)", x = 0.35, y = 0.05, size = 12) + + plot2 = print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) + + + } + + else if((input$matrix_UMAP2_forComparison)=="Motif Matrix") + { + p_empty <- ggplot() + + xlab("UMAP Dimension 1") + ylab("UMAP Dimension 2") + theme_bw(base_size=10)+ + ggtitle(paste0("UMAP of IterativeLSI colored by \n MotifMatrix: ",input$UMAP1_forComparison)) + + theme( + panel.background = element_rect(fill='transparent'), #transparent panel bg + plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg + panel.grid.major = element_blank(), #remove major gridlines + panel.grid.minor = element_blank(), #remove minor gridlines + legend.background = element_rect(fill='transparent'), #transparent legend bg + legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), + plot.title = element_text(size=16) + ) + + emptyPlot(0,0, axes=FALSE) + legend_plot <- gradientLegend(valRange=c(scale()$mm[,input$UMAP1_forComparison][1],scale()$mm[,input$UMAP1_forComparison][2]), + color = color()$mm, pos=.5, side=1) + + p <- h5read("./inputData/plotBlank72.h5", paste0("MM/", input$UMAP1_forComparison)) + + temp_jpg <- t(matrix(decode_native(p), nrow = 216)) + + last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + + draw_plot(p_empty, scale = 0.8) + + draw_text("Log2(+1)", x = 0.35, y = 0.05, size = 12) + + plot2 = print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) + + + } + + else + { + + if((input$matrix_UMAP2_forComparison)=="Clusters"){ + + title = "Colored by scATAC-seq clusters" + + } + + if((input$matrix_UMAP2_forComparison)=="Constrained"){ + + title = "UMAP: constrained integration" + + } + + if((input$matrix_UMAP2_forComparison)=="Constrained remap"){ + + title = "UMAP: Constrained remmaped clusters" + + } + + if((input$matrix_UMAP2_forComparison)=="Sample"){ + + title = "Colored by original identity" + + } + + if((input$matrix_UMAP2_forComparison)=="Unconstrained"){ + + title = "UMAP: unconstrained integration" + + } + + p_empty <- ggplot() + + xlab("UMAP Dimension 1") + ylab("UMAP Dimension 2") + theme_bw(base_size=10)+ + ggtitle(title) + + theme( + panel.background = element_rect(fill='transparent'), #transparent panel bg + plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg + panel.grid.major = element_blank(), #remove major gridlines + panel.grid.minor = element_blank(), #remove minor gridlines + legend.background = element_rect(fill='transparent'), #transparent legend bg + legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), + plot.title = element_text(size=16) + ) + + emptyPlot(0,0, axes=FALSE) + + if((input$matrix_UMAP2_forComparison)=="Clusters"){ + + legend('bottom', legend=umap_legend_names$Clusters, + pch=15, col = color_umaps$Clusters, + horiz = FALSE, x.intersp = 1, text.width=0.35, + cex = 0.7, bty="n", ncol = 4) + + + + } + + if((input$matrix_UMAP2_forComparison)=="Sample"){ + legend('bottom', legend=umap_legend_names$Sample, pch=15, + col = color_umaps$Sample, + horiz = TRUE, x.intersp = 1, text.width=0.6, + cex = 0.7, bty="n") + } + + if((input$matrix_UMAP2_forComparison)=="Constrained"){ + + legend('bottom', legend=umap_legend_names$Constrained, + pch=15, col = color_umaps$Constrained, + horiz = FALSE, x.intersp = 1, text.width=0.35, + cex = 0.5, bty="n", ncol = 5) + + + } + + + if((input$matrix_UMAP2_forComparison)=="Unconstrained"){ + legend('bottom', legend=umap_legend_names$Unconstrained, + pch=15, col = color_umaps$unconstrained, + horiz = FALSE, x.intersp = 1, text.width=0.35, + cex = 0.5, bty="n", ncol = 5) + } + + + if((input$matrix_UMAP2_forComparison)=="Constrained remap"){ + legend('bottom', legend=umap_legend_names$`Constrained remap`, + pch=15, col = color_umaps$`Constrained remap`, + horiz = FALSE, x.intersp = 1, text.width=0.35, + cex = 0.7, bty="n", ncol = 4) + } + + p <- h5read("./inputData/mainUMAPs.h5", input$matrix_UMAP2_forComparison) + temp_jpg <- t(matrix(decode_native(p), nrow = 216)) + + last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.7) + + draw_plot(p_empty, scale = 0.7) + + draw_text("color", x = 0.1, y = 0.135, size = 12) + + plot2 = print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) + } + + + grid.arrange(plot2) + dev.off() + } + ) + + output$UMAP_plot_1 <- DT::renderDT(NULL) + output$UMAP_plot_2 <- DT::renderDT(NULL) + + color <- reactive({readRDS("./inputData/pal.rds")}) + scale <- reactive({readRDS("./inputData/scale.rds")}) + + #plot UMAP1 + output$UMAP_plot_1<- renderPlot({ + + + if((input$matrix_UMAP1_forComparison)=="Gene Score Matrix") + { + + p_empty <- ggplot() + + xlab("UMAP Dimension 1") + ylab("UMAP Dimension 2") + theme_bw(base_size=10)+ + ggtitle(paste0("UMAP of IterativeLSI colored by \n GeneScoreMatrix: ",input$UMAP1_forComparison)) + + theme( + panel.background = element_rect(fill='transparent'), #transparent panel bg + plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg + panel.grid.major = element_blank(), #remove major gridlines + panel.grid.minor = element_blank(), #remove minor gridlines + legend.background = element_rect(fill='transparent'), #transparent legend bg + legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), + plot.title = element_text(size=16) + ) + + emptyPlot(0,0, axes=FALSE) + legend_plot <- gradientLegend(valRange=c(scale()$gsm[,input$UMAP1_forComparison][1],scale()$gsm[,input$UMAP1_forComparison][2]), + color = color()$gsm, pos=.5, side=1) + + + p <- h5read("./inputData/plotBlank72.h5", paste0("GSM/", input$UMAP1_forComparison)) + temp_jpg <- t(matrix(decode_native(p), nrow = 216)) + + + last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + + draw_plot(p_empty, scale = 0.8) + + draw_text("Log2(+1)", x = 0.35, y = 0.05, size = 12) + + print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) + + } + + else if((input$matrix_UMAP1_forComparison)=="Gene Integration Matrix") + { + # getUmap(input$UMAP1_forComparison,GSM_Umaps_data_fileIndexer,"GSM_Umaps_data","plot_scaffold_GSM",isolate(input$matrix_UMAP1_forComparison)) + + + p_empty <- ggplot() + + xlab("UMAP Dimension 1") + ylab("UMAP Dimension 2") + theme_bw(base_size=10)+ + ggtitle(paste0("UMAP of IterativeLSI colored by \n GeneIntegrationMatrix: ",input$UMAP1_forComparison)) + + theme( + panel.background = element_rect(fill='transparent'), #transparent panel bg + plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg + panel.grid.major = element_blank(), #remove major gridlines + panel.grid.minor = element_blank(), #remove minor gridlines + legend.background = element_rect(fill='transparent'), #transparent legend bg + legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), + plot.title = element_text(size=16) + ) + + emptyPlot(0,0, axes=FALSE) + legend_plot <- gradientLegend(valRange=c(scale()$gim[,input$UMAP1_forComparison][1],scale()$gim[,input$UMAP1_forComparison][2]), + color = color()$gim, pos=.5, side=1) + + p <- h5read("./inputData/plotBlank72.h5", paste0("GIM/", input$UMAP1_forComparison)) + temp_jpg <- t(matrix(decode_native(p), nrow = 216)) + + + last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + + draw_plot(p_empty, scale = 0.8) + + draw_text("Log2(+1)", x = 0.35, y = 0.05, size = 12) + + print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) + + + } + + else if((input$matrix_UMAP1_forComparison)=="Motif Matrix") + { + p_empty <- ggplot() + + xlab("UMAP Dimension 1") + ylab("UMAP Dimension 2") + theme_bw(base_size=10)+ + ggtitle(paste0("UMAP of IterativeLSI colored by \n MotifMatrix: ",input$UMAP1_forComparison)) + + theme( + panel.background = element_rect(fill='transparent'), #transparent panel bg + plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg + panel.grid.major = element_blank(), #remove major gridlines + panel.grid.minor = element_blank(), #remove minor gridlines + legend.background = element_rect(fill='transparent'), #transparent legend bg + legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), + plot.title = element_text(size=16) + ) + + emptyPlot(0,0, axes=FALSE) + legend_plot <- gradientLegend(valRange=c(scale()$mm[,input$UMAP1_forComparison][1],scale()$mm[,input$UMAP1_forComparison][2]), + color = color()$mm, pos=.5, side=1) + + p <- h5read("./inputData/plotBlank72.h5", paste0("MM/", input$UMAP1_forComparison)) + + temp_jpg <- t(matrix(decode_native(p), nrow = 216)) + + last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + + draw_plot(p_empty, scale = 0.8) + + draw_text("Log2(+1)", x = 0.35, y = 0.05, size = 12) + + print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) + + + } + + else + { + + + if((input$matrix_UMAP1_forComparison)=="Clusters"){ + + title = "Colored by scATAC-seq clusters" + + } + + if((input$matrix_UMAP1_forComparison)=="Constrained"){ + + title = "UMAP: constrained integration" + + } + + if((input$matrix_UMAP1_forComparison)=="Constrained remap"){ + + title = "UMAP: Constrained remmaped clusters" + + } + + if((input$matrix_UMAP1_forComparison)=="Sample"){ + + title = "Colored by original identity" + + } + + if((input$matrix_UMAP1_forComparison)=="Unconstrained"){ + + title = "UMAP: unconstrained integration" + + } + + p_empty <- ggplot() + + xlab("UMAP Dimension 1") + ylab("UMAP Dimension 2") + theme_bw(base_size=10)+ + ggtitle(title) + + theme( + panel.background = element_rect(fill='transparent'), #transparent panel bg + plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg + panel.grid.major = element_blank(), #remove major gridlines + panel.grid.minor = element_blank(), #remove minor gridlines + legend.background = element_rect(fill='transparent'), #transparent legend bg + legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), + plot.title = element_text(size=16) + ) + + emptyPlot(0,0, axes=FALSE) + + if((input$matrix_UMAP1_forComparison)=="Clusters"){ + + legend('bottom', legend=umap_legend_names$Clusters, + pch=15, col = color_umaps$Clusters, + horiz = FALSE, x.intersp = 1, text.width=0.35, + cex = 0.7, bty="n", ncol = 4) + + + + } + + if((input$matrix_UMAP1_forComparison)=="Sample"){ + legend('bottom', legend=umap_legend_names$Sample, pch=15, + col = color_umaps$Sample, + horiz = TRUE, x.intersp = 1, text.width=0.6, + cex = 0.7, bty="n") + } + + if((input$matrix_UMAP1_forComparison)=="Constrained"){ + + legend('bottom', legend=umap_legend_names$Constrained, + pch=15, col = color_umaps$Constrained, + horiz = FALSE, x.intersp = 1, text.width=0.35, + cex = 0.5, bty="n", ncol = 5) + + + } + + + if((input$matrix_UMAP1_forComparison)=="Unconstrained"){ + legend('bottom', legend=umap_legend_names$Unconstrained, + pch=15, col = color_umaps$unconstrained, + horiz = FALSE, x.intersp = 1, text.width=0.35, + cex = 0.5, bty="n", ncol = 5) + } + + + if((input$matrix_UMAP1_forComparison)=="Constrained remap"){ + legend('bottom', legend=umap_legend_names$`Constrained remap`, + pch=15, col = color_umaps$`Constrained remap`, + horiz = FALSE, x.intersp = 1, text.width=0.35, + cex = 0.7, bty="n", ncol = 4) + } + + p <- h5read("./inputData/mainUMAPs.h5", input$matrix_UMAP1_forComparison)# input$UMAP1_forComparison)) + temp_jpg <- t(matrix(decode_native(p), nrow = 216)) + + last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.7) + + draw_plot(p_empty, scale = 0.7) + + draw_text("color", x = 0.1, y = 0.135, size = 12) + + print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) + + # umaps[input$matrix_UMAP1_forComparison] + + + } + + }, height = 450,width=450) + + # #plot UMAP2 + output$UMAP_plot_2<- renderPlot({ + if((input$matrix_UMAP2_forComparison)=="Gene Score Matrix") + { + + p_empty <- ggplot() + + xlab("UMAP Dimension 1") + ylab("UMAP Dimension 2") + theme_bw(base_size=10)+ + ggtitle(paste0("UMAP of IterativeLSI colored by \n GeneScoreMatrix: ",input$UMAP2_forComparison)) + + theme( + panel.background = element_rect(fill='transparent'), #transparent panel bg + plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg + panel.grid.major = element_blank(), #remove major gridlines + panel.grid.minor = element_blank(), #remove minor gridlines + legend.background = element_rect(fill='transparent'), #transparent legend bg + legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), plot.title = element_text(size=16) + ) + + emptyPlot(0,0, axes=FALSE) + legend_plot <- gradientLegend(valRange=c(scale()$gsm[,input$UMAP2_forComparison][1],scale()$gsm[,input$UMAP2_forComparison][2]), + color = color()$gsm, pos=.5, side=1) + + p <- h5read("./inputData/plotBlank72.h5", paste0("GSM/", input$UMAP2_forComparison))# input$UMAP1_forComparison)) + temp_jpg <- t(matrix(decode_native(p), nrow = 216)) + + last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + + draw_plot(p_empty, scale = 0.8) + + draw_text("Log2(+1)", x = 0.35, y = 0.05, size = 12) + + print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) + + } + + else if((input$matrix_UMAP2_forComparison)=="Gene Integration Matrix") + { + # getUmap(input$UMAP2_forComparison,GSM_Umaps_data_fileIndexer,"GSM_Umaps_data","plot_scaffold_GSM",isolate(input$matrix_UMAP2_forComparison)) + + p_empty <- ggplot() + + xlab("UMAP Dimension 1") + ylab("UMAP Dimension 2") + theme_bw(base_size=10)+ + ggtitle(paste0("UMAP of IterativeLSI colored by \n GeneIntegrationMatrix: ",input$UMAP2_forComparison)) + + theme( + panel.background = element_rect(fill='transparent'), #transparent panel bg + plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg + panel.grid.major = element_blank(), #remove major gridlines + panel.grid.minor = element_blank(), #remove minor gridlines + legend.background = element_rect(fill='transparent'), #transparent legend bg + legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), + plot.title = element_text(size=16) + ) + + emptyPlot(0,0, axes=FALSE) + legend_plot <- gradientLegend(valRange=c(scale()$gim[,input$UMAP2_forComparison][1],scale()$gim[,input$UMAP2_forComparison][2]), + color = color()$gim, pos=.5, side=1) + + p <- h5read("./inputData/plotBlank72.h5", paste0("GIM/", input$UMAP2_forComparison))# input$UMAP1_forComparison)) + temp_jpg <- t(matrix(decode_native(p), nrow = 216)) + + last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + + draw_plot(p_empty, scale = 0.8) + + draw_text("Log2(+1)", x = 0.35, y = 0.05, size = 12) + + print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) + + + } + + else if((input$matrix_UMAP2_forComparison)=="Motif Matrix") + { + # getUmap(input$UMAP2_forComparison,MM_Umaps_data_fileIndexer,"MM_Umaps_data","plot_scaffold_MM",isolate(input$matrix_UMAP2_forComparison)) + + p_empty <- ggplot() + + xlab("UMAP Dimension 1") + ylab("UMAP Dimension 2") + theme_bw(base_size=10)+ + ggtitle(paste0("UMAP of IterativeLSI colored by \n MotifMatrix: ",input$UMAP2_forComparison)) + + theme( + panel.background = element_rect(fill='transparent'), #transparent panel bg + plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg + panel.grid.major = element_blank(), #remove major gridlines + panel.grid.minor = element_blank(), #remove minor gridlines + legend.background = element_rect(fill='transparent'), #transparent legend bg + legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), + plot.title = element_text(size=16) + ) + + emptyPlot(0,0, axes=FALSE) + legend_plot <- gradientLegend(valRange=c(scale()$mm[,input$UMAP2_forComparison][1],scale()$mm[,input$UMAP2_forComparison][2]), + color = color()$mm, pos=.5, side=1) + + p <- h5read("./inputData/plotBlank72.h5", paste0("MM/", input$UMAP2_forComparison))# input$UMAP1_forComparison)) + temp_jpg <- t(matrix(decode_native(p), nrow = 216)) + + + last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + + draw_plot(p_empty, scale = 0.8) + + draw_text("Log2(+1)", x = 0.35, y = 0.05, size = 12) + + print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) + + + } + + else + { + # umaps[input$matrix_UMAP2_forComparison] + + + if((input$matrix_UMAP2_forComparison)=="Clusters"){ + + title = "Colored by scATAC-seq clusters" + + } + + if((input$matrix_UMAP2_forComparison)=="Constrained"){ + + title = "UMAP: constrained integration" + + } + + if((input$matrix_UMAP2_forComparison)=="Constrained remap"){ + + title = "UMAP: Constrained remmaped clusters" + + } + + if((input$matrix_UMAP2_forComparison)=="Sample"){ + + title = "Colored by original identity" + + } + + if((input$matrix_UMAP2_forComparison)=="Unconstrained"){ + + title = "UMAP: unconstrained integration" + + } + + p_empty <- ggplot() + + xlab("UMAP Dimension 1") + ylab("UMAP Dimension 2") + theme_bw(base_size=10)+ + ggtitle(title) + + theme( + panel.background = element_rect(fill='transparent'), #transparent panel bg + plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg + panel.grid.major = element_blank(), #remove major gridlines + panel.grid.minor = element_blank(), #remove minor gridlines + legend.background = element_rect(fill='transparent'), #transparent legend bg + legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), + plot.title = element_text(size=16) + ) + + emptyPlot(0,0, axes=FALSE) + + if((input$matrix_UMAP2_forComparison)=="Clusters"){ + + legend('bottom', legend=umap_legend_names$Clusters, + pch=15, col = color_umaps$Clusters, + horiz = FALSE, x.intersp = 1, text.width=0.35, + cex = 0.7, bty="n", ncol = 4) + + + + } + + if((input$matrix_UMAP2_forComparison)=="Sample"){ + legend('bottom', legend=umap_legend_names$Sample, pch=15, + col = color_umaps$Sample, + horiz = TRUE, x.intersp = 1, text.width=0.6, + cex = 0.7, bty="n") + } + + if((input$matrix_UMAP2_forComparison)=="Constrained"){ + + legend('bottom', legend=umap_legend_names$Constrained, + pch=15, col = color_umaps$Constrained, + horiz = FALSE, x.intersp = 1, text.width=0.35, + cex = 0.5, bty="n", ncol = 5) + + + } + + + if((input$matrix_UMAP2_forComparison)=="Unconstrained"){ + legend('bottom', legend=umap_legend_names$Unconstrained, + pch=15, col = color_umaps$unconstrained, + horiz = FALSE, x.intersp = 1, text.width=0.35, + cex = 0.5, bty="n", ncol = 5) + } + + + if((input$matrix_UMAP2_forComparison)=="Constrained remap"){ + legend('bottom', legend=umap_legend_names$`Constrained remap`, + pch=15, col = color_umaps$`Constrained remap`, + horiz = FALSE, x.intersp = 1, text.width=0.35, + cex = 0.7, bty="n", ncol = 4) + } + + p <- h5read("./inputData/mainUMAPs.h5", input$matrix_UMAP2_forComparison) + temp_jpg <- t(matrix(decode_native(p), nrow = 216)) + + last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.7) + + draw_plot(p_empty, scale = 0.7) + + draw_text("color", x = 0.1, y = 0.135, size = 12) + + print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) + + } + + } ,height = 450,width=450) + + #update Umap dropdown based on selected Matrix-------------------------------- + + #Update dropdown for UMAP1 + observeEvent(input$matrix_UMAP1_forComparison,{ + if(isolate(input$matrix_UMAP1_forComparison)=="Motif Matrix") + { + updateSelectizeInput(session, 'UMAP1_forComparison', label = 'Feature Name', + choices = sort(MM_dropdown), + server = TRUE,selected =sort(MM_dropdown)[1]) + } + + else if(isolate(input$matrix_UMAP1_forComparison)=="Gene Score Matrix") + { + updateSelectizeInput(session, 'UMAP1_forComparison', label = 'Feature Name', + choices = sort(GSM_dropdown), + server = TRUE,selected =sort(GSM_dropdown)[1]) + } + else if(isolate(input$matrix_UMAP1_forComparison)=="Gene Integration Matrix") + { + updateSelectizeInput(session, 'UMAP1_forComparison', label = 'Feature Name', + choices = sort(GIM_dropdown), + server = TRUE,selected =sort(GIM_dropdown)[1]) + } + + }) + + #Update dropdown for UMAP2 + observeEvent(input$matrix_UMAP2_forComparison,{ + if(isolate(input$matrix_UMAP2_forComparison)=="Motif Matrix") + { + + updateSelectizeInput(session, 'UMAP2_forComparison', label = 'Feature Name', + choices = sort(MM_dropdown), + server = TRUE,selected =sort(MM_dropdown)[2]) + } + + else if(isolate(input$matrix_UMAP2_forComparison)=="Gene Score Matrix") + { + updateSelectizeInput(session, 'UMAP2_forComparison', label = 'Feature Name', + choices = sort(GSM_dropdown), + server = TRUE,selected =sort(GSM_dropdown)[2]) + } + else if(isolate(input$matrix_UMAP2_forComparison)=="Gene Integration Matrix") + { + + updateSelectizeInput(session, 'UMAP2_forComparison', label = 'Feature Name', + choices = sort(GIM_dropdown), + server = TRUE,selected =sort(GIM_dropdown)[2]) + } + + }) + + # Plot Browser ---------------------------------------------------------------- + + # Observe the inputs for ATAC-Seq Explorer + observeEvent(input$range_min, { + updateSliderInput(session, "range", + value = c(input$range_min,max(input$range))) + }) + + observeEvent(input$range_max, { + updateSliderInput(session, "range", + value = c(input$range_min,input$range_max)) + }) + + 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) + }, + 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)} + + + if(isolate(input$browserContent)=="Unconstrained") + { + p_browser_atacClusters<- plotBrowserTrack( + ArchRProj = ArchRProj, + ShinyArchR = TRUE, + plotSummary = c("bulkTrack", input$selectPlotSummary), + baseSize = 11, + facetbaseSize = 11, + groupBy = "Clusters", + geneSymbol = isolate(input$gene_name), + 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(ArchRProj) + + )[[input$gene_name]] + } + else + { + + p_browser_atacClusters <- plotBrowserTrack( + ArchRProj = ArchRProj, + ShinyArchR = TRUE, + plotSummary = c("bulkTrack", input$selectPlotSummary), + groupBy = "Clusters", + baseSize = 11, + facetbaseSize = 11, + geneSymbol = isolate(input$gene_name), + upstream =-min(isolate(input$range))*1000 , + downstream = max(isolate(input$range))*1000, + tileSize = isolate(input$tile_size), + ylim = c(0, isolate(input$ymax)), + loops = getPeak2GeneLinks(ArchRProj) + )[[input$gene_name]] + } + + grid.arrange(p_browser_atacClusters) + + dev.off() + } + ) + output$browser_atacClusters <- DT::renderDT(NULL) + + #handles error + restartFN <- observeEvent(input$restartButton, { + 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() + print(p) + }) + }else{ + + # Plots scATACSeq clusters + output$browser_atacClusters<- renderPlot({ + grid::grid.newpage() + + if(isolate(input$browserContent)=="Unconstrained") + { + p_browser_atacClusters<- plotBrowserTrack( + ArchRProj = ArchRProj, + ShinyArchR = TRUE, + plotSummary = c("bulkTrack", input$selectPlotSummary), + baseSize = 11, + facetbaseSize = 11, + groupBy = "Clusters", + geneSymbol = isolate(input$gene_name), + 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(ArchRProj) + + )[[input$gene_name]] + } + else + { + p_browser_atacClusters <- plotBrowserTrack( + ArchRProj = ArchRProj, + ShinyArchR = TRUE, + plotSummary = c("bulkTrack", input$selectPlotSummary), + groupBy = "Clusters", + baseSize = 11, + facetbaseSize = 11, + geneSymbol = isolate(input$gene_name), + upstream =-min(isolate(input$range))*1000 , + downstream = max(isolate(input$range))*1000, + tileSize = isolate(input$tile_size), + ylim = c(0, isolate(input$ymax)), + loops = getPeak2GeneLinks(ArchRProj) + )[[input$gene_name]] + } + + + + grid::grid.draw(p_browser_atacClusters) + + },height = 900) + + } + }) +} diff --git a/Shiny/ui.R b/Shiny/ui.R new file mode 100644 index 00000000..8bb88b56 --- /dev/null +++ b/Shiny/ui.R @@ -0,0 +1,179 @@ +library(shinybusy) + +# This file contains UI widgets. + +# Umap plotting ---------------------------------------------------------------------- +umap_panel <- tabPanel(id="umap_panel", + + titlePanel(h5("scClusters")), + sidebarPanel( + titlePanel(h3('UMAP 1', align = 'center')), + width = 3, + h4(''), + hr(style = "border-color: grey"), + + selectizeInput( + 'matrix_UMAP1_forComparison', + label = 'UMAP type', + choices = c("Clusters","Constrained","Constrained remap","Sample","Unconstrained","Gene Score Matrix","Gene Integration Matrix","Motif Matrix"), + selected ="Clusters" + ), + + conditionalPanel(condition = "input.matrix_UMAP1_forComparison=='Gene Score Matrix' ||input.matrix_UMAP1_forComparison=='Gene Integration Matrix' || input.matrix_UMAP1_forComparison=='Motif Matrix'", + selectizeInput( + 'UMAP1_forComparison', + label = 'UMAP 1', + choices = "", + selected = NULL + )), + + 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"), + tags$head(tags$style(HTML(" + .shiny-split-layout > div { + overflow: visible;}"))) + ), + + downloadButton(outputId = "download_UMAP1", label = "Download UMAP 1"), + + titlePanel(h3('UMAP 2', align = 'center')), + hr(style = "border-color: grey"), + selectizeInput( + 'matrix_UMAP2_forComparison', + label = 'UMAP type', + choices = c("Clusters","Constrained","Constrained remap","Sample","Unconstrained","Gene Score Matrix","Gene Integration Matrix","Motif Matrix"), + selected ="Clusters" + ), + + conditionalPanel(condition = "input.matrix_UMAP2_forComparison=='Gene Score Matrix' ||input.matrix_UMAP2_forComparison=='Gene Integration Matrix' || input.matrix_UMAP2_forComparison=='Motif Matrix'", + selectizeInput( + 'UMAP2_forComparison', + label = 'UMAP 2', + choices ="", + selected = NULL + )), + + + 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"), + tags$head(tags$style(HTML(" + .shiny-split-layout > div { + overflow: visible;}"))) + ), + downloadButton(outputId = "download_UMAP2", label = "Download UMAP 2"), + + ), + + mainPanel( + verbatimTextOutput("text"), + 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")) + ) + ) +) + +# Plot Browser:scATAC Clusters -------------------------------------------------------- + +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")), + + + checkboxGroupInput(inputId = "selectPlotSummary", label = "Select track plots", + choices = c("Feature" = "featureTrack", "Loop" = "loopTrack", "Gene" = "geneTrack"), + selected = c("featureTrack", "loopTrack", "geneTrack"), + inline = TRUE), + + selectizeInput( + 'browserContent', + label = 'Type', + choices = c("Unconstrained","Constrained"), + selected = "Unconstrained" + ), + + selectizeInput( + 'gene_name', + label = 'Gene Name', + choices = sort(gene_names), + selected = sort(sort(gene_names))[1] + ), + + 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%"), + numericInput("tile_size", "TileSize:", min = 10, max = 5000, value = 250), + numericInput("ymax", "Y-Max (0,1):", min = 0, max = 1, value = 0.99) + ), + + hr(style = "border-color: grey"), + + 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"), + 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" + )), + plotOutput("browser_atacClusters") + ) +) + +ui <- shinyUI(fluidPage( + add_busy_spinner(spin = "radar", color = "#CCCCCC", onstart = TRUE, height = "55px", width = "55px"), + + navbarPage( + umap_panel, + scATACbrowser_panel, + title ="ShinyArchR Export", + tags$head(tags$style(".shiny-output-error{color: grey;}")) + ), + + tags$footer(HTML("

This webpage was made using ArchR Browser.

"), + align = "left", style = " + position:relative; + bottom:0; + color: black; + padding: 10px; + z-index: 1000;") +) +) From bef371af9b7fd92ccac85bfe4d4822f7e15d528b Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Thu, 3 Nov 2022 16:36:03 -0700 Subject: [PATCH 002/162] modifying after deploying --- Shiny/global.R | 983 ++++++++++++++++++++++++++++++++++++++++++++++++- Shiny/server.R | 46 ++- Shiny/ui.R | 2 +- 3 files changed, 1012 insertions(+), 19 deletions(-) diff --git a/Shiny/global.R b/Shiny/global.R index df2dcfdd..2ba9d18c 100644 --- a/Shiny/global.R +++ b/Shiny/global.R @@ -20,7 +20,7 @@ library(ArchR) # specify desired number of threads addArchRThreads(threads = 1) # specify genome version. Default hg19 set -addArchRGenome("hg19") +# addArchRGenome("hg19") set.seed(1) # Load all hidden ArchR functions ------------------------------------------------ @@ -32,6 +32,52 @@ for (i in seq_along(fn)) { }) } +#' Load Previous ArchRProject into R +#' +#' This function will load a previously saved ArchRProject and re-normalize paths for usage. +#' +#' @param path A character path to an `ArchRProject` directory that was previously saved using `saveArchRProject()`. +#' @param force A boolean value indicating whether missing optional `ArchRProject` components (i.e. peak annotations / +#' background peaks) should be ignored when re-normalizing file paths. If set to `FALSE` loading of the `ArchRProject` +#' will fail unless all components can be found. +#' @param showLogo A boolean value indicating whether to show the ascii ArchR logo after successful creation of an `ArchRProject`. +#' @export +myLoadArchRProject <- function( + path = "./", + force = FALSE, + showLogo = TRUE +){ + + .validInput(input = path, name = "path", valid = "character") + .validInput(input = force, name = "force", valid = "boolean") + .validInput(input = showLogo, name = "showLogo", valid = "boolean") + + path2Proj <- file.path(path, "Save-ArchR-Project.rds") + + if(!file.exists(path2Proj)){ + stop("Could not find previously saved ArchRProject in the path specified!, + Please ") + } + + ArchRProj <- recoverArchRProject(readRDS(path2Proj)) + outputDir <- getOutputDirectory(ArchRProj) + outputDirNew <- normalizePath(path) + + + ArchRProj@projectMetadata$outputDirectory <- outputDirNew + + message("Successfully loaded ArchRProject!") + if(showLogo){ + .ArchRLogo(ascii = "Logo") + } + + ArchRProj + +} +print("start") +ArchRProj=myLoadArchRProject("./inputData/") +print("load") + # UMAP Visualization ------------------------------------------------------------ # create a list of dropdown options for umap tab @@ -76,4 +122,937 @@ getUmap<-function(gene,fileIndexer,folderName,scaffoldName,matrixType) # PlotBrowser ------------------------------------------------------------------ # create a list of dropdown options for plotbroswer tab -gene_names=readRDS("./inputData/gene_names.rds") \ No newline at end of file +gene_names=readRDS("./inputData/gene_names.rds") + +#Extend where upstream can be negative for browser +extendGR2 <- function(gr = NULL, upstream = NULL, downstream = NULL){ + .validInput(input = gr, name = "gr", valid = c("GRanges")) + .validInput(input = upstream, name = "upstream", valid = c("integer")) + .validInput(input = downstream, name = "downstream", valid = c("integer")) + #Get Info From gr + st <- start(gr) + ed <- end(gr) + #https://bioinformatics.stackexchange.com/questions/4390/expand-granges-object-different-amounts-upstream-vs-downstream + isMinus <- BiocGenerics::which(strand(gr) == "-") + isOther <- BiocGenerics::which(strand(gr) != "-") + #Forward + st[isOther] <- st[isOther] - upstream + ed[isOther] <- ed[isOther] + downstream + #Reverse + ed[isMinus] <- ed[isMinus] + upstream + st[isMinus] <- st[isMinus] - downstream + #If Any extensions now need to be flipped. + end(gr) <- pmax(st, ed) + start(gr) <- pmin(st, ed) + return(gr) +} + +.subsetSeqnamesGR <- function(gr = NULL, names = NULL){ + .validInput(input = gr, name = "gr", valid = c("GRanges")) + .validInput(input = names, name = "names", valid = c("character")) + gr <- gr[which(as.character(seqnames(gr)) %in% names),] + seqlevels(gr) <- as.character(unique(seqnames(gr))) + return(gr) +} + +.myQuantileCut <- function(x = NULL, lo = 0.025, hi = 0.975, maxIf0 = TRUE, na.rm = TRUE){ + q <- quantile(x, probs = c(lo,hi), na.rm = TRUE) + if(q[2] == 0){ + if(maxIf0){ + q[2] <- max(x) + } + } + x[x < q[1]] <- q[1] + x[x > q[2]] <- q[2] + return(x) +} + +#' Plot an ArchR Region Track +#' +#' This function will plot the coverage at an input region in the style of a browser track. It allows for normalization of the signal +#' which enables direct comparison across samples. +#' +#' @param ArchRProj An `ArchRProject` object. +#' @param region A `GRanges` region that indicates the region to be plotted. If more than one region exists in the `GRanges` object, +#' all will be plotted. If no region is supplied, then the `geneSymbol` argument can be used to center the plot window at the +#' transcription start site of the supplied gene. +#' @param groupBy A string that indicates how cells should be grouped. This string corresponds to one of the standard or +#' user-supplied `cellColData` metadata columns (for example, "Clusters"). Cells with the same value annotated in this metadata +#' column will be grouped together and the average signal will be plotted. +#' @param useGroups A character vector that is used to select a subset of groups by name from the designated `groupBy` column in +#' `cellColData`. This limits the groups to be plotted. +#' @param plotSummary A character vector containing the features to be potted. Possible values include "bulkTrack" (the ATAC-seq signal), +#' "scTrack" (scATAC-seq signal), "featureTrack" (i.e. the peak regions), "geneTrack" (line diagrams of genes with introns and exons shown. +#' Blue-colored genes are on the minus strand and red-colored genes are on the plus strand), and "loopTrack" (links between a peak and a gene). +#' @param sizes A numeric vector containing up to 3 values that indicate the sizes of the individual components passed to `plotSummary`. +#' The order must be the same as `plotSummary`. +#' @param features A `GRanges` object containing the "features" to be plotted via the "featureTrack". This should be thought of as a +#' bed track. i.e. the set of peaks obtained using `getPeakSet(ArchRProj))`. +#' @param loops A `GRanges` object containing the "loops" to be plotted via the "loopTrack". +#' This `GRanges` object start represents the center position of one loop anchor and the end represents the center position of another loop anchor. +#' A "loopTrack" draws an arc between two genomic regions that show some type of interaction. This type of track can be used +#' to display chromosome conformation capture data or co-accessibility links obtained using `getCoAccessibility()`. +#' @param geneSymbol If `region` is not supplied, plotting can be centered at the transcription start site corresponding to the gene symbol(s) passed here. +#' @param useMatrix If supplied geneSymbol, one can plot the corresponding GeneScores/GeneExpression within this matrix. I.E. "GeneScoreMatrix" +#' @param log2Norm If supplied geneSymbol, Log2 normalize the corresponding GeneScores/GeneExpression matrix before plotting. +#' @param upstream The number of basepairs upstream of the transcription start site of `geneSymbol` to extend the plotting window. +#' If `region` is supplied, this argument is ignored. +#' @param downstream The number of basepairs downstream of the transcription start site of `geneSymbol` to extend the plotting window. +#' If `region` is supplied, this argument is ignored. +#' @param tileSize The numeric width of the tile/bin in basepairs for plotting ATAC-seq signal tracks. All insertions in a single bin will be summed. +#' @param minCells The minimum number of cells contained within a cell group to allow for this cell group to be plotted. This argument can be +#' used to exclude pseudo-bulk replicates generated from low numbers of cells. +#' @param normMethod The name of the column in `cellColData` by which normalization should be performed. The recommended and default value +#' is "ReadsInTSS" which simultaneously normalizes tracks based on sequencing depth and sample data quality. +#' @param threads The number of threads to use for parallel execution. +#' @param ylim The numeric quantile y-axis limit to be used for for "bulkTrack" plotting. If not provided, the y-axis limit will be c(0, 0.999). +#' @param pal A custom palette (see `paletteDiscrete` or `ArchRPalettes`) used to override coloring for groups. +#' @param baseSize The numeric font size to be used in the plot. This applies to all plot labels. +#' @param scTileSize The width of the tiles in scTracks. Larger numbers may make cells overlap more. Default is 0.5 for about 100 cells. +#' @param scCellsMax The maximum number of cells for scTracks. +#' @param borderWidth The numeric line width to be used for plot borders. +#' @param tickWidth The numeric line width to be used for axis tick marks. +#' @param facetbaseSize The numeric font size to be used in the facets (gray boxes used to provide track labels) of the plot. +#' @param geneAnnotation The `geneAnnotation` object to be used for plotting the "geneTrack" object. See `createGeneAnnotation()` for more info. +#' @param title The title to add at the top of the plot next to the plot's genomic coordinates. +#' @param verbose A boolean value that determines whether standard output should be printed. +#' @param logFile The path to a file to be used for logging ArchR output. +#' @export +plotBrowserTrack_Test <- function( + ArchRProj = NULL, + region = NULL, + groupBy = "Clusters", + useGroups = NULL, + plotSummary = c("bulkTrack", "featureTrack", "loopTrack", "geneTrack"), + sizes = c(10, 1.5, 3, 4), + features = getPeakSet(ArchRProj), + loops = getCoAccessibility(ArchRProj), + geneSymbol = NULL, + useMatrix = NULL, + log2Norm = TRUE, + upstream = 50000, + downstream = 50000, + tileSize = 100, + minCells = 25, + normMethod = "ReadsInTSS", + threads = getArchRThreads(), + ylim = NULL, + pal = NULL, + baseSize = 7, + scTileSize = 0.5, + scCellsMax = 100, + borderWidth = 0.4, + tickWidth = 0.4, + facetbaseSize = 7, + geneAnnotation = getGeneAnnotation(ArchRProj), + title = "", + verbose = TRUE, + logFile = createLogFile("plotBrowserTrack") +){ + + .validInput(input = ArchRProj, name = "ArchRProj", valid = "ArchRProj") + .validInput(input = region, name = "region", valid = c("granges","null")) + .validInput(input = groupBy, name = "groupBy", valid = "character") + .validInput(input = useGroups, name = "useGroups", valid = c("character", "null")) + .validInput(input = plotSummary, name = "plotSummary", valid = "character") + .validInput(input = sizes, name = "sizes", valid = "numeric") + .validInput(input = features, name = "features", valid = c("granges", "grangeslist", "null")) + .validInput(input = loops, name = "loops", valid = c("granges", "grangeslist", "null")) + .validInput(input = geneSymbol, name = "geneSymbol", valid = c("character", "null")) + .validInput(input = useMatrix, name = "useMatrix", valid = c("character", "null")) + .validInput(input = log2Norm, name = "log2Norm", valid = c("boolean")) + .validInput(input = upstream, name = "upstream", valid = c("integer")) + .validInput(input = downstream, name = "downstream", valid = c("integer")) + .validInput(input = tileSize, name = "tileSize", valid = c("integer")) + .validInput(input = minCells, name = "minCells", valid = c("integer")) + .validInput(input = normMethod, name = "normMethod", valid = c("character")) + .validInput(input = threads, name = "threads", valid = c("integer")) + .validInput(input = ylim, name = "ylim", valid = c("numeric", "null")) + .validInput(input = pal, name = "pal", valid = c("palette", "null")) + .validInput(input = baseSize, name = "baseSize", valid = "numeric") + .validInput(input = scTileSize, name = "scTileSize", valid = "numeric") + .validInput(input = scCellsMax, name = "scCellsMax", valid = "integer") + .validInput(input = borderWidth, name = "borderWidth", valid = "numeric") + .validInput(input = tickWidth, name = "tickWidth", valid = "numeric") + .validInput(input = facetbaseSize, name = "facetbaseSize", valid = "numeric") + geneAnnotation <- .validGeneAnnotation(geneAnnotation) + .validInput(input = title, name = "title", valid = "character") + + tstart <- Sys.time() + .startLogging(logFile=logFile) + .logThis(mget(names(formals()),sys.frame(sys.nframe())), "plotBrowserTrack Input-Parameters", logFile = logFile) + + + # Get Region Where Plot Will Occur (GenomicRanges) ------------------------------------------------------------------ + .logDiffTime("Validating Region", t1=tstart, verbose=verbose, logFile=logFile) + if(is.null(region)){ + if(!is.null(geneSymbol)){ + region <- geneAnnotation$genes + region <- region[which(tolower(mcols(region)$symbol) %in% tolower(geneSymbol))] + region <- region[order(match(tolower(mcols(region)$symbol), tolower(geneSymbol)))] + print(region) + region <- resize(region, 1, "start") + strand(region) <- "*" + region <- extendGR(region, upstream = upstream, downstream = downstream) + } + } + region <- .validGRanges(region) + .logThis(region, "region", logFile = logFile) + + if(is.null(geneSymbol)){ + useMatrix <- NULL + } + + if(!is.null(useMatrix)){ + featureMat <- .getMatrixValues( + ArchRProj = ArchRProj, + matrixName = useMatrix, + name = mcols(region)$symbol + ) + if(log2Norm){ + featureMat <- log2(featureMat + 1) + } + featureMat <- data.frame(t(featureMat)) + featureMat$Group <- getCellColData(ArchRProj, groupBy, drop = FALSE)[rownames(featureMat), 1] + } + + ggList <- lapply(seq_along(region), function(x){ + + plotList <- list() + + + # Bulk Tracks ------------------------------------------------------------------ + + if("bulktrack" %in% tolower(plotSummary)){ + .logDiffTime(sprintf("Adding Bulk Tracks (%s of %s)",x,length(region)), t1=tstart, verbose=verbose, logFile=logFile) + plotList$bulktrack <- .bulkTracks( + ArchRProj = ArchRProj, + region = region[x], + tileSize = tileSize, + groupBy = groupBy, + threads = threads, + minCells = minCells, + pal = pal, + ylim = ylim, + baseSize = baseSize, + borderWidth = borderWidth, + tickWidth = tickWidth, + facetbaseSize = facetbaseSize, + normMethod = normMethod, + geneAnnotation = geneAnnotation, + title = title, + useGroups = useGroups, + tstart = tstart, + logFile = logFile) + theme(plot.margin = unit(c(0.35, 0.75, 0.35, 0.75), "cm")) + } + + + # Feature Tracks ------------------------------------------------------------------ + + if("featuretrack" %in% tolower(plotSummary)){ + if(!is.null(features)){ + .logDiffTime(sprintf("Adding Feature Tracks (%s of %s)",x,length(region)), t1=tstart, verbose=verbose, logFile=logFile) + plotList$featuretrack <- .featureTracks( + features = features, + region = region[x], + facetbaseSize = facetbaseSize, + hideX = TRUE, + title = "Peaks", + logFile = logFile) + theme(plot.margin = unit(c(0.1, 0.75, 0.1, 0.75), "cm")) + } + } + + + # Loop Tracks ------------------------------------------------------------------ + if("looptrack" %in% tolower(plotSummary)){ + if(!is.null(loops)){ + .logDiffTime(sprintf("Adding Loop Tracks (%s of %s)",x,length(region)), t1=tstart, verbose=verbose, logFile=logFile) + plotList$looptrack <- .loopTracks( + loops = loops, + region = region[x], + facetbaseSize = facetbaseSize, + hideX = TRUE, + hideY = TRUE, + title = "Loops", + logFile = logFile) + theme(plot.margin = unit(c(0.1, 0.75, 0.1, 0.75), "cm")) + } + } + + + # Gene Tracks ------------------------------------------------------------------ + if("genetrack" %in% tolower(plotSummary)){ + .logDiffTime(sprintf("Adding Gene Tracks (%s of %s)",x,length(region)), t1=tstart, verbose=verbose, logFile=logFile) + plotList$genetrack <- .geneTracks( + geneAnnotation = geneAnnotation, + region = region[x], + facetbaseSize = facetbaseSize, + title = "Genes", + logFile = logFile) + theme(plot.margin = unit(c(0.1, 0.75, 0.1, 0.75), "cm")) + } + + # Time to plot ------------------------------------------------------------------ + plotSummary <- tolower(plotSummary) + names(sizes) <- plotSummary + sizes <- sizes[order(plotSummary)] + plotSummary <- plotSummary[order(plotSummary)] + + sizes <- sizes[tolower(names(plotList))] + + if(!is.null(useMatrix)){ + + suppressWarnings(.combinedFeaturePlot( + plotList = plotList, + log2Norm = log2Norm, + featureMat = featureMat, + feature = region[x]$symbol[[1]], + useMatrix = useMatrix, + pal = pal, + sizes = sizes, + baseSize = baseSize, + facetbaseSize = facetbaseSize, + borderWidth = borderWidth, + tickWidth = tickWidth + )) + + }else{ + + .logThis(names(plotList), sprintf("(%s of %s) names(plotList)",x,length(region)), logFile=logFile) + .logThis(sizes, sprintf("(%s of %s) sizes",x,length(region)), logFile=logFile) + .logDiffTime("Plotting", t1=tstart, verbose=verbose, logFile=logFile) + + tryCatch({ + suppressWarnings(ggAlignPlots(plotList = plotList, sizes=sizes, draw = FALSE)) + }, error = function(e){ + .logMessage("Error with plotting, diagnosing each element", verbose = TRUE, logFile = logFile) + for(i in seq_along(plotList)){ + tryCatch({ + print(plotList[[i]]) + }, error = function(f){ + .logError(f, fn = names(plotList)[i], info = "", errorList = NULL, logFile = logFile) + }) + } + .logError(e, fn = "ggAlignPlots", info = "", errorList = NULL, logFile = logFile) + }) + + } + + }) + + if(!is.null(mcols(region)$symbol)){ + names(ggList) <- mcols(region)$symbol + }else{ + if(length(ggList) == 1){ + ggList <- ggList[[1]] + } + } + + .endLogging(logFile=logFile) + + ggList + +} + +# Bulk Aggregated ATAC Track Methods -------------------------------------------- +.bulkTracks <- function( + ArchRProj = NULL, + region = NULL, + tileSize = 100, + minCells = 25, + groupBy = "Clusters", + useGroups = NULL, + normMethod = "ReadsInTSS", + threads = 1, + ylim = NULL, + baseSize = 7, + borderWidth = 0.4, + tickWidth = 0.4, + facetbaseSize = 7, + geneAnnotation = getGeneAnnotation(ArchRProj), + title = "", + pal = NULL, + tstart = NULL, + verbose = FALSE, + logFile = NULL +){ + + .requirePackage("ggplot2", source = "cran") + + if(is.null(tstart)){ + tstart <- Sys.time() + } + + df <- .groupRegionSumCvg( + ArchRProj = ArchRProj, + groupBy = groupBy, + normMethod = normMethod, + useGroups = useGroups, + minCells = minCells, + region = region, + tileSize = tileSize, + threads = threads, + verbose = verbose, + logFile = logFile + ) + .logThis(split(df, df[,3]), ".bulkTracks df", logFile = logFile) + + # Plot Track ------------------------------------------------------------------ + if(!is.null(ylim)){ + ylim <- quantile(df$y, ylim) + df$y[df$y < ylim[1]] <- ylim[1] + df$y[df$y > ylim[2]] <- ylim[2] + }else{ + ylim <- c(0,quantile(df$y, probs=c(0.999))) + df$y[df$y < ylim[1]] <- ylim[1] + df$y[df$y > ylim[2]] <- ylim[2] + } + uniqueGroups <- gtools::mixedsort(unique(paste0(df$group))) + if(!is.null(useGroups)){ + uniqueGroups <- unique(useGroups) + } + df$group <- factor(df$group, levels = uniqueGroups) + title <- paste0(as.character(seqnames(region)),":", start(region)-1, "-", end(region), " ", title) + + allGroups <- gtools::mixedsort(unique(getCellColData(ArchRProj = ArchRProj, select = groupBy, drop = TRUE))) + + if(is.null(pal)){ + pal <- suppressWarnings(paletteDiscrete(values = allGroups)) + } + + p <- ggplot(df, aes_string("x","y", color = "group", fill = "group")) + + geom_area(stat = "identity") + + facet_wrap(facets = ~group, strip.position = 'right', ncol = 1) + + ylab(sprintf("Coverage\n(Norm. ATAC Signal Range (%s-%s) by %s)", round(min(ylim),2), round(max(ylim),2), normMethod)) + + scale_color_manual(values = pal) + + scale_fill_manual(values = pal) + + scale_x_continuous(limits = c(start(region), end(region)), expand = c(0,0)) + + scale_y_continuous(limits = ylim, expand = c(0,0)) + + theme_ArchR(baseSize = baseSize, + baseRectSize = borderWidth, + baseLineSize = tickWidth, + legendPosition = "right", + axisTickCm = 0.1) + + theme(panel.spacing= unit(0, "lines"), + axis.title.x=element_blank(), + axis.text.y=element_blank(), + axis.ticks.y=element_blank(), + strip.text = element_text( + size = facetbaseSize, + color = "black", + margin = margin(0,0.35,0,0.35, "cm")), + strip.text.y = element_text(angle = 0), + strip.background = element_rect(color="black")) + + guides(fill = FALSE, colour = FALSE) + ggtitle(title) + + p + +} + +# Create Average Tracks from Coverage Objects ----------------------------------- +.groupRegionSumCvg <- function( + ArchRProj = NULL, + useGroups = NULL, + groupBy = NULL, + region = NULL, + tileSize = NULL, + normMethod = NULL, + verbose = FALSE, + minCells = 25, + maxCells = 500, + threads = NULL, + logFile = NULL +){ + + # Group Info + cellGroups <- getCellColData(ArchRProj, groupBy, drop = TRUE) + tabGroups <- table(cellGroups) + + + groupsBySample <- split(cellGroups, getCellColData(ArchRProj, "Sample", drop = TRUE)) + uniqueGroups <- gtools::mixedsort(unique(cellGroups)) + + # Tile Region + regionTiles <- (seq(trunc(start(region) / tileSize), + trunc(end(region) / tileSize) + 1) * tileSize) + 1 + allRegionTilesGR <- GRanges( + seqnames = seqnames(region), + ranges = IRanges(start = regionTiles, width=100) + ) + + cvgObjs = list.files(path = "./coverage", full.names = TRUE) + allCvgGR = c() + for(i in seq_along(cvgObjs)) { + cvgrds <- readRDS(cvgObjs[[i]]) + gr <- GRanges(cvgrds) + allCvgGR = c(allCvgGR, gr) + } + + groupMat <- .safelapply(seq_along(allCvgGR), function(i){ + .logMessage(sprintf("Getting Region From Coverage Objects %s of %s", i, length(allCvgGR)), logFile = logFile) + tryCatch({ + .regionSumCvg( + cvgObj = allCvgGR[[i]], + region = region, + regionTiles = regionTiles, + allRegionTilesGR = allRegionTilesGR, + tileSize = tileSize, + ) + }, error = function(e){ + errorList <- list( + cvgObj = allCvgGR[[i]], + region = region, + regionTiles = regionTiles, + allRegionTilesGR = allRegionTilesGR, + tileSize = tileSize, + ) + }) + }, threads = threads) %>% do.call(cbind, .) + + # Plot DF ------------------------------------------------------------------ + df <- data.frame(which(groupMat > 0, arr.ind=TRUE)) + # df$y stores the non-zero scores. + df$y <- groupMat[cbind(df[,1], df[,2])] + + #Minus 1 Tile Size + dfm1 <- df + dfm1$row <- dfm1$row - 1 + dfm1$y <- 0 + + #Plus 1 Size + dfp1 <- df + dfp1$row <- dfp1$row + 1 + dfp1$y <- 0 + + #Create plot DF + df <- rbind(df, dfm1, dfp1) + df <- df[!duplicated(df[,1:2]),] + df <- df[df$row > 0,] + # df$x are the regionTiles that have a non-zero score. + df$x <- regionTiles[df$row] + #NA from below + df$group <- uniqueGroups[df$col] + + #Add In Ends + dfs <- data.frame( + col = seq_along(uniqueGroups), + row = 1, + y = 0, + x = start(region), + group = uniqueGroups + ) + + dfe <- data.frame( + col = seq_along(uniqueGroups), + row = length(regionTiles), + y = 0, + x = end(region), + group = uniqueGroups + ) + + # Final output + plotDF <- rbind(df,dfs,dfe) + plotDF <- df[order(df$group,df$x),] + plotDF <- df[,c("x", "y", "group")] + + # Normalization + g <- getCellColData(ArchRProj, groupBy, drop = TRUE) + + if(tolower(normMethod) %in% c("readsintss","readsinpromoter", "nfrags")) { + v <- getCellColData(ArchRProj, normMethod, drop = TRUE) + groupNormFactors <- unlist(lapply(split(v, g), sum)) + }else if(tolower(normMethod) == "ncells"){ + groupNormFactors <- table(g) + }else if(tolower(normMethod) == "none"){ + groupNormFactors <- rep(10^4, length(g)) + names(groupNormFactors) <- g + }else{ + stop("Norm Method Not Recognized : ", normMethod) + } + + # Scale with Norm Factors + scaleFactors <- 10^4 / groupNormFactors + matchGroup <- match(paste0(plotDF$group), names(scaleFactors)) + plotDF$y <- plotDF$y * as.vector(scaleFactors[matchGroup]) + + return(plotDF) + +} + +.regionSumCvg <- function( + cvgObj = NULL, + region = NULL, + regionTiles = NULL, + allRegionTilesGR = NULL, + tileSize = NULL, + logFile = NULL +){ + + hits <- findOverlaps(query = allRegionTilesGR, subject = cvgObj) + clusterVector <- cvgObj$score[subjectHits(hits)] + + return(clusterVector) + +} + +# Gene Tracks ------------------------------------------------------------------ + +.geneTracks <- function( + geneAnnotation = NULL, + region = NULL, + baseSize = 9, + borderWidth = 0.4, + title = "Genes", + geneWidth = 2, + exonWidth = 4, + labelSize = 2, + facetbaseSize, + colorMinus = "dodgerblue2", + colorPlus = "red", + logFile = NULL +){ + + .requirePackage("ggplot2", source = "cran") + .requirePackage("ggrepel", source = "cran") + + # only take first region + region <- .validGRanges(region) + region <- .subsetSeqnamesGR(region[1], as.character(seqnames(region[1]))) + + genes <- sort(sortSeqlevels(geneAnnotation$genes), ignore.strand = TRUE) + exons <- sort(sortSeqlevels(geneAnnotation$exons), ignore.strand = TRUE) + genesO <- data.frame(subsetByOverlaps(genes, region, ignore.strand = TRUE)) + + if(nrow(genesO) > 0){ + + # Identify Info for Exons and Genes + exonsO <- data.frame(subsetByOverlaps(exons, region, ignore.strand = TRUE)) + exonsO <- exonsO[which(exonsO$symbol %in% genesO$symbol),] + genesO$facet = title + genesO$start <- matrixStats::rowMaxs(cbind(genesO$start, start(region))) + genesO$end <- matrixStats::rowMins(cbind(genesO$end, end(region))) + + # Collapse Iteratively + # backwards iteration so that the last value chosen is the lowest cluster possible to fit in. + genesO$cluster <- 0 + for(i in seq_len(nrow(genesO))){ + if(i==1){ + genesO$cluster[i] <- 1 + }else{ + for(j in seq_len(max(genesO$cluster))){ + jEnd <- rev(genesO$end)[match(rev(seq_len(max(genesO$cluster)))[j], rev(genesO$cluster))] + if(genesO$start[i] > jEnd + median(genesO$width)){ + genesO$cluster[i] <- rev(genesO$cluster)[match(rev(seq_len(max(genesO$cluster)))[j],rev(genesO$cluster))] + } + } + if(genesO$cluster[i]==0){ + genesO$cluster[i] <- genesO$cluster[i-1] + 1 + } + } + } + exonsO$cluster <- genesO$cluster[match(exonsO$symbol, genesO$symbol)] + pal <- c("-"=colorMinus,"+"=colorPlus,"*"=colorPlus) + + p <- ggplot(data = genesO, aes(color = strand, fill = strand)) + + facet_grid(facet~.) + + + # Limits + ylim(c(0.5, max(genesO$cluster) + 0.5)) + + scale_x_continuous(limits = c(start(region), end(region)), expand = c(0,0)) + + + # Segment for Not Minus Stranded + geom_segment(data = genesO[which(as.character(genesO$strand)!="-"),], + aes(x = start, xend = end, y = cluster, yend = cluster, color = strand),size=geneWidth) + + + # Segment for Minus Stranded + geom_segment(data = genesO[which(as.character(genesO$strand)=="-"),], + aes(x = end, xend = start, y = cluster, yend = cluster, color = strand),size=geneWidth) + + + # Segement for Exons + geom_segment(data = exonsO, aes(x = start, xend = end, y = cluster, + yend = cluster, color = strand),size=exonWidth) + + + # Colors + scale_color_manual(values = pal, guide = FALSE) + + scale_fill_manual(values = pal) + + + # Theme + theme_ArchR(baseSize = baseSize, baseLineSize = borderWidth, baseRectSize = borderWidth) + + theme(axis.title.x=element_blank(), axis.text.x=element_blank(),axis.ticks.x=element_blank()) + + theme(axis.title.y=element_blank(), axis.text.y=element_blank(),axis.ticks.y=element_blank()) + + theme(legend.text = element_text(size = baseSize), strip.text.y = element_text(size = facetbaseSize, angle = 0)) + + guides(fill = guide_legend(override.aes = list(colour = NA, shape = "c", size=3)), color = FALSE) + + theme(legend.position="bottom") + + theme(legend.title=element_text(size=5), legend.text=element_text(size=7), + legend.key.size = unit(0.75,"line"), legend.background = element_rect(color =NA), strip.background = element_blank()) + + # Add Labels if There are Genes with this orientation! + if(length(which(genesO$strand!="-")) > 0){ + p <- p + ggrepel::geom_label_repel(data=genesO[which(genesO$strand!="-"),], + aes(x = start, y = cluster, label = symbol, color = strand), + segment.color = "grey", nudge_x = -0.01*(end(region) - start(region)), nudge_y = -0.25, + size = labelSize, direction = "x", inherit.aes=FALSE) + } + + # Add Labels if There are Genes with this orientation! + if(length(which(genesO$strand=="-")) > 0){ + p <- p + ggrepel::geom_label_repel(data=genesO[which(genesO$strand=="-"),], + aes(x = end, y = cluster, label = symbol, color = strand), + segment.color = "grey", nudge_x = +0.01*(end(region) - start(region)), nudge_y = 0.25, + size = labelSize, direction = "x", inherit.aes=FALSE) + } + + p <- p + theme(legend.justification = c(0, 1), + legend.background = element_rect(colour = NA, fill = NA), legend.position="none") + + }else{ + + # create empty plot + df <- data.frame(facet = "GeneTrack", start = 0, end = 0, strand = "*", symbol = "none") + pal <- c("*"=colorPlus) + p <- ggplot(data = df, aes(start, end, fill = strand)) + geom_point() + + facet_grid(facet~.) + + theme_ArchR(baseSize = baseSize, baseLineSize = borderWidth, baseRectSize = borderWidth) + + scale_color_manual(values = pal) + + scale_x_continuous(limits = c(start(region), end(region)), expand = c(0,0)) + + theme(axis.title.x=element_blank(), axis.text.x=element_blank(),axis.ticks.x=element_blank()) + + theme(axis.title.y=element_blank(), axis.text.y=element_blank(),axis.ticks.y=element_blank()) + + } + + if(!is.ggplot(p)){ + .logError("geneTrack is not a ggplot!", fn = ".geneTracks", info = "", errorList = NULL, logFile = logFile) + } + + return(p) + +} + +# Feature Tracks ------------------------------------------------------------------ + +.featureTracks <- function( + features = NULL, + region = NULL, + title = "FeatureTrack", + pal = NULL, + baseSize = 9, + facetbaseSize = NULL, + featureWidth = 2, + borderWidth = 0.4, + hideX = FALSE, + hideY = FALSE, + logFile = NULL +){ + + .requirePackage("ggplot2", source = "cran") + + # only take first region + region <- .validGRanges(region) + region <- .subsetSeqnamesGR(region[1], as.character(seqnames(region[1]))) + + if(!is.null(features)){ + + if(!.isGRList(features)){ + features <- .validGRanges(features) + featureList <- SimpleList(FeatureTrack = features) + hideY <- TRUE + }else{ + featureList <- features + hideY <- FALSE + } + featureList <- featureList[rev(seq_along(featureList))] + + featureO <- lapply(seq_along(featureList), function(x){ + featurex <- featureList[[x]] + namex <- names(featureList)[x] + mcols(featurex) <- NULL + sub <- subsetByOverlaps(featurex, region, ignore.strand = TRUE) + if(length(sub) > 0){ + data.frame(sub, name = namex) + }else{ + empty <- GRanges(as.character(seqnames(region[1])), ranges = IRanges(0,0)) + data.frame(empty, name = namex) + } + + }) + + featureO <- Reduce("rbind", featureO) + + .logThis(featureO, "featureO", logFile = logFile) + + featureO$facet <- title + + if(is.null(pal)){ + pal <- paletteDiscrete(set = "stallion", values = rev(unique(paste0(featureO$name)))) + } + + featureO$name <- factor(paste0(featureO$name), levels=names(featureList)) + + p <- ggplot(data = featureO, aes(color = name)) + + facet_grid(facet~.) + + geom_segment(data = featureO, aes(x = start, xend = end, y = name, yend = name, color = name), size=featureWidth) + + ylab("") + xlab("") + + scale_x_continuous(limits = c(start(region), end(region)), expand = c(0,0)) + + scale_color_manual(values = pal) + + theme(legend.text = element_text(size = baseSize)) + + theme_ArchR(baseSize = baseSize, baseLineSize = borderWidth, baseRectSize = borderWidth) + + guides(color = FALSE, fill = FALSE) + theme(strip.text.y = element_text(size = facetbaseSize, angle = 0), strip.background = element_blank()) + + }else{ + + # create empty plot + df <- data.frame(facet = "FeatureTrack", start = 0, end = 0, strand = "*", symbol = "none") + p <- ggplot(data = df, aes(start, end)) + + geom_point() + + facet_grid(facet~.) + + theme_ArchR(baseSize = baseSize, baseLineSize = borderWidth, baseRectSize = borderWidth) + + scale_x_continuous(limits = c(start(region), end(region)), expand = c(0,0)) + + theme(axis.title.x=element_blank(), axis.text.x=element_blank(),axis.ticks.x=element_blank()) + + theme(axis.title.y=element_blank(), axis.text.y=element_blank(),axis.ticks.y=element_blank()) + + } + + if(hideX){ + p <- p + theme(axis.title.x=element_blank(), axis.text.x=element_blank(), axis.ticks.x=element_blank()) + } + + if(hideY){ + p <- p + theme(axis.title.y=element_blank(), axis.text.y=element_blank(), axis.ticks.y=element_blank()) + } + + if(!is.ggplot(p)){ + .logError("featureTrack is not a ggplot!", fn = ".featureTracks", info = "", errorList = NULL, logFile = logFile) + } + + return(p) + +} + +# Loop Tracks +.loopTracks <- function( + loops = NULL, + region = NULL, + title = "LoopTrack", + pal = NULL, + baseSize = 9, + facetbaseSize = 9, + featureWidth = 2, + borderWidth = 0.4, + hideX = FALSE, + hideY = FALSE, + logFile = NULL +){ + + getArchDF <- function(lp, r = 100){ + angles <- seq(pi, 2*pi,length.out=100) + rx <- (end(lp)-start(lp))/2 + rscale <- r * (rx/max(rx)) + cx <- start(lp) + rx + if(is.null(mcols(lp)$value)){ + mcols(lp)$value <- 1 + } + df <- lapply(seq_along(cx), function(z){ + xz <- rx[z]*cos(angles)+cx[z] + dfz <- DataFrame(x=xz, y=rscale[z]*sin(angles), id=Rle(paste0("l",z)), value = mcols(lp)$value[z]) + }) %>% Reduce("rbind",.) + return(df) + } + + if(!is.null(loops)){ + + if(is(loops, "GRanges")){ + loops <- SimpleList(Loops = loops) + }else if(.isGRList(loops)){ + }else{ + stop("Loops is not a GRanges or a list of GRanges! Please supply valid input!") + } + + valueMin <- min(unlist(lapply(loops, function(x) min(x$value)))) + valueMax <- max(unlist(lapply(loops, function(x) max(x$value)))) + + loopO <- lapply(seq_along(loops), function(x){ + subLoops <- subsetByOverlaps(loops[[x]], region, ignore.strand = TRUE, type = "within") + if(length(subLoops)>0){ + dfx <- getArchDF(subLoops) + dfx$name <- Rle(paste0(names(loops)[x])) + dfx + }else{ + NULL + } + }) %>% Reduce("rbind",.) + .logThis(loopO, "loopO", logFile = logFile) + + testDim <- tryCatch({ + if(is.null(loopO)){ + FALSE + } + if(nrow(loopO) > 0){ + TRUE + }else{ + FALSE + } + }, error = function(x){ + FALSE + }) + + if(testDim){ + + loopO$facet <- title + if(is.null(pal)){ + pal <- colorRampPalette(c("#E6E7E8","#3A97FF","#8816A7","black"))(100) + } + + p <- ggplot(data = data.frame(loopO), aes(x = x, y = y, group = id, color = value)) + + geom_line() + + facet_grid(name ~ .) + + ylab("") + + coord_cartesian(ylim = c(-100,0)) + + scale_x_continuous(limits = c(start(region), end(region)), expand = c(0,0)) + + scale_color_gradientn(colors = pal, limits = c(valueMin, valueMax)) + + theme(legend.text = element_text(size = baseSize)) + + theme_ArchR(baseSize = baseSize, baseLineSize = borderWidth, baseRectSize = borderWidth, legendPosition = "right") + + theme(strip.text.y = element_text(size = facetbaseSize, angle = 0), strip.background = element_blank(), + legend.box.background = element_rect(color = NA)) + + guides(color= guide_colorbar(barwidth = 0.75, barheight = 3)) + + }else{ + + # create empty plot + df <- data.frame(facet = "LoopTrack", start = 0, end = 0, strand = "*", symbol = "none") + p <- ggplot(data = df, aes(start, end)) + + geom_point() + + facet_grid(facet~.) + + theme_ArchR(baseSize = baseSize, baseLineSize = borderWidth, baseRectSize = borderWidth) + + scale_x_continuous(limits = c(start(region), end(region)), expand = c(0,0)) + + theme(axis.title.x=element_blank(), axis.text.x=element_blank(),axis.ticks.x=element_blank()) + + theme(axis.title.y=element_blank(), axis.text.y=element_blank(),axis.ticks.y=element_blank()) + + } + + }else{ + + # create empty plot + df <- data.frame(facet = "LoopTrack", start = 0, end = 0, strand = "*", symbol = "none") + p <- ggplot(data = df, aes(start, end)) + + geom_point() + + facet_grid(facet~.) + + theme_ArchR(baseSize = baseSize, baseLineSize = borderWidth, baseRectSize = borderWidth) + + scale_x_continuous(limits = c(start(region), end(region)), expand = c(0,0)) + + theme(axis.title.x=element_blank(), axis.text.x=element_blank(),axis.ticks.x=element_blank()) + + theme(axis.title.y=element_blank(), axis.text.y=element_blank(),axis.ticks.y=element_blank()) + + } + + if(hideX){ + p <- p + theme(axis.title.x=element_blank(), axis.text.x=element_blank(), axis.ticks.x=element_blank()) + } + + if(hideY){ + p <- p + theme(axis.title.y=element_blank(), axis.text.y=element_blank(), axis.ticks.y=element_blank()) + } + + if(!is.ggplot(p)){ + .logError("loopTracks is not a ggplot!", fn = ".loopTracks", info = "", errorList = NULL, logFile = logFile) + } + + return(p) + +} diff --git a/Shiny/server.R b/Shiny/server.R index cdf905ca..67f2eccc 100644 --- a/Shiny/server.R +++ b/Shiny/server.R @@ -192,7 +192,7 @@ shinyServer <- function(input,output, session){ if((input$matrix_UMAP1_forComparison)=="Unconstrained"){ - legend('bottom', legend=umap_legend_names$Unconstrained, + legend('bottom', legend=umap_legend_names$unconstrained, pch=15, col = color_umaps$unconstrained, horiz = FALSE, x.intersp = 1, text.width=0.35, cex = 0.5, bty="n", ncol = 5) @@ -206,7 +206,12 @@ shinyServer <- function(input,output, session){ cex = 0.7, bty="n", ncol = 4) } - p <- h5read("./inputData/mainUMAPs.h5", input$matrix_UMAP1_forComparison) + # p <- h5read("./inputData/mainUMAPs.h5", input$matrix_UMAP1_forComparison) + + if(input$matrix_UMAP1_forComparison == "Unconstrained"){p <- h5read("./inputData/mainUMAPs.h5", "unconstrained")}else{ + p <- h5read("./inputData/mainUMAPs.h5", input$matrix_UMAP1_forComparison) + } + temp_jpg <- t(matrix(decode_native(p), nrow = 216)) last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.7) + @@ -414,7 +419,7 @@ shinyServer <- function(input,output, session){ if((input$matrix_UMAP2_forComparison)=="Unconstrained"){ - legend('bottom', legend=umap_legend_names$Unconstrained, + legend('bottom', legend=umap_legend_names$unconstrained, pch=15, col = color_umaps$unconstrained, horiz = FALSE, x.intersp = 1, text.width=0.35, cex = 0.5, bty="n", ncol = 5) @@ -428,7 +433,12 @@ shinyServer <- function(input,output, session){ cex = 0.7, bty="n", ncol = 4) } - p <- h5read("./inputData/mainUMAPs.h5", input$matrix_UMAP2_forComparison) + # p <- h5read("./inputData/mainUMAPs.h5", input$matrix_UMAP2_forComparison) + + if(input$matrix_UMAP2_forComparison == "Unconstrained"){p <- h5read("./inputData/mainUMAPs.h5", "unconstrained")}else{ + p <- h5read("./inputData/mainUMAPs.h5", input$matrix_UMAP2_forComparison) + } + temp_jpg <- t(matrix(decode_native(p), nrow = 216)) last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.7) + @@ -633,7 +643,7 @@ shinyServer <- function(input,output, session){ if((input$matrix_UMAP1_forComparison)=="Unconstrained"){ - legend('bottom', legend=umap_legend_names$Unconstrained, + legend('bottom', legend=umap_legend_names$unconstrained, pch=15, col = color_umaps$unconstrained, horiz = FALSE, x.intersp = 1, text.width=0.35, cex = 0.5, bty="n", ncol = 5) @@ -647,7 +657,10 @@ shinyServer <- function(input,output, session){ cex = 0.7, bty="n", ncol = 4) } - p <- h5read("./inputData/mainUMAPs.h5", input$matrix_UMAP1_forComparison)# input$UMAP1_forComparison)) + if(input$matrix_UMAP1_forComparison == "Unconstrained"){p <- h5read("./inputData/mainUMAPs.h5", "unconstrained")}else{ + p <- h5read("./inputData/mainUMAPs.h5", input$matrix_UMAP1_forComparison) + } + temp_jpg <- t(matrix(decode_native(p), nrow = 216)) last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.7) + @@ -842,7 +855,7 @@ shinyServer <- function(input,output, session){ if((input$matrix_UMAP2_forComparison)=="Unconstrained"){ - legend('bottom', legend=umap_legend_names$Unconstrained, + legend('bottom', legend=umap_legend_names$unconstrained, pch=15, col = color_umaps$unconstrained, horiz = FALSE, x.intersp = 1, text.width=0.35, cex = 0.5, bty="n", ncol = 5) @@ -856,7 +869,12 @@ shinyServer <- function(input,output, session){ cex = 0.7, bty="n", ncol = 4) } - p <- h5read("./inputData/mainUMAPs.h5", input$matrix_UMAP2_forComparison) + # p <- h5read("./inputData/mainUMAPs.h5", input$matrix_UMAP2_forComparison) + + if(input$matrix_UMAP2_forComparison == "Unconstrained"){p <- h5read("./inputData/mainUMAPs.h5", "unconstrained")}else{ + p <- h5read("./inputData/mainUMAPs.h5", input$matrix_UMAP2_forComparison) + } + temp_jpg <- t(matrix(decode_native(p), nrow = 216)) last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.7) + @@ -960,9 +978,8 @@ shinyServer <- function(input,output, session){ if(isolate(input$browserContent)=="Unconstrained") { - p_browser_atacClusters<- plotBrowserTrack( + p_browser_atacClusters<- plotBrowserTrack_Test( ArchRProj = ArchRProj, - ShinyArchR = TRUE, plotSummary = c("bulkTrack", input$selectPlotSummary), baseSize = 11, facetbaseSize = 11, @@ -979,9 +996,8 @@ shinyServer <- function(input,output, session){ else { - p_browser_atacClusters <- plotBrowserTrack( + p_browser_atacClusters <- plotBrowserTrack_Test( ArchRProj = ArchRProj, - ShinyArchR = TRUE, plotSummary = c("bulkTrack", input$selectPlotSummary), groupBy = "Clusters", baseSize = 11, @@ -1020,9 +1036,8 @@ shinyServer <- function(input,output, session){ if(isolate(input$browserContent)=="Unconstrained") { - p_browser_atacClusters<- plotBrowserTrack( + p_browser_atacClusters<- plotBrowserTrack_Test( ArchRProj = ArchRProj, - ShinyArchR = TRUE, plotSummary = c("bulkTrack", input$selectPlotSummary), baseSize = 11, facetbaseSize = 11, @@ -1038,9 +1053,8 @@ shinyServer <- function(input,output, session){ } else { - p_browser_atacClusters <- plotBrowserTrack( + p_browser_atacClusters <- plotBrowserTrack_Test( ArchRProj = ArchRProj, - ShinyArchR = TRUE, plotSummary = c("bulkTrack", input$selectPlotSummary), groupBy = "Clusters", baseSize = 11, diff --git a/Shiny/ui.R b/Shiny/ui.R index 8bb88b56..49b1bbca 100644 --- a/Shiny/ui.R +++ b/Shiny/ui.R @@ -1,6 +1,6 @@ library(shinybusy) -# This file contains UI widgets. +# This file contain UI widgets. # Umap plotting ---------------------------------------------------------------------- umap_panel <- tabPanel(id="umap_panel", From a25b9fcfaad1830ab7cd8ac277847b33f1a4148d Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Mon, 7 Nov 2022 13:07:38 -0800 Subject: [PATCH 003/162] add a @param definition for Shiny loadArchRproj() --- R/AllClasses.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/AllClasses.R b/R/AllClasses.R index 32519f1c..a78e7e07 100644 --- a/R/AllClasses.R +++ b/R/AllClasses.R @@ -379,7 +379,9 @@ recoverArchRProject <- function(ArchRProj){ #' background peaks) should be ignored when re-normalizing file paths. If set to `FALSE` loading of the `ArchRProject` #' will fail unless all components can be found. #' @param showLogo A boolean value indicating whether to show the ascii ArchR logo after successful creation of an `ArchRProject`. -#' +#' @param Shiny A boolean value indicating whether an ArchR project will be used for deploying on Shiny Apps. `TRUE` if the project +#' won't have any arrow files. +#' #' @examples #' #' # Get Small PBMC Project Location From 13ce91620d2a6e399ff46814dd726ae319f8240a Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Mon, 7 Nov 2022 13:10:13 -0800 Subject: [PATCH 004/162] Update AnnotationGenome.R --- R/AnnotationGenome.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/AnnotationGenome.R b/R/AnnotationGenome.R index 878a1c20..568eed91 100644 --- a/R/AnnotationGenome.R +++ b/R/AnnotationGenome.R @@ -382,7 +382,8 @@ createGeneAnnotation <- function( #' group in an ArchRProject and output them under a directory. #' #' @param gr A GRanges object. -#' @param genome A BSgenome object. +#' @param genome See the genome parameter for validBSgenome(). This option must be one of the following: (i) the name of a valid ArchR-supported genome ("hg38", "hg19", or "mm10"), +#' (ii) the name of a BSgenome package (for ex. "BSgenome.Hsapiens.UCSC.hg19"), or (iii) a BSgenome object. #' #' @export addSeqLengths <- function (gr, genome) { From a0ca2d469562ee7929664ab882fed07964981fbf Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Mon, 7 Nov 2022 13:27:56 -0800 Subject: [PATCH 005/162] Update ArchRBrowser.R --- R/ArchRBrowser.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/ArchRBrowser.R b/R/ArchRBrowser.R index 8e2b7880..847e7cde 100644 --- a/R/ArchRBrowser.R +++ b/R/ArchRBrowser.R @@ -648,7 +648,8 @@ ArchRBrowserTrack <- function(...){ #' (i.e. the `BSgenome` object you used) so they may not match other online genome browsers that use different gene annotations. #' #' @param ArchRProj An `ArchRProject` object. -#' @param ShinyArchR Boolean indicating whether to use coverage RLEs or arrow files. Default = FALSE. +#' @param ShinyArchR A boolean value indicating whether to use coverage RLEs or Arrow Files for browser track plotting. +#' This parameter is not meant to be controlled by the end user and is only meant to be used as part of an exported ShinyArchR app. #' @param region A `GRanges` region that indicates the region to be plotted. If more than one region exists in the `GRanges` object, #' all will be plotted. If no region is supplied, then the `geneSymbol` argument can be used to center the plot window at the #' transcription start site of the supplied gene. From 3ee4410b3e102af142343ecd0666960a12a37db4 Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Mon, 7 Nov 2022 13:30:20 -0800 Subject: [PATCH 006/162] adding .validInput to shinyarchr --- R/ArchRBrowser.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/ArchRBrowser.R b/R/ArchRBrowser.R index 847e7cde..57155127 100644 --- a/R/ArchRBrowser.R +++ b/R/ArchRBrowser.R @@ -783,6 +783,7 @@ plotBrowserTrack <- function( .validInput(input = borderWidth, name = "borderWidth", valid = "numeric") .validInput(input = tickWidth, name = "tickWidth", valid = "numeric") .validInput(input = facetbaseSize, name = "facetbaseSize", valid = "numeric") + .validInput(input = ShinyArchR, name = "ShinyArchR", valid = c("boolean")) geneAnnotation <- .validGeneAnnotation(geneAnnotation) .validInput(input = title, name = "title", valid = "character") From 93a5fd92a93114f3661705a746ac686991c1af97 Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Mon, 7 Nov 2022 13:57:14 -0800 Subject: [PATCH 007/162] pattern match to list coverage files --- R/ArchRBrowser.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ArchRBrowser.R b/R/ArchRBrowser.R index 57155127..e45813d1 100644 --- a/R/ArchRBrowser.R +++ b/R/ArchRBrowser.R @@ -1381,7 +1381,7 @@ plotBrowserTrack <- function( ranges = IRanges(start = regionTiles, width=100) ) - cvgObjs = list.files(path = "./coverage", full.names = TRUE) + cvgObjs = list.files(path = "./coverage", pattern = "*_cvg.rds", full.names = TRUE) allCvgGR = c() for(i in seq_along(cvgObjs)) { cvgrds <- readRDS(cvgObjs[[i]]) From 4495ed877f753ef0b5f247673b84dda906720793 Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Mon, 7 Nov 2022 14:02:45 -0800 Subject: [PATCH 008/162] use previously stored cellGroups --- R/ArchRBrowser.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ArchRBrowser.R b/R/ArchRBrowser.R index e45813d1..02877a5c 100644 --- a/R/ArchRBrowser.R +++ b/R/ArchRBrowser.R @@ -1457,7 +1457,7 @@ plotBrowserTrack <- function( plotDF <- df[,c("x", "y", "group")] # Normalization - g <- getCellColData(ArchRProj, groupBy, drop = TRUE) + g <- cellGroups if(tolower(normMethod) %in% c("readsintss","readsinpromoter", "nfrags")) { v <- getCellColData(ArchRProj, normMethod, drop = TRUE) From 68ea6b0c2dfa92afcb70e132411c8b6b11b27449 Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Sun, 13 Nov 2022 20:30:49 -0800 Subject: [PATCH 009/162] force create coverage force create coverage subdirectory within the outputDirectory of the ArchRProject --- R/ArchRBrowser.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ArchRBrowser.R b/R/ArchRBrowser.R index 02877a5c..243de9f2 100644 --- a/R/ArchRBrowser.R +++ b/R/ArchRBrowser.R @@ -1369,7 +1369,6 @@ plotBrowserTrack <- function( cellGroups <- getCellColData(ArchRProj, groupBy, drop = TRUE) tabGroups <- table(cellGroups) - groupsBySample <- split(cellGroups, getCellColData(ArchRProj, "Sample", drop = TRUE)) uniqueGroups <- gtools::mixedsort(unique(cellGroups)) @@ -1381,6 +1380,7 @@ plotBrowserTrack <- function( ranges = IRanges(start = regionTiles, width=100) ) + dir.create("coverage") cvgObjs = list.files(path = "./coverage", pattern = "*_cvg.rds", full.names = TRUE) allCvgGR = c() for(i in seq_along(cvgObjs)) { From 3a62d513e00cb4c0d5f64b22b0d701691cbaebfc Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Sun, 13 Nov 2022 21:43:43 -0800 Subject: [PATCH 010/162] safelapply to .getGroupFragsFromProj also remove @exports from hidden functions --- R/GroupExport.R | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/R/GroupExport.R b/R/GroupExport.R index b55eb0d2..99fd5777 100644 --- a/R/GroupExport.R +++ b/R/GroupExport.R @@ -581,10 +581,9 @@ getGroupFragments <- function( #' # Get Test ArchR Project #' proj <- getTestProject() #' -#' # Get Group BW -#' frags <- getGroupFragmentsFromProj(proj, groupBy = "Clusters", outDir = "./Shiny/Fragments") +#' # Create directory for fragments +#' getGroupFragmentsFromProj(proj, groupBy = "Clusters", outDir = "./Shiny/Fragments") #' -#' @export .getGroupFragsFromProj <- function(ArchRProj = NULL, groupBy = NULL, outDir = file.path("Shiny", "fragments")) { @@ -599,17 +598,17 @@ getGroupFragments <- function( clusters <- names(cellGroups) - for (cluster in clusters) { - cat("Making fragment file for cluster:", cluster, "\n") + .safelapply(seq_along(clusters), function(x){ + cat("Making fragment file for cluster:", clusters[x], "\n") # get GRanges with all fragments for that cluster - cellNames = cellGroups[[cluster]] + cellNames = cellGroups[[clusters[x]]] fragments <- getFragmentsFromProject(ArchRProj = ArchRProj, cellNames = cellNames) fragments <- unlist(fragments, use.names = FALSE) # filter Fragments fragments <- GenomeInfoDb::keepStandardChromosomes(fragments, pruning.mode = "coarse") - saveRDS(fragments, file.path(outDir, paste0(cluster, "_cvg.rds"))) + saveRDS(fragments, file.path(outDir, paste0(clusters[x], "_cvg.rds"))) } } @@ -627,7 +626,6 @@ getGroupFragments <- function( #' column will be grouped together and the average signal will be plotted. #' @param outDir the directory to output the group fragment files. #' -#' @export .getClusterCoverage <- function(ArchRProj = NULL, tileSize = 100, scaleFactor = 1, From e2816857b388298d4dac3e01f77820473bd85643 Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Mon, 14 Nov 2022 09:49:11 -0800 Subject: [PATCH 011/162] cellGroups for consistency --- R/GroupExport.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/GroupExport.R b/R/GroupExport.R index 99fd5777..6491c816 100644 --- a/R/GroupExport.R +++ b/R/GroupExport.R @@ -590,9 +590,9 @@ getGroupFragments <- function( dir.create(outDir, showWarnings = FALSE) # find barcodes of cells in that groupBy. - groups <- getCellColData(ArchRProj, select = groupBy, drop = TRUE) + cellGroups <- getCellColData(ArchRProj, select = groupBy, drop = TRUE) cells <- ArchRProj$cellNames - cellGroups <- split(cells, groups) + cellGroups <- split(cells, cellGroups) # outputs unique cell groups/clusters. clusters <- names(cellGroups) From 25f39b5d35e237aede727ce03c777e105bbd96eb Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Mon, 14 Nov 2022 10:06:43 -0800 Subject: [PATCH 012/162] change cluster to groupIDs --- R/GroupExport.R | 36 +++++++++++++++++------------------- 1 file changed, 17 insertions(+), 19 deletions(-) diff --git a/R/GroupExport.R b/R/GroupExport.R index 6491c816..02cf346a 100644 --- a/R/GroupExport.R +++ b/R/GroupExport.R @@ -594,21 +594,21 @@ getGroupFragments <- function( cells <- ArchRProj$cellNames cellGroups <- split(cells, cellGroups) - # outputs unique cell groups/clusters. - clusters <- names(cellGroups) + # outputs unique cell groups (e.g. cluster). + groupIDs <- names(cellGroups) - .safelapply(seq_along(clusters), function(x){ - cat("Making fragment file for cluster:", clusters[x], "\n") + .safelapply(seq_along(groupIDs), function(x){ + cat("Making fragment file for cluster:", groupIDs[x], "\n") # get GRanges with all fragments for that cluster - cellNames = cellGroups[[clusters[x]]] + cellNames = cellGroups[[groupIDs[x]]] fragments <- getFragmentsFromProject(ArchRProj = ArchRProj, cellNames = cellNames) fragments <- unlist(fragments, use.names = FALSE) # filter Fragments fragments <- GenomeInfoDb::keepStandardChromosomes(fragments, pruning.mode = "coarse") - saveRDS(fragments, file.path(outDir, paste0(clusters[x], "_cvg.rds"))) + saveRDS(fragments, file.path(outDir, paste0(groupIDs[x], "_cvg.rds"))) } } @@ -635,12 +635,12 @@ getGroupFragments <- function( dir.create(outDir, showWarnings = FALSE) # find barcodes of cells in that groupBy. - groups <- getCellColData(ArchRProj, select = groupBy, drop = TRUE) + cellGroups <- getCellColData(ArchRProj, select = groupBy, drop = TRUE) cells <- ArchRProj$cellNames cellGroups <- split(cells, groups) # outputs unique cell groups/clusters. - clusters <- names(cellGroups) + groupIDs <- names(cellGroups) chrRegions <- getChromSizes(ArchRProj) genome <- getGenome(ArchRProj) @@ -651,18 +651,16 @@ getGroupFragments <- function( ranges = IRanges(start(fragments), width = 1)) right <- GRanges(seqnames = seqnames(fragments), ranges = IRanges(end(fragments), width = 1)) - # call sort() after sortSeqlevels() to sort also the ranges in addition - # to the chromosomes. - insertions <- c(left, right) %>% sortSeqlevels() %>% - sort() + # call sort() after sortSeqlevels() to sort also the ranges in addition to the chromosomes. + insertions <- c(left, right) %>% sortSeqlevels() %>% sort() - cluster <- file %>% basename() %>% gsub("_.*", "", .) + groupID <- file %>% basename() %>% gsub("_.*", "", .) # binnedCoverage - message("Creating bins for cluster ",clusters[clusteridx], "...") + message("Creating bins for group ", groupID, "...") bins <- unlist(slidingWindows(chrRegions, width = tileSize, step = tileSize)) - message("Counting overlaps for cluster ",clusters[clusteridx], "...") + message("Counting overlaps for group ", groupID, "...") bins$reads <- countOverlaps( bins, @@ -673,11 +671,11 @@ getGroupFragments <- function( ) addSeqLengths(bins, genome) - clusterReadsInTSS <- - ArchRProj@cellColData$ReadsInTSS[cells %in% cellGroups$cluster] + groupReadsInTSS <- + ArchRProj@cellColData$ReadsInTSS[cells %in% cellGroups$groupID] - binnedCoverage <- coverage(bins, weight = bins$reads *scaleFactor ) - saveRDS(binnedCoverage, file.path(outDir, paste0(cluster, "_cvg.rds"))) + binnedCoverage <- coverage(bins, weight = bins$reads * scaleFactor ) + saveRDS(binnedCoverage, file.path(outDir, paste0(groupID, "_cvg.rds"))) } } From 455724f59dbde6cd9ad76bee8f2f2ec19c6886b5 Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Mon, 14 Nov 2022 10:13:41 -0800 Subject: [PATCH 013/162] fragFiles --- R/GroupExport.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/GroupExport.R b/R/GroupExport.R index 02cf346a..0bf04d63 100644 --- a/R/GroupExport.R +++ b/R/GroupExport.R @@ -631,7 +631,7 @@ getGroupFragments <- function( scaleFactor = 1, groupBy = "Clusters", outDir = file.path("Shiny", "coverage")) { - fragfiles = list.files(path = file.path("Shiny", "fragments"), full.names = TRUE) + fragFiles = list.files(path = file.path("Shiny", "fragments"), full.names = TRUE) dir.create(outDir, showWarnings = FALSE) # find barcodes of cells in that groupBy. @@ -645,7 +645,7 @@ getGroupFragments <- function( chrRegions <- getChromSizes(ArchRProj) genome <- getGenome(ArchRProj) - for (file in fragfiles) { + for (file in fragFiles) { fragments <- readRDS(file) left <- GRanges(seqnames = seqnames(fragments), ranges = IRanges(start(fragments), width = 1)) From c748edf16da86a9ed49081af9fe5e584a9a62b2c Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Mon, 14 Nov 2022 15:04:31 -0800 Subject: [PATCH 014/162] fix the path to the ArchRProject outputDirectory --- R/GroupExport.R | 31 +++---------------------------- 1 file changed, 3 insertions(+), 28 deletions(-) diff --git a/R/GroupExport.R b/R/GroupExport.R index 0bf04d63..497e6f83 100644 --- a/R/GroupExport.R +++ b/R/GroupExport.R @@ -630,8 +630,8 @@ getGroupFragments <- function( tileSize = 100, scaleFactor = 1, groupBy = "Clusters", - outDir = file.path("Shiny", "coverage")) { - fragFiles = list.files(path = file.path("Shiny", "fragments"), full.names = TRUE) + outDir = file.path(getOutputDirectory(ArchRProj), "Shiny", "coverage")) { + fragFiles = list.files(path = file.path(getOutputDirectory(ArchRProj), "Shiny", "fragments"), full.names = TRUE) dir.create(outDir, showWarnings = FALSE) # find barcodes of cells in that groupBy. @@ -676,30 +676,5 @@ getGroupFragments <- function( binnedCoverage <- coverage(bins, weight = bins$reads * scaleFactor ) saveRDS(binnedCoverage, file.path(outDir, paste0(groupID, "_cvg.rds"))) - } - -} - -if(!file.exists(file.path("Shiny"))){ - dir.create("Shiny", showWarnings = FALSE) - message("Shiny folder is created...") -} - -if(!file.exists(file.path("Shiny/inputData"))){ - message("Shiny/inputData folder is created...") - dir.create("Shiny/inputData", showWarnings = FALSE) -} - -set.seed(1) - -if (!file.exists(file.path( - "Save-ArchRProjShiny/Save-ArchRProjShiny-Arrows/" -))) { - stop( - "Please add Save-ArchRProjShiny/Save-ArchRProjShiny-Arrows/ folder into the Shiny/inputData/ path!" - ) -} else{ - ArchRProj <- - ArchR::loadArchRProject("Save-ArchRProjShiny/Save-ArchRProjShiny-Arrows/") - ArchRProj <- addImputeWeights(ArchRProj = ArchRProj) + } } From 9e7f16595ab650fd15e4eb12171c8b26e1323ac2 Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Mon, 14 Nov 2022 15:29:57 -0800 Subject: [PATCH 015/162] correct gsub --- R/GroupExport.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/GroupExport.R b/R/GroupExport.R index 497e6f83..ee696ba3 100644 --- a/R/GroupExport.R +++ b/R/GroupExport.R @@ -598,7 +598,7 @@ getGroupFragments <- function( groupIDs <- names(cellGroups) - .safelapply(seq_along(groupIDs), function(x){ + .safelapply(seq_along(groupIDs), function(x)){ cat("Making fragment file for cluster:", groupIDs[x], "\n") # get GRanges with all fragments for that cluster cellNames = cellGroups[[groupIDs[x]]] @@ -654,7 +654,7 @@ getGroupFragments <- function( # call sort() after sortSeqlevels() to sort also the ranges in addition to the chromosomes. insertions <- c(left, right) %>% sortSeqlevels() %>% sort() - groupID <- file %>% basename() %>% gsub("_.*", "", .) + groupID <- file %>% basename() %>% gsub(".{4}$", "", .) # binnedCoverage message("Creating bins for group ", groupID, "...") bins <- From 0ac8bfe2222f83b41e16a6627cb15ba474297f74 Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Mon, 14 Nov 2022 15:52:08 -0800 Subject: [PATCH 016/162] modify to ShinyRasterUMAPs --- R/RasterUMAPs.R | 8 +- R/ShinyRasterUMAPs.R | 250 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 254 insertions(+), 4 deletions(-) create mode 100644 R/ShinyRasterUMAPs.R diff --git a/R/RasterUMAPs.R b/R/RasterUMAPs.R index 18ca3d72..77398b53 100644 --- a/R/RasterUMAPs.R +++ b/R/RasterUMAPs.R @@ -1,4 +1,4 @@ -# rasterUmaps function ----------------------------------------------------------- +# shinyRasterUmaps function ----------------------------------------------------------- #' #' #' Create an HDF5 containing the nativeRaster vectors for all features for all feature matrices. @@ -9,13 +9,13 @@ #' @param threads The number of threads to use for parallel execution. #' @param verbose A boolean value that determines whether standard output should be printed. #' @param logFile The path to a file to be used for logging ArchR output. -#' @export -rasterUMAPs <- function( +#' +shinyRasterUMAPs <- function( ArchRProj = NULL, outputDirUmaps = "Shiny/inputData", threads = getArchRThreads(), verbose = TRUE, - logFile = createLogFile("rasterUMAPs") + logFile = createLogFile("shinyRasterUMAPs") ){ ArchR:::.validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) diff --git a/R/ShinyRasterUMAPs.R b/R/ShinyRasterUMAPs.R new file mode 100644 index 00000000..3e495ac5 --- /dev/null +++ b/R/ShinyRasterUMAPs.R @@ -0,0 +1,250 @@ +# shinyRasterUmaps function ----------------------------------------------------------- +#' +#' +#' Create an HDF5 containing the nativeRaster vectors for all features for all feature matrices. +#' This function will be called by exportShinyArchR() +#' +#' @param ArchRProj An `ArchRProject` object loaded in the environment. Can do this using: loadArchRProject("path to ArchRProject/") +#' @param outputDirUmaps Where the HDF5 and the jpgs will be saved. +#' @param threads The number of threads to use for parallel execution. +#' @param verbose A boolean value that determines whether standard output should be printed. +#' @param logFile The path to a file to be used for logging ArchR output. +#' +ShinyRasterUMAPs <- function( + ArchRProj = NULL, + outputDirUmaps = "Shiny/inputData", + threads = getArchRThreads(), + verbose = TRUE, + logFile = createLogFile("ShinyRasterUMAPs") +){ + .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) + .validInput(input = outputDirUmaps, name = "outputDirUmaps", valid = c("character")) + .validInput(input = threads, name = "threads", valid = c("numeric")) + .validInput(input = verbose, name = "verbose", valid = c("boolean")) + .validInput(input = logFile, name = "logFile", valid = c("character")) + + if (file.exists(file.path(outputDirUmaps, "plotBlank72.h5"))){ + + file.remove(file.path(outputDirUmaps, "plotBlank72.h5")) + + } + + h5closeAll() + points <- H5Fcreate(name = file.path(outputDirUmaps,"plotBlank72.h5")) + h5createGroup(file.path(outputDirUmaps, "plotBlank72.h5"),"GSM") + h5createGroup(file.path(outputDirUmaps, "plotBlank72.h5"),"GIM") + h5createGroup(file.path(outputDirUmaps, "plotBlank72.h5"),"MM") + + + if(!exists("GSM_umaps_points")){ + + GSM_umaps_points <- ArchR:::.safelapply(1:length(gene_names_GSM), function(x){ + + print(paste0("Creating plots for GSM_umaps_points: ",x,": ",round((x/length(gene_names_GSM))*100,3), "%")) + + gene_plot <- plotEmbeddingShiny( + ArchRProj = ArchRProj, + colorBy = "GeneScoreMatrix", + name = gene_names_GSM[x], + embedding = "UMAP", + embeddingDF = df, + quantCut = c(0.01, 0.95), + imputeWeights = getImputeWeights(ArchRProj = ArchRProj), + plotAs = "points", + rastr = TRUE + ) + + if(!is.null(gene_plot)){ + + gene_plot_blank <- gene_plot[[1]] + theme(axis.title.x = element_blank()) + + theme(axis.title.y = element_blank()) + + theme(axis.title = element_blank()) + + theme(legend.position = "none") + + theme( + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.border = element_blank(), + title=element_blank() + ) + + #save plot without axes etc as a jpg. + ggsave(filename = file.path(outputDirUmaps, "GSM_umaps", paste0(gene_names_GSM[x],"_blank72.jpg")), + plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) + + #read back in that jpg because we need vector in native format + blank_jpg72 <- readJPEG(source = file.path(outputDirUmaps, "GSM_umaps", + paste0(gene_names_GSM[x],"_blank72.jpg")), native = TRUE) + + res = list(list(plot=as.vector(blank_jpg72), min = round(min(gene_plot[[1]]$data$color),1), + max = round(max(gene_plot[[1]]$data$color),1), pal = gene_plot[[2]])) + + return(res) + } + }, threads = threads) + names(GSM_umaps_points) <- gene_names_GSM + }else{ + message("GSM_umaps_points already exists. Skipping the loop...") + } + + if(!exists("GIM_umaps_points")){ + GIM_umaps_points <- ArchR:::.safelapply(1:length(gene_names_GIM), function(x){ + + print(paste0("Creating plots for GIM_umaps_points: ",x,": ",round((x/length(gene_names_GIM))*100,3), "%")) + + gene_plot <- plotEmbeddingShiny( + ArchRProj = ArchRProj, + colorBy = "GeneIntegrationMatrix", + name = gene_names_GIM[x], + embedding = "UMAP", + embeddingDF = df, + quantCut = c(0.01, 0.95), + imputeWeights = getImputeWeights(ArchRProj = ArchRProj), + plotAs = "points", + rastr = TRUE + ) + + if(!is.null(gene_plot)){ + gene_plot_blank <- gene_plot[[1]] + theme(axis.title.x = element_blank()) + + theme(axis.title.y = element_blank()) + + theme(axis.title = element_blank()) + + theme(legend.position = "none") + + theme( + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.border = element_blank(), + title=element_blank() + ) + + #save plot without axes etc as a jpg. + ggsave(filename = file.path(outputDirUmaps, "GIM_umaps", paste0(gene_names_GIM[x],"_blank72.jpg")), + plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) + + #read back in that jpg because we need vector in native format + blank_jpg72 <- readJPEG(source = file.path(outputDirUmaps, "GIM_umaps", + paste0(gene_names_GIM[x],"_blank72.jpg")), native = TRUE) + + + res = list(list(plot=as.vector(blank_jpg72), min = round(min(gene_plot[[1]]$data$color),1), + max = round(max(gene_plot[[1]]$data$color),1), pal = gene_plot[[2]])) + return(res) + } + + }, threads = threads) + names(GIM_umaps_points) <- gene_names_GIM + }else{ + message("GIM_umaps_points already exists. Skipping the loop...") + } + + if(!exists("MM_umaps_points")){ + + MM_umaps_points <- ArchR:::.safelapply(1:length(motif_names), function(x){ + + print(paste0("Creating plots for MM_umaps_points: ",x,": ",round((x/length(motif_names))*100,3), "%")) + + gene_plot <- plotEmbeddingShiny( + ArchRProj = ArchRProj, + colorBy = "MotifMatrix", + name = motif_names[x], + embedding = "UMAP", + embeddingDF = df, + quantCut = c(0.01, 0.95), + imputeWeights = getImputeWeights(ArchRProj = ArchRProj), + plotAs = "points", + rastr = TRUE + ) + + if(!is.null(gene_plot)){ + gene_plot_blank <- gene_plot[[1]] + theme(axis.title.x = element_blank()) + + theme(axis.title.y = element_blank()) + + theme(axis.title = element_blank()) + + theme(legend.position = "none") + + theme( + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.border = element_blank(), + title=element_blank() + ) + + #save plot without axes etc as a jpg + ggsave(filename = file.path(outputDirUmaps, "MM_umaps", paste0(motif_names[x],"_blank72.jpg")), + plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) + + + #read back in that jpg because we need vector in native format + blank_jpg72 <- readJPEG(source = file.path(outputDirUmaps, "MM_umaps", + paste0(motif_names[x],"_blank72.jpg")), native = TRUE) + + res = list(list(plot=as.vector(blank_jpg72), min = round(min(gene_plot[[1]]$data$color),1), + max = round(max(gene_plot[[1]]$data$color),1), pal = gene_plot[[2]])) + + names(res) = motif_names[x] + return(res) + } + }, threads = threads) + names(MM_umaps_points) <- motif_names + }else{ + message("MM_umaps_points already exists. Skipping the loop...") + } + + GSM_umaps_points = GSM_umaps_points[!unlist(lapply(GSM_umaps_points, is.null))] + GIM_umaps_points = GIM_umaps_points[!unlist(lapply(GIM_umaps_points, is.null))] + MM_umaps_points = MM_umaps_points[!unlist(lapply(MM_umaps_points, is.null))] + + GSM_min_max <- data.frame(matrix(NA, 2, length(GSM_umaps_points))) + colnames(GSM_min_max) <- names(GSM_umaps_points)[which(!unlist(lapply(GSM_umaps_points, is.null)))] + rownames(GSM_min_max) <- c("min","max") + + GIM_min_max <- data.frame(matrix(NA, 2, length(GIM_umaps_points))) + colnames(GIM_min_max) <- names(GIM_umaps_points)[which(!unlist(lapply(GIM_umaps_points, is.null)))] + rownames(GIM_min_max) <- c("min","max") + + MM_min_max <- data.frame(matrix(NA, 2, length(MM_umaps_points))) + colnames(MM_min_max) <- names(MM_umaps_points)[which(!unlist(lapply(MM_umaps_points, is.null)))] + rownames(MM_min_max) <- c("min","max") + + for(i in 1:length(GSM_umaps_points)){ + + print(paste0("Getting H5 files for GSM_umaps_points: ",i,": ",round((i/length(GSM_umaps_points))*100,3), "%")) + + h5createDataset(file = points, dataset = paste0("GSM/", gene_names_GSM[i]), dims = c(46656,1), storage.mode = "integer") + h5writeDataset(obj = GSM_umaps_points[[i]][[1]]$plot, h5loc = points, name=paste0("GSM/", gene_names_GSM[i])) + + GSM_min_max[1,i] = GSM_umaps_points[[i]][[1]]$min + GSM_min_max[2,i] = GSM_umaps_points[[i]][[1]]$max + + } + + for(i in 1:length(GIM_umaps_points)){ + + print(paste0("Getting H5 files for GIM_umaps_points: ",i,": ",round((i/length(GIM_umaps_points))*100,3), "%")) + + h5createDataset(file = points, dataset = paste0("GIM/", gene_names_GIM[i]), dims = c(46656,1), storage.mode = "integer") + h5writeDataset(obj = GIM_umaps_points[[i]][[1]]$plot, h5loc = points, name=paste0("GIM/", gene_names_GIM[i])) + + GIM_min_max[1,i] = GIM_umaps_points[[i]][[1]]$min + GIM_min_max[2,i] = GIM_umaps_points[[i]][[1]]$max + + } + + for(i in 1:length(MM_umaps_points)){ + + print(paste0("Getting H5 files for MM_umaps_points: ",i,": ",round((i/length(MM_umaps_points))*100,3), "%")) + h5createDataset(file = points, dataset = paste0("MM/", motif_names[i]), dims = c(46656,1), storage.mode = "integer") + h5writeDataset(obj = MM_umaps_points[[i]][[1]]$plot, h5loc = points, name=paste0("MM/", motif_names[i])) + MM_min_max[1,i] = MM_umaps_points[[i]][[1]]$min + MM_min_max[2,i] = MM_umaps_points[[i]][[1]]$max + + } + + scale <- list(gsm = GSM_min_max, gim = GIM_min_max, mm = MM_min_max) + pal <- list(gsm = GSM_umaps_points[[1]][[1]]$pal, gim = GIM_umaps_points[[1]][[1]]$pal, mm = MM_umaps_points[[1]][[1]]$pal) + + saveRDS(scale, file.path(outputDirUmaps, "scale.rds")) + saveRDS(pal, file.path(outputDirUmaps, "pal.rds")) + + if(exists("GSM_umaps_points")){ rm(GSM_umaps_points) } + if(exists("GIM_umaps_points")){ rm(GIM_umaps_points) } + if(exists("MM_umaps_points")){ rm(MM_umaps_points) } + +} + From f5775fc790f8dbb1445ff69c7dad1361967902d4 Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Mon, 14 Nov 2022 19:40:06 -0800 Subject: [PATCH 017/162] removing most ArchR::: mine --- R/AnnotationGenome.R | 2 +- R/Clustering.R | 2 +- R/InputData.R | 6 ++-- R/ModuleScore.R | 4 +-- R/MultiModal.R | 2 +- R/VisualizeData.R | 68 ++++++++++++++++++++++---------------------- 6 files changed, 42 insertions(+), 42 deletions(-) diff --git a/R/AnnotationGenome.R b/R/AnnotationGenome.R index 568eed91..d71d35fa 100644 --- a/R/AnnotationGenome.R +++ b/R/AnnotationGenome.R @@ -387,7 +387,7 @@ createGeneAnnotation <- function( #' #' @export addSeqLengths <- function (gr, genome) { - gr <- ArchR:::.validGRanges(gr) + gr <- .validGRanges(gr) genome <- validBSgenome(genome) stopifnot(all(as.character(seqnames(gr)) %in% as.character(seqnames(genome)))) seqlengths(gr) <- diff --git a/R/Clustering.R b/R/Clustering.R index 864c46f9..0e28892c 100644 --- a/R/Clustering.R +++ b/R/Clustering.R @@ -374,7 +374,7 @@ addClusters <- function( if(!is.null(maxClusters)){ if(length(unique(clust)) > maxClusters){ .logDiffTime(sprintf("Identified more clusters than maxClusters allowed (n = %s). Merging clusters to maxClusters (n = %s).\nIf this is not desired set maxClusters = NULL!", length(clustAssign), maxClusters), tstart, verbose = verbose, logFile = logFile) - meanDR <- t(ArchR:::.groupMeans(t(matDR), clust)) + meanDR <- t(.groupMeans(t(matDR), clust)) hc <- hclust(dist(as.matrix(meanDR))) ct <- cutree(hc, maxClusters) clust <- mapLabels( diff --git a/R/InputData.R b/R/InputData.R index 76fc949e..ccf289b7 100644 --- a/R/InputData.R +++ b/R/InputData.R @@ -20,8 +20,8 @@ getTutorialData <- function( ){ #Validate - ArchR:::.validInput(input = tutorial, name = "tutorial", valid = "character") - ArchR:::.validInput(input = threads, name = "threads", valid = c("integer")) + .validInput(input = tutorial, name = "tutorial", valid = "character") + .validInput(input = threads, name = "threads", valid = c("integer")) ######### #Make Sure URL doesnt timeout @@ -367,7 +367,7 @@ getValidBarcodes <- function( } barcodeList <- lapply(seq_along(csvFiles), function(x){ - df <- ArchR:::.suppressAll(data.frame(readr::read_csv(csvFiles[x]))) + df <- .suppressAll(data.frame(readr::read_csv(csvFiles[x]))) if("cell_id" %in% colnames(df)){ as.character(df[which(paste0(df$cell_id) != "None"),]$barcode) }else if("is__cell_barcode" %in% colnames(df)){ diff --git a/R/ModuleScore.R b/R/ModuleScore.R index b143f48f..61a1c28a 100644 --- a/R/ModuleScore.R +++ b/R/ModuleScore.R @@ -85,7 +85,7 @@ addModuleScore <- function( .logThis(mget(names(formals()),sys.frame(sys.nframe())), "addModuleScore Input-Parameters", logFile=logFile) #Get Feature DF - featureDF <- ArchR:::.getFeatureDF(head(getArrowFiles(ArchRProj),2), subGroup=useMatrix) + featureDF <- .getFeatureDF(head(getArrowFiles(ArchRProj),2), subGroup=useMatrix) featureDF$Match <- seq_len(nrow(featureDF)) if("name" %in% colnames(featureDF)){ @@ -253,7 +253,7 @@ addModuleScore <- function( binx <- binList[moduleList[[x]]] idxFgd <- featureList[[x]] idxBgd <- unlist(lapply(binx, function(x) sample(x, nBgd)), use.names=FALSE) - m <- ArchR:::.getPartialMatrix( + m <- .getPartialMatrix( ArrowFiles = getArrowFiles(ArchRProj), featureDF = featureDF[c(idxFgd, idxBgd), ], useMatrix = useMatrix, diff --git a/R/MultiModal.R b/R/MultiModal.R index 50be21ce..aa130912 100644 --- a/R/MultiModal.R +++ b/R/MultiModal.R @@ -114,7 +114,7 @@ import10xFeatureMatrix <- function( rowRanges(dummySE) <- rowRanges(rse_final[rownames(rse_final)[finalNotI],]) rownames(dummySE) <- rownames(rse_final)[finalNotI] rse_i <- SummarizedExperiment::rbind(rse_i, dummySE) - rse_i <- ArchR:::.sortRSE(rse_i) + rse_i <- .sortRSE(rse_i) #check to ensure that the rownames now exactly match. if not something is wrong if(!identical(rownames(rse_final), rownames(rse_i))) { diff --git a/R/VisualizeData.R b/R/VisualizeData.R index 2917e255..9d2588df 100644 --- a/R/VisualizeData.R +++ b/R/VisualizeData.R @@ -607,42 +607,42 @@ plotEmbeddingShiny <- function( logFile = createLogFile("plotEmbedding") ){ - ArchR:::.validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) - ArchR:::.validInput(input = embedding, name = "reducedDims", valid = c("character")) - ArchR:::.validInput(input = colorBy, name = "colorBy", valid = c("character")) - ArchR:::.validInput(input = name, name = "name", valid = c("character")) - ArchR:::.validInput(input = log2Norm, name = "log2Norm", valid = c("boolean", "null")) - ArchR:::.validInput(input = imputeWeights, name = "imputeWeights", valid = c("list", "null")) - ArchR:::.validInput(input = pal, name = "pal", valid = c("palette", "null")) - ArchR:::.validInput(input = size, name = "size", valid = c("numeric")) - ArchR:::.validInput(input = sampleCells, name = "sampleCells", valid = c("numeric", "null")) - ArchR:::.validInput(input = highlightCells, name = "highlightCells", valid = c("character", "null")) - ArchR:::.validInput(input = rastr, name = "rastr", valid = c("boolean")) - ArchR:::.validInput(input = quantCut, name = "quantCut", valid = c("numeric", "null")) - ArchR:::.validInput(input = discreteSet, name = "discreteSet", valid = c("character", "null")) - ArchR:::.validInput(input = continuousSet, name = "continuousSet", valid = c("character", "null")) - ArchR:::.validInput(input = randomize, name = "randomize", valid = c("boolean")) - ArchR:::.validInput(input = keepAxis, name = "keepAxis", valid = c("boolean")) - ArchR:::.validInput(input = baseSize, name = "baseSize", valid = c("numeric")) - ArchR:::.validInput(input = plotAs, name = "plotAs", valid = c("character", "null")) - ArchR:::.validInput(input = threads, name = "threads", valid = c("integer")) - ArchR:::.validInput(input = logFile, name = "logFile", valid = c("character")) + .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) + .validInput(input = embedding, name = "reducedDims", valid = c("character")) + .validInput(input = colorBy, name = "colorBy", valid = c("character")) + .validInput(input = name, name = "name", valid = c("character")) + .validInput(input = log2Norm, name = "log2Norm", valid = c("boolean", "null")) + .validInput(input = imputeWeights, name = "imputeWeights", valid = c("list", "null")) + .validInput(input = pal, name = "pal", valid = c("palette", "null")) + .validInput(input = size, name = "size", valid = c("numeric")) + .validInput(input = sampleCells, name = "sampleCells", valid = c("numeric", "null")) + .validInput(input = highlightCells, name = "highlightCells", valid = c("character", "null")) + .validInput(input = rastr, name = "rastr", valid = c("boolean")) + .validInput(input = quantCut, name = "quantCut", valid = c("numeric", "null")) + .validInput(input = discreteSet, name = "discreteSet", valid = c("character", "null")) + .validInput(input = continuousSet, name = "continuousSet", valid = c("character", "null")) + .validInput(input = randomize, name = "randomize", valid = c("boolean")) + .validInput(input = keepAxis, name = "keepAxis", valid = c("boolean")) + .validInput(input = baseSize, name = "baseSize", valid = c("numeric")) + .validInput(input = plotAs, name = "plotAs", valid = c("character", "null")) + .validInput(input = threads, name = "threads", valid = c("integer")) + .validInput(input = logFile, name = "logFile", valid = c("character")) - ArchR:::.requirePackage("ggplot2", source = "cran") + .requirePackage("ggplot2", source = "cran") - ArchR:::.startLogging(logFile = logFile) - ArchR:::.logThis(mget(names(formals()),sys.frame(sys.nframe())), "Input-Parameters", logFile=logFile) + .startLogging(logFile = logFile) + .logThis(mget(names(formals()),sys.frame(sys.nframe())), "Input-Parameters", logFile=logFile) # Get Embedding ------------------------------------------------------------------ - ArchR:::.logMessage("Getting UMAP Embedding", logFile = logFile) + .logMessage("Getting UMAP Embedding", logFile = logFile) df <- embeddingDF if(!all(rownames(df) %in% ArchRProj$cellNames)){ stop("Not all cells in embedding are present in ArchRProject!") } - ArchR:::.logThis(df, name = "Embedding data.frame", logFile = logFile) + .logThis(df, name = "Embedding data.frame", logFile = logFile) if(!is.null(sampleCells)){ if(sampleCells < nrow(df)){ if(!is.null(imputeWeights)){ @@ -686,7 +686,7 @@ plotEmbeddingShiny <- function( } colorBy <- allColorBy[match(tolower(colorBy), tolower(allColorBy))] - ArchR:::.logMessage(paste0("ColorBy = ", colorBy), logFile = logFile) + .logMessage(paste0("ColorBy = ", colorBy), logFile = logFile) suppressMessages(message(logFile)) @@ -719,13 +719,13 @@ plotEmbeddingShiny <- function( rownames(colorMat)=name if(!all(rownames(df) %in% colnames(colorMat))){ - ArchR:::.logMessage("Not all cells in embedding are present in feature matrix. This may be due to using a custom embedding.", logFile = logFile) + .logMessage("Not all cells in embedding are present in feature matrix. This may be due to using a custom embedding.", logFile = logFile) stop("Not all cells in embedding are present in feature matrix. This may be due to using a custom embedding.") } colorMat <- colorMat[,rownames(df), drop=FALSE] - ArchR:::.logThis(colorMat, "colorMat-Before-Impute", logFile = logFile) + .logThis(colorMat, "colorMat-Before-Impute", logFile = logFile) if(!is.null(imputeWeights)){ if(getArchRVerbose()) message("Imputing Matrix") @@ -736,7 +736,7 @@ plotEmbeddingShiny <- function( } } - ArchR:::.logThis(colorMat, "colorMat-After-Impute", logFile = logFile) + .logThis(colorMat, "colorMat-After-Impute", logFile = logFile) colorList <- lapply(seq_len(nrow(colorMat)), function(x){ colorParams <- list() @@ -755,7 +755,7 @@ plotEmbeddingShiny <- function( colorParams$discreteSet <- discreteSet } if(x == 1){ - ArchR:::.logThis(colorParams, name = "ColorParams 1", logFile = logFile) + .logThis(colorParams, name = "ColorParams 1", logFile = logFile) } colorParams }) @@ -764,7 +764,7 @@ plotEmbeddingShiny <- function( for(x in 1:length(colorList)){ - plotParamsx = ArchR:::.mergeParams(colorList[[x]], plotParams) + plotParamsx = .mergeParams(colorList[[x]], plotParams) if(getArchRVerbose()) {message(x, " ", appendLF = FALSE)} @@ -806,7 +806,7 @@ plotEmbeddingShiny <- function( plotParamsx$size <- NULL plotParamsx$randomize <- NULL - ArchR:::.logThis(plotParamsx, name = paste0("PlotParams-", x), logFile = logFile) + .logThis(plotParamsx, name = paste0("PlotParams-", x), logFile = logFile) gg <- do.call(ggHex, plotParamsx) }else{ @@ -815,7 +815,7 @@ plotEmbeddingShiny <- function( plotParamsx$highlightPoints <- highlightPoints } - ArchR:::.logThis(plotParamsx, name = paste0("PlotParams-", x), logFile = logFile) + .logThis(plotParamsx, name = paste0("PlotParams-", x), logFile = logFile) gg <- do.call(ggPoint, plotParamsx) } @@ -830,7 +830,7 @@ plotEmbeddingShiny <- function( plotParamsx$highlightPoints <- highlightPoints } - ArchR:::.logThis(plotParamsx, name = paste0("PlotParams-", x), logFile = logFile) + .logThis(plotParamsx, name = paste0("PlotParams-", x), logFile = logFile) gg <- do.call(ggPoint, plotParamsx) } From 3dc36005751457f507e64be5aa4908383d7cfdf4 Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Mon, 14 Nov 2022 19:40:40 -0800 Subject: [PATCH 018/162] remove ArchR::: to load hidden functions --- R/RasterUMAPs.R | 247 ------------------------------------------- R/ShinyRasterUMAPs.R | 106 +++++++++---------- R/exportShinyArchR.R | 10 +- 3 files changed, 53 insertions(+), 310 deletions(-) delete mode 100644 R/RasterUMAPs.R diff --git a/R/RasterUMAPs.R b/R/RasterUMAPs.R deleted file mode 100644 index 77398b53..00000000 --- a/R/RasterUMAPs.R +++ /dev/null @@ -1,247 +0,0 @@ -# shinyRasterUmaps function ----------------------------------------------------------- -#' -#' -#' Create an HDF5 containing the nativeRaster vectors for all features for all feature matrices. -#' This function will be called by exportShinyArchR() -#' -#' @param ArchRProj An `ArchRProject` object loaded in the environment. Can do this using: loadArchRProject("path to ArchRProject/") -#' @param outputDirUmaps Where the HDF5 and the jpgs will be saved. -#' @param threads The number of threads to use for parallel execution. -#' @param verbose A boolean value that determines whether standard output should be printed. -#' @param logFile The path to a file to be used for logging ArchR output. -#' -shinyRasterUMAPs <- function( - ArchRProj = NULL, - outputDirUmaps = "Shiny/inputData", - threads = getArchRThreads(), - verbose = TRUE, - logFile = createLogFile("shinyRasterUMAPs") -){ - - ArchR:::.validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) - - if (file.exists(file.path(outputDirUmaps, "plotBlank72.h5"))){ - - file.remove(file.path(outputDirUmaps, "plotBlank72.h5")) - - } - - h5closeAll() - points <- H5Fcreate(name = file.path(outputDirUmaps,"plotBlank72.h5")) - h5createGroup(file.path(outputDirUmaps, "plotBlank72.h5"),"GSM") - h5createGroup(file.path(outputDirUmaps, "plotBlank72.h5"),"GIM") - h5createGroup(file.path(outputDirUmaps, "plotBlank72.h5"),"MM") - - - if(!exists("GSM_umaps_points")){ - - GSM_umaps_points <- ArchR:::.safelapply(1:length(gene_names_GSM), function(x){ - - print(paste0("Creating plots for GSM_umaps_points: ",x,": ",round((x/length(gene_names_GSM))*100,3), "%")) - - gene_plot <- plotEmbeddingShiny( - ArchRProj = ArchRProj, - colorBy = "GeneScoreMatrix", - name = gene_names_GSM[x], - embedding = "UMAP", - embeddingDF = df, - quantCut = c(0.01, 0.95), - imputeWeights = getImputeWeights(ArchRProj = ArchRProj), - plotAs = "points", - rastr = TRUE - ) - - if(!is.null(gene_plot)){ - - gene_plot_blank <- gene_plot[[1]] + theme(axis.title.x = element_blank()) + - theme(axis.title.y = element_blank()) + - theme(axis.title = element_blank()) + - theme(legend.position = "none") + - theme( - panel.grid.major = element_blank(), - panel.grid.minor = element_blank(), - panel.border = element_blank(), - title=element_blank() - ) - - #save plot without axes etc as a jpg. - ggsave(filename = file.path(outputDirUmaps, "GSM_umaps", paste0(gene_names_GSM[x],"_blank72.jpg")), - plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) - - #read back in that jpg because we need vector in native format - blank_jpg72 <- readJPEG(source = file.path(outputDirUmaps, "GSM_umaps", - paste0(gene_names_GSM[x],"_blank72.jpg")), native = TRUE) - - res = list(list(plot=as.vector(blank_jpg72), min = round(min(gene_plot[[1]]$data$color),1), - max = round(max(gene_plot[[1]]$data$color),1), pal = gene_plot[[2]])) - - return(res) - } - }, threads = threads) - names(GSM_umaps_points) <- gene_names_GSM - }else{ - message("GSM_umaps_points already exists. Skipping the loop...") - } - - if(!exists("GIM_umaps_points")){ - GIM_umaps_points <- ArchR:::.safelapply(1:length(gene_names_GIM), function(x){ - - print(paste0("Creating plots for GIM_umaps_points: ",x,": ",round((x/length(gene_names_GIM))*100,3), "%")) - - gene_plot <- plotEmbeddingShiny( - ArchRProj = ArchRProj, - colorBy = "GeneIntegrationMatrix", - name = gene_names_GIM[x], - embedding = "UMAP", - embeddingDF = df, - quantCut = c(0.01, 0.95), - imputeWeights = getImputeWeights(ArchRProj = ArchRProj), - plotAs = "points", - rastr = TRUE - ) - - if(!is.null(gene_plot)){ - gene_plot_blank <- gene_plot[[1]] + theme(axis.title.x = element_blank()) + - theme(axis.title.y = element_blank()) + - theme(axis.title = element_blank()) + - theme(legend.position = "none") + - theme( - panel.grid.major = element_blank(), - panel.grid.minor = element_blank(), - panel.border = element_blank(), - title=element_blank() - ) - - #save plot without axes etc as a jpg. - ggsave(filename = file.path(outputDirUmaps, "GIM_umaps", paste0(gene_names_GIM[x],"_blank72.jpg")), - plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) - - #read back in that jpg because we need vector in native format - blank_jpg72 <- readJPEG(source = file.path(outputDirUmaps, "GIM_umaps", - paste0(gene_names_GIM[x],"_blank72.jpg")), native = TRUE) - - - res = list(list(plot=as.vector(blank_jpg72), min = round(min(gene_plot[[1]]$data$color),1), - max = round(max(gene_plot[[1]]$data$color),1), pal = gene_plot[[2]])) - return(res) - } - - }, threads = threads) - names(GIM_umaps_points) <- gene_names_GIM - }else{ - message("GIM_umaps_points already exists. Skipping the loop...") - } - - if(!exists("MM_umaps_points")){ - - MM_umaps_points <- ArchR:::.safelapply(1:length(motif_names), function(x){ - - print(paste0("Creating plots for MM_umaps_points: ",x,": ",round((x/length(motif_names))*100,3), "%")) - - gene_plot <- plotEmbeddingShiny( - ArchRProj = ArchRProj, - colorBy = "MotifMatrix", - name = motif_names[x], - embedding = "UMAP", - embeddingDF = df, - quantCut = c(0.01, 0.95), - imputeWeights = getImputeWeights(ArchRProj = ArchRProj), - plotAs = "points", - rastr = TRUE - ) - - if(!is.null(gene_plot)){ - gene_plot_blank <- gene_plot[[1]] + theme(axis.title.x = element_blank()) + - theme(axis.title.y = element_blank()) + - theme(axis.title = element_blank()) + - theme(legend.position = "none") + - theme( - panel.grid.major = element_blank(), - panel.grid.minor = element_blank(), - panel.border = element_blank(), - title=element_blank() - ) - - #save plot without axes etc as a jpg - ggsave(filename = file.path(outputDirUmaps, "MM_umaps", paste0(motif_names[x],"_blank72.jpg")), - plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) - - - #read back in that jpg because we need vector in native format - blank_jpg72 <- readJPEG(source = file.path(outputDirUmaps, "MM_umaps", - paste0(motif_names[x],"_blank72.jpg")), native = TRUE) - - res = list(list(plot=as.vector(blank_jpg72), min = round(min(gene_plot[[1]]$data$color),1), - max = round(max(gene_plot[[1]]$data$color),1), pal = gene_plot[[2]])) - - names(res) = motif_names[x] - return(res) - } - }, threads = threads) - names(MM_umaps_points) <- motif_names - }else{ - message("MM_umaps_points already exists. Skipping the loop...") - } - - GSM_umaps_points = GSM_umaps_points[!unlist(lapply(GSM_umaps_points, is.null))] - GIM_umaps_points = GIM_umaps_points[!unlist(lapply(GIM_umaps_points, is.null))] - MM_umaps_points = MM_umaps_points[!unlist(lapply(MM_umaps_points, is.null))] - - GSM_min_max <- data.frame(matrix(NA, 2, length(GSM_umaps_points))) - colnames(GSM_min_max) <- names(GSM_umaps_points)[which(!unlist(lapply(GSM_umaps_points, is.null)))] - rownames(GSM_min_max) <- c("min","max") - - GIM_min_max <- data.frame(matrix(NA, 2, length(GIM_umaps_points))) - colnames(GIM_min_max) <- names(GIM_umaps_points)[which(!unlist(lapply(GIM_umaps_points, is.null)))] - rownames(GIM_min_max) <- c("min","max") - - MM_min_max <- data.frame(matrix(NA, 2, length(MM_umaps_points))) - colnames(MM_min_max) <- names(MM_umaps_points)[which(!unlist(lapply(MM_umaps_points, is.null)))] - rownames(MM_min_max) <- c("min","max") - - for(i in 1:length(GSM_umaps_points)){ - - print(paste0("Getting H5 files for GSM_umaps_points: ",i,": ",round((i/length(GSM_umaps_points))*100,3), "%")) - - h5createDataset(file = points, dataset = paste0("GSM/", gene_names_GSM[i]), dims = c(46656,1), storage.mode = "integer") - h5writeDataset(obj = GSM_umaps_points[[i]][[1]]$plot, h5loc = points, name=paste0("GSM/", gene_names_GSM[i])) - - GSM_min_max[1,i] = GSM_umaps_points[[i]][[1]]$min - GSM_min_max[2,i] = GSM_umaps_points[[i]][[1]]$max - - } - - for(i in 1:length(GIM_umaps_points)){ - - print(paste0("Getting H5 files for GIM_umaps_points: ",i,": ",round((i/length(GIM_umaps_points))*100,3), "%")) - - h5createDataset(file = points, dataset = paste0("GIM/", gene_names_GIM[i]), dims = c(46656,1), storage.mode = "integer") - h5writeDataset(obj = GIM_umaps_points[[i]][[1]]$plot, h5loc = points, name=paste0("GIM/", gene_names_GIM[i])) - - GIM_min_max[1,i] = GIM_umaps_points[[i]][[1]]$min - GIM_min_max[2,i] = GIM_umaps_points[[i]][[1]]$max - - } - - for(i in 1:length(MM_umaps_points)){ - - print(paste0("Getting H5 files for MM_umaps_points: ",i,": ",round((i/length(MM_umaps_points))*100,3), "%")) - h5createDataset(file = points, dataset = paste0("MM/", motif_names[i]), dims = c(46656,1), storage.mode = "integer") - h5writeDataset(obj = MM_umaps_points[[i]][[1]]$plot, h5loc = points, name=paste0("MM/", motif_names[i])) - MM_min_max[1,i] = MM_umaps_points[[i]][[1]]$min - MM_min_max[2,i] = MM_umaps_points[[i]][[1]]$max - - } - - scale <- list(gsm = GSM_min_max, gim = GIM_min_max, mm = MM_min_max) - pal <- list(gsm = GSM_umaps_points[[1]][[1]]$pal, gim = GIM_umaps_points[[1]][[1]]$pal, mm = MM_umaps_points[[1]][[1]]$pal) - - saveRDS(scale, file.path(outputDirUmaps, "scale.rds")) - saveRDS(pal, file.path(outputDirUmaps, "pal.rds")) - - if(exists("GSM_umaps_points")){ rm(GSM_umaps_points) } - if(exists("GIM_umaps_points")){ rm(GIM_umaps_points) } - if(exists("MM_umaps_points")){ rm(MM_umaps_points) } - -} - diff --git a/R/ShinyRasterUMAPs.R b/R/ShinyRasterUMAPs.R index 3e495ac5..a4a95684 100644 --- a/R/ShinyRasterUMAPs.R +++ b/R/ShinyRasterUMAPs.R @@ -10,7 +10,7 @@ #' @param verbose A boolean value that determines whether standard output should be printed. #' @param logFile The path to a file to be used for logging ArchR output. #' -ShinyRasterUMAPs <- function( +shinyRasterUMAPs <- function( ArchRProj = NULL, outputDirUmaps = "Shiny/inputData", threads = getArchRThreads(), @@ -23,71 +23,65 @@ ShinyRasterUMAPs <- function( .validInput(input = verbose, name = "verbose", valid = c("boolean")) .validInput(input = logFile, name = "logFile", valid = c("character")) - if (file.exists(file.path(outputDirUmaps, "plotBlank72.h5"))){ - + if (file.exists(file.path(outputDirUmaps, "plotBlank72.h5"))){ file.remove(file.path(outputDirUmaps, "plotBlank72.h5")) - } h5closeAll() + + shinyMatrices <- getAvailableMatrices(ArchRProj) + + # create an HDF5 to store the native raster vectors points <- H5Fcreate(name = file.path(outputDirUmaps,"plotBlank72.h5")) - h5createGroup(file.path(outputDirUmaps, "plotBlank72.h5"),"GSM") - h5createGroup(file.path(outputDirUmaps, "plotBlank72.h5"),"GIM") - h5createGroup(file.path(outputDirUmaps, "plotBlank72.h5"),"MM") - + # create groups for each of the available matrices + for (matrix in shinyMatrices) { + h5createGroup(file.path(outputDirUmaps, "plotBlank72.h5"), matrix) - if(!exists("GSM_umaps_points")){ - - GSM_umaps_points <- ArchR:::.safelapply(1:length(gene_names_GSM), function(x){ + c(matrix, "points") <- .safelapply(1:length(gene_names_GSM), function(x){ + + gene_plot <- plotEmbeddingShiny( + ArchRProj = ArchRProj, + colorBy = "GeneScoreMatrix", + name = gene_names_GSM[x], + embedding = "UMAP", + embeddingDF = df, + quantCut = c(0.01, 0.95), + imputeWeights = getImputeWeights(ArchRProj = ArchRProj), + plotAs = "points", + rastr = TRUE + ) + + if(!is.null(gene_plot)){ - print(paste0("Creating plots for GSM_umaps_points: ",x,": ",round((x/length(gene_names_GSM))*100,3), "%")) + gene_plot_blank <- gene_plot[[1]] + theme(axis.title.x = element_blank()) + + theme(axis.title.y = element_blank()) + + theme(axis.title = element_blank()) + + theme(legend.position = "none") + + theme( + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.border = element_blank(), + title=element_blank() + ) - gene_plot <- plotEmbeddingShiny( - ArchRProj = ArchRProj, - colorBy = "GeneScoreMatrix", - name = gene_names_GSM[x], - embedding = "UMAP", - embeddingDF = df, - quantCut = c(0.01, 0.95), - imputeWeights = getImputeWeights(ArchRProj = ArchRProj), - plotAs = "points", - rastr = TRUE - ) + #save plot without axes etc as a jpg. + ggsave(filename = file.path(outputDirUmaps, "GSM_umaps", paste0(gene_names_GSM[x],"_blank72.jpg")), + plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) - if(!is.null(gene_plot)){ - - gene_plot_blank <- gene_plot[[1]] + theme(axis.title.x = element_blank()) + - theme(axis.title.y = element_blank()) + - theme(axis.title = element_blank()) + - theme(legend.position = "none") + - theme( - panel.grid.major = element_blank(), - panel.grid.minor = element_blank(), - panel.border = element_blank(), - title=element_blank() - ) - - #save plot without axes etc as a jpg. - ggsave(filename = file.path(outputDirUmaps, "GSM_umaps", paste0(gene_names_GSM[x],"_blank72.jpg")), - plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) - - #read back in that jpg because we need vector in native format - blank_jpg72 <- readJPEG(source = file.path(outputDirUmaps, "GSM_umaps", - paste0(gene_names_GSM[x],"_blank72.jpg")), native = TRUE) - - res = list(list(plot=as.vector(blank_jpg72), min = round(min(gene_plot[[1]]$data$color),1), - max = round(max(gene_plot[[1]]$data$color),1), pal = gene_plot[[2]])) - - return(res) - } - }, threads = threads) - names(GSM_umaps_points) <- gene_names_GSM - }else{ - message("GSM_umaps_points already exists. Skipping the loop...") - } + #read back in that jpg because we need vector in native format + blank_jpg72 <- readJPEG(source = file.path(outputDirUmaps, "GSM_umaps", + paste0(gene_names_GSM[x],"_blank72.jpg")), native = TRUE) + + res = list(list(plot=as.vector(blank_jpg72), min = round(min(gene_plot[[1]]$data$color),1), + max = round(max(gene_plot[[1]]$data$color),1), pal = gene_plot[[2]])) + + return(res) + } + }, threads = threads) + names(GSM_umaps_points) <- gene_names_GSM if(!exists("GIM_umaps_points")){ - GIM_umaps_points <- ArchR:::.safelapply(1:length(gene_names_GIM), function(x){ + GIM_umaps_points <- .safelapply(1:length(gene_names_GIM), function(x){ print(paste0("Creating plots for GIM_umaps_points: ",x,": ",round((x/length(gene_names_GIM))*100,3), "%")) @@ -137,7 +131,7 @@ ShinyRasterUMAPs <- function( if(!exists("MM_umaps_points")){ - MM_umaps_points <- ArchR:::.safelapply(1:length(motif_names), function(x){ + MM_umaps_points <- .safelapply(1:length(motif_names), function(x){ print(paste0("Creating plots for MM_umaps_points: ",x,": ",round((x/length(motif_names))*100,3), "%")) diff --git a/R/exportShinyArchR.R b/R/exportShinyArchR.R index 65fa3819..e2fc2108 100644 --- a/R/exportShinyArchR.R +++ b/R/exportShinyArchR.R @@ -88,7 +88,7 @@ exportShinyArchR <- function(ArchRProj = NULL, ArchRProjShiny@projectMetadata[["units"]] <- units - #need arrowFiles to getFeatures so need to save genes as RDS + # need arrowFiles to getFeatures so need to save genes as RDS gene_names <- getFeatures(ArchRProj = ArchRProj) saveRDS(gene_names, "./inputData/gene_names.rds") @@ -158,7 +158,7 @@ exportShinyArchR <- function(ArchRProj = NULL, ## colorMats without Impute Weights---------------------------------------------------------------- - #Get gene and motif names and save as RDS + # Get gene and motif names and save as RDS gene_names_GSM <- getFeatures(ArchRProj = ArchRProj, useMatrix = "GeneScoreMatrix") saveRDS(gene_names_GSM, file="./inputData/geneNamesGSM.rds") @@ -193,7 +193,6 @@ exportShinyArchR <- function(ArchRProj = NULL, #colorMatMM has 1740 rows because in name = getFeatures() returns the 870 z: + the 870 deviations: colorMatMM <- Matrix(.getMatrixValues( ArchRProj = ArchRProj, - #name = getFeatures(ArchRProj, "MotifMatrix") name = paste0("deviations:", markerListMM), #used deviations: matrixName = "MotifMatrix", log2Norm = FALSE, @@ -201,11 +200,8 @@ exportShinyArchR <- function(ArchRProj = NULL, ), sparse = TRUE) matrices$"MotifMatrix" <- colorMatMM - #TODO modify this so it only has the matrices we are actually supporting + # TODO modify this so it only has the matrices we are actually supporting matrices$allColorBy=c("colData", "cellColData", .availableArrays(head(getArrowFiles(ArchRProj), 2))) - # shouldn't save rds because it's too hefty for ShinyApps - saveRDS(matrices,"~/tests/raster/inputData/matrices.rds") - matrices <- readRDS("matrices.rds") ## Impute Weights ------------------------------------------------------------ imputeWeights <- getImputeWeights(ArchRProj = ArchRProj) From e57321bdc9a7dc620f087797e39b974f4901575e Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Thu, 17 Nov 2022 12:25:52 -0800 Subject: [PATCH 019/162] downloadFiles() --- R/exportShinyArchR.R | 501 ++++++++++++++++++++++++++----------------- 1 file changed, 303 insertions(+), 198 deletions(-) diff --git a/R/exportShinyArchR.R b/R/exportShinyArchR.R index e2fc2108..7afb7d33 100644 --- a/R/exportShinyArchR.R +++ b/R/exportShinyArchR.R @@ -1,28 +1,59 @@ +library(Matrix) +library(plyr) +library(dplyr) +library(rhandsontable) +library(parallel) +library(jpeg) +library(rhdf5) +library(ArchR) +library(rstudioapi) +library(BSgenome.Hsapiens.UCSC.hg19) +source("rasterUMAPs.R") +source("plotEmbeddingShiny.r") + +setwd(dirname(getActiveDocumentContext()$path)) +dir.create("Shiny", showWarnings = FALSE) +dir.create("Shiny/inputData", showWarnings = FALSE) + +set.seed(1) +ArchRProj <- loadArchRProject("~/tests/ArchR/Save-ArchRProjShiny-Arrows/") +ArchRProj <- addImputeWeights(ArchRProj = ArchRProj) +ArchRProj_noArrows <- myLoadArchRProject("~/tests/colors/inputData") +ArchRProj_noArrows <- addImputeWeights(ArchRProj = ArchRProj) + + + +# exportShiny function ----------------------------------------------------------- #' Export a Shiny App based on ArchRProj -#' -#' Generate all files required for an autonomous Shiny app to display your browser tracks. +#' +#' Generate all files required for an autonomous Shiny app to display browser tracks and UMAPs. #' #' @param ArchRProj An `ArchRProject` object loaded in the environment. Can do this using: loadArchRProject("path to ArchRProject/") -#' @param outputDir The name of the directory for the Shiny App files. -#' @param groupBy The name of the column in `cellColData` to use for grouping cells together for summarizing. +#' @param outputDir The name of the directory for the Shiny App files. +#' @param groupBy The name of the column in cellColData to use for grouping cells together for generating sequencing tracks. Only one cell grouping is allowed. #' @param tileSize The numeric width of the tile/bin in basepairs for plotting ATAC-seq signal tracks. All insertions in a single bin will be summed. #' @param threads The number of threads to use for parallel execution. -#' @param verbose A boolean value that determines whether standard output should be printed. #' @param logFile The path to a file to be used for logging ArchR output. #' @export -exportShinyArchR <- function(ArchRProj = NULL, - outputDir = "Shiny", - groupBy = "Clusters", - tileSize = 100, - threads = getArchRThreads(), - verbose = TRUE, - logFile = createLogFile("exportShinyArchR")) { +exportShinyArchR <- function( + ArchRProj = NULL, + FDR = 0.01, + Log2FC = 1.25, + outputDir = "Shiny", + groupBy = "Clusters", + tileSize = 100, + markerList = NULL, + threads = getArchRThreads(), + logFile = createLogFile("exportShinyArchR") +){ .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) .validInput(input = outputDir, name = "outputDir", valid = c("character")) .validInput(input = groupBy, name = "groupBy", valid = c("character")) .validInput(input = tileSize, name = "tileSize", valid = c("integer")) .validInput(input = threads, name = "threads", valid = c("integer")) + .validInput(input = logFile, name = "logFile", valid = c("character")) + .validInput(input = threads, name = "threads", valid = c("integer")) .validInput(input = verbose, name = "verbose", valid = c("boolean")) .validInput(input = logFile, name = "logFile", valid = c("character")) @@ -36,23 +67,23 @@ exportShinyArchR <- function(ArchRProj = NULL, if(!dir.exists(outputDir)) { dir.create(outputDir) - # if(length(dir(outDir, all.files = TRUE, include.dirs = TRUE, no.. = TRUE)) > 0){ - # stop("Please specify a new or empty directory") - # } - filesUrl <- c( + filesUrl <- data.frame( + fileUrl = c( "https://raw.githubusercontent.com/paupaiz/ArchR/Shiny_export/R/Shiny/app.R", "https://raw.githubusercontent.com/paupaiz/ArchR/Shiny_export/R/Shiny/global.R", "https://raw.githubusercontent.com/paupaiz/ArchR/Shiny_export/R/Shiny/server.R", "https://raw.githubusercontent.com/paupaiz/ArchR/Shiny_export/R/Shiny/ui.R" + ), + md5sum = c( + "77502e1f195e21d2f7a4e8ac9c96e65e", + "618613b486e4f8c0101f4c05c69723b0", + "a8d5ae747841055ef230ba496bcfe937" + ), + stringsAsFactors = FALSE ) - downloadFiles <- lapply(seq_along(filesUrl), function(x){ - download.file( - url = filesUrl[x], - destfile = file.path(outputDir, basename(filesUrl[x])) - ) - }) + .downloadFiles(filesUrl = filesUrl, pathDownload = outputDir, threads = threads) }else{ message("Using existing Shiny files...") @@ -69,16 +100,32 @@ exportShinyArchR <- function(ArchRProj = NULL, ArchRProjShiny@projectMetadata[["groupBy"]] <- groupBy } ArchRProjShiny@projectMetadata[["tileSize"]] <- tileSize - saveArchRProject(ArchRProj = ArchRProj, outputDirectory = "Save-ArchRProjShiny") - + # saveArchRProject(ArchRProj = ArchRProj, outputDirectory = "Save-ArchRProjShiny", dropCells = TRUE) + # file = "/Users/selcukkorkmaz/Documents/upwork/Paulina Paiz/Shiny/Save-ArchRProjShiny/ArrowFiles/scATAC_BMMC_R1.arrow" # Create fragment files - .getGroupFragsFromProj(ArchRProj = ArchRProjShiny, groupBy = groupBy, outDir = file.path(outputDir, "fragments")) - # Create coverage objects - .getClusterCoverage(ArchRProj = ArchRProjShiny, tileSize = tileSize, groupBy = groupBy, outDir = file.path(outputDir, "coverage")) + + if(length(list.files(file.path(outputDir, "fragments"))) == 0){ + .getGroupFragsFromProj(ArchRProj = ArchRProjShiny, groupBy = groupBy, outDir = file.path(outputDir, "fragments")) + }else{ + + message("Fragment files already exist...") + + } + + + + # Create coverage objects + if(length(list.files(file.path(outputDir, "coverage"))) == 0){ + .getClusterCoverage(ArchRProj = ArchRProjShiny, tileSize = tileSize, groupBy = groupBy, outDir = file.path(outputDir, "coverage")) + }else{ + + message("Coverage files already exist...") + + } ## main umaps ----------------------------------------------------------------- - dir.create("UMAPs") + # dir.create("UMAPs") units <- tryCatch({ .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, "/Info/Units"))[1] @@ -88,193 +135,251 @@ exportShinyArchR <- function(ArchRProj = NULL, ArchRProjShiny@projectMetadata[["units"]] <- units - # need arrowFiles to getFeatures so need to save genes as RDS - gene_names <- getFeatures(ArchRProj = ArchRProj) - saveRDS(gene_names, "./inputData/gene_names.rds") - - umaps <- list() - cluster_umap <- plotEmbedding( - ArchRProj = ArchRProjShiny, - baseSize=12, - colorBy = "cellColData", - name = "Clusters", - embedding = "UMAP", - rastr = FALSE, - 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)) - umaps[["Clusters"]] <- cluster_umap - # saveRDS(cluster_umap, "./UMAPs/cluster_umap.rds") - - sample_umap <- plotEmbedding( - ArchRProj = ArchRProj, - 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)) - umaps[["Sample"]] <- sample_umap - # saveRDS(sample_umap, "./UMAPs/sample_umap.rds") - - constrained_umap <- plotEmbedding( - ArchRProj = ArchRProjShiny, - 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)) - # saveRDS(constrained_umap, "./UMAPs/constrained_umap.rds") - umaps[["Constrained"]] <- constrained_umap - - unconstrained_umap <- plotEmbedding( - ArchRProj = ArchRProjShiny, - embedding = "UMAP", - colorBy = "cellColData", - name = "predictedGroup_Un", - 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)) - # saveRDS(unconstrained_umap, "./UMAPs/unconstrained_umap.rds") - umaps[["unconstrained"]] <- unconstrained_umap - - constrained_remapped_umap <- plotEmbedding( - ArchRProj = ArchRProjShiny, - 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)) - # saveRDS(constrained_remapped_umap, "./UMAPs/constrained_remapped_umap.rds") - umaps[["Constrained remap"]] <- constrained_remapped_umap - - saveRDS(umaps, "./inputData/umaps.rds") - umaps <- readRDS("./inputData/umaps.rds") - - ## colorMats without Impute Weights---------------------------------------------------------------- - - # Get gene and motif names and save as RDS - gene_names_GSM <- getFeatures(ArchRProj = ArchRProj, useMatrix = "GeneScoreMatrix") - saveRDS(gene_names_GSM, file="./inputData/geneNamesGSM.rds") - - gene_names_GIM <- getFeatures(ArchRProj = ArchRProj, useMatrix = "GeneIntegrationMatrix") - saveRDS(gene_names_GIM, file = "./inputData/geneNamesGIM.rds") - - motif_names <- getFeatures(ArchRProj = ArchRProj, useMatrix = "MotifMatrix") %>% - gsub(".*:", "", .) %>% unique(.) - saveRDS(motif_names, "./inputData/markerListMM.rds") - - matrices <- list() - #GSM colorMat - colorMatGSM <- Matrix(.getMatrixValues( - ArchRProj = ArchRProj, - name = gene_names_GSM, - matrixName = "GeneScoreMatrix", - log2Norm = FALSE, - threads = threads, - ), sparse = TRUE) - matrices$"GeneScoreMatrix" <- colorMatGSM - - #GIM - colorMatGIM <- Matrix(.getMatrixValues( - ArchRProj = ArchRProj, - name = getFeatures(ArchRProj = ArchRProj, useMatrix = "GeneIntegrationMatrix"), - matrixName = "GeneIntegrationMatrix", - log2Norm = FALSE, - threads = threads - ),sparse = TRUE) - matrices$"GeneIntegrationMatrix" <- colorMatGIM - - #colorMatMM has 1740 rows because in name = getFeatures() returns the 870 z: + the 870 deviations: - colorMatMM <- Matrix(.getMatrixValues( - ArchRProj = ArchRProj, - name = paste0("deviations:", markerListMM), #used deviations: - matrixName = "MotifMatrix", - log2Norm = FALSE, - threads = threads - ), sparse = TRUE) - matrices$"MotifMatrix" <- colorMatMM - - # TODO modify this so it only has the matrices we are actually supporting - matrices$allColorBy=c("colData", "cellColData", .availableArrays(head(getArrowFiles(ArchRProj), 2))) - - ## Impute Weights ------------------------------------------------------------ - imputeWeights <- getImputeWeights(ArchRProj = ArchRProj) - if(!is.null(imputeWeights)) { - df <- getEmbedding(ArchRProj, embedding = "UMAP", returnDF = TRUE) + #need arrowFiles to getFeatures so need to save genes as RDS + if(!file.exists("./Shiny/data/inputData/gene_names.rds")){ + gene_names <- getFeatures(ArchRProj = ArchRProj) + saveRDS(gene_names, "./Shiny/data/inputData/gene_names.rds") + }else{ + message("gene_names already exists...") + gene_names <- readRDS("./Shiny/data/inputData/gene_names.rds") - imputeMatricesList <- list() - # colorMats for each colorBy + } + + if(!file.exists("./Shiny/data/inputData/umaps.rds")){ + umaps <- list() + cluster_umap <- plotEmbedding( + ArchRProj = ArchRProjShiny, + baseSize=12, + colorBy = "cellColData", + name = "Clusters", + embedding = "UMAP", + rastr = FALSE, + size=0.5, + file="/Users/selcukkorkmaz/Documents/upwork/Paulina Paiz/Shiny/Save-ArchRProjShiny/ArrowFiles/scATAC_BMMC_R1.arrow" + )+ggtitle("Colored by scATAC-seq clusters")+theme(text=element_text(size=12), + legend.title = element_text(size = 12),legend.text = element_text(size = 6)) + umaps[["Clusters"]] <- cluster_umap + # saveRDS(cluster_umap, "./UMAPs/cluster_umap.rds") - # GSM - colorMatGSM <- matrices$"GeneScoreMatrix" - colorMatGSM <- colorMatGSM[,rownames(df), drop=FALSE] + sample_umap <- plotEmbedding( + ArchRProj = ArchRProj, + 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)) + umaps[["Sample"]] <- sample_umap + # saveRDS(sample_umap, "./UMAPs/sample_umap.rds") - .logThis(colorMatGSM, "colorMatGSM-Before-Impute", logFile = logFile) + constrained_umap <- plotEmbedding( + ArchRProj = ArchRProjShiny, + 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)) + # saveRDS(constrained_umap, "./UMAPs/constrained_umap.rds") + umaps[["Constrained"]] <- constrained_umap - if(getArchRVerbose()) message("Imputing Matrix") - colorMatGSM_Impute <- imputeMatrix(mat = as.matrix(colorMatGSM), imputeWeights = imputeWeights, logFile = logFile) - if(!inherits(colorMatGSM_Impute, "matrix")){ - colorMatGSM_Impute <- matrix(colorMatGSM_Impute, ncol = nrow(df)) - colnames(colorMatGSM_Impute) <- rownames(df) - } + unconstrained_umap <- plotEmbedding( + ArchRProj = ArchRProjShiny, + embedding = "UMAP", + colorBy = "cellColData", + name = "predictedGroup_Un", + 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)) + # saveRDS(unconstrained_umap, "./UMAPs/unconstrained_umap.rds") + umaps[["unconstrained"]] <- unconstrained_umap - .logThis(colorMat_Impute, "colorMatGSM-After-Impute", logFile = logFile) + constrained_remapped_umap <- plotEmbedding( + ArchRProj = ArchRProjShiny, + 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)) + # saveRDS(constrained_remapped_umap, "./UMAPs/constrained_remapped_umap.rds") + umaps[["Constrained remap"]] <- constrained_remapped_umap - imputeMatricesList$"GeneScoreMatrix" <- colorMatGSM_Impute - - # GIM - colorMatGIM <- matrices$"GeneIntegrationMatrix" - colorMatGIM <- colorMatGIM[,rownames(df), drop=FALSE] + saveRDS(umaps, "./Shiny/data/inputData/umaps.rds")}else{ + message("umaps already exists...") + umaps <- readRDS("./Shiny/data/inputData/umaps.rds") + } + + ## colorMats without Impute Weights---------------------------------------------------------------- + + #Get gene and motif names and save as RDS + if(!file.exists("./Shiny/data/inputData/gene_names_GSM.rds")){ + gene_names_GSM <- getFeatures(ArchRProj = ArchRProj, useMatrix = "GeneScoreMatrix") + saveRDS(gene_names_GSM, file="./Shiny/data/inputData/gene_names_GSM.rds") + }else{ + message("gene_names_GSM already exists...") + gene_names_GSM <- readRDS("./Shiny/data/inputData/gene_names_GSM.rds") + } + + if(!file.exists("./Shiny/data/inputData/gene_names_GIM.rds")){ + gene_names_GIM <- getFeatures(ArchRProj = ArchRProj, useMatrix = "GeneIntegrationMatrix") + saveRDS(gene_names_GIM, "./Shiny/data/inputData/gene_names_GIM.rds") + }else{ + message("gene_names_GIM already exists...") + gene_names_GIM <- readRDS("./Shiny/data/inputData/gene_names_GIM.rds") + } + + if(!file.exists("./Shiny/data/inputData/motif_names.rds")){ + motif_names <- getFeatures(ArchRProj = ArchRProj, useMatrix = "MotifMatrix") %>% + gsub(".*:", "", .) %>% unique(.) + saveRDS(motif_names, "./Shiny/data/inputData/motif_names.rds") + }else{ - .logThis(colorMatGIM, "colorMatGIM-Before-Impute", logFile = logFile) + message("motif_names already exists...") + motif_names <- readRDS("./Shiny/data/inputData/motif_names.rds") + } + + if(!file.exists("./Shiny/data/inputData/matrices.rds")){ + matrices <- list() + #GSM colorMat + colorMatGSM <- Matrix(.getMatrixValues( + ArchRProj = ArchRProj, + name = gene_names_GSM, + matrixName = "GeneScoreMatrix", + log2Norm = FALSE, + threads = threads, + ), sparse = TRUE) + matrices$"GeneScoreMatrix" <- colorMatGSM - if(getArchRVerbose()) message("Imputing Matrix") - colorMatGIM_Impute <- imputeMatrix(mat = as.matrix(colorMatGIM), imputeWeights = imputeWeights, logFile = logFile) - if(!inherits(colorMatGIM_Impute, "matrix")){ - colorMatGIM_Impute <- matrix(colorMatGIM_Impute, ncol = nrow(df)) - colnames(colorMatGIM_Impute) <- rownames(df) - } + #GIM + colorMatGIM <- Matrix(.getMatrixValues( + ArchRProj = ArchRProj, + name = getFeatures(ArchRProj = ArchRProj, useMatrix = "GeneIntegrationMatrix"), + matrixName = "GeneIntegrationMatrix", + log2Norm = FALSE, + threads = threads + ),sparse = TRUE) + matrices$"GeneIntegrationMatrix" <- colorMatGIM - .logThis(colorMatGIM_Impute, "colorMatGIM-After-Impute", logFile = logFile) + #colorMatMM has 1740 rows because in name = getFeatures() returns the 870 z: + the 870 deviations: + colorMatMM <- Matrix(.getMatrixValues( + ArchRProj = ArchRProj, + #name = getFeatures(ArchRProj, "MotifMatrix") + name = paste0("deviations:", motif_names), #used deviations: + matrixName = "MotifMatrix", + log2Norm = FALSE, + threads = threads + ), sparse = TRUE) + matrices$"MotifMatrix" <- colorMatMM - imputeMatricesList$"GeneIntegrationMatrix" <- colorMatGIM_Impute + #TODO modify this so it only has the matrices we are actually supporting + matrices$allColorBy=c("colData", "cellColData", .availableArrays(head(getArrowFiles(ArchRProj), 2))) + # shouldn't save rds because it's too hefty for ShinyApps + saveRDS(matrices,"./Shiny/data/inputData/matrices.rds") - # Motif Matrix - colorMatMM <- matrices$"MotifMatrix" - colorMatMM <- colorMatMM[,rownames(df), drop=FALSE] + }else{ + message("matrices already exist...") + matrices <- readRDS("./Shiny/data/inputData/matrices.rds") + } + ## Impute Weights ------------------------------------------------------------ + imputeWeights <- getImputeWeights(ArchRProj = ArchRProj) + if(!is.null(imputeWeights)) { + df <- getEmbedding(ArchRProj, embedding = "UMAP", returnDF = TRUE) - .logThis(colorMatMM, "colorMatMM-Before-Impute", logFile = logFile) - if(getArchRVerbose()) message("Imputing Matrix") - colorMatMM_Impute <- imputeMatrix(mat = as.matrix(colorMatMM), imputeWeights = imputeWeights, logFile = logFile) - if(!inherits(colorMatMM_Impute, "matrix")){ - colorMatMM_Impute <- matrix(colorMatMM_Impute, ncol = nrow(df)) - colnames(colorMatMM_Impute) <- rownames(df) + if(!file.exists("./Shiny/data/inputData/imputeMatricesList.rds")){ + imputeMatricesList <- list() + # colorMats for each colorBy + + # GSM + colorMatGSM <- matrices$"GeneScoreMatrix" + colorMatGSM <- colorMatGSM[,rownames(df), drop=FALSE] + + .logThis(colorMatGSM, "colorMatGSM-Before-Impute", logFile = logFile) + + if(getArchRVerbose()) message("Imputing Matrix") + colorMatGSM_Impute <- imputeMatrix(mat = as.matrix(colorMatGSM), imputeWeights = imputeWeights, logFile = logFile) + if(!inherits(colorMatGSM_Impute, "matrix")){ + colorMatGSM_Impute <- matrix(colorMatGSM_Impute, ncol = nrow(df)) + colnames(colorMatGSM_Impute) <- rownames(df) + } + + # .logThis(colorMat_Impute, "colorMatGSM-After-Impute", logFile = logFile) + + imputeMatricesList$"GeneScoreMatrix" <- colorMatGSM_Impute + + # GIM + colorMatGIM <- matrices$"GeneIntegrationMatrix" + colorMatGIM <- colorMatGIM[,rownames(df), drop=FALSE] + + .logThis(colorMatGIM, "colorMatGIM-Before-Impute", logFile = logFile) + + if(getArchRVerbose()) message("Imputing Matrix") + colorMatGIM_Impute <- imputeMatrix(mat = as.matrix(colorMatGIM), imputeWeights = imputeWeights, logFile = logFile) + if(!inherits(colorMatGIM_Impute, "matrix")){ + colorMatGIM_Impute <- matrix(colorMatGIM_Impute, ncol = nrow(df)) + colnames(colorMatGIM_Impute) <- rownames(df) + } + + .logThis(colorMatGIM_Impute, "colorMatGIM-After-Impute", logFile = logFile) + + imputeMatricesList$"GeneIntegrationMatrix" <- colorMatGIM_Impute + + # Motif Matrix + colorMatMM <- matrices$"MotifMatrix" + colorMatMM <- colorMatMM[,rownames(df), drop=FALSE] + + .logThis(colorMatMM, "colorMatMM-Before-Impute", logFile = logFile) + + if(getArchRVerbose()) message("Imputing Matrix") + colorMatMM_Impute <- imputeMatrix(mat = as.matrix(colorMatMM), imputeWeights = imputeWeights, logFile = logFile) + if(!inherits(colorMatMM_Impute, "matrix")){ + colorMatMM_Impute <- matrix(colorMatMM_Impute, ncol = nrow(df)) + colnames(colorMatMM_Impute) <- rownames(df) + } + + .logThis(colorMatMM_Impute, "colorMatMM-After-Impute", logFile = logFile) + + imputeMatricesList$"MotifMatrix" <- colorMatMM_Impute + + saveRDS(imputeMatricesList,"./Shiny/data/inputData/imputeMatricesList.rds") + }else{ + message("imputeMatricesList already exists...") + imputeMatricesList <- readRDS("./Shiny/data/inputData/imputeMatricesList.rds") } - .logThis(colorMatMM_Impute, "colorMatMM-After-Impute", logFile = logFile) + if(!file.exists("./Shiny/data/inputData/plotBlank72.h5")){ + + rasterUmaps( + ArchRProj = ArchRProj, + FDR = 0.01, + Log2FC = 1.25, + outputDir = "Shiny", + groupBy = "Clusters", + tileSize = 100, + markerList = NULL, + threads = getArchRThreads(), + verbose = TRUE, + logFile = createLogFile("exportShinyArchR") + ) + + }else{ + + message("H5 file already exists...") + + } + ## delete unnecessary files ----------------------------------------------------------------- + unlink("./fragments", recursive = TRUE) + unlink("./ArchRLogs", recursive = TRUE) - imputeMatricesList$"MotifMatrix" <- colorMatMM_Impute - } - - saveRDS(imputeMatricesList,"~/tests/raster/inputData/imputeMatricesList.rds") - imputeMatricesList <- readRDS("imputeMatricesList.rds") - - ## delete unnecessary files ----------------------------------------------------------------- - unlink("./fragments", recursive = TRUE) - unlink("./ArchRLogs", recursive = TRUE) - - ## ready to launch --------------------------------------------------------------- - message("App created! To launch, + ## ready to launch --------------------------------------------------------------- + message("App created! To launch, ArchRProj <- loadArchRProject('path to ArchRProject/') and run shiny::runApp('", outputDir, "') from parent directory") - # runApp("myappdir") + # runApp("myappdir") + } } - From bc5431b6d840902294d110847699f699aeeeb777 Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Thu, 17 Nov 2022 12:30:36 -0800 Subject: [PATCH 020/162] removing all the ArchR::: --- R/ArrowRead.R | 2 +- R/InputData.R | 2 +- R/ModuleScore.R | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/ArrowRead.R b/R/ArrowRead.R index 5e759313..feeea122 100644 --- a/R/ArrowRead.R +++ b/R/ArrowRead.R @@ -44,7 +44,7 @@ getFragmentsFromProject <- function( chr <- NULL } - ArchR:::.startLogging(logFile = logFile) + .startLogging(logFile = logFile) FragmentsList <- lapply(seq_along(ArrowFiles), function(x){ message(sprintf("Reading ArrowFile %s of %s", x, length(ArrowFiles))) diff --git a/R/InputData.R b/R/InputData.R index ccf289b7..041b10f6 100644 --- a/R/InputData.R +++ b/R/InputData.R @@ -139,7 +139,7 @@ getTutorialData <- function( message(paste0("Downloading files to ",pathDownload,"...")) - downloadFiles <- ArchR:::.safelapply(seq_along(filesUrl$fileUrl), function(x){ + downloadFiles <- .safelapply(seq_along(filesUrl$fileUrl), function(x){ if(file.exists(file.path(pathDownload, basename(filesUrl$fileUrl[x])))){ if(tools::md5sum(file.path(pathDownload, basename(filesUrl$fileUrl[x]))) != filesUrl$md5sum[x]) { diff --git a/R/ModuleScore.R b/R/ModuleScore.R index 61a1c28a..48295348 100644 --- a/R/ModuleScore.R +++ b/R/ModuleScore.R @@ -213,7 +213,7 @@ addModuleScore <- function( #Get average values for all features and then order the features based on their average values #so that the features can be binned into nBins - rS <- ArchR:::.getRowSums(ArrowFiles = getArrowFiles(ArchRProj), useMatrix = useMatrix) + rS <- .getRowSums(ArrowFiles = getArrowFiles(ArchRProj), useMatrix = useMatrix) rS <- rS[order(rS[,3]), ] if(is(featureData, "GRanges")){ rS$Match <- match(paste0(rS$seqnames, ":", rS$idx), paste0(seqnames(featureData), ":", featureData$idx)) From 09eb384be5b3a2c26e594dce4c77cb8c11bc695d Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Thu, 17 Nov 2022 12:40:10 -0800 Subject: [PATCH 021/162] adding all files with ArchR::: --- R/HiddenUtils.R | 2 +- R/Trajectory.R | 10 +++--- R/VisualizeData.R | 2 +- Shiny/global.R | 2 +- tests/testthat/test_1_arrow.R | 60 +++++++++++++++++------------------ tests/testthat/test_3_cpp.R | 10 +++--- 6 files changed, 43 insertions(+), 43 deletions(-) diff --git a/R/HiddenUtils.R b/R/HiddenUtils.R index cb9cb1ee..5651c687 100644 --- a/R/HiddenUtils.R +++ b/R/HiddenUtils.R @@ -531,7 +531,7 @@ fn <- unclass(lsf.str(envir = asNamespace("ArchR"), all = TRUE)) for(i in seq_along(fn)){ tryCatch({ - eval(parse(text=paste0(fn[i], '<-ArchR:::', fn[i]))) + eval(parse(text=paste0(fn[i], '<- ArchR:::', fn[i]))) }, error = function(x){ }) } diff --git a/R/Trajectory.R b/R/Trajectory.R index 406a1180..5c1dfd9a 100644 --- a/R/Trajectory.R +++ b/R/Trajectory.R @@ -1181,7 +1181,7 @@ getMonocleTrajectories <- function( cds <- order_cells(cds, root_pr_nodes = rootNodes) #Get Pseudotime - cds@principal_graph_aux[[1]]$pseudotime <- ArchR:::.getQuantiles(cds@principal_graph_aux[[1]]$pseudotime) * 100 + cds@principal_graph_aux[[1]]$pseudotime <- .getQuantiles(cds@principal_graph_aux[[1]]$pseudotime) * 100 #Plot Results canRaster <- requireNamespace("ggrastr", quietly = TRUE) @@ -1211,8 +1211,8 @@ getMonocleTrajectories <- function( message("Plotting Results - ", path) pdf(path, width = 6, height = 6, useDingbats = FALSE) - ArchR:::.fixPlotSize(p1) - ArchR:::.fixPlotSize(p2, newPage = TRUE) + .fixPlotSize(p1) + .fixPlotSize(p2, newPage = TRUE) dev.off() cds @@ -1280,7 +1280,7 @@ addMonocleTrajectory <- function( monoclePT <- pseudotime(monocleCDS) monoclePT <- monoclePT[rownames(groupDF)] - monoclePT <- ArchR:::.getQuantiles(monoclePT) * 100 + monoclePT <- .getQuantiles(monoclePT) * 100 #Add To ArchR Project ArchRProj <- addCellColData( @@ -1384,7 +1384,7 @@ addSlingShotTrajectories <- function( colnames(pt) <- paste0(name, ".Curve", seq_len(ncol(pt))) #Scale - ptn <- apply(pt, 2, ArchR:::.getQuantiles) * 100 + ptn <- apply(pt, 2, .getQuantiles) * 100 for(i in seq_len(ncol(ptn))){ diff --git a/R/VisualizeData.R b/R/VisualizeData.R index 9d2588df..f2f1485c 100644 --- a/R/VisualizeData.R +++ b/R/VisualizeData.R @@ -849,7 +849,7 @@ plotEmbeddingShiny <- function( gg <- gg } - ArchR:::.endLogging(logFile = logFile) + .endLogging(logFile = logFile) return(list(gg, plotParamsx$pal)) } diff --git a/Shiny/global.R b/Shiny/global.R index 2ba9d18c..28fd6ee8 100644 --- a/Shiny/global.R +++ b/Shiny/global.R @@ -27,7 +27,7 @@ set.seed(1) fn <- unclass(lsf.str(envir = asNamespace("ArchR"), all = TRUE)) for (i in seq_along(fn)) { tryCatch({ - eval(parse(text = paste0(fn[i], "<-ArchR:::", fn[i]))) + eval(parse(text = paste0(fn[i], "<-", fn[i]))) }, error = function(x) { }) } diff --git a/tests/testthat/test_1_arrow.R b/tests/testthat/test_1_arrow.R index 63bab730..17449d5e 100644 --- a/tests/testthat/test_1_arrow.R +++ b/tests/testthat/test_1_arrow.R @@ -45,42 +45,42 @@ arrowFiles <- createArrowFiles( test_that("Checking Arrow Contents...", { expect_equal( - ArchR:::.validArrow(arrowFiles), + .validArrow(arrowFiles), arrowFiles ) expect_equal( - ArchR:::.availableArrays(arrowFiles), + .availableArrays(arrowFiles), c("GeneScoreMatrix", "TileMatrix") ) expect_equal( - nrow(ArchR:::.getFeatureDF(arrowFiles, "TileMatrix")), + nrow(.getFeatureDF(arrowFiles, "TileMatrix")), 31593 ) expect_equal( - nrow(ArchR:::.getFeatureDF(arrowFiles, "GeneScoreMatrix")), + nrow(.getFeatureDF(arrowFiles, "GeneScoreMatrix")), 2454 ) expect_equal( - ArchR:::.availableSeqnames(arrowFiles), + .availableSeqnames(arrowFiles), c("chr11", "chr5") ) expect_equal( - ArchR:::.availableChr(arrowFiles), + .availableChr(arrowFiles), c("chr11", "chr5") ) expect_equal( - as.vector(table(substr(ArchR:::.availableCells(arrowFiles), 9, 9))[c("B", "M", "T")]), + as.vector(table(substr(.availableCells(arrowFiles), 9, 9))[c("B", "M", "T")]), c(45, 33, 49) ) expect_equal( - paste0(ArchR:::.sampleName(arrowFiles)), + paste0(.sampleName(arrowFiles)), "PBSmall" ) @@ -90,7 +90,7 @@ test_that("Checking Arrow Contents...", { # Testing Dropping Matrices ################################################ -arrowFiles <- ArchR:::.dropGroupsFromArrow( +arrowFiles <- .dropGroupsFromArrow( ArrowFile = arrowFiles, dropGroups = c("GeneScoreMatrix", "TileMatrix") ) @@ -99,32 +99,32 @@ arrowFiles <- ArchR:::.dropGroupsFromArrow( test_that("Checking Arrow Contents After Drop...", { expect_equal( - ArchR:::.validArrow(arrowFiles), + .validArrow(arrowFiles), arrowFiles ) expect_equal( - paste0(ArchR:::.availableArrays(arrowFiles)), + paste0(.availableArrays(arrowFiles)), c("")[-1] ) expect_equal( - ArchR:::.availableSeqnames(arrowFiles), + .availableSeqnames(arrowFiles), c("chr11", "chr5") ) expect_equal( - ArchR:::.availableChr(arrowFiles), + .availableChr(arrowFiles), c("chr11", "chr5") ) expect_equal( - as.vector(table(substr(ArchR:::.availableCells(arrowFiles), 9, 9))[c("B", "M", "T")]), + as.vector(table(substr(.availableCells(arrowFiles), 9, 9))[c("B", "M", "T")]), c(45, 33, 49) ) expect_equal( - paste0(ArchR:::.sampleName(arrowFiles)), + paste0(.sampleName(arrowFiles)), "PBSmall" ) @@ -145,37 +145,37 @@ arrowFiles <- addTileMatrix( test_that("Checking Arrow Contents after addTileMatrix", { expect_equal( - ArchR:::.validArrow(arrowFiles), + .validArrow(arrowFiles), arrowFiles ) expect_equal( - paste0(ArchR:::.availableArrays(arrowFiles)), + paste0(.availableArrays(arrowFiles)), "TileMatrix" ) expect_equal( - nrow(ArchR:::.getFeatureDF(arrowFiles, "TileMatrix")), + nrow(.getFeatureDF(arrowFiles, "TileMatrix")), 12638 ) expect_equal( - ArchR:::.availableSeqnames(arrowFiles), + .availableSeqnames(arrowFiles), c("chr11", "chr5") ) expect_equal( - ArchR:::.availableChr(arrowFiles), + .availableChr(arrowFiles), c("chr11", "chr5") ) expect_equal( - as.vector(table(substr(ArchR:::.availableCells(arrowFiles), 9, 9))[c("B", "M", "T")]), + as.vector(table(substr(.availableCells(arrowFiles), 9, 9))[c("B", "M", "T")]), c(45, 33, 49) ) expect_equal( - paste0(ArchR:::.sampleName(arrowFiles)), + paste0(.sampleName(arrowFiles)), "PBSmall" ) @@ -195,42 +195,42 @@ arrowFiles <- addGeneScoreMatrix( test_that("Checking Arrow Contents after addGeneScoreMatrix...", { expect_equal( - ArchR:::.validArrow(arrowFiles), + .validArrow(arrowFiles), arrowFiles ) expect_equal( - ArchR:::.availableArrays(arrowFiles), + .availableArrays(arrowFiles), c("GeneScoreMatrix", "TileMatrix") ) expect_equal( - nrow(ArchR:::.getFeatureDF(arrowFiles, "TileMatrix")), + nrow(.getFeatureDF(arrowFiles, "TileMatrix")), 12638 ) expect_equal( - nrow(ArchR:::.getFeatureDF(arrowFiles, "GeneScoreMatrix")), + nrow(.getFeatureDF(arrowFiles, "GeneScoreMatrix")), 2454 ) expect_equal( - ArchR:::.availableSeqnames(arrowFiles), + .availableSeqnames(arrowFiles), c("chr11", "chr5") ) expect_equal( - ArchR:::.availableChr(arrowFiles), + .availableChr(arrowFiles), c("chr11", "chr5") ) expect_equal( - as.vector(table(substr(ArchR:::.availableCells(arrowFiles), 9, 9))[c("B", "M", "T")]), + as.vector(table(substr(.availableCells(arrowFiles), 9, 9))[c("B", "M", "T")]), c(45, 33, 49) ) expect_equal( - paste0(ArchR:::.sampleName(arrowFiles)), + paste0(.sampleName(arrowFiles)), "PBSmall" ) diff --git a/tests/testthat/test_3_cpp.R b/tests/testthat/test_3_cpp.R index ecb4685f..61510e4b 100644 --- a/tests/testthat/test_3_cpp.R +++ b/tests/testthat/test_3_cpp.R @@ -19,7 +19,7 @@ m2 <- m1[rev(1:10), rev(1:10)] ################################################ #Correlations -c1 <- ArchR:::rowCorCpp(1:10, 1:10, m1, m2) +c1 <- rowCorCpp(1:10, 1:10, m1, m2) c2 <- lapply(1:10, function(x){ cor(m1[x, ], m2[x, ]) }) %>% unlist @@ -34,10 +34,10 @@ test_that("Row-wise Correlation is working...", { ################################################ #KNN -knnObj <- ArchR:::.computeKNN(m1, m2, k = 5) +knnObj <- .computeKNN(m1, m2, k = 5) #Check Knn Overlap Cpp -overlapCpp <- ArchR:::determineOverlapCpp(knnObj, 3) +overlapCpp <- determineOverlapCpp(knnObj, 3) #Check Knn Overlap R overlapR <- lapply(seq_len(nrow(knnObj)), function(x){ @@ -61,7 +61,7 @@ test_that("KNN Utils is working...", { ################################################ #tabulate2dCpp -tab2d <- as.matrix(ArchR:::tabulate2dCpp( +tab2d <- as.matrix(tabulate2dCpp( x = c(0,0,2,2,3), xmin = 0, xmax = 3, @@ -85,7 +85,7 @@ test_that("Tabulate Utils is working...", { sm1 <- as(m1, "dgCMatrix") #Variances -var1 <- ArchR:::computeSparseRowVariances( +var1 <- computeSparseRowVariances( sm1@i + 1, sm1@x, Matrix::rowMeans(sm1), ncol(sm1)) var2 <- apply(m1, 1, var) From 0bea89269f75342f1cfc8a59b34b8ff2cbd32d06 Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Thu, 17 Nov 2022 13:53:12 -0800 Subject: [PATCH 022/162] saving ArchRProjShiny --- R/exportShinyArchR.R | 44 +++++++++++++++++--------------------------- 1 file changed, 17 insertions(+), 27 deletions(-) diff --git a/R/exportShinyArchR.R b/R/exportShinyArchR.R index 7afb7d33..60645c01 100644 --- a/R/exportShinyArchR.R +++ b/R/exportShinyArchR.R @@ -70,10 +70,10 @@ exportShinyArchR <- function( filesUrl <- data.frame( fileUrl = c( - "https://raw.githubusercontent.com/paupaiz/ArchR/Shiny_export/R/Shiny/app.R", - "https://raw.githubusercontent.com/paupaiz/ArchR/Shiny_export/R/Shiny/global.R", - "https://raw.githubusercontent.com/paupaiz/ArchR/Shiny_export/R/Shiny/server.R", - "https://raw.githubusercontent.com/paupaiz/ArchR/Shiny_export/R/Shiny/ui.R" + https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/app.R + https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/global.R + https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/server.R + https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/ui.R ), md5sum = c( "77502e1f195e21d2f7a4e8ac9c96e65e", @@ -84,7 +84,7 @@ exportShinyArchR <- function( ) .downloadFiles(filesUrl = filesUrl, pathDownload = outputDir, threads = threads) - + }else{ message("Using existing Shiny files...") } @@ -92,41 +92,34 @@ exportShinyArchR <- function( # Create a copy of the ArchRProj object ArchRProjShiny <- ArchRProj # Add metadata to ArchRProjShiny - if (is.na(paste0("ArchRProj$", groupBy))) { + if (groupBy %ni% colnames(ArchRProjShiny@cellColData)) { stop("groupBy is not part of cellColData") } else if ((any(is.na(paste0("ArchRProj$", groupBy))))) { - stop("incomplete data. some NA observations for groupBy") + stop("Some entries in the column indicated by groupBy have NA values. + This is not allowed. Please subset your project using subsetArchRProject() to only contain cells with values for groupBy") } else { ArchRProjShiny@projectMetadata[["groupBy"]] <- groupBy } ArchRProjShiny@projectMetadata[["tileSize"]] <- tileSize - # saveArchRProject(ArchRProj = ArchRProj, outputDirectory = "Save-ArchRProjShiny", dropCells = TRUE) - # file = "/Users/selcukkorkmaz/Documents/upwork/Paulina Paiz/Shiny/Save-ArchRProjShiny/ArrowFiles/scATAC_BMMC_R1.arrow" - # Create fragment files - - + ArchrProjShiny <- saveArchRProject(ArchRProj = ArchRProjShiny, outputDirectory = "Save-ArchRProjShiny", dropCells = TRUE, overwrite = FALSE) + # Create fragment files if(length(list.files(file.path(outputDir, "fragments"))) == 0){ - .getGroupFragsFromProj(ArchRProj = ArchRProjShiny, groupBy = groupBy, outDir = file.path(outputDir, "fragments")) - }else{ - + .getGroupFragsFromProj(ArchRProj = ArchRProj, groupBy = groupBy, outDir = file.path(outputDir, "fragments")) + }else{ message("Fragment files already exist...") - } - - # Create coverage objects if(length(list.files(file.path(outputDir, "coverage"))) == 0){ - .getClusterCoverage(ArchRProj = ArchRProjShiny, tileSize = tileSize, groupBy = groupBy, outDir = file.path(outputDir, "coverage")) + .getClusterCoverage(ArchRProj = ArchRProj, tileSize = tileSize, groupBy = groupBy, outDir = file.path(outputDir, "coverage")) }else{ message("Coverage files already exist...") } ## main umaps ----------------------------------------------------------------- - # dir.create("UMAPs") - + units <- tryCatch({ .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, "/Info/Units"))[1] },error=function(e){ @@ -135,8 +128,9 @@ exportShinyArchR <- function( ArchRProjShiny@projectMetadata[["units"]] <- units - #need arrowFiles to getFeatures so need to save genes as RDS - if(!file.exists("./Shiny/data/inputData/gene_names.rds")){ + # need arrowFiles to getFeatures so need to save genes as RDS + # TODO change hardcoding of these paths: Should be file.path(getOutputDirectory(ArchRProj), outputDir, "inputData", "features.rds" + if(!file.exists(file.path(getOutputDirectory(ArchRProj), outputDir, "inputData", "features.rds"))){ gene_names <- getFeatures(ArchRProj = ArchRProj) saveRDS(gene_names, "./Shiny/data/inputData/gene_names.rds") }else{ @@ -155,11 +149,9 @@ exportShinyArchR <- function( embedding = "UMAP", rastr = FALSE, size=0.5, - file="/Users/selcukkorkmaz/Documents/upwork/Paulina Paiz/Shiny/Save-ArchRProjShiny/ArrowFiles/scATAC_BMMC_R1.arrow" )+ggtitle("Colored by scATAC-seq clusters")+theme(text=element_text(size=12), legend.title = element_text(size = 12),legend.text = element_text(size = 6)) umaps[["Clusters"]] <- cluster_umap - # saveRDS(cluster_umap, "./UMAPs/cluster_umap.rds") sample_umap <- plotEmbedding( ArchRProj = ArchRProj, @@ -172,7 +164,6 @@ exportShinyArchR <- function( )+ ggtitle("Colored by original identity")+theme(text=element_text(size=12), legend.title = element_text( size = 12),legend.text = element_text(size = 6)) umaps[["Sample"]] <- sample_umap - # saveRDS(sample_umap, "./UMAPs/sample_umap.rds") constrained_umap <- plotEmbedding( ArchRProj = ArchRProjShiny, @@ -183,7 +174,6 @@ exportShinyArchR <- function( 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)) - # saveRDS(constrained_umap, "./UMAPs/constrained_umap.rds") umaps[["Constrained"]] <- constrained_umap unconstrained_umap <- plotEmbedding( From 6ec7a1752793bde2a8dab4b367f3de7fa440799b Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Thu, 17 Nov 2022 14:42:21 -0800 Subject: [PATCH 023/162] adding arguments to exportShinyArchR --- R/exportShinyArchR.R | 45 +++++++++----------------------------------- 1 file changed, 9 insertions(+), 36 deletions(-) diff --git a/R/exportShinyArchR.R b/R/exportShinyArchR.R index 60645c01..34dfeeaa 100644 --- a/R/exportShinyArchR.R +++ b/R/exportShinyArchR.R @@ -1,28 +1,3 @@ -library(Matrix) -library(plyr) -library(dplyr) -library(rhandsontable) -library(parallel) -library(jpeg) -library(rhdf5) -library(ArchR) -library(rstudioapi) -library(BSgenome.Hsapiens.UCSC.hg19) -source("rasterUMAPs.R") -source("plotEmbeddingShiny.r") - -setwd(dirname(getActiveDocumentContext()$path)) -dir.create("Shiny", showWarnings = FALSE) -dir.create("Shiny/inputData", showWarnings = FALSE) - -set.seed(1) -ArchRProj <- loadArchRProject("~/tests/ArchR/Save-ArchRProjShiny-Arrows/") -ArchRProj <- addImputeWeights(ArchRProj = ArchRProj) -ArchRProj_noArrows <- myLoadArchRProject("~/tests/colors/inputData") -ArchRProj_noArrows <- addImputeWeights(ArchRProj = ArchRProj) - - - # exportShiny function ----------------------------------------------------------- #' Export a Shiny App based on ArchRProj #' @@ -31,18 +6,17 @@ ArchRProj_noArrows <- addImputeWeights(ArchRProj = ArchRProj) #' @param ArchRProj An `ArchRProject` object loaded in the environment. Can do this using: loadArchRProject("path to ArchRProject/") #' @param outputDir The name of the directory for the Shiny App files. #' @param groupBy The name of the column in cellColData to use for grouping cells together for generating sequencing tracks. Only one cell grouping is allowed. +#' defaults to "Clusters". #' @param tileSize The numeric width of the tile/bin in basepairs for plotting ATAC-seq signal tracks. All insertions in a single bin will be summed. #' @param threads The number of threads to use for parallel execution. #' @param logFile The path to a file to be used for logging ArchR output. #' @export exportShinyArchR <- function( ArchRProj = NULL, - FDR = 0.01, - Log2FC = 1.25, outputDir = "Shiny", groupBy = "Clusters", + embedding = "UMAP", tileSize = 100, - markerList = NULL, threads = getArchRThreads(), logFile = createLogFile("exportShinyArchR") ){ @@ -50,12 +24,10 @@ exportShinyArchR <- function( .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) .validInput(input = outputDir, name = "outputDir", valid = c("character")) .validInput(input = groupBy, name = "groupBy", valid = c("character")) + .validInput(input = embedding, name = "embedding", valid = c("character")) .validInput(input = tileSize, name = "tileSize", valid = c("integer")) .validInput(input = threads, name = "threads", valid = c("integer")) .validInput(input = logFile, name = "logFile", valid = c("character")) - .validInput(input = threads, name = "threads", valid = c("integer")) - .validInput(input = verbose, name = "verbose", valid = c("boolean")) - .validInput(input = logFile, name = "logFile", valid = c("character")) .startLogging(logFile=logFile) .logThis(mget(names(formals()),sys.frame(sys.nframe())), "exportShinyArchR Input-Parameters", logFile = logFile) @@ -101,6 +73,11 @@ exportShinyArchR <- function( ArchRProjShiny@projectMetadata[["groupBy"]] <- groupBy } ArchRProjShiny@projectMetadata[["tileSize"]] <- tileSize + units <- tryCatch({ + .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, "/Info/Units"))[1] + },error=function(e){ + "values" + }) ArchrProjShiny <- saveArchRProject(ArchRProj = ArchRProjShiny, outputDirectory = "Save-ArchRProjShiny", dropCells = TRUE, overwrite = FALSE) # Create fragment files @@ -120,11 +97,7 @@ exportShinyArchR <- function( } ## main umaps ----------------------------------------------------------------- - units <- tryCatch({ - .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, "/Info/Units"))[1] - },error=function(e){ - "values" - }) + dir.create(file.path(getOutputDirectory(ArchRProj), outputDir, "inputData")"showWarnings = FALSE") ArchRProjShiny@projectMetadata[["units"]] <- units From fe687650538241ef8cf9865eb8f9dc06679d9306 Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Thu, 17 Nov 2022 21:36:31 -0800 Subject: [PATCH 024/162] allow for any embedding in mainUMAPs WIP --- R/exportShinyArchR.R | 20 ++++-- R/mainUMAPs.R | 148 +++++++++++++++++++------------------------ 2 files changed, 80 insertions(+), 88 deletions(-) diff --git a/R/exportShinyArchR.R b/R/exportShinyArchR.R index 34dfeeaa..01da0fa4 100644 --- a/R/exportShinyArchR.R +++ b/R/exportShinyArchR.R @@ -35,6 +35,17 @@ exportShinyArchR <- function( .requirePackage("shiny", installInfo = 'install.packages("shiny")') .requirePackage("rhandsontable", installInfo = 'install.packages("rhandsontable")') + # Check that all columns exist in cellColData + if(is.null(groupBy)){ + stop("groupBy must be provided") + } else if(name %ni% colnames(getCellColData(ArchRProj))){ + stop("groupBy must be a column in cellColData") + } + # Check that the embedding exists in ArchRProj@embeddings + if(name %in% names(ArchRProj@embeddings)){ + stop("embedding doesn't exist in ArchRProj@embeddings") + } + # Make directory for Shiny App if(!dir.exists(outputDir)) { @@ -78,6 +89,7 @@ exportShinyArchR <- function( },error=function(e){ "values" }) + ArchRProjShiny@projectMetadata[["units"]] <- units ArchrProjShiny <- saveArchRProject(ArchRProj = ArchRProjShiny, outputDirectory = "Save-ArchRProjShiny", dropCells = TRUE, overwrite = FALSE) # Create fragment files @@ -98,9 +110,7 @@ exportShinyArchR <- function( ## main umaps ----------------------------------------------------------------- dir.create(file.path(getOutputDirectory(ArchRProj), outputDir, "inputData")"showWarnings = FALSE") - - ArchRProjShiny@projectMetadata[["units"]] <- units - + # need arrowFiles to getFeatures so need to save genes as RDS # TODO change hardcoding of these paths: Should be file.path(getOutputDirectory(ArchRProj), outputDir, "inputData", "features.rds" if(!file.exists(file.path(getOutputDirectory(ArchRProj), outputDir, "inputData", "features.rds"))){ @@ -117,9 +127,9 @@ exportShinyArchR <- function( cluster_umap <- plotEmbedding( ArchRProj = ArchRProjShiny, baseSize=12, - colorBy = "cellColData", + colorBy = groupBy, name = "Clusters", - embedding = "UMAP", + embedding = embedding, rastr = FALSE, size=0.5, )+ggtitle("Colored by scATAC-seq clusters")+theme(text=element_text(size=12), diff --git a/R/mainUMAPs.R b/R/mainUMAPs.R index c104d0be..3b69d104 100644 --- a/R/mainUMAPs.R +++ b/R/mainUMAPs.R @@ -1,97 +1,79 @@ -# mainUmaps function ----------------------------------------------------------- +# mainEmbeds function ----------------------------------------------------------- #' -#' Create an HDF5, mainUMAPs.h5, containing the nativeRaster vectors for the 5 main UMAPS. +#' Create an HDF5, mainEmbeds.h5, containing the nativeRaster vectors for the 5 main embeddings. #' This function will be called by exportShinyArchR() #' #' @param ArchRProj An `ArchRProject` object loaded in the environment. Can do this using: loadArchRProject("path to ArchRProject/") -#' @param outputDirUmaps Where the HDF5 and the jpgs will be saved. +#' @param outDirEmbed Where the HDF5 and the jpgs will be saved. +#' @param colorBy A string indicating whether points in the plot should be colored by a column in `cellColData` ("cellColData") or by +#' a data matrix in the corresponding ArrowFiles (i.e. "GeneScoreMatrix", "MotifMatrix", "PeakMatrix"). +#' @param names A list of the names of the columns in `cellColData` or the featureName/rowname of the data matrix to be used for plotting. +#' For example if colorBy is "cellColData" then `names` refers to a column names in the `cellcoldata` (see `getCellcoldata()`). If `colorBy` +#' is "GeneScoreMatrix" then `name` refers to a gene name which can be listed by `getFeatures(ArchRProj, useMatrix = "GeneScoreMatrix")`. +#' @param embedding The embedding to use. Default is "UMAP" #' @param threads The number of threads to use for parallel execution. -#' @param verbose A boolean value that determines whether standard output should be printed. #' @param logFile The path to a file to be used for logging ArchR output. #' @export -mainUMAPs <- function( +mainEmbeds <- function( ArchRProj = NULL, - outputDirUmaps = "Shiny/inputData", + outDirEmbed = "Shiny/inputData", + colorBy = "cellColData" + names = list("Clusters", "Sample", "unconstrained") + embedding = "UMAP" threads = getArchRThreads(), - verbose = TRUE, - logFile = createLogFile("mainUMAPs") + logFile = createLogFile("mainEmbeds") ){ - if(!file.exists(file.path(outputDirUmaps, "umaps.rds"))){ - umaps <- list() + .validInput(input = ArchRProj, name = "ArchRProj", valid = c("list","null")) + .validInput(input = outDirEmbed, name = "outDirEmbed", valid = c("character")) + .validInput(input = colorBy, name = "colorBy", valid = c("character")) + .validInput(input = names, name = "names", valid = c("list")) + .validInput(input = embedding, name = "embedding", valid = c("character")) + .validInput(input = threads, name = "threads", valid = c("numeric")) + .validInput(input = logFile, name = "logFile", valid = c("character")) + + .startLogging(logFile=logFile) + .logThis(mget(names(formals()),sys.frame(sys.nframe())), "exportShinyArchR Input-Parameters", logFile = logFile) + + if(!file.exists(file.path(outDirEmbed, "embeds.rds"))){ - cluster_umap <- plotEmbedding( - ArchRProj = ArchRProj, - baseSize=12, - colorBy = "cellColData", - name = "Clusters", - embedding = "UMAP", - rastr = FALSE, - 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)) - umaps[["Clusters"]] <- cluster_umap + embeds <- .safelapply(seq_along(names), function(x)){ + + name <- names[[x]] - sample_umap <- plotEmbedding( + named_embed <- plotEmbedding( ArchRProj = ArchRProj, - baseSize=12, - colorBy = "cellColData", - name = "Sample", - embedding = "UMAP", + baseSize = 12, + colorBy = colorBy, + name = name, + embedding = embedding, 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)) - umaps[["Sample"]] <- sample_umap - - constrained_umap <- plotEmbedding( - ArchRProj = ArchRProjShiny, - 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)) - umaps[["Constrained"]] <- constrained_umap - - unconstrained_umap <- plotEmbedding( - ArchRProj = ArchRProjShiny, - embedding = "UMAP", - colorBy = "cellColData", - name = "predictedGroup_Un", - 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)) - umaps[["Unconstrained"]] <- unconstrained_umap - - constrained_remapped_umap <- plotEmbedding( - ArchRProj = ArchRProjShiny, - 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)) - umaps[["Constrained remap"]] <- constrained_remapped_umap - - saveRDS(umaps, file.path(outputDirUmaps, "umaps.rds")) + size = 0.5, + )+ggtitle(paste0("Colored by", name))+theme(text = element_text(size=12), + legend.title = element_text(size = 12),legend.text = element_text(size = 6)) + embeds[[named_embed]] <- named_embed + } + + saveRDS(embeds, file.path(outDirEmbed, "embeds.rds")) + } else { - message("umaps already exists...") - umaps <- readRDS(file.path(outputDirUmaps, "umaps.rds")) + message("embeddings already exist...") + embeds <- readRDS(file.path(outDirEmbed, "embeds.rds")) } h5closeAll() - points <- H5Fcreate(name = file.path(outputDirUmaps, "mainUMAPs.h5")) - umap_legend <- list() - umap_color <- list() - for(i in 1:length(umaps)){ + points <- H5Fcreate(name = file.path(outDirEmbed, "mainEmbeds.h5")) + + embed_legend <- list() + embed_color <- list() + + for(i in 1:length(embeds)){ - umap_plot <- umaps[i] + embed_plot <- embeds[i] - umap_plot[[1]]$labels$title <- NULL - umap_plot_blank <- umap_plot[[1]] + theme(axis.title.x = element_blank()) + + embed_plot[[1]]$labels$title <- NULL + embed_plot_blank <- embed_plot[[1]] + theme(axis.title.x = element_blank()) + theme(axis.title.y = element_blank()) + theme(axis.title = element_blank()) + theme(legend.position = "none") + @@ -103,24 +85,24 @@ mainUMAPs <- function( ) #save plot without axes etc as a jpg. - ggsave(filename = file.path(outputDirUmaps, paste0(names(umaps)[i],"_blank72.jpg")), - plot = umap_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) + ggsave(filename = file.path(outDirEmbed, paste0(names(embeds)[i],"_blank72.jpg")), + plot = embed_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) #read back in that jpg because we need vector in native format - blank_jpg72 <- readJPEG(source = file.path(outputDirUmaps, paste0(names(umaps)[[i]],"_blank72.jpg")), native = TRUE) + blank_jpg72 <- readJPEG(source = file.path(outDirEmbed, paste0(names(embeds)[[i]],"_blank72.jpg")), native = TRUE) - h5createDataset(file = points, dataset = names(umaps)[i], dims = c(46656,1), storage.mode = "integer") - h5writeDataset(obj = as.vector(blank_jpg72), h5loc = points, name= names(umaps)[i]) + h5createDataset(file = points, dataset = names(embeds)[i], dims = c(46656,1), storage.mode = "integer") + h5writeDataset(obj = as.vector(blank_jpg72), h5loc = points, name= names(embeds)[i]) - umap_legend[[i]] <- levels(umap_plot[[1]]$data$color) - names(umap_legend)[[i]] <- names(umap_plot) + embed_legend[[i]] <- levels(embed_plot[[1]]$data$color) + names(embed_legend)[[i]] <- names(embed_plot) - umap_color[[i]] <- unique(ggplot_build(umap_plot[[1]])$data[[1]][,"colour"]) - names(umap_color)[[i]] <- names(umap_plot) + embed_color[[i]] <- unique(ggplot_build(embed_plot[[1]])$data[[1]][,"colour"]) + names(embed_color)[[i]] <- names(embed_plot) } - saveRDS(umap_color, file.path(outputDirUmaps, "color_umaps.rds")) - saveRDS(umap_legend, file.path(outputDirUmaps, "umap_legend_names.rds")) + saveRDS(embed_color, file.path(outDirEmbed, "embeddings.rds")) + saveRDS(embed_legend, file.path(outDirEmbed, "embed_legend_names.rds")) } From 63061870fdbea8f728d6f63c865308d2ec3f7cd2 Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Sun, 27 Nov 2022 12:31:13 -0600 Subject: [PATCH 025/162] "de-hard-coding embeddings" --- R/{mainUMAPs.R => MainEmbed.R} | 24 ++++++++++++++++++++---- R/exportShinyArchR.R | 3 +++ 2 files changed, 23 insertions(+), 4 deletions(-) rename R/{mainUMAPs.R => MainEmbed.R} (85%) diff --git a/R/mainUMAPs.R b/R/MainEmbed.R similarity index 85% rename from R/mainUMAPs.R rename to R/MainEmbed.R index 3b69d104..e45b2250 100644 --- a/R/mainUMAPs.R +++ b/R/MainEmbed.R @@ -1,4 +1,4 @@ -# mainEmbeds function ----------------------------------------------------------- +# mainEmbed function ----------------------------------------------------------- #' #' Create an HDF5, mainEmbeds.h5, containing the nativeRaster vectors for the 5 main embeddings. #' This function will be called by exportShinyArchR() @@ -10,14 +10,14 @@ #' @param names A list of the names of the columns in `cellColData` or the featureName/rowname of the data matrix to be used for plotting. #' For example if colorBy is "cellColData" then `names` refers to a column names in the `cellcoldata` (see `getCellcoldata()`). If `colorBy` #' is "GeneScoreMatrix" then `name` refers to a gene name which can be listed by `getFeatures(ArchRProj, useMatrix = "GeneScoreMatrix")`. -#' @param embedding The embedding to use. Default is "UMAP" +#' @param embedding The embedding to use. Default is "UMAP". #' @param threads The number of threads to use for parallel execution. #' @param logFile The path to a file to be used for logging ArchR output. #' @export -mainEmbeds <- function( +mainEmbed <- function( ArchRProj = NULL, outDirEmbed = "Shiny/inputData", - colorBy = "cellColData" + colorBy = "cellColData" names = list("Clusters", "Sample", "unconstrained") embedding = "UMAP" threads = getArchRThreads(), @@ -35,8 +35,24 @@ mainEmbeds <- function( .startLogging(logFile=logFile) .logThis(mget(names(formals()),sys.frame(sys.nframe())), "exportShinyArchR Input-Parameters", logFile = logFile) +# check to see if the matrix exists using getAvailableMatrices() +# Check if colorBy is cellColData or Matrix (e.g. GSM, GIM, or MM) +# Check if embedding exists in ArchRProj@embeddings +# Check all names exist + if(!file.exists(file.path(outDirEmbed, "embeds.rds"))){ + # check all names exist in ArchRProj + ccd <- getCellColData(ArchRProj) + discreteCols <- lapply(seq_len(ncol(ccd)), function(x){ + .isDiscrete(ccd[, x]) + }) %>% unlist %>% {colnames(ccd)[.]} + if("Clusters" %in% discreteCols){ + selectCols <- "Clusters" + }else{ + selectCols <- "Sample" + } + embeds <- .safelapply(seq_along(names), function(x)){ name <- names[[x]] diff --git a/R/exportShinyArchR.R b/R/exportShinyArchR.R index 01da0fa4..9063a85b 100644 --- a/R/exportShinyArchR.R +++ b/R/exportShinyArchR.R @@ -190,6 +190,7 @@ exportShinyArchR <- function( #Get gene and motif names and save as RDS if(!file.exists("./Shiny/data/inputData/gene_names_GSM.rds")){ + # TODO check if ArchRProj has GSM gene_names_GSM <- getFeatures(ArchRProj = ArchRProj, useMatrix = "GeneScoreMatrix") saveRDS(gene_names_GSM, file="./Shiny/data/inputData/gene_names_GSM.rds") }else{ @@ -198,6 +199,7 @@ exportShinyArchR <- function( } if(!file.exists("./Shiny/data/inputData/gene_names_GIM.rds")){ + # TODO check if ArchRProj has GIM gene_names_GIM <- getFeatures(ArchRProj = ArchRProj, useMatrix = "GeneIntegrationMatrix") saveRDS(gene_names_GIM, "./Shiny/data/inputData/gene_names_GIM.rds") }else{ @@ -206,6 +208,7 @@ exportShinyArchR <- function( } if(!file.exists("./Shiny/data/inputData/motif_names.rds")){ + # TODO check if ArchRProj has MM motif_names <- getFeatures(ArchRProj = ArchRProj, useMatrix = "MotifMatrix") %>% gsub(".*:", "", .) %>% unique(.) saveRDS(motif_names, "./Shiny/data/inputData/motif_names.rds") From a2021414e5f95b1bd78a6a11ec4f97ed80c75ca4 Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Sun, 27 Nov 2022 12:51:26 -0600 Subject: [PATCH 026/162] de-hardcoding embeds --- R/exportShinyArchR.R | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/R/exportShinyArchR.R b/R/exportShinyArchR.R index 9063a85b..8e43949d 100644 --- a/R/exportShinyArchR.R +++ b/R/exportShinyArchR.R @@ -188,11 +188,18 @@ exportShinyArchR <- function( ## colorMats without Impute Weights---------------------------------------------------------------- + #TODO check with matrices are available + allMatrices <- getAvailableMatrices(ArchRProj) + #Get gene and motif names and save as RDS if(!file.exists("./Shiny/data/inputData/gene_names_GSM.rds")){ # TODO check if ArchRProj has GSM - gene_names_GSM <- getFeatures(ArchRProj = ArchRProj, useMatrix = "GeneScoreMatrix") - saveRDS(gene_names_GSM, file="./Shiny/data/inputData/gene_names_GSM.rds") + if ("GeneScoreMatrix" %in% allMatrices){ + gene_names_GSM <- getFeatures(ArchRProj = ArchRProj, matrix = "GeneScoreMatrix") + saveRDS(gene_names_GSM, "./Shiny/data/inputData/gene_names_GSM.rds") + { + # else skip to checking if next matrix exists and output message saying no GSM + } }else{ message("gene_names_GSM already exists...") gene_names_GSM <- readRDS("./Shiny/data/inputData/gene_names_GSM.rds") From 77e49db48ee1bccdfc8816c85eb4d3113816d905 Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Sun, 4 Dec 2022 21:49:27 +0300 Subject: [PATCH 027/162] multiple changes have been made MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 1. “subOutputDir” argument added 2. umaps created with the loop 3. available matrices in the ArchRProj checked 4. The message changed as follows: message("App created! To launch, ArchRProj <- loadArchRProject('",getwd(),"') and run shiny::runApp('", outputDir, "') from parent directory") --- R/exportShinyArchR.R | 498 +++++++++++++++++++++++++++++++++---------- 1 file changed, 388 insertions(+), 110 deletions(-) diff --git a/R/exportShinyArchR.R b/R/exportShinyArchR.R index 8e43949d..34109a1b 100644 --- a/R/exportShinyArchR.R +++ b/R/exportShinyArchR.R @@ -1,3 +1,214 @@ +# Setting up ---------------------------------------------------------------------- + +library(shinycssloaders) +library(hexbin) +library(magick) +library(gridExtra) +library(grid) +library(patchwork) +library(shinybusy) +library(cowplot) +library(ggpubr) +library(farver) +library(rhdf5) +library(plotfunctions) +library(raster) +library(jpeg) +library(sparseMatrixStats) +library(BiocManager) +# options(repos = BiocManager::repositories()) +library(AnnotationDbi) +library(BSgenome) +library(Biobase) +library(BiocGenerics) +library(BiocParallel) +library(Biostrings) +library(CNEr) +library(ComplexHeatmap) +# options(download.file.method = "libcurl") +# devtools::install_github("selcukorkmaz/ArchR", ref = "dev") +library(ArchR) + +# specify whether you use a local machine or the shiny app +ShinyArchR = TRUE + +# specify desired number of threads +addArchRThreads(threads = 1) +# specify genome version. Default hg19 set +addArchRGenome("hg19") +set.seed(1) + +ArchRProj=loadArchRProject(path = "Save-ProjHeme5/") +ArchRProj <- addImputeWeights(ArchRProj = ArchRProj) +setwd(getOutputDirectory(ArchRProj)) + +# myLoadArchRProject ----------------------------------- +#' Load Previous ArchRProject into R +#' +#' This function will load a previously saved ArchRProject and re-normalize paths for usage. +#' +#' @param path A character path to an `ArchRProject` directory that was previously saved using `saveArchRProject()`. +#' @param force A boolean value indicating whether missing optional `ArchRProject` components (i.e. peak annotations / +#' background peaks) should be ignored when re-normalizing file paths. If set to `FALSE` loading of the `ArchRProject` +#' will fail unless all components can be found. +#' @param showLogo A boolean value indicating whether to show the ascii ArchR logo after successful creation of an `ArchRProject`. +#' @export +myLoadArchRProject <- function(path = "./", + force = FALSE, + showLogo = TRUE) { + .validInput(input = path, + name = "path", + valid = "character") + .validInput(input = force, + name = "force", + valid = "boolean") + .validInput(input = showLogo, + name = "showLogo", + valid = "boolean") + + path2Proj <- file.path(path, "Save-ArchR-Project.rds") + + if (!file.exists(path2Proj)) { + stop("Could not find previously saved ArchRProject in the path specified!") + } + + ArchRProj <- recoverArchRProject(readRDS(path2Proj)) + outputDir <- getOutputDirectory(ArchRProj) + outputDirNew <- normalizePath(path) + + + ArchRProj@projectMetadata$outputDirectory <- outputDirNew + + message("Successfully loaded ArchRProject!") + if (showLogo) { + .ArchRLogo(ascii = "Logo") + } + + ArchRProj + +} + + +## Create fragment files ----------------------------------------------------------- +.getGroupFragsFromProj <- function(ArchRProj = NULL, + groupBy = NULL, + outDir = file.path("Shiny", "fragments")) { + dir.create(outDir, showWarnings = FALSE) + + # find barcodes of cells in that groupBy. + groups <- getCellColData(ArchRProj, select = groupBy, drop = TRUE) + cells <- ArchRProj$cellNames + cellGroups <- split(cells, groups) + + # outputs unique cell groups/clusters. + clusters <- names(cellGroups) + + + for (cluster in clusters) { + cat("Making fragment file for cluster:", cluster, "\n") + # get GRanges with all fragments for that cluster + cellNames = cellGroups[[cluster]] + fragments <- + getFragmentsFromProject(ArchRProj = ArchRProj, cellNames = cellNames) + fragments <- unlist(fragments, use.names = FALSE) + # filter Fragments + fragments <- + GenomeInfoDb::keepStandardChromosomes(fragments, pruning.mode = "coarse") + saveRDS(fragments, file.path(outDir, paste0(cluster, "_cvg.rds"))) + } +} + +addSeqLengths <- function (gr, genome) { + gr <- ArchR:::.validGRanges(gr) + genome <- validBSgenome(genome) + stopifnot(all(as.character(seqnames(gr)) %in% as.character(seqnames(genome)))) + seqlengths(gr) <- + seqlengths(genome)[as.character(names(seqlengths(gr)))] + return(gr) +} + +.getClusterCoverage <- function(ArchRProj = NULL, + tileSize = 100, + scaleFactor = 1, + groupBy = "Clusters", + outDir = file.path("Shiny", "coverage")) { + fragfiles = list.files(path = file.path("Shiny", "fragments"), + full.names = TRUE) + dir.create(outDir, showWarnings = FALSE) + + # find barcodes of cells in that groupBy. + groups <- getCellColData(ArchRProj, select = groupBy, drop = TRUE) + cells <- ArchRProj$cellNames + cellGroups <- split(cells, groups) + + # outputs unique cell groups/clusters. + clusters <- names(cellGroups) + + chrRegions <- getChromSizes(ArchRProj) + genome <- getGenome(ArchRProj) + + for (file in fragfiles) { + fragments <- readRDS(file) + #fragmentsToInsertions() + left <- GRanges(seqnames = seqnames(fragments), + ranges = IRanges(start(fragments), width = 1)) + right <- GRanges(seqnames = seqnames(fragments), + ranges = IRanges(end(fragments), width = 1)) + # call sort() after sortSeqlevels() to sort also the ranges in addition + # to the chromosomes. + insertions <- c(left, right) %>% sortSeqlevels() %>% + sort() + + cluster <- file %>% basename() %>% gsub("_.*", "", .) + #binnedCoverage + # message("Creating bins for cluster ",clusters[clusteridx], "...") + bins <- + unlist(slidingWindows(chrRegions, width = tileSize, step = tileSize)) + # message("Counting overlaps for cluster ",clusters[clusteridx], "...") + bins$reads <- + countOverlaps( + bins, + insertions, + maxgap = -1L, + minoverlap = 0L, + type = "any" + ) + addSeqLengths(bins, genome) + # message("Creating binned coverage for cluster ",clusters[clusteridx], "...") + #each value is multiplied by that weight. + # TODO add scaleFactor + # allCells as.vector(ArchRProj@cellColData$Sample, mode="any") + clusterReadsInTSS <- + ArchRProj@cellColData$ReadsInTSS[cells %in% cellGroups$cluster] + # scaleFactor <- 5e+06 / sum(clusterReadsInTSS) + binnedCoverage <- + coverage(bins, weight = bins$reads * scaleFactor) + saveRDS(binnedCoverage, file.path(outDir, paste0(cluster, "_cvg.rds"))) + } + +} + + +############################################################# + +# ArchRProj=myLoadArchRProject("./Shiny/inputData/") + + +# Load all hidden ArchR functions ------------------------------------------------ +fn <- unclass(lsf.str(envir = asNamespace("ArchR"), all = TRUE)) +for (i in seq_along(fn)) { + tryCatch({ + eval(parse(text = paste0(fn[i], "<-", fn[i]))) + }, error = function(x) { + }) +} + +# UMAP Visualization ------------------------------------------------------------ + + + + + # exportShiny function ----------------------------------------------------------- #' Export a Shiny App based on ArchRProj #' @@ -14,6 +225,7 @@ exportShinyArchR <- function( ArchRProj = NULL, outputDir = "Shiny", + subOutputDir = "inputData", groupBy = "Clusters", embedding = "UMAP", tileSize = 100, @@ -35,28 +247,37 @@ exportShinyArchR <- function( .requirePackage("shiny", installInfo = 'install.packages("shiny")') .requirePackage("rhandsontable", installInfo = 'install.packages("rhandsontable")') - # Check that all columns exist in cellColData + # ArchRProj <- myLoadArchRProject(path = paste0("./",outputDir,"/inputData/")) + # ArchRProj <- addImputeWeights(ArchRProj = ArchRProj) + + # TODO: Check that all columns exist in cellColData if(is.null(groupBy)){ stop("groupBy must be provided") - } else if(name %ni% colnames(getCellColData(ArchRProj))){ + } + else if(groupBy %ni% colnames(getCellColData(ArchRProj))){ stop("groupBy must be a column in cellColData") + }else{ + print(paste0("groupBy:", groupBy)) } # Check that the embedding exists in ArchRProj@embeddings - if(name %in% names(ArchRProj@embeddings)){ + if(embedding %ni% names(ArchRProj@embeddings)){ stop("embedding doesn't exist in ArchRProj@embeddings") + }else{ + print(paste0("embedding:", embedding)) } # Make directory for Shiny App if(!dir.exists(outputDir)) { dir.create(outputDir) - + + ## Check the links for the files filesUrl <- data.frame( fileUrl = c( - https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/app.R - https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/global.R - https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/server.R - https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/ui.R + "https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/app.R", + "https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/global.R", + "https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/server.R", + "https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/ui.R" ), md5sum = c( "77502e1f195e21d2f7a4e8ac9c96e65e", @@ -77,7 +298,8 @@ exportShinyArchR <- function( # Add metadata to ArchRProjShiny if (groupBy %ni% colnames(ArchRProjShiny@cellColData)) { stop("groupBy is not part of cellColData") - } else if ((any(is.na(paste0("ArchRProj$", groupBy))))) { + } + else if ((any(is.na(paste0("ArchRProj$", groupBy))))) { stop("Some entries in the column indicated by groupBy have NA values. This is not allowed. Please subset your project using subsetArchRProject() to only contain cells with values for groupBy") } else { @@ -90,7 +312,10 @@ exportShinyArchR <- function( "values" }) ArchRProjShiny@projectMetadata[["units"]] <- units - ArchrProjShiny <- saveArchRProject(ArchRProj = ArchRProjShiny, outputDirectory = "Save-ArchRProjShiny", dropCells = TRUE, overwrite = FALSE) + + # The following gives error: Error in file.copy(oldPath, outputDirectory, recursive = TRUE, overwrite = overwrite) : + # attempt to copy a directory to itself (That is why I commented it out) + # ArchrProjShiny <- saveArchRProject(ArchRProj = ArchRProjShiny, outputDirectory = "Save-ArchRProjShiny", dropCells = TRUE, overwrite = TRUE) # Create fragment files if(length(list.files(file.path(outputDir, "fragments"))) == 0){ @@ -109,82 +334,108 @@ exportShinyArchR <- function( } ## main umaps ----------------------------------------------------------------- - dir.create(file.path(getOutputDirectory(ArchRProj), outputDir, "inputData")"showWarnings = FALSE") + dir.create(file.path(getOutputDirectory(ArchRProj), outputDir, subOutputDir),showWarnings = FALSE) # need arrowFiles to getFeatures so need to save genes as RDS - # TODO change hardcoding of these paths: Should be file.path(getOutputDirectory(ArchRProj), outputDir, "inputData", "features.rds" - if(!file.exists(file.path(getOutputDirectory(ArchRProj), outputDir, "inputData", "features.rds"))){ + # TODO change hardcoding of these paths: Should be file.path(getOutputDirectory(ArchRProj), outputDir, subOutputDir, "features.rds" + if(!file.exists(file.path(getOutputDirectory(ArchRProj), outputDir, subOutputDir, "gene_names.rds"))){ gene_names <- getFeatures(ArchRProj = ArchRProj) - saveRDS(gene_names, "./Shiny/data/inputData/gene_names.rds") + saveRDS(gene_names, paste0("./", outputDir, "/", subOutputDir,"/gene_names.rds")) }else{ message("gene_names already exists...") - gene_names <- readRDS("./Shiny/data/inputData/gene_names.rds") + gene_names <- readRDS(paste0("./", outputDir, "/", subOutputDir,"/gene_names.rds")) } - if(!file.exists("./Shiny/data/inputData/umaps.rds")){ + if(!file.exists(paste0("./", outputDir, "/", subOutputDir,"/umaps.rds"))){ umaps <- list() - cluster_umap <- plotEmbedding( - ArchRProj = ArchRProjShiny, - baseSize=12, - colorBy = groupBy, - name = "Clusters", - embedding = embedding, - rastr = FALSE, - 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)) - umaps[["Clusters"]] <- cluster_umap - - sample_umap <- plotEmbedding( - ArchRProj = ArchRProj, - 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)) - umaps[["Sample"]] <- sample_umap + umapNames <- colnames(ArchRProjShiny@cellColData) - constrained_umap <- plotEmbedding( - ArchRProj = ArchRProjShiny, - 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)) - umaps[["Constrained"]] <- constrained_umap + for(x in 1:length(umapNames)){ + tryCatch( + umap <- plotEmbedding( + ArchRProj = ArchRProjShiny, + baseSize=12, + colorBy = "cellColData", + name = umapNames[x], + embedding = embedding, + rastr = FALSE, + 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)), + + umaps[[umapNames[[x]]]] <- umap, + error = function(e){ + print(e) + }) + } - unconstrained_umap <- plotEmbedding( - ArchRProj = ArchRProjShiny, - embedding = "UMAP", - colorBy = "cellColData", - name = "predictedGroup_Un", - 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)) - # saveRDS(unconstrained_umap, "./UMAPs/unconstrained_umap.rds") - umaps[["unconstrained"]] <- unconstrained_umap + saveRDS(umaps, paste0("./", outputDir, "/", subOutputDir,"/umaps.rds")) - constrained_remapped_umap <- plotEmbedding( - ArchRProj = ArchRProjShiny, - 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)) - # saveRDS(constrained_remapped_umap, "./UMAPs/constrained_remapped_umap.rds") - umaps[["Constrained remap"]] <- constrained_remapped_umap - saveRDS(umaps, "./Shiny/data/inputData/umaps.rds")}else{ + }else{ message("umaps already exists...") - umaps <- readRDS("./Shiny/data/inputData/umaps.rds") + umaps <- readRDS(paste0("./", outputDir, "/", subOutputDir,"/umaps.rds")) } + + # cluster_umap <- plotEmbedding( + # ArchRProj = ArchRProjShiny, + # baseSize=12, + # colorBy = "cellColData", + # name = "TSSEnrichment", + # embedding = embedding, + # rastr = FALSE, + # 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)) + # umaps[["Clusters"]] <- cluster_umap + # + # sample_umap <- plotEmbedding( + # ArchRProj = ArchRProj, + # 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)) + # umaps[["Sample"]] <- sample_umap + # + # constrained_umap <- plotEmbedding( + # ArchRProj = ArchRProjShiny, + # 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)) + # umaps[["Constrained"]] <- constrained_umap + # + # unconstrained_umap <- plotEmbedding( + # ArchRProj = ArchRProjShiny, + # embedding = "UMAP", + # colorBy = "cellColData", + # name = "predictedGroup_Un", + # 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)) + # # saveRDS(unconstrained_umap, "./UMAPs/unconstrained_umap.rds") + # umaps[["Unconstrained"]] <- unconstrained_umap + # + # constrained_remapped_umap <- plotEmbedding( + # ArchRProj = ArchRProjShiny, + # 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)) + # # saveRDS(constrained_remapped_umap, "./UMAPs/constrained_remapped_umap.rds") + # umaps[["Constrained remap"]] <- constrained_remapped_umap + # + ## colorMats without Impute Weights---------------------------------------------------------------- @@ -192,40 +443,53 @@ exportShinyArchR <- function( allMatrices <- getAvailableMatrices(ArchRProj) #Get gene and motif names and save as RDS - if(!file.exists("./Shiny/data/inputData/gene_names_GSM.rds")){ + if(!file.exists(paste0("./", outputDir, "/", subOutputDir,"/gene_names_GSM.rds"))){ # TODO check if ArchRProj has GSM if ("GeneScoreMatrix" %in% allMatrices){ - gene_names_GSM <- getFeatures(ArchRProj = ArchRProj, matrix = "GeneScoreMatrix") - saveRDS(gene_names_GSM, "./Shiny/data/inputData/gene_names_GSM.rds") - { - # else skip to checking if next matrix exists and output message saying no GSM + gene_names_GSM <- getFeatures(ArchRProj = ArchRProj, useMatrix = "GeneScoreMatrix") + saveRDS(gene_names_GSM, paste0("./", outputDir, "/", subOutputDir,"/gene_names_GSM.rds")) + }else{ + message("GeneScoreMatrix does not exist...") } }else{ message("gene_names_GSM already exists...") - gene_names_GSM <- readRDS("./Shiny/data/inputData/gene_names_GSM.rds") + gene_names_GSM <- readRDS(paste0("./", outputDir, "/", subOutputDir,"/gene_names_GSM.rds")) } - if(!file.exists("./Shiny/data/inputData/gene_names_GIM.rds")){ - # TODO check if ArchRProj has GIM + +if(!file.exists(paste0("./", outputDir, "/", subOutputDir,"/gene_names_GIM.rds"))){ + # TODO check if ArchRProj has GIM + if ("GeneIntegrationMatrix" %in% allMatrices){ gene_names_GIM <- getFeatures(ArchRProj = ArchRProj, useMatrix = "GeneIntegrationMatrix") - saveRDS(gene_names_GIM, "./Shiny/data/inputData/gene_names_GIM.rds") + saveRDS(gene_names_GSM, paste0("./", outputDir, "/", subOutputDir,"/gene_names_GIM.rds")) }else{ + + message("GeneIntegrationMatrix does not exist...") + } +}else{ message("gene_names_GIM already exists...") - gene_names_GIM <- readRDS("./Shiny/data/inputData/gene_names_GIM.rds") + gene_names_GIM <- readRDS(paste0("./", outputDir, "/", subOutputDir,"/gene_names_GIM.rds")) } - if(!file.exists("./Shiny/data/inputData/motif_names.rds")){ + + if(!file.exists(paste0("./", outputDir, "/", subOutputDir,"/motif_names.rds"))){ # TODO check if ArchRProj has MM + if ("MotifMatrix" %in% allMatrices){ motif_names <- getFeatures(ArchRProj = ArchRProj, useMatrix = "MotifMatrix") %>% gsub(".*:", "", .) %>% unique(.) - saveRDS(motif_names, "./Shiny/data/inputData/motif_names.rds") + saveRDS(motif_names, paste0("./", outputDir, "/", subOutputDir,"/motif_names.rds")) + }else{ + + message("MotifMatrix does not exist...") + + } }else{ message("motif_names already exists...") - motif_names <- readRDS("./Shiny/data/inputData/motif_names.rds") + motif_names <- readRDS(paste0("./", outputDir, "/", subOutputDir,"/motif_names.rds")) } - if(!file.exists("./Shiny/data/inputData/matrices.rds")){ + if(!file.exists(paste0("./", outputDir, "/", subOutputDir,"/matrices.rds"))){ matrices <- list() #GSM colorMat colorMatGSM <- Matrix(.getMatrixValues( @@ -240,7 +504,7 @@ exportShinyArchR <- function( #GIM colorMatGIM <- Matrix(.getMatrixValues( ArchRProj = ArchRProj, - name = getFeatures(ArchRProj = ArchRProj, useMatrix = "GeneIntegrationMatrix"), + name = gene_names_GIM, matrixName = "GeneIntegrationMatrix", log2Norm = FALSE, threads = threads @@ -251,7 +515,7 @@ exportShinyArchR <- function( colorMatMM <- Matrix(.getMatrixValues( ArchRProj = ArchRProj, #name = getFeatures(ArchRProj, "MotifMatrix") - name = paste0("deviations:", motif_names), #used deviations: + name = paste0("deviations:", motif_names), #used deviations: matrixName = "MotifMatrix", log2Norm = FALSE, threads = threads @@ -261,25 +525,27 @@ exportShinyArchR <- function( #TODO modify this so it only has the matrices we are actually supporting matrices$allColorBy=c("colData", "cellColData", .availableArrays(head(getArrowFiles(ArchRProj), 2))) # shouldn't save rds because it's too hefty for ShinyApps - saveRDS(matrices,"./Shiny/data/inputData/matrices.rds") + saveRDS(matrices, paste0("./", outputDir, "/", subOutputDir,"/matrices.rds")) }else{ message("matrices already exist...") - matrices <- readRDS("./Shiny/data/inputData/matrices.rds") + matrices <- readRDS(paste0("./", outputDir, "/", subOutputDir,"/matrices.rds")) } ## Impute Weights ------------------------------------------------------------ imputeWeights <- getImputeWeights(ArchRProj = ArchRProj) if(!is.null(imputeWeights)) { df <- getEmbedding(ArchRProj, embedding = "UMAP", returnDF = TRUE) - - if(!file.exists("./Shiny/data/inputData/imputeMatricesList.rds")){ + if(!file.exists(paste0("./", outputDir, "/", subOutputDir,"/imputeMatricesList.rds"))){ imputeMatricesList <- list() # colorMats for each colorBy # GSM - colorMatGSM <- matrices$"GeneScoreMatrix" - colorMatGSM <- colorMatGSM[,rownames(df), drop=FALSE] + # colorMatGSM <- matrices$"GeneScoreMatrix" + # colorMatGSM <- colorMatGSM[,rownames(df), drop=FALSE] + colorMatGSM <- matrices[["GeneScoreMatrix"]][,rownames(df), drop=FALSE] + + .logThis(colorMatGSM, "colorMatGSM-Before-Impute", logFile = logFile) @@ -295,8 +561,10 @@ exportShinyArchR <- function( imputeMatricesList$"GeneScoreMatrix" <- colorMatGSM_Impute # GIM - colorMatGIM <- matrices$"GeneIntegrationMatrix" - colorMatGIM <- colorMatGIM[,rownames(df), drop=FALSE] + # colorMatGIM <- matrices$"GeneIntegrationMatrix" + # colorMatGIM <- colorMatGIM[,rownames(df), drop=FALSE] + colorMatGIM <- matrices[["GeneIntegrationMatrix"]][,rownames(df), drop=FALSE] + .logThis(colorMatGIM, "colorMatGIM-Before-Impute", logFile = logFile) @@ -312,8 +580,10 @@ exportShinyArchR <- function( imputeMatricesList$"GeneIntegrationMatrix" <- colorMatGIM_Impute # Motif Matrix - colorMatMM <- matrices$"MotifMatrix" - colorMatMM <- colorMatMM[,rownames(df), drop=FALSE] + # colorMatMM <- matrices$"MotifMatrix" + # colorMatMM <- colorMatMM[,rownames(df), drop=FALSE] + colorMatMM <- matrices[["MotifMatrix"]][,rownames(df), drop=FALSE] + .logThis(colorMatMM, "colorMatMM-Before-Impute", logFile = logFile) @@ -328,25 +598,32 @@ exportShinyArchR <- function( imputeMatricesList$"MotifMatrix" <- colorMatMM_Impute - saveRDS(imputeMatricesList,"./Shiny/data/inputData/imputeMatricesList.rds") + saveRDS(imputeMatricesList,paste0("./", outputDir, "/", subOutputDir,"/imputeMatricesList.rds")) }else{ message("imputeMatricesList already exists...") - imputeMatricesList <- readRDS("./Shiny/data/inputData/imputeMatricesList.rds") + imputeMatricesList <- readRDS(paste0("./", outputDir, "/", subOutputDir,"/imputeMatricesList.rds")) + } + + # Create an HDF5 containing the nativeRaster vectors for the main matrices + if (!file.exists(file.path(outputDir, subOutputDir, "mainEmbeds.h5"))) { + + mainEmbed(ArchRProj = ArchRProj, + outDirEmbed = file.path(outputDir, subOutputDir), + names = as.list(colnames(ArchRProjShiny@cellColData)) + ) + } else{ + message("H5 for main embeds already exists...") } - if(!file.exists("./Shiny/data/inputData/plotBlank72.h5")){ + + if(!file.exists(paste0("./", outputDir, "/", subOutputDir,"/plotBlank72.h5"))){ - rasterUmaps( - ArchRProj = ArchRProj, - FDR = 0.01, - Log2FC = 1.25, - outputDir = "Shiny", - groupBy = "Clusters", - tileSize = 100, - markerList = NULL, + shinyRasterUMAPs( + ArchRProj = NULL, + outputDirUmaps = paste0(outputDir,"/", subOutputDir), threads = getArchRThreads(), verbose = TRUE, - logFile = createLogFile("exportShinyArchR") + logFile = createLogFile("ShinyRasterUMAPs") ) }else{ @@ -360,9 +637,10 @@ exportShinyArchR <- function( ## ready to launch --------------------------------------------------------------- message("App created! To launch, - ArchRProj <- loadArchRProject('path to ArchRProject/') and + ArchRProj <- loadArchRProject('",getwd(),"') and run shiny::runApp('", outputDir, "') from parent directory") # runApp("myappdir") } + } From d7a0c69de4f590bdf43c426791251f5aee6a2687 Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Sun, 4 Dec 2022 21:53:35 +0300 Subject: [PATCH 028/162] Hardcodings and duplicated part removed --- R/MainEmbed.R | 45 ++++++++++++++++++++++++--------------------- 1 file changed, 24 insertions(+), 21 deletions(-) diff --git a/R/MainEmbed.R b/R/MainEmbed.R index e45b2250..57351a3a 100644 --- a/R/MainEmbed.R +++ b/R/MainEmbed.R @@ -16,15 +16,15 @@ #' @export mainEmbed <- function( ArchRProj = NULL, - outDirEmbed = "Shiny/inputData", - colorBy = "cellColData" - names = list("Clusters", "Sample", "unconstrained") - embedding = "UMAP" + outDirEmbed = NULL, + colorBy = "cellColData", + names = list("Clusters", "Sample", "unconstrained"), + embedding = "UMAP", threads = getArchRThreads(), logFile = createLogFile("mainEmbeds") ){ - .validInput(input = ArchRProj, name = "ArchRProj", valid = c("list","null")) + .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) .validInput(input = outDirEmbed, name = "outDirEmbed", valid = c("character")) .validInput(input = colorBy, name = "colorBy", valid = c("character")) .validInput(input = names, name = "names", valid = c("list")) @@ -40,6 +40,8 @@ mainEmbed <- function( # Check if embedding exists in ArchRProj@embeddings # Check all names exist + + if(!file.exists(file.path(outDirEmbed, "embeds.rds"))){ # check all names exist in ArchRProj @@ -53,22 +55,23 @@ mainEmbed <- function( selectCols <- "Sample" } - embeds <- .safelapply(seq_along(names), function(x)){ - - name <- names[[x]] - - named_embed <- plotEmbedding( - ArchRProj = ArchRProj, - baseSize = 12, - colorBy = colorBy, - name = name, - embedding = embedding, - rastr = FALSE, - size = 0.5, - )+ggtitle(paste0("Colored by", name))+theme(text = element_text(size=12), - legend.title = element_text(size = 12),legend.text = element_text(size = 6)) - embeds[[named_embed]] <- named_embed - } + embeds <- .safelapply(1:seq_along(names), function(x){ + name <- names[[x]] + print(name) + + named_embed <- plotEmbedding( + ArchRProj = ArchRProj, + baseSize = 12, + colorBy = colorBy, + name = name, + embedding = embedding, + rastr = FALSE, + size = 0.5, + )+ggtitle(paste0("Colored by ", name))+theme(text = element_text(size=12), + legend.title = element_text(size = 12),legend.text = element_text(size = 6)) + + return(named_embed) + }) saveRDS(embeds, file.path(outDirEmbed, "embeds.rds")) From 920b016ca520ef7aeb4bf5addcdb22103672aea5 Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Sun, 4 Dec 2022 21:56:14 +0300 Subject: [PATCH 029/162] Minor changes have been made. --- R/ShinyRasterUMAPs.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/ShinyRasterUMAPs.R b/R/ShinyRasterUMAPs.R index a4a95684..c1b9b0a2 100644 --- a/R/ShinyRasterUMAPs.R +++ b/R/ShinyRasterUMAPs.R @@ -12,7 +12,7 @@ #' shinyRasterUMAPs <- function( ArchRProj = NULL, - outputDirUmaps = "Shiny/inputData", + outputDirUmaps = NULL, threads = getArchRThreads(), verbose = TRUE, logFile = createLogFile("ShinyRasterUMAPs") @@ -241,4 +241,4 @@ shinyRasterUMAPs <- function( if(exists("MM_umaps_points")){ rm(MM_umaps_points) } } - +} From 84f5c5aea8d75809e438e27ee5dce605e3ace1ca Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Fri, 9 Dec 2022 10:31:07 +0300 Subject: [PATCH 030/162] Delete plotEmbeddingShiny, added new arguments. --- R/VisualizeData.R | 791 ++++++++++++++-------------------------------- 1 file changed, 237 insertions(+), 554 deletions(-) diff --git a/R/VisualizeData.R b/R/VisualizeData.R index f2f1485c..9d542f0b 100644 --- a/R/VisualizeData.R +++ b/R/VisualizeData.R @@ -39,8 +39,8 @@ plotPDF <- function( addDOC = TRUE, useDingbats = FALSE, plotList = NULL - ){ - +){ + #Validate .validInput(input = name, name = "name", valid = "character") .validInput(input = width, name = "width", valid = "numeric") @@ -50,7 +50,7 @@ plotPDF <- function( .validInput(input = useDingbats, name = "useDingbats", valid = "boolean") .validInput(input = plotList, name = "plotList", valid = c("list","null")) ######### - + if(is.null(plotList)){ plotList <- list(...) plotList2 <- list() @@ -97,37 +97,37 @@ plotPDF <- function( }else{ filename <- file.path(outDir, paste0(name, ".pdf")) } - + o <- suppressWarnings(tryCatch({ - + pdf(filename, width = width, height = height, useDingbats = useDingbats) for(i in seq_along(plotList)){ if(inherits(plotList[[i]], "gg")){ - + if(inherits(plotList[[i]], "patchwork")){ - + if(getArchRVerbose()) message("Plotting Patchwork!") print(plotList[[i]]) - + }else{ - + if(getArchRVerbose()) message("Plotting Ggplot!") - + if(!is.null(attr(plotList[[i]], "ratioYX"))){ .fixPlotSize(plotList[[i]], plotWidth = width, plotHeight = height, height = attr(plotList[[i]], "ratioYX"), newPage = FALSE) }else{ .fixPlotSize(plotList[[i]], plotWidth = width, plotHeight = height, newPage = FALSE) } - + } - + if(i != length(plotList)){ grid::grid.newpage() } - + }else if(inherits(plotList[[i]], "gtable")){ - + if(getArchRVerbose()) message("Plotting Gtable!") print(grid::grid.draw(plotList[[i]])) @@ -135,36 +135,36 @@ plotPDF <- function( grid::grid.newpage() } }else if(inherits(plotList[[i]], "HeatmapList") | inherits(plotList[[i]], "Heatmap") ){ - + if(getArchRVerbose()) message("Plotting ComplexHeatmap!") - + padding <- 15 draw(plotList[[i]], - padding = unit(c(padding, padding, padding, padding), "mm"), - heatmap_legend_side = "bot", - annotation_legend_side = "bot" + padding = unit(c(padding, padding, padding, padding), "mm"), + heatmap_legend_side = "bot", + annotation_legend_side = "bot" ) - + }else{ - + if(getArchRVerbose()) message("Plotting Other") - + print(plotList[[i]]) - + } - + } dev.off() - - + + }, error = function(x){ - + if(getArchRVerbose()) message(x) - + })) - + return(invisible(0)) - + } #################################################################### @@ -210,6 +210,9 @@ plotPDF <- function( #' @param baseSize The base font size to use in the plot. #' @param plotAs A string that indicates whether points ("points") should be plotted or a hexplot ("hex") should be plotted. By default #' if `colorBy` is numeric, then `plotAs` is set to "hex". +#' @param Shiny A boolean value that tells the function is calling for Shiny or not. +#' @param matrices A list that contains color matrices for genes. +#' @param imputeMatricesList A list that contains color matrices for genes after imputation. #' @param threads The number of threads to be used for parallel computing. #' @param logFile The path to a file to be used for logging ArchR output. #' @param ... Additional parameters to pass to `ggPoint()` or `ggHex()`. @@ -245,11 +248,14 @@ plotEmbedding <- function( keepAxis = FALSE, baseSize = 10, plotAs = NULL, + Shiny = FALSE, + matrices = NULL, + imputeMatricesList = NULL, threads = getArchRThreads(), logFile = createLogFile("plotEmbedding"), ... - ){ - +){ + .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) .validInput(input = embedding, name = "reducedDims", valid = c("character")) .validInput(input = colorBy, name = "colorBy", valid = c("character")) @@ -268,24 +274,27 @@ plotEmbedding <- function( .validInput(input = keepAxis, name = "keepAxis", valid = c("boolean")) .validInput(input = baseSize, name = "baseSize", valid = c("numeric")) .validInput(input = plotAs, name = "plotAs", valid = c("character", "null")) + .validInput(input = Shiny, name = "Shiny", valid = c("boolean")) + .validInput(input = matrices, name = "matrices", valid = c("list")) + .validInput(input = imputeMatricesList, name = "imputeMatricesList", valid = c("list")) .validInput(input = threads, name = "threads", valid = c("integer")) .validInput(input = logFile, name = "logFile", valid = c("character")) - + .requirePackage("ggplot2", source = "cran") - + .startLogging(logFile = logFile) .logThis(mget(names(formals()),sys.frame(sys.nframe())), "Input-Parameters", logFile=logFile) - + ############################## # Get Embedding ############################## .logMessage("Getting UMAP Embedding", logFile = logFile) df <- getEmbedding(ArchRProj, embedding = embedding, returnDF = TRUE) - + if(!all(rownames(df) %in% ArchRProj$cellNames)){ stop("Not all cells in embedding are present in ArchRProject!") } - + .logThis(df, name = "Embedding data.frame", logFile = logFile) if(!is.null(sampleCells)){ if(sampleCells < nrow(df)){ @@ -295,7 +304,7 @@ plotEmbedding <- function( df <- df[sort(sample(seq_len(nrow(df)), sampleCells)), , drop = FALSE] } } - + #Parameters plotParams <- list(...) plotParams$x <- df[,1] @@ -309,7 +318,7 @@ plotEmbedding <- function( plotParams$rastr <- rastr plotParams$size <- size plotParams$randomize <- randomize - + #Check if Cells To Be Highlighed if(!is.null(highlightCells)){ highlightPoints <- match(highlightCells, rownames(df), nomatch = 0) @@ -317,7 +326,7 @@ plotEmbedding <- function( stop("highlightCells contain cells not in Embedding cellNames! Please make sure that these match!") } } - + #Make Sure ColorBy is valid! if(length(colorBy) > 1){ stop("colorBy must be of length 1!") @@ -327,11 +336,11 @@ plotEmbedding <- function( stop("colorBy must be one of the following :\n", paste0(allColorBy, sep=", ")) } colorBy <- allColorBy[match(tolower(colorBy), tolower(allColorBy))] - + .logMessage(paste0("ColorBy = ", colorBy), logFile = logFile) - + if(tolower(colorBy) == "coldata" | tolower(colorBy) == "cellcoldata"){ - + colorList <- lapply(seq_along(name), function(x){ colorParams <- list() colorParams$color <- as.vector(getCellColData(ArchRProj, select = name[x], drop = FALSE)[rownames(df), 1]) @@ -348,434 +357,106 @@ plotEmbedding <- function( if(x == 1){ .logThis(colorParams, name = "ColorParams 1", logFile = logFile) } - + if(!is.null(imputeWeights)){ if(getArchRVerbose()) message("Imputing Matrix") colorMat <- matrix(colorParams$color, nrow=1) colnames(colorMat) <- rownames(df) - colorMat <- imputeMatrix(mat = colorMat, imputeWeights = imputeWeights, logFile = logFile) - colorParams$color <- as.vector(colorMat) - } - colorParams - }) - - - }else{ - - suppressMessages(message(logFile)) - - units <- tryCatch({ - .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, "/Info/Units"))[1] - },error=function(e){ - "values" - }) - - if(is.null(log2Norm) & tolower(colorBy) == "genescorematrix"){ - log2Norm <- TRUE - } - - if(is.null(log2Norm)){ - log2Norm <- FALSE - } - - colorMat <- .getMatrixValues( - ArchRProj = ArchRProj, - name = name, - matrixName = colorBy, - log2Norm = FALSE, - threads = threads, - logFile = logFile - ) - - if(!all(rownames(df) %in% colnames(colorMat))){ - .logMessage("Not all cells in embedding are present in feature matrix. This may be due to using a custom embedding.", logFile = logFile) - stop("Not all cells in embedding are present in feature matrix. This may be due to using a custom embedding.") - } - - colorMat <- colorMat[,rownames(df), drop=FALSE] - - .logThis(colorMat, "colorMat-Before-Impute", logFile = logFile) - - if(!is.null(imputeWeights)){ - if(getArchRVerbose()) message("Imputing Matrix") - colorMat <- imputeMatrix(mat = as.matrix(colorMat), imputeWeights = imputeWeights, logFile = logFile) - if(!inherits(colorMat, "matrix")){ - colorMat <- matrix(colorMat, ncol = nrow(df)) - colnames(colorMat) <- rownames(df) - } - } - - .logThis(colorMat, "colorMat-After-Impute", logFile = logFile) - - colorList <- lapply(seq_len(nrow(colorMat)), function(x){ - colorParams <- list() - colorParams$color <- colorMat[x, ] - colorParams$discrete <- FALSE - colorParams$title <- sprintf("%s colored by\n%s : %s", plotParams$title, colorBy, name[x]) - if(tolower(colorBy) == "genescorematrix"){ - colorParams$continuousSet <- "horizonExtra" - }else{ - colorParams$continuousSet <- "solarExtra" - } - if(!is.null(continuousSet)){ - colorParams$continuousSet <- continuousSet - } - if(!is.null(discreteSet)){ - colorParams$discreteSet <- discreteSet - } - if(x == 1){ - .logThis(colorParams, name = "ColorParams 1", logFile = logFile) - } - colorParams - }) - - } - - if(getArchRVerbose()) message("Plotting Embedding") - - ggList <- lapply(seq_along(colorList), function(x){ - - if(getArchRVerbose()) message(x, " ", appendLF = FALSE) - - plotParamsx <- .mergeParams(colorList[[x]], plotParams) - - if(plotParamsx$discrete){ - plotParamsx$color <- paste0(plotParamsx$color) - } - - if(!plotParamsx$discrete){ - - if(!is.null(quantCut)){ - plotParamsx$color <- .quantileCut(plotParamsx$color, min(quantCut), max(quantCut)) - } - - plotParamsx$pal <- paletteContinuous(set = plotParamsx$continuousSet) - - if(!is.null(pal)){ - - plotParamsx$pal <- pal - - } - - if(is.null(plotAs)){ - plotAs <- "hexplot" - } - - if(!is.null(log2Norm)){ - if(log2Norm){ - plotParamsx$color <- log2(plotParamsx$color + 1) - plotParamsx$colorTitle <- paste0("Log2(",units," + 1)") - }else{ - plotParamsx$colorTitle <- units - } - } - - if(tolower(plotAs) == "hex" | tolower(plotAs) == "hexplot"){ - - plotParamsx$discrete <- NULL - plotParamsx$continuousSet <- NULL - plotParamsx$rastr <- NULL - plotParamsx$size <- NULL - plotParamsx$randomize <- NULL - - .logThis(plotParamsx, name = paste0("PlotParams-", x), logFile = logFile) - gg <- do.call(ggHex, plotParamsx) - - }else{ - - if(!is.null(highlightCells)){ - plotParamsx$highlightPoints <- highlightPoints - } - - .logThis(plotParamsx, name = paste0("PlotParams-", x), logFile = logFile) - gg <- do.call(ggPoint, plotParamsx) - - } - - }else{ - - if(!is.null(pal)){ - plotParamsx$pal <- pal - } - - if(!is.null(highlightCells)){ - plotParamsx$highlightPoints <- highlightPoints - } - - .logThis(plotParamsx, name = paste0("PlotParams-", x), logFile = logFile) - gg <- do.call(ggPoint, plotParamsx) - - } - - if(!keepAxis){ - gg <- gg + theme(axis.text.x=element_blank(), axis.ticks.x=element_blank(), axis.text.y=element_blank(), axis.ticks.y=element_blank()) - } - - gg - - }) - names(ggList) <- name - if(getArchRVerbose()) message("") - - if(length(ggList) == 1){ - ggList <- ggList[[1]] - } - - .endLogging(logFile = logFile) - - ggList - -} - -#' Visualize an Embedding from ArchR Project without Arrow Files. -#' -#' This function will plot an embedding stored in an ArchRProject without Arrow Files. -#' -#' @param ArchRProj An `ArchRProject` object. -#' @param embedding The name of the embedding stored in the `ArchRProject` to be plotted. See `computeEmbedding()` for more information. -#' @param colorBy A string indicating whether points in the plot should be colored by a column in `cellColData` ("cellColData") or by -#' a data matrix in the corresponding ArrowFiles (i.e. "GeneScoreMatrix", "MotifMatrix", "PeakMatrix"). -#' @param name The name of the column in `cellColData` or the featureName/rowname of the data matrix to be used for plotting. -#' For example if colorBy is "cellColData" then `name` refers to a column name in the `cellcoldata` (see `getCellcoldata()`). If `colorBy` -#' is "GeneScoreMatrix" then `name` refers to a gene name which can be listed by `getFeatures(ArchRProj, useMatrix = "GeneScoreMatrix")`. -#' @param log2Norm A boolean value indicating whether a log2 transformation should be performed on the values (if continuous) in plotting. -#' @param imputeWeights The weights to be used for imputing numerical values for each cell as a linear combination of other cells values. -#' See `addImputationWeights()` and `getImutationWeights()` for more information. -#' @param pal A custom palette used to override discreteSet/continuousSet for coloring cells. Typically created using `paletteDiscrete()` or `paletteContinuous()`. -#' To make a custom palette, you must construct this following strict specifications. If the coloring is for discrete data (i.e. "Clusters"), -#' then this palette must be a named vector of colors where each color is named for the corresponding group (e.g. `"C1" = "#F97070"`). If the coloring -#' for continuous data, then it just needs to be a vector of colors. If you are using `pal` in conjuction with `highlightCells`, your palette -#' must be a named vector with two entries, one named for the value of the cells in the `name` column of `cellColData` and the other named -#' "Non.Highlighted". For example, `pal=c("Mono" = "green", "Non.Highlighted" = "lightgrey")` would be used to change the color of cells with the value -#' "Mono" in the `cellColData` column indicated by `name`. Because of this, the cells indicated by `highlightCells` must also match this value in the `name` column. -#' @param size A number indicating the size of the points to plot if `plotAs` is set to "points". -#' @param sampleCells A numeric describing number of cells to use for plot. If using impute weights, this will occur after imputation. -#' @param highlightCells A character vector of cellNames describing which cells to hightlight if using `plotAs = "points"` (default if discrete). -#' The remainder of cells will be colored light gray. -#' @param rastr A boolean value that indicates whether the plot should be rasterized. This does not rasterize lines and labels, just the -#' internal portions of the plot. -#' @param quantCut If this is not `NULL`, a quantile cut is performed to threshold the top and bottom of the distribution of numerical values. -#' This prevents skewed color scales caused by strong outliers. The format of this should be c(x,y) where x is the lower threshold and y is -#' the upper threshold. For example, quantileCut = c(0.025,0.975) will take the 2.5th percentile and 97.5 percentile of values and set -#' values below/above to the value of the 2.5th and 97.5th percentile values respectively. -#' @param discreteSet The name of a discrete palette from `ArchRPalettes` for visualizing `colorBy` in the embedding if a discrete color set is desired. -#' @param continuousSet The name of a continuous palette from `ArchRPalettes` for visualizing `colorBy` in the embedding if a continuous color set is desired. -#' @param randomize A boolean value that indicates whether to randomize points prior to plotting to prevent cells from one cluster being -#' uniformly present at the front of the plot. -#' @param keepAxis A boolean value that indicates whether the x- and y-axis ticks and labels should be plotted. -#' @param baseSize The base font size to use in the plot. -#' @param plotAs A string that indicates whether points ("points") should be plotted or a hexplot ("hex") should be plotted. By default -#' if `colorBy` is numeric, then `plotAs` is set to "hex". -#' @param threads The number of threads to be used for parallel computing. -#' @param logFile The path to a file to be used for logging ArchR output. -#' @param ... Additional parameters to pass to `ggPoint()` or `ggHex()`. -#' -#' @examples -#' -#' #Get Test Project -#' proj <- getTestProject() -#' -#' #Plot UMAP -#' p <- plotEmbedding(proj, name = "Clusters") -#' -#' #PDF -#' plotPDF(p, name = "UMAP-Clusters", ArchRProj = proj) -#' -#' @export -plotEmbeddingShiny <- function( - ArchRProj = NULL, - embedding = "UMAP", - embeddingDF = NULL, - colorBy = "GeneScoreMatrix", - name = "Sample", - log2Norm = NULL, - imputeWeights = if(!grepl("coldata",tolower(colorBy[1]))) getImputeWeights(ArchRProj), - pal = NULL, - size = 0.1, - sampleCells = NULL, - highlightCells = NULL, - rastr = TRUE, - quantCut = c(0.01, 0.99), - discreteSet = NULL, - continuousSet = NULL, - randomize = TRUE, - keepAxis = FALSE, - baseSize = 10, - plotAs = NULL, - threads = getArchRThreads(), - plotParamsx = NULL, - logFile = createLogFile("plotEmbedding") -){ - - .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) - .validInput(input = embedding, name = "reducedDims", valid = c("character")) - .validInput(input = colorBy, name = "colorBy", valid = c("character")) - .validInput(input = name, name = "name", valid = c("character")) - .validInput(input = log2Norm, name = "log2Norm", valid = c("boolean", "null")) - .validInput(input = imputeWeights, name = "imputeWeights", valid = c("list", "null")) - .validInput(input = pal, name = "pal", valid = c("palette", "null")) - .validInput(input = size, name = "size", valid = c("numeric")) - .validInput(input = sampleCells, name = "sampleCells", valid = c("numeric", "null")) - .validInput(input = highlightCells, name = "highlightCells", valid = c("character", "null")) - .validInput(input = rastr, name = "rastr", valid = c("boolean")) - .validInput(input = quantCut, name = "quantCut", valid = c("numeric", "null")) - .validInput(input = discreteSet, name = "discreteSet", valid = c("character", "null")) - .validInput(input = continuousSet, name = "continuousSet", valid = c("character", "null")) - .validInput(input = randomize, name = "randomize", valid = c("boolean")) - .validInput(input = keepAxis, name = "keepAxis", valid = c("boolean")) - .validInput(input = baseSize, name = "baseSize", valid = c("numeric")) - .validInput(input = plotAs, name = "plotAs", valid = c("character", "null")) - .validInput(input = threads, name = "threads", valid = c("integer")) - .validInput(input = logFile, name = "logFile", valid = c("character")) - - .requirePackage("ggplot2", source = "cran") - - .startLogging(logFile = logFile) - .logThis(mget(names(formals()),sys.frame(sys.nframe())), "Input-Parameters", logFile=logFile) - - - # Get Embedding ------------------------------------------------------------------ - .logMessage("Getting UMAP Embedding", logFile = logFile) - df <- embeddingDF - - if(!all(rownames(df) %in% ArchRProj$cellNames)){ - stop("Not all cells in embedding are present in ArchRProject!") - } - - .logThis(df, name = "Embedding data.frame", logFile = logFile) - if(!is.null(sampleCells)){ - if(sampleCells < nrow(df)){ - if(!is.null(imputeWeights)){ - stop("Cannot sampleCells with imputeWeights not equalt to NULL at this time!") - } - df <- df[sort(sample(seq_len(nrow(df)), sampleCells)), , drop = FALSE] - } - } - - #Parameters - plotParams <- list() - plotParams$x <- df[,1] - plotParams$y <- df[,2] - plotParams$title <- paste0(embedding, " of ", stringr::str_split(colnames(df)[1],pattern="#",simplify=TRUE)[,1]) - plotParams$baseSize <- baseSize - - #Additional Params - plotParams$xlabel <- gsub("_", " ",stringr::str_split(colnames(df)[1],pattern="#",simplify=TRUE)[,2]) - plotParams$ylabel <- gsub("_", " ",stringr::str_split(colnames(df)[2],pattern="#",simplify=TRUE)[,2]) - plotParams$rastr <- rastr - plotParams$size <- size - plotParams$randomize <- randomize - - #Check if Cells To Be Highlighted - if(!is.null(highlightCells)){ - highlightPoints <- match(highlightCells, rownames(df), nomatch = 0) - if(any(highlightPoints==0)){ - stop("highlightCells contain cells not in Embedding cellNames! Please make sure that these match!") - } - } - - #Make Sure ColorBy is valid - if(length(colorBy) > 1){ - stop("colorBy must be of length 1!") - } - - allColorBy <- matrices$allColorBy - - if(tolower(colorBy) %ni% tolower(allColorBy)){ - stop("colorBy must be one of the following :\n", paste0(allColorBy, sep=", ")) - } - colorBy <- allColorBy[match(tolower(colorBy), tolower(allColorBy))] - - .logMessage(paste0("ColorBy = ", colorBy), logFile = logFile) - - suppressMessages(message(logFile)) - - units <- ArchRProj@projectMetadata[["units"]] - - if(is.null(log2Norm) & tolower(colorBy) == "genescorematrix"){ - log2Norm <- TRUE - } - - if(is.null(log2Norm)){ - log2Norm <- FALSE - } - - #get values from pre-saved list - colorMat = tryCatch({ - t(as.matrix(matrices[[colorBy]][name,])) - }, warning = function(warning_condition) { - message(paste("name not seem to exist:", name)) - message(warning_condition) - # Choose a return value in case of warning - return(NULL) - }, error = function(error_condition) { - message(paste("name not seem to exist:", name)) - message(error_condition) - return(NA) - }, finally={ + colorMat <- imputeMatrix(mat = colorMat, imputeWeights = imputeWeights, logFile = logFile) + colorParams$color <- as.vector(colorMat) + } + colorParams + }) - }) - - rownames(colorMat)=name - - if(!all(rownames(df) %in% colnames(colorMat))){ - .logMessage("Not all cells in embedding are present in feature matrix. This may be due to using a custom embedding.", logFile = logFile) - stop("Not all cells in embedding are present in feature matrix. This may be due to using a custom embedding.") - } - - colorMat <- colorMat[,rownames(df), drop=FALSE] - - .logThis(colorMat, "colorMat-Before-Impute", logFile = logFile) - - if(!is.null(imputeWeights)){ - if(getArchRVerbose()) message("Imputing Matrix") - colorMat <- imputeMatricesList[[colorBy]][name,] - if(!inherits(colorMat, "matrix")){ - colorMat <- matrix(colorMat, ncol = nrow(df)) - colnames(colorMat) <- rownames(df) - } - } - - .logThis(colorMat, "colorMat-After-Impute", logFile = logFile) - - colorList <- lapply(seq_len(nrow(colorMat)), function(x){ - colorParams <- list() - colorParams$color <- colorMat[x, ] - colorParams$discrete <- FALSE - colorParams$title <- sprintf("%s colored by\n%s : %s", plotParams$title, colorBy, name[x]) - if(tolower(colorBy) == "genescorematrix"){ - colorParams$continuousSet <- "horizonExtra" - }else{ - colorParams$continuousSet <- "solarExtra" + + }else{ + + suppressMessages(message(logFile)) + + units <- tryCatch({ + .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, "/Info/Units"))[1] + },error=function(e){ + "values" + }) + + if(is.null(log2Norm) & tolower(colorBy) == "genescorematrix"){ + log2Norm <- TRUE } - if(!is.null(continuousSet)){ - colorParams$continuousSet <- continuousSet + + if(is.null(log2Norm)){ + log2Norm <- FALSE } - if(!is.null(discreteSet)){ - colorParams$discreteSet <- discreteSet + + colorMat <- .getMatrixValues( + ArchRProj = ArchRProj, + name = name, + matrixName = colorBy, + log2Norm = FALSE, + threads = threads, + logFile = logFile + ) + + if(!all(rownames(df) %in% colnames(colorMat))){ + .logMessage("Not all cells in embedding are present in feature matrix. This may be due to using a custom embedding.", logFile = logFile) + stop("Not all cells in embedding are present in feature matrix. This may be due to using a custom embedding.") } - if(x == 1){ - .logThis(colorParams, name = "ColorParams 1", logFile = logFile) + + colorMat <- colorMat[,rownames(df), drop=FALSE] + + .logThis(colorMat, "colorMat-Before-Impute", logFile = logFile) + + if(!is.null(imputeWeights)){ + if(getArchRVerbose()) message("Imputing Matrix") + colorMat <- imputeMatrix(mat = as.matrix(colorMat), imputeWeights = imputeWeights, logFile = logFile) + if(!inherits(colorMat, "matrix")){ + colorMat <- matrix(colorMat, ncol = nrow(df)) + colnames(colorMat) <- rownames(df) + } } - colorParams - }) + + .logThis(colorMat, "colorMat-After-Impute", logFile = logFile) + + colorList <- lapply(seq_len(nrow(colorMat)), function(x){ + colorParams <- list() + colorParams$color <- colorMat[x, ] + colorParams$discrete <- FALSE + colorParams$title <- sprintf("%s colored by\n%s : %s", plotParams$title, colorBy, name[x]) + if(tolower(colorBy) == "genescorematrix"){ + colorParams$continuousSet <- "horizonExtra" + }else{ + colorParams$continuousSet <- "solarExtra" + } + if(!is.null(continuousSet)){ + colorParams$continuousSet <- continuousSet + } + if(!is.null(discreteSet)){ + colorParams$discreteSet <- discreteSet + } + if(x == 1){ + .logThis(colorParams, name = "ColorParams 1", logFile = logFile) + } + colorParams + }) + + } - if(getArchRVerbose()) {message("Plotting Embedding")} + if(getArchRVerbose()) message("Plotting Embedding") - for(x in 1:length(colorList)){ - - plotParamsx = .mergeParams(colorList[[x]], plotParams) + ggList <- lapply(seq_along(colorList), function(x){ + if(getArchRVerbose()) message(x, " ", appendLF = FALSE) - if(getArchRVerbose()) {message(x, " ", appendLF = FALSE)} + plotParamsx <- .mergeParams(colorList[[x]], plotParams) if(plotParamsx$discrete){ - plotParamsx$color <- .myQuantileCut(plotParamsx$color, min(quantCut), max(quantCut), na.rm = TRUE) + plotParamsx$color <- paste0(plotParamsx$color) } if(!plotParamsx$discrete){ - plotParamsx$color <- .quantileCut(plotParamsx$color, min(quantCut), max(quantCut)) + if(!is.null(quantCut)){ + plotParamsx$color <- .quantileCut(plotParamsx$color, min(quantCut), max(quantCut)) + } plotParamsx$pal <- paletteContinuous(set = plotParamsx$continuousSet) @@ -841,19 +522,21 @@ plotEmbeddingShiny <- function( gg - } - + }) + names(ggList) <- name if(getArchRVerbose()) message("") - if(length(gg) == 1){ - gg <- gg + if(length(ggList) == 1){ + ggList <- ggList[[1]] } .endLogging(logFile = logFile) - return(list(gg, plotParamsx$pal)) + ggList + } + #' Visualize Groups from ArchR Project #' #' This function will group, summarize and then plot data from an ArchRProject for visual comparison. @@ -914,7 +597,7 @@ plotGroups <- function( plotAs = "ridges", threads = getArchRThreads(), ... - ){ +){ .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) .validInput(input = groupBy, name = "groupBy", valid = c("character")) @@ -933,9 +616,9 @@ plotGroups <- function( .validInput(input = ridgeScale, name = "ridgeScale", valid = c("numeric")) .validInput(input = plotAs, name = "plotAs", valid = c("character")) .validInput(input = threads, name = "threads", valid = c("integer")) - + .requirePackage("ggplot2", source = "cran") - + #Make Sure ColorBy is valid! if(length(colorBy) > 1){ stop("colorBy must be of length 1!") @@ -945,17 +628,17 @@ plotGroups <- function( stop("colorBy must be one of the following :\n", paste0(allColorBy, sep=", ")) } colorBy <- allColorBy[match(tolower(colorBy), tolower(allColorBy))] - + groups <- getCellColData(ArchRProj, groupBy, drop = FALSE) groupNames <- groups[,1] names(groupNames) <- rownames(groups) groupNames2 <- gtools::mixedsort(unique(groupNames)) - - + + plotParams <- list(...) - + if(tolower(colorBy) == "coldata" | tolower(colorBy) == "cellcoldata"){ - + colorList <- lapply(seq_along(name), function(x){ colorParams <- list() colorParams$color <- as.vector(getCellColData(ArchRProj, select = name[x], drop = TRUE)) @@ -970,23 +653,23 @@ plotGroups <- function( } colorParams }) - + }else{ - + units <- tryCatch({ - .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, "/Info/Units"))[1] - },error=function(e){ - "values" + .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, "/Info/Units"))[1] + },error=function(e){ + "values" }) if(is.null(log2Norm) & tolower(colorBy) == "genescorematrix"){ log2Norm <- TRUE } - + if(is.null(log2Norm)){ log2Norm <- FALSE } - + colorMat <- .getMatrixValues( ArchRProj = ArchRProj, name = name, @@ -994,7 +677,7 @@ plotGroups <- function( log2Norm = FALSE, threads = threads ) - + if(!is.null(imputeWeights)){ colorMat <- imputeMatrix(mat = as.matrix(colorMat), imputeWeights = imputeWeights) if(!inherits(colorMat, "matrix")){ @@ -1002,7 +685,7 @@ plotGroups <- function( colnames(colorMat) <- ArchRProj$cellNames } } - + colorList <- lapply(seq_len(nrow(colorMat)), function(x){ colorParams <- list() colorParams$color <- colorMat[x, ] @@ -1014,9 +697,9 @@ plotGroups <- function( } colorParams }) - + } - + if(!is.null(maxCells)){ splitGroup <- split(names(groupNames), groupNames) useCells <- lapply(splitGroup, function(x){ @@ -1030,15 +713,15 @@ plotGroups <- function( }else{ idx <- seq_along(groupNames) } - + pl <- lapply(seq_along(colorList), function(x){ - + if(getArchRVerbose()) message(paste0(x, " "), appendLF = FALSE) - + if(is.null(ylim)){ ylim <- range(colorList[[x]]$color,na.rm=TRUE) %>% extendrange(f = 0.05) } - + plotParamsx <- plotParams plotParamsx$x <- groupNames[idx] if(!is.null(quantCut)){ @@ -1054,13 +737,13 @@ plotGroups <- function( plotParamsx$size <- size plotParamsx$plotAs <- plotAs plotParamsx$pal <- colorList[[x]]$pal - + p <- do.call(ggGroup, plotParamsx) - + p - + }) - + names(pl) <- name if(getArchRVerbose()) message("") @@ -1069,7 +752,7 @@ plotGroups <- function( }else{ pl } - + } .getMatrixValues <- function( @@ -1079,29 +762,29 @@ plotGroups <- function( log2Norm = FALSE, threads = getArchRThreads(), logFile = NULL - ){ +){ o <- h5closeAll() - + .logMessage("Getting Matrix Values...", verbose = TRUE, logFile = logFile) - + featureDF <- .getFeatureDF(head(getArrowFiles(ArchRProj), 2), matrixName) .logThis(featureDF, "FeatureDF", logFile = logFile) - + matrixClass <- h5read(getArrowFiles(ArchRProj)[1], paste0(matrixName, "/Info/Class")) - + if(matrixClass == "Sparse.Assays.Matrix"){ if(!all(unlist(lapply(name, function(x) grepl(":",x))))){ .logMessage("When accessing features from a matrix of class Sparse.Assays.Matrix it requires seqnames\n(denoted by seqnames:name) specifying to which assay to pull the feature from.\nIf confused, try getFeatures(ArchRProj, useMatrix) to list out available formats for input!", logFile = logFile) stop("When accessing features from a matrix of class Sparse.Assays.Matrix it requires seqnames\n(denoted by seqnames:name) specifying to which assay to pull the feature from.\nIf confused, try getFeatures(ArchRProj, useMatrix) to list out available formats for input!") } } - + if(grepl(":",name[1])){ - + sname <- stringr::str_split(name,pattern=":",simplify=TRUE)[,1] name <- stringr::str_split(name,pattern=":",simplify=TRUE)[,2] - + idx <- lapply(seq_along(name), function(x){ ix <- intersect(which(tolower(name[x]) == tolower(featureDF$name)), BiocGenerics::which(tolower(sname[x]) == tolower(featureDF$seqnames))) if(length(ix)==0){ @@ -1109,7 +792,7 @@ plotGroups <- function( } ix }) %>% unlist - + }else{ idx <- lapply(seq_along(name), function(x){ @@ -1119,17 +802,17 @@ plotGroups <- function( } ix }) %>% unlist - + } .logThis(idx, "idx", logFile = logFile) - + if(any(is.na(idx))){ .logStop(sprintf("FeatureName (%s) does not exist! See getFeatures", paste0(name[which(is.na(idx))], collapse=",")), logFile = logFile) } - + featureDF <- featureDF[idx, ,drop=FALSE] .logThis(featureDF, "FeatureDF-Subset", logFile = logFile) - + #Get Values for FeatureName cellNamesList <- split(rownames(getCellColData(ArchRProj)), getCellColData(ArchRProj)$Sample) @@ -1139,13 +822,13 @@ plotGroups <- function( o <- h5closeAll() ArrowFile <- getSampleColData(ArchRProj)[names(cellNamesList)[x],"ArrowFiles"] valuesx <- .getMatFromArrow( - ArrowFile = ArrowFile, - featureDF = featureDF, - binarize = FALSE, - useMatrix = matrixName, - cellNames = cellNamesList[[x]], - threads = 1 - ) + ArrowFile = ArrowFile, + featureDF = featureDF, + binarize = FALSE, + useMatrix = matrixName, + cellNames = cellNamesList[[x]], + threads = 1 + ) colnames(valuesx) <- cellNamesList[[x]] valuesx }, error = function(e){ @@ -1165,12 +848,12 @@ plotGroups <- function( if(getArchRVerbose()) message("") gc() .logThis(values, "Feature-Matrix", logFile = logFile) - + if(!inherits(values, "matrix")){ values <- matrix(as.matrix(values), ncol = nCells(ArchRProj)) colnames(values) <- ArchRProj$cellNames } - + #Values Summary if(!is.null(log2Norm)){ if(log2Norm){ @@ -1178,11 +861,11 @@ plotGroups <- function( values <- log2(values + 1) } } - + rownames(values) <- name - + return(values) - + } .fixPlotSize <- function( @@ -1193,19 +876,19 @@ plotGroups <- function( height = 1, it = 0.05, newPage = FALSE - ){ - +){ + .requirePackage("grid", source = "cran") .requirePackage("gridExtra", source = "cran") - + if(!inherits(plotWidth, "unit")){ plotWidth <- unit(plotWidth, "in") } - + if(!inherits(plotHeight, "unit")){ plotHeight <- unit(plotHeight, "in") } - + #adapted from https://github.com/jwdink/egg/blob/master/R/set_panel_size.r g <- ggplotGrob(p) @@ -1217,20 +900,20 @@ plotGroups <- function( gl <- NULL g <- ggplotGrob(p) } - + panels <- grep("panel", g$layout$name) panel_index_w <- unique(g$layout$l[panels]) panel_index_h <- unique(g$layout$t[panels]) - + nw <- length(panel_index_w) nh <- length(panel_index_h) pw <- convertWidth(plotWidth, unitTo = "in", valueOnly = TRUE) ph <- convertWidth(plotHeight, unitTo = "in", valueOnly = TRUE) - + pw <- pw * 0.95 ph <- ph * 0.95 - + x <- 0 width <- 1 sm <- FALSE @@ -1238,20 +921,20 @@ plotGroups <- function( while(!sm){ x <- x + it - + w <- unit(x * width, "in") h <- unit(x * height / width, "in") m <- unit(x * margin / width, "in") - + g$widths[panel_index_w] <- rep(w, nw) g$heights[panel_index_h] <- rep(h, nh) - + sw <- convertWidth( x = sum(g$widths) + m, unitTo = "in", valueOnly = TRUE ) - + sh <- convertHeight( x = sum(g$heights) + m, unitTo = "in", @@ -1259,87 +942,87 @@ plotGroups <- function( ) sm <- sw > pw | sh > ph - + } - + if(length(legend)!=0){ - + sgh <- convertHeight( x = sum(g$heights), unitTo = "in", valueOnly = TRUE ) - + sgw <- convertWidth( x = sum(g$widths), unitTo = "in", valueOnly = TRUE ) - + slh <- convertHeight( x = sum(gl$heights), unitTo = "in", valueOnly = TRUE ) - + slw <- convertWidth( x = sum(gl$widths), unitTo = "in", valueOnly = TRUE ) - + size <- 6 wh <- 0.1 it <- 0 - + while(slh > 0.2 * ph | slw > pw){ - + it <- it + 1 - + if(it > 3){ break } - + size <- size * 0.8 wh <- wh * 0.8 - + gl <- ggplotGrob( p + theme( - legend.key.width = unit(wh, "cm"), - legend.key.height = unit(wh, "cm"), - legend.spacing.x = unit(0, 'cm'), - legend.spacing.y = unit(0, 'cm'), - legend.text = element_text(size = max(size, 2)) - ) + .gg_guides(fill = guide_legend(ncol = 4), color = guide_legend(ncol = 4)) - )$grobs[[legend]] - + legend.key.width = unit(wh, "cm"), + legend.key.height = unit(wh, "cm"), + legend.spacing.x = unit(0, 'cm'), + legend.spacing.y = unit(0, 'cm'), + legend.text = element_text(size = max(size, 2)) + ) + .gg_guides(fill = guide_legend(ncol = 4), color = guide_legend(ncol = 4)) + )$grobs[[legend]] + slh <- convertHeight( x = sum(gl$heights), unitTo = "in", valueOnly = TRUE ) - + slw <- convertWidth( x = sum(gl$widths), unitTo = "in", valueOnly = TRUE ) - + } - + p <- grid.arrange(g, gl, ncol=1, nrow=2, - heights = unit.c(unit(sgh,"in"), unit(min(slh, 0.2 * pw), "in")), - newpage = newPage + heights = unit.c(unit(sgh,"in"), unit(min(slh, 0.2 * pw), "in")), + newpage = newPage ) - + }else{ - + p <- grid.arrange(g, newpage = newPage) - + } - - + + invisible(p) - + } From f61707a51470a3c169ffa34bf4652766cc7b0a5a Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Fri, 9 Dec 2022 12:12:57 -0800 Subject: [PATCH 031/162] getFeatureDF --- R/MainEmbed.R | 2 -- R/exportShinyArchR.R | 2 +- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/R/MainEmbed.R b/R/MainEmbed.R index 57351a3a..5b5e6caa 100644 --- a/R/MainEmbed.R +++ b/R/MainEmbed.R @@ -39,8 +39,6 @@ mainEmbed <- function( # Check if colorBy is cellColData or Matrix (e.g. GSM, GIM, or MM) # Check if embedding exists in ArchRProj@embeddings # Check all names exist - - if(!file.exists(file.path(outDirEmbed, "embeds.rds"))){ diff --git a/R/exportShinyArchR.R b/R/exportShinyArchR.R index 34109a1b..54d490d6 100644 --- a/R/exportShinyArchR.R +++ b/R/exportShinyArchR.R @@ -339,12 +339,12 @@ exportShinyArchR <- function( # need arrowFiles to getFeatures so need to save genes as RDS # TODO change hardcoding of these paths: Should be file.path(getOutputDirectory(ArchRProj), outputDir, subOutputDir, "features.rds" if(!file.exists(file.path(getOutputDirectory(ArchRProj), outputDir, subOutputDir, "gene_names.rds"))){ + # TODO probably need to add param to get specific features based on matrix? gene_names <- getFeatures(ArchRProj = ArchRProj) saveRDS(gene_names, paste0("./", outputDir, "/", subOutputDir,"/gene_names.rds")) }else{ message("gene_names already exists...") gene_names <- readRDS(paste0("./", outputDir, "/", subOutputDir,"/gene_names.rds")) - } if(!file.exists(paste0("./", outputDir, "/", subOutputDir,"/umaps.rds"))){ From e7635fb1145df5a1f6baa2b01d3ff5b4e56e7e06 Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Sun, 11 Dec 2022 17:44:12 +0300 Subject: [PATCH 032/162] fixing minor issues --- R/VisualizeData.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/VisualizeData.R b/R/VisualizeData.R index 9d542f0b..cf2efcf7 100644 --- a/R/VisualizeData.R +++ b/R/VisualizeData.R @@ -306,7 +306,7 @@ plotEmbedding <- function( } #Parameters - plotParams <- list(...) + plotParams <- list() plotParams$x <- df[,1] plotParams$y <- df[,2] plotParams$title <- paste0(embedding, " of ", stringr::str_split(colnames(df)[1],pattern="#",simplify=TRUE)[,1]) From a067832a4f85b64499774d6ab0ce9fcbafe8d252 Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Sun, 11 Dec 2022 17:44:59 +0300 Subject: [PATCH 033/162] fixed the reported issues --- R/exportShinyArchR.R | 90 ++++++++++---------------------------------- 1 file changed, 19 insertions(+), 71 deletions(-) diff --git a/R/exportShinyArchR.R b/R/exportShinyArchR.R index 54d490d6..f03e2e96 100644 --- a/R/exportShinyArchR.R +++ b/R/exportShinyArchR.R @@ -198,13 +198,15 @@ addSeqLengths <- function (gr, genome) { fn <- unclass(lsf.str(envir = asNamespace("ArchR"), all = TRUE)) for (i in seq_along(fn)) { tryCatch({ - eval(parse(text = paste0(fn[i], "<-", fn[i]))) + # eval(parse(text = paste0(fn[i], "<-", fn[i]))) + eval(parse(text=paste0(fn[i], '<-ArchR:::', fn[i]))) }, error = function(x) { }) } -# UMAP Visualization ------------------------------------------------------------ +outputDir = "Shiny" +subOutputDir = "inputData" @@ -253,8 +255,7 @@ exportShinyArchR <- function( # TODO: Check that all columns exist in cellColData if(is.null(groupBy)){ stop("groupBy must be provided") - } - else if(groupBy %ni% colnames(getCellColData(ArchRProj))){ + } else if(groupBy %ni% colnames(getCellColData(ArchRProj))){ stop("groupBy must be a column in cellColData") }else{ print(paste0("groupBy:", groupBy)) @@ -298,8 +299,7 @@ exportShinyArchR <- function( # Add metadata to ArchRProjShiny if (groupBy %ni% colnames(ArchRProjShiny@cellColData)) { stop("groupBy is not part of cellColData") - } - else if ((any(is.na(paste0("ArchRProj$", groupBy))))) { + } else if ((any(is.na(paste0("ArchRProj$", groupBy))))) { stop("Some entries in the column indicated by groupBy have NA values. This is not allowed. Please subset your project using subsetArchRProject() to only contain cells with values for groupBy") } else { @@ -334,7 +334,7 @@ exportShinyArchR <- function( } ## main umaps ----------------------------------------------------------------- - dir.create(file.path(getOutputDirectory(ArchRProj), outputDir, subOutputDir),showWarnings = FALSE) + dir.create(file.path(getOutputDirectory(ArchRProj), outputDir, subOutputDir),showWarnings = TRUE) # need arrowFiles to getFeatures so need to save genes as RDS # TODO change hardcoding of these paths: Should be file.path(getOutputDirectory(ArchRProj), outputDir, subOutputDir, "features.rds" @@ -352,6 +352,9 @@ exportShinyArchR <- function( umapNames <- colnames(ArchRProjShiny@cellColData) for(x in 1:length(umapNames)){ + + print(umapNames[x]) + tryCatch( umap <- plotEmbedding( ArchRProj = ArchRProjShiny, @@ -378,65 +381,7 @@ exportShinyArchR <- function( umaps <- readRDS(paste0("./", outputDir, "/", subOutputDir,"/umaps.rds")) } - # cluster_umap <- plotEmbedding( - # ArchRProj = ArchRProjShiny, - # baseSize=12, - # colorBy = "cellColData", - # name = "TSSEnrichment", - # embedding = embedding, - # rastr = FALSE, - # 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)) - # umaps[["Clusters"]] <- cluster_umap - # - # sample_umap <- plotEmbedding( - # ArchRProj = ArchRProj, - # 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)) - # umaps[["Sample"]] <- sample_umap - # - # constrained_umap <- plotEmbedding( - # ArchRProj = ArchRProjShiny, - # 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)) - # umaps[["Constrained"]] <- constrained_umap - # - # unconstrained_umap <- plotEmbedding( - # ArchRProj = ArchRProjShiny, - # embedding = "UMAP", - # colorBy = "cellColData", - # name = "predictedGroup_Un", - # 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)) - # # saveRDS(unconstrained_umap, "./UMAPs/unconstrained_umap.rds") - # umaps[["Unconstrained"]] <- unconstrained_umap - # - # constrained_remapped_umap <- plotEmbedding( - # ArchRProj = ArchRProjShiny, - # 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)) - # # saveRDS(constrained_remapped_umap, "./UMAPs/constrained_remapped_umap.rds") - # umaps[["Constrained remap"]] <- constrained_remapped_umap - # - - + ## colorMats without Impute Weights---------------------------------------------------------------- #TODO check with matrices are available @@ -603,13 +548,16 @@ if(!file.exists(paste0("./", outputDir, "/", subOutputDir,"/gene_names_GIM.rds") message("imputeMatricesList already exists...") imputeMatricesList <- readRDS(paste0("./", outputDir, "/", subOutputDir,"/imputeMatricesList.rds")) } - + } # Create an HDF5 containing the nativeRaster vectors for the main matrices if (!file.exists(file.path(outputDir, subOutputDir, "mainEmbeds.h5"))) { mainEmbed(ArchRProj = ArchRProj, outDirEmbed = file.path(outputDir, subOutputDir), - names = as.list(colnames(ArchRProjShiny@cellColData)) + names = colnames(ArchRProjShiny@cellColData), + matrices = matrices, + imputeMatricesList = imputeMatricesList, + Shiny = ShinyArchR ) } else{ message("H5 for main embeds already exists...") @@ -619,7 +567,7 @@ if(!file.exists(paste0("./", outputDir, "/", subOutputDir,"/gene_names_GIM.rds") if(!file.exists(paste0("./", outputDir, "/", subOutputDir,"/plotBlank72.h5"))){ shinyRasterUMAPs( - ArchRProj = NULL, + ArchRProj = ArchRProj, outputDirUmaps = paste0(outputDir,"/", subOutputDir), threads = getArchRThreads(), verbose = TRUE, @@ -637,10 +585,10 @@ if(!file.exists(paste0("./", outputDir, "/", subOutputDir,"/gene_names_GIM.rds") ## ready to launch --------------------------------------------------------------- message("App created! To launch, - ArchRProj <- loadArchRProject('",getwd(),"') and + ArchRProj <- loadArchRProject('",getOutputDirectory(ArchRProj),"') and run shiny::runApp('", outputDir, "') from parent directory") # runApp("myappdir") - } + } From 5bb977c4417713e5d809ec247801e7089c4756c3 Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Sun, 11 Dec 2022 17:46:18 +0300 Subject: [PATCH 034/162] fixed the reported issues --- R/ShinyRasterUMAPs.R | 294 ++++++++++++++++++++++++------------------- 1 file changed, 166 insertions(+), 128 deletions(-) diff --git a/R/ShinyRasterUMAPs.R b/R/ShinyRasterUMAPs.R index c1b9b0a2..8dfa6293 100644 --- a/R/ShinyRasterUMAPs.R +++ b/R/ShinyRasterUMAPs.R @@ -23,119 +23,185 @@ shinyRasterUMAPs <- function( .validInput(input = verbose, name = "verbose", valid = c("boolean")) .validInput(input = logFile, name = "logFile", valid = c("character")) - if (file.exists(file.path(outputDirUmaps, "plotBlank72.h5"))){ + shinyMatrices <- getAvailableMatrices(ArchRProj) + + if (file.exists(file.path(outputDirUmaps, "plotBlank72.h5"))){ + file.remove(file.path(outputDirUmaps, "plotBlank72.h5")) + } h5closeAll() - - shinyMatrices <- getAvailableMatrices(ArchRProj) - - # create an HDF5 to store the native raster vectors points <- H5Fcreate(name = file.path(outputDirUmaps,"plotBlank72.h5")) - # create groups for each of the available matrices - for (matrix in shinyMatrices) { - h5createGroup(file.path(outputDirUmaps, "plotBlank72.h5"), matrix) - - c(matrix, "points") <- .safelapply(1:length(gene_names_GSM), function(x){ - - gene_plot <- plotEmbeddingShiny( - ArchRProj = ArchRProj, - colorBy = "GeneScoreMatrix", - name = gene_names_GSM[x], - embedding = "UMAP", - embeddingDF = df, - quantCut = c(0.01, 0.95), - imputeWeights = getImputeWeights(ArchRProj = ArchRProj), - plotAs = "points", - rastr = TRUE - ) - - if(!is.null(gene_plot)){ + + if("GeneScoreMatrix" %in% shinyMatrices){ + h5createGroup(file.path(outputDirUmaps, "plotBlank72.h5"),"GSM") + if(!exists("GSM_umaps_points")){ - gene_plot_blank <- gene_plot[[1]] + theme(axis.title.x = element_blank()) + - theme(axis.title.y = element_blank()) + - theme(axis.title = element_blank()) + - theme(legend.position = "none") + - theme( - panel.grid.major = element_blank(), - panel.grid.minor = element_blank(), - panel.border = element_blank(), - title=element_blank() + GSM_umaps_points <- ArchR:::.safelapply(1:length(gene_names_GSM), function(x){ + + print(paste0("Creating plots for GSM_umaps_points: ",x,": ",round((x/length(gene_names_GSM))*100,3), "%")) + + gene_plot <- plotEmbedding( + ArchRProj = ArchRProj, + colorBy = "GeneScoreMatrix", + name = gene_names_GSM[x], + embedding = "UMAP", + quantCut = c(0.01, 0.95), + imputeWeights = getImputeWeights(ArchRProj = ArchRProj), + plotAs = "points", + rastr = TRUE ) + + if(!is.null(gene_plot)){ + + gene_plot_blank <- gene_plot + theme(axis.title.x = element_blank()) + + theme(axis.title.y = element_blank()) + + theme(axis.title = element_blank()) + + theme(legend.position = "none") + + theme( + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.border = element_blank(), + title=element_blank() + ) + + #save plot without axes etc as a jpg. + ggsave(filename = file.path(outputDirUmaps, "GSM_umaps", paste0(gene_names_GSM[x],"_blank72.jpg")), + plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) + + #read back in that jpg because we need vector in native format + blank_jpg72 <- readJPEG(source = file.path(outputDirUmaps, "GSM_umaps", + paste0(gene_names_GSM[x],"_blank72.jpg")), native = TRUE) + + res = list(list(plot=as.vector(blank_jpg72), min = round(min(gene_plot[[1]]$data$color),1), + max = round(max(gene_plot[[1]]$data$color),1), pal = gene_plot[[2]])) + + return(res) + } + }, threads = threads) + names(GSM_umaps_points) <- gene_names_GSM + }else{ + message("GSM_umaps_points already exists. Skipping the loop...") + } + + GSM_umaps_points = GSM_umaps_points[!unlist(lapply(GSM_umaps_points, is.null))] + + GSM_min_max <- data.frame(matrix(NA, 2, length(GSM_umaps_points))) + colnames(GSM_min_max) <- names(GSM_umaps_points)[which(!unlist(lapply(GSM_umaps_points, is.null)))] + rownames(GSM_min_max) <- c("min","max") + + for(i in 1:length(GSM_umaps_points)){ - #save plot without axes etc as a jpg. - ggsave(filename = file.path(outputDirUmaps, "GSM_umaps", paste0(gene_names_GSM[x],"_blank72.jpg")), - plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) + print(paste0("Getting H5 files for GSM_umaps_points: ",i,": ",round((i/length(GSM_umaps_points))*100,3), "%")) - #read back in that jpg because we need vector in native format - blank_jpg72 <- readJPEG(source = file.path(outputDirUmaps, "GSM_umaps", - paste0(gene_names_GSM[x],"_blank72.jpg")), native = TRUE) + h5createDataset(file = points, dataset = paste0("GSM/", gene_names_GSM[i]), dims = c(46656,1), storage.mode = "integer") + h5writeDataset(obj = GSM_umaps_points[[i]][[1]]$plot, h5loc = points, name=paste0("GSM/", gene_names_GSM[i])) - res = list(list(plot=as.vector(blank_jpg72), min = round(min(gene_plot[[1]]$data$color),1), - max = round(max(gene_plot[[1]]$data$color),1), pal = gene_plot[[2]])) + GSM_min_max[1,i] = GSM_umaps_points[[i]][[1]]$min + GSM_min_max[2,i] = GSM_umaps_points[[i]][[1]]$max - return(res) } - }, threads = threads) - names(GSM_umaps_points) <- gene_names_GSM + + GSM_pal = GSM_umaps_points[[1]][[1]]$pal + + }else{ + + GSM_min_max = NULL + GSM_pal = NULL + } - if(!exists("GIM_umaps_points")){ - GIM_umaps_points <- .safelapply(1:length(gene_names_GIM), function(x){ - - print(paste0("Creating plots for GIM_umaps_points: ",x,": ",round((x/length(gene_names_GIM))*100,3), "%")) - - gene_plot <- plotEmbeddingShiny( - ArchRProj = ArchRProj, - colorBy = "GeneIntegrationMatrix", - name = gene_names_GIM[x], - embedding = "UMAP", - embeddingDF = df, - quantCut = c(0.01, 0.95), - imputeWeights = getImputeWeights(ArchRProj = ArchRProj), - plotAs = "points", - rastr = TRUE - ) - - if(!is.null(gene_plot)){ - gene_plot_blank <- gene_plot[[1]] + theme(axis.title.x = element_blank()) + - theme(axis.title.y = element_blank()) + - theme(axis.title = element_blank()) + - theme(legend.position = "none") + - theme( - panel.grid.major = element_blank(), - panel.grid.minor = element_blank(), - panel.border = element_blank(), - title=element_blank() - ) + if("GeneIntegrationMatrix" %in% shinyMatrices){ + + h5createGroup(file.path(outputDirUmaps, "plotBlank72.h5"),"GIM") + + if(!exists("GIM_umaps_points")){ + GIM_umaps_points <- ArchR:::.safelapply(1:length(gene_names_GIM), function(x){ - #save plot without axes etc as a jpg. - ggsave(filename = file.path(outputDirUmaps, "GIM_umaps", paste0(gene_names_GIM[x],"_blank72.jpg")), - plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) + print(paste0("Creating plots for GIM_umaps_points: ",x,": ",round((x/length(gene_names_GIM))*100,3), "%")) - #read back in that jpg because we need vector in native format - blank_jpg72 <- readJPEG(source = file.path(outputDirUmaps, "GIM_umaps", - paste0(gene_names_GIM[x],"_blank72.jpg")), native = TRUE) + gene_plot <- plotEmbedding( + ArchRProj = ArchRProj, + colorBy = "GeneIntegrationMatrix", + name = gene_names_GIM[x], + embedding = "UMAP", + embeddingDF = df, + quantCut = c(0.01, 0.95), + imputeWeights = getImputeWeights(ArchRProj = ArchRProj), + plotAs = "points", + rastr = TRUE + ) + if(!is.null(gene_plot)){ + gene_plot_blank <- gene_plot + theme(axis.title.x = element_blank()) + + theme(axis.title.y = element_blank()) + + theme(axis.title = element_blank()) + + theme(legend.position = "none") + + theme( + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.border = element_blank(), + title=element_blank() + ) + + #save plot without axes etc as a jpg. + ggsave(filename = file.path(outputDirUmaps, "GIM_umaps", paste0(gene_names_GIM[x],"_blank72.jpg")), + plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) + + #read back in that jpg because we need vector in native format + blank_jpg72 <- readJPEG(source = file.path(outputDirUmaps, "GIM_umaps", + paste0(gene_names_GIM[x],"_blank72.jpg")), native = TRUE) + + + res = list(list(plot=as.vector(blank_jpg72), min = round(min(gene_plot[[1]]$data$color),1), + max = round(max(gene_plot[[1]]$data$color),1), pal = gene_plot[[2]])) + return(res) + } - res = list(list(plot=as.vector(blank_jpg72), min = round(min(gene_plot[[1]]$data$color),1), - max = round(max(gene_plot[[1]]$data$color),1), pal = gene_plot[[2]])) - return(res) - } + }, threads = threads) + names(GIM_umaps_points) <- gene_names_GIM + }else{ + message("GIM_umaps_points already exists. Skipping the loop...") + } + + GIM_umaps_points = GIM_umaps_points[!unlist(lapply(GIM_umaps_points, is.null))] + MM_umaps_points = MM_umaps_points[!unlist(lapply(MM_umaps_points, is.null))] + + GIM_min_max <- data.frame(matrix(NA, 2, length(GIM_umaps_points))) + colnames(GIM_min_max) <- names(GIM_umaps_points)[which(!unlist(lapply(GIM_umaps_points, is.null)))] + rownames(GIM_min_max) <- c("min","max") + + for(i in 1:length(GIM_umaps_points)){ - }, threads = threads) - names(GIM_umaps_points) <- gene_names_GIM + print(paste0("Getting H5 files for GIM_umaps_points: ",i,": ",round((i/length(GIM_umaps_points))*100,3), "%")) + + h5createDataset(file = points, dataset = paste0("GIM/", gene_names_GIM[i]), dims = c(46656,1), storage.mode = "integer") + h5writeDataset(obj = GIM_umaps_points[[i]][[1]]$plot, h5loc = points, name=paste0("GIM/", gene_names_GIM[i])) + + GIM_min_max[1,i] = GIM_umaps_points[[i]][[1]]$min + GIM_min_max[2,i] = GIM_umaps_points[[i]][[1]]$max + + } + + GIM_pal = GIM_umaps_points[[1]][[1]]$pal + }else{ - message("GIM_umaps_points already exists. Skipping the loop...") + + GIM_min_max = NULL + GIM_pal = NULL } + if("MotifMatrix" %in% shinyMatrices){ + + h5createGroup(file.path(outputDirUmaps, "plotBlank72.h5"),"MM") + if(!exists("MM_umaps_points")){ - - MM_umaps_points <- .safelapply(1:length(motif_names), function(x){ + + MM_umaps_points <- ArchR:::.safelapply(1:length(motif_names), function(x){ print(paste0("Creating plots for MM_umaps_points: ",x,": ",round((x/length(motif_names))*100,3), "%")) - gene_plot <- plotEmbeddingShiny( + gene_plot <- plotEmbedding( ArchRProj = ArchRProj, colorBy = "MotifMatrix", name = motif_names[x], @@ -148,7 +214,7 @@ shinyRasterUMAPs <- function( ) if(!is.null(gene_plot)){ - gene_plot_blank <- gene_plot[[1]] + theme(axis.title.x = element_blank()) + + gene_plot_blank <- gene_plot + theme(axis.title.x = element_blank()) + theme(axis.title.y = element_blank()) + theme(axis.title = element_blank()) + theme(legend.position = "none") + @@ -169,7 +235,7 @@ shinyRasterUMAPs <- function( paste0(motif_names[x],"_blank72.jpg")), native = TRUE) res = list(list(plot=as.vector(blank_jpg72), min = round(min(gene_plot[[1]]$data$color),1), - max = round(max(gene_plot[[1]]$data$color),1), pal = gene_plot[[2]])) + max = round(max(gene_plot[[1]]$data$color),1), pal = gene_plot[[2]])) names(res) = motif_names[x] return(res) @@ -180,46 +246,10 @@ shinyRasterUMAPs <- function( message("MM_umaps_points already exists. Skipping the loop...") } - GSM_umaps_points = GSM_umaps_points[!unlist(lapply(GSM_umaps_points, is.null))] - GIM_umaps_points = GIM_umaps_points[!unlist(lapply(GIM_umaps_points, is.null))] - MM_umaps_points = MM_umaps_points[!unlist(lapply(MM_umaps_points, is.null))] - - GSM_min_max <- data.frame(matrix(NA, 2, length(GSM_umaps_points))) - colnames(GSM_min_max) <- names(GSM_umaps_points)[which(!unlist(lapply(GSM_umaps_points, is.null)))] - rownames(GSM_min_max) <- c("min","max") - - GIM_min_max <- data.frame(matrix(NA, 2, length(GIM_umaps_points))) - colnames(GIM_min_max) <- names(GIM_umaps_points)[which(!unlist(lapply(GIM_umaps_points, is.null)))] - rownames(GIM_min_max) <- c("min","max") - MM_min_max <- data.frame(matrix(NA, 2, length(MM_umaps_points))) colnames(MM_min_max) <- names(MM_umaps_points)[which(!unlist(lapply(MM_umaps_points, is.null)))] rownames(MM_min_max) <- c("min","max") - for(i in 1:length(GSM_umaps_points)){ - - print(paste0("Getting H5 files for GSM_umaps_points: ",i,": ",round((i/length(GSM_umaps_points))*100,3), "%")) - - h5createDataset(file = points, dataset = paste0("GSM/", gene_names_GSM[i]), dims = c(46656,1), storage.mode = "integer") - h5writeDataset(obj = GSM_umaps_points[[i]][[1]]$plot, h5loc = points, name=paste0("GSM/", gene_names_GSM[i])) - - GSM_min_max[1,i] = GSM_umaps_points[[i]][[1]]$min - GSM_min_max[2,i] = GSM_umaps_points[[i]][[1]]$max - - } - - for(i in 1:length(GIM_umaps_points)){ - - print(paste0("Getting H5 files for GIM_umaps_points: ",i,": ",round((i/length(GIM_umaps_points))*100,3), "%")) - - h5createDataset(file = points, dataset = paste0("GIM/", gene_names_GIM[i]), dims = c(46656,1), storage.mode = "integer") - h5writeDataset(obj = GIM_umaps_points[[i]][[1]]$plot, h5loc = points, name=paste0("GIM/", gene_names_GIM[i])) - - GIM_min_max[1,i] = GIM_umaps_points[[i]][[1]]$min - GIM_min_max[2,i] = GIM_umaps_points[[i]][[1]]$max - - } - for(i in 1:length(MM_umaps_points)){ print(paste0("Getting H5 files for MM_umaps_points: ",i,": ",round((i/length(MM_umaps_points))*100,3), "%")) @@ -230,8 +260,16 @@ shinyRasterUMAPs <- function( } + MM_pal = MM_umaps_points[[1]][[1]]$pal + + }else{ + + MM_min_max = NULL + MM_pal = NULL + } + scale <- list(gsm = GSM_min_max, gim = GIM_min_max, mm = MM_min_max) - pal <- list(gsm = GSM_umaps_points[[1]][[1]]$pal, gim = GIM_umaps_points[[1]][[1]]$pal, mm = MM_umaps_points[[1]][[1]]$pal) + pal <- list(gsm = GSM_pal, gim = GIM_pal, mm = MM_pal) saveRDS(scale, file.path(outputDirUmaps, "scale.rds")) saveRDS(pal, file.path(outputDirUmaps, "pal.rds")) @@ -241,4 +279,4 @@ shinyRasterUMAPs <- function( if(exists("MM_umaps_points")){ rm(MM_umaps_points) } } -} + From 244e5ce85203756268264812cc39f167831aaf04 Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Sun, 11 Dec 2022 17:47:01 +0300 Subject: [PATCH 035/162] fixed the reported issues --- R/MainEmbed.R | 44 ++++++++++++++++++++++++++++++-------------- 1 file changed, 30 insertions(+), 14 deletions(-) diff --git a/R/MainEmbed.R b/R/MainEmbed.R index 5b5e6caa..9a437223 100644 --- a/R/MainEmbed.R +++ b/R/MainEmbed.R @@ -11,6 +11,9 @@ #' For example if colorBy is "cellColData" then `names` refers to a column names in the `cellcoldata` (see `getCellcoldata()`). If `colorBy` #' is "GeneScoreMatrix" then `name` refers to a gene name which can be listed by `getFeatures(ArchRProj, useMatrix = "GeneScoreMatrix")`. #' @param embedding The embedding to use. Default is "UMAP". +#' @param Shiny A boolean value that tells the function is calling for Shiny or not. +#' @param matrices A list that contains color matrices for genes. +#' @param imputeMatricesList A list that contains color matrices for genes after imputation. #' @param threads The number of threads to use for parallel execution. #' @param logFile The path to a file to be used for logging ArchR output. #' @export @@ -18,8 +21,11 @@ mainEmbed <- function( ArchRProj = NULL, outDirEmbed = NULL, colorBy = "cellColData", - names = list("Clusters", "Sample", "unconstrained"), + names = NULL, embedding = "UMAP", + Shiny = FALSE, + matrices = matrices, + imputeMatricesList = imputeMatricesList, threads = getArchRThreads(), logFile = createLogFile("mainEmbeds") ){ @@ -27,8 +33,11 @@ mainEmbed <- function( .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) .validInput(input = outDirEmbed, name = "outDirEmbed", valid = c("character")) .validInput(input = colorBy, name = "colorBy", valid = c("character")) - .validInput(input = names, name = "names", valid = c("list")) + .validInput(input = names, name = "names", valid = c("character")) .validInput(input = embedding, name = "embedding", valid = c("character")) + .validInput(input = Shiny, name = "Shiny", valid = c("boolean")) + .validInput(input = matrices, name = "matrices", valid = c("list")) + .validInput(input = imputeMatricesList, name = "imputeMatricesList", valid = c("list")) .validInput(input = threads, name = "threads", valid = c("numeric")) .validInput(input = logFile, name = "logFile", valid = c("character")) @@ -53,20 +62,27 @@ mainEmbed <- function( selectCols <- "Sample" } - embeds <- .safelapply(1:seq_along(names), function(x){ + embeds <- .safelapply(1:length(names), function(x){ name <- names[[x]] print(name) - named_embed <- plotEmbedding( - ArchRProj = ArchRProj, - baseSize = 12, - colorBy = colorBy, - name = name, - embedding = embedding, - rastr = FALSE, - size = 0.5, - )+ggtitle(paste0("Colored by ", name))+theme(text = element_text(size=12), - legend.title = element_text(size = 12),legend.text = element_text(size = 6)) + tryCatch({ + named_embed <- plotEmbedding( + ArchRProj = ArchRProj, + baseSize = 12, + colorBy = colorBy, + name = name, + embedding = embedding, + rastr = FALSE, + size = 0.5, + matrices = matrices, + imputeMatricesList = imputeMatricesList, + Shiny = ShinyArchR + )+ggtitle(paste0("Colored by ", name))+theme(text = element_text(size=12), + legend.title = element_text(size = 12),legend.text = element_text(size = 6)) + }, error = function(x) { + }) + return(named_embed) }) @@ -109,7 +125,7 @@ mainEmbed <- function( blank_jpg72 <- readJPEG(source = file.path(outDirEmbed, paste0(names(embeds)[[i]],"_blank72.jpg")), native = TRUE) h5createDataset(file = points, dataset = names(embeds)[i], dims = c(46656,1), storage.mode = "integer") - h5writeDataset(obj = as.vector(blank_jpg72), h5loc = points, name= names(embeds)[i]) + h5writeDataset(obj = as.vector(blank_jpg72), h5loc = points, name= names[i]) embed_legend[[i]] <- levels(embed_plot[[1]]$data$color) names(embed_legend)[[i]] <- names(embed_plot) From 2567e09c4303dff5b3012ba8c330e6f2c28693cb Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Sun, 11 Dec 2022 18:25:05 -0800 Subject: [PATCH 036/162] cleaning up --- R/exportShinyArchR.R | 276 +------------------------------------------ 1 file changed, 3 insertions(+), 273 deletions(-) diff --git a/R/exportShinyArchR.R b/R/exportShinyArchR.R index f03e2e96..6814d733 100644 --- a/R/exportShinyArchR.R +++ b/R/exportShinyArchR.R @@ -1,216 +1,3 @@ -# Setting up ---------------------------------------------------------------------- - -library(shinycssloaders) -library(hexbin) -library(magick) -library(gridExtra) -library(grid) -library(patchwork) -library(shinybusy) -library(cowplot) -library(ggpubr) -library(farver) -library(rhdf5) -library(plotfunctions) -library(raster) -library(jpeg) -library(sparseMatrixStats) -library(BiocManager) -# options(repos = BiocManager::repositories()) -library(AnnotationDbi) -library(BSgenome) -library(Biobase) -library(BiocGenerics) -library(BiocParallel) -library(Biostrings) -library(CNEr) -library(ComplexHeatmap) -# options(download.file.method = "libcurl") -# devtools::install_github("selcukorkmaz/ArchR", ref = "dev") -library(ArchR) - -# specify whether you use a local machine or the shiny app -ShinyArchR = TRUE - -# specify desired number of threads -addArchRThreads(threads = 1) -# specify genome version. Default hg19 set -addArchRGenome("hg19") -set.seed(1) - -ArchRProj=loadArchRProject(path = "Save-ProjHeme5/") -ArchRProj <- addImputeWeights(ArchRProj = ArchRProj) -setwd(getOutputDirectory(ArchRProj)) - -# myLoadArchRProject ----------------------------------- -#' Load Previous ArchRProject into R -#' -#' This function will load a previously saved ArchRProject and re-normalize paths for usage. -#' -#' @param path A character path to an `ArchRProject` directory that was previously saved using `saveArchRProject()`. -#' @param force A boolean value indicating whether missing optional `ArchRProject` components (i.e. peak annotations / -#' background peaks) should be ignored when re-normalizing file paths. If set to `FALSE` loading of the `ArchRProject` -#' will fail unless all components can be found. -#' @param showLogo A boolean value indicating whether to show the ascii ArchR logo after successful creation of an `ArchRProject`. -#' @export -myLoadArchRProject <- function(path = "./", - force = FALSE, - showLogo = TRUE) { - .validInput(input = path, - name = "path", - valid = "character") - .validInput(input = force, - name = "force", - valid = "boolean") - .validInput(input = showLogo, - name = "showLogo", - valid = "boolean") - - path2Proj <- file.path(path, "Save-ArchR-Project.rds") - - if (!file.exists(path2Proj)) { - stop("Could not find previously saved ArchRProject in the path specified!") - } - - ArchRProj <- recoverArchRProject(readRDS(path2Proj)) - outputDir <- getOutputDirectory(ArchRProj) - outputDirNew <- normalizePath(path) - - - ArchRProj@projectMetadata$outputDirectory <- outputDirNew - - message("Successfully loaded ArchRProject!") - if (showLogo) { - .ArchRLogo(ascii = "Logo") - } - - ArchRProj - -} - - -## Create fragment files ----------------------------------------------------------- -.getGroupFragsFromProj <- function(ArchRProj = NULL, - groupBy = NULL, - outDir = file.path("Shiny", "fragments")) { - dir.create(outDir, showWarnings = FALSE) - - # find barcodes of cells in that groupBy. - groups <- getCellColData(ArchRProj, select = groupBy, drop = TRUE) - cells <- ArchRProj$cellNames - cellGroups <- split(cells, groups) - - # outputs unique cell groups/clusters. - clusters <- names(cellGroups) - - - for (cluster in clusters) { - cat("Making fragment file for cluster:", cluster, "\n") - # get GRanges with all fragments for that cluster - cellNames = cellGroups[[cluster]] - fragments <- - getFragmentsFromProject(ArchRProj = ArchRProj, cellNames = cellNames) - fragments <- unlist(fragments, use.names = FALSE) - # filter Fragments - fragments <- - GenomeInfoDb::keepStandardChromosomes(fragments, pruning.mode = "coarse") - saveRDS(fragments, file.path(outDir, paste0(cluster, "_cvg.rds"))) - } -} - -addSeqLengths <- function (gr, genome) { - gr <- ArchR:::.validGRanges(gr) - genome <- validBSgenome(genome) - stopifnot(all(as.character(seqnames(gr)) %in% as.character(seqnames(genome)))) - seqlengths(gr) <- - seqlengths(genome)[as.character(names(seqlengths(gr)))] - return(gr) -} - -.getClusterCoverage <- function(ArchRProj = NULL, - tileSize = 100, - scaleFactor = 1, - groupBy = "Clusters", - outDir = file.path("Shiny", "coverage")) { - fragfiles = list.files(path = file.path("Shiny", "fragments"), - full.names = TRUE) - dir.create(outDir, showWarnings = FALSE) - - # find barcodes of cells in that groupBy. - groups <- getCellColData(ArchRProj, select = groupBy, drop = TRUE) - cells <- ArchRProj$cellNames - cellGroups <- split(cells, groups) - - # outputs unique cell groups/clusters. - clusters <- names(cellGroups) - - chrRegions <- getChromSizes(ArchRProj) - genome <- getGenome(ArchRProj) - - for (file in fragfiles) { - fragments <- readRDS(file) - #fragmentsToInsertions() - left <- GRanges(seqnames = seqnames(fragments), - ranges = IRanges(start(fragments), width = 1)) - right <- GRanges(seqnames = seqnames(fragments), - ranges = IRanges(end(fragments), width = 1)) - # call sort() after sortSeqlevels() to sort also the ranges in addition - # to the chromosomes. - insertions <- c(left, right) %>% sortSeqlevels() %>% - sort() - - cluster <- file %>% basename() %>% gsub("_.*", "", .) - #binnedCoverage - # message("Creating bins for cluster ",clusters[clusteridx], "...") - bins <- - unlist(slidingWindows(chrRegions, width = tileSize, step = tileSize)) - # message("Counting overlaps for cluster ",clusters[clusteridx], "...") - bins$reads <- - countOverlaps( - bins, - insertions, - maxgap = -1L, - minoverlap = 0L, - type = "any" - ) - addSeqLengths(bins, genome) - # message("Creating binned coverage for cluster ",clusters[clusteridx], "...") - #each value is multiplied by that weight. - # TODO add scaleFactor - # allCells as.vector(ArchRProj@cellColData$Sample, mode="any") - clusterReadsInTSS <- - ArchRProj@cellColData$ReadsInTSS[cells %in% cellGroups$cluster] - # scaleFactor <- 5e+06 / sum(clusterReadsInTSS) - binnedCoverage <- - coverage(bins, weight = bins$reads * scaleFactor) - saveRDS(binnedCoverage, file.path(outDir, paste0(cluster, "_cvg.rds"))) - } - -} - - -############################################################# - -# ArchRProj=myLoadArchRProject("./Shiny/inputData/") - - -# Load all hidden ArchR functions ------------------------------------------------ -fn <- unclass(lsf.str(envir = asNamespace("ArchR"), all = TRUE)) -for (i in seq_along(fn)) { - tryCatch({ - # eval(parse(text = paste0(fn[i], "<-", fn[i]))) - eval(parse(text=paste0(fn[i], '<-ArchR:::', fn[i]))) - }, error = function(x) { - }) -} - - -outputDir = "Shiny" -subOutputDir = "inputData" - - - - # exportShiny function ----------------------------------------------------------- #' Export a Shiny App based on ArchRProj #' @@ -248,11 +35,7 @@ exportShinyArchR <- function( .requirePackage("shiny", installInfo = 'install.packages("shiny")') .requirePackage("rhandsontable", installInfo = 'install.packages("rhandsontable")') - - # ArchRProj <- myLoadArchRProject(path = paste0("./",outputDir,"/inputData/")) - # ArchRProj <- addImputeWeights(ArchRProj = ArchRProj) - # TODO: Check that all columns exist in cellColData if(is.null(groupBy)){ stop("groupBy must be provided") } else if(groupBy %ni% colnames(getCellColData(ArchRProj))){ @@ -332,64 +115,16 @@ exportShinyArchR <- function( message("Coverage files already exist...") } - ## main umaps ----------------------------------------------------------------- dir.create(file.path(getOutputDirectory(ArchRProj), outputDir, subOutputDir),showWarnings = TRUE) - # need arrowFiles to getFeatures so need to save genes as RDS - # TODO change hardcoding of these paths: Should be file.path(getOutputDirectory(ArchRProj), outputDir, subOutputDir, "features.rds" - if(!file.exists(file.path(getOutputDirectory(ArchRProj), outputDir, subOutputDir, "gene_names.rds"))){ - # TODO probably need to add param to get specific features based on matrix? - gene_names <- getFeatures(ArchRProj = ArchRProj) - saveRDS(gene_names, paste0("./", outputDir, "/", subOutputDir,"/gene_names.rds")) - }else{ - message("gene_names already exists...") - gene_names <- readRDS(paste0("./", outputDir, "/", subOutputDir,"/gene_names.rds")) - } - - if(!file.exists(paste0("./", outputDir, "/", subOutputDir,"/umaps.rds"))){ - umaps <- list() - umapNames <- colnames(ArchRProjShiny@cellColData) - - for(x in 1:length(umapNames)){ - - print(umapNames[x]) - - tryCatch( - umap <- plotEmbedding( - ArchRProj = ArchRProjShiny, - baseSize=12, - colorBy = "cellColData", - name = umapNames[x], - embedding = embedding, - rastr = FALSE, - 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)), - - umaps[[umapNames[[x]]]] <- umap, - error = function(e){ - print(e) - }) - } - - saveRDS(umaps, paste0("./", outputDir, "/", subOutputDir,"/umaps.rds")) - - - }else{ - message("umaps already exists...") - umaps <- readRDS(paste0("./", outputDir, "/", subOutputDir,"/umaps.rds")) - } - - ## colorMats without Impute Weights---------------------------------------------------------------- - #TODO check with matrices are available + # check which matrices are available allMatrices <- getAvailableMatrices(ArchRProj) - #Get gene and motif names and save as RDS + # Get gene and motif names and save as RDS if(!file.exists(paste0("./", outputDir, "/", subOutputDir,"/gene_names_GSM.rds"))){ - # TODO check if ArchRProj has GSM if ("GeneScoreMatrix" %in% allMatrices){ gene_names_GSM <- getFeatures(ArchRProj = ArchRProj, useMatrix = "GeneScoreMatrix") saveRDS(gene_names_GSM, paste0("./", outputDir, "/", subOutputDir,"/gene_names_GSM.rds")) @@ -403,7 +138,6 @@ exportShinyArchR <- function( if(!file.exists(paste0("./", outputDir, "/", subOutputDir,"/gene_names_GIM.rds"))){ - # TODO check if ArchRProj has GIM if ("GeneIntegrationMatrix" %in% allMatrices){ gene_names_GIM <- getFeatures(ArchRProj = ArchRProj, useMatrix = "GeneIntegrationMatrix") saveRDS(gene_names_GSM, paste0("./", outputDir, "/", subOutputDir,"/gene_names_GIM.rds")) @@ -418,7 +152,6 @@ if(!file.exists(paste0("./", outputDir, "/", subOutputDir,"/gene_names_GIM.rds") if(!file.exists(paste0("./", outputDir, "/", subOutputDir,"/motif_names.rds"))){ - # TODO check if ArchRProj has MM if ("MotifMatrix" %in% allMatrices){ motif_names <- getFeatures(ArchRProj = ArchRProj, useMatrix = "MotifMatrix") %>% gsub(".*:", "", .) %>% unique(.) @@ -456,7 +189,6 @@ if(!file.exists(paste0("./", outputDir, "/", subOutputDir,"/gene_names_GIM.rds") ),sparse = TRUE) matrices$"GeneIntegrationMatrix" <- colorMatGIM - #colorMatMM has 1740 rows because in name = getFeatures() returns the 870 z: + the 870 deviations: colorMatMM <- Matrix(.getMatrixValues( ArchRProj = ArchRProj, #name = getFeatures(ArchRProj, "MotifMatrix") @@ -467,9 +199,7 @@ if(!file.exists(paste0("./", outputDir, "/", subOutputDir,"/gene_names_GIM.rds") ), sparse = TRUE) matrices$"MotifMatrix" <- colorMatMM - #TODO modify this so it only has the matrices we are actually supporting - matrices$allColorBy=c("colData", "cellColData", .availableArrays(head(getArrowFiles(ArchRProj), 2))) - # shouldn't save rds because it's too hefty for ShinyApps + matrices$allColorBy=c(.availableArrays(head(getArrowFiles(ArchRProj), 2))) saveRDS(matrices, paste0("./", outputDir, "/", subOutputDir,"/matrices.rds")) }else{ From c2dea086c3564333256535a795e61343d562cec8 Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Mon, 19 Dec 2022 20:05:25 +0300 Subject: [PATCH 037/162] Hardcodings are removed. Available matrices are used --- R/exportShinyArchR.R | 306 +++++++++++++++++-------------------------- 1 file changed, 121 insertions(+), 185 deletions(-) diff --git a/R/exportShinyArchR.R b/R/exportShinyArchR.R index 6814d733..9203d206 100644 --- a/R/exportShinyArchR.R +++ b/R/exportShinyArchR.R @@ -35,7 +35,8 @@ exportShinyArchR <- function( .requirePackage("shiny", installInfo = 'install.packages("shiny")') .requirePackage("rhandsontable", installInfo = 'install.packages("rhandsontable")') - + + if(is.null(groupBy)){ stop("groupBy must be provided") } else if(groupBy %ni% colnames(getCellColData(ArchRProj))){ @@ -49,21 +50,21 @@ exportShinyArchR <- function( }else{ print(paste0("embedding:", embedding)) } - + # Make directory for Shiny App if(!dir.exists(outputDir)) { dir.create(outputDir) - + ## Check the links for the files filesUrl <- data.frame( fileUrl = c( - "https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/app.R", - "https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/global.R", - "https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/server.R", - "https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/ui.R" - ), - md5sum = c( + "https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/app.R", + "https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/global.R", + "https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/server.R", + "https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/ui.R" + ), + md5sum = c( "77502e1f195e21d2f7a4e8ac9c96e65e", "618613b486e4f8c0101f4c05c69723b0", "a8d5ae747841055ef230ba496bcfe937" @@ -72,7 +73,7 @@ exportShinyArchR <- function( ) .downloadFiles(filesUrl = filesUrl, pathDownload = outputDir, threads = threads) - + }else{ message("Using existing Shiny files...") } @@ -89,7 +90,7 @@ exportShinyArchR <- function( ArchRProjShiny@projectMetadata[["groupBy"]] <- groupBy } ArchRProjShiny@projectMetadata[["tileSize"]] <- tileSize - units <- tryCatch({ + units <- tryCatch({ .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, "/Info/Units"))[1] },error=function(e){ "values" @@ -116,209 +117,144 @@ exportShinyArchR <- function( } - dir.create(file.path(getOutputDirectory(ArchRProj), outputDir, subOutputDir),showWarnings = TRUE) - - ## colorMats without Impute Weights---------------------------------------------------------------- + dir.create(file.path(getOutputDirectory(ArchRProj), outputDir, subOutputDir), showWarnings = TRUE) - # check which matrices are available - allMatrices <- getAvailableMatrices(ArchRProj) - - # Get gene and motif names and save as RDS - if(!file.exists(paste0("./", outputDir, "/", subOutputDir,"/gene_names_GSM.rds"))){ - if ("GeneScoreMatrix" %in% allMatrices){ - gene_names_GSM <- getFeatures(ArchRProj = ArchRProj, useMatrix = "GeneScoreMatrix") - saveRDS(gene_names_GSM, paste0("./", outputDir, "/", subOutputDir,"/gene_names_GSM.rds")) - }else{ - message("GeneScoreMatrix does not exist...") - } + + if(!file.exists(file.path(getOutputDirectory(ArchRProj), outputDir, subOutputDir, "features.rds"))){ + gene_names <- getFeatures(ArchRProj = ArchRProj) + saveRDS(gene_names, paste0("./", outputDir, "/", subOutputDir,"/features.rds")) }else{ - message("gene_names_GSM already exists...") - gene_names_GSM <- readRDS(paste0("./", outputDir, "/", subOutputDir,"/gene_names_GSM.rds")) + message("gene_names already exists...") + gene_names <- readRDS(paste0("./", outputDir, "/", subOutputDir,"/features.rds")) } - -if(!file.exists(paste0("./", outputDir, "/", subOutputDir,"/gene_names_GIM.rds"))){ - if ("GeneIntegrationMatrix" %in% allMatrices){ - gene_names_GIM <- getFeatures(ArchRProj = ArchRProj, useMatrix = "GeneIntegrationMatrix") - saveRDS(gene_names_GSM, paste0("./", outputDir, "/", subOutputDir,"/gene_names_GIM.rds")) - }else{ + if(!file.exists(paste0("./", outputDir, "/", subOutputDir,"/umaps.rds"))){ + umaps <- list() + umapNames <- colnames(ArchRProjShiny@cellColData) - message("GeneIntegrationMatrix does not exist...") - } -}else{ - message("gene_names_GIM already exists...") - gene_names_GIM <- readRDS(paste0("./", outputDir, "/", subOutputDir,"/gene_names_GIM.rds")) - } - - - if(!file.exists(paste0("./", outputDir, "/", subOutputDir,"/motif_names.rds"))){ - if ("MotifMatrix" %in% allMatrices){ - motif_names <- getFeatures(ArchRProj = ArchRProj, useMatrix = "MotifMatrix") %>% - gsub(".*:", "", .) %>% unique(.) - saveRDS(motif_names, paste0("./", outputDir, "/", subOutputDir,"/motif_names.rds")) - }else{ + for(x in 1:length(umapNames)){ - message("MotifMatrix does not exist...") + print(umapNames[x]) + tryCatch({ + umap <- plotEmbedding( + + ArchRProj = ArchRProjShiny, + baseSize=12, + colorBy = "cellColData", + name = umapNames[x], + embedding = embedding, + rastr = FALSE, + 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)) + + umaps[[umapNames[[x]]]] <- umap + }, + error = function(e){ + print(e) + }) } - }else{ - - message("motif_names already exists...") - motif_names <- readRDS(paste0("./", outputDir, "/", subOutputDir,"/motif_names.rds")) - } - - if(!file.exists(paste0("./", outputDir, "/", subOutputDir,"/matrices.rds"))){ - matrices <- list() - #GSM colorMat - colorMatGSM <- Matrix(.getMatrixValues( - ArchRProj = ArchRProj, - name = gene_names_GSM, - matrixName = "GeneScoreMatrix", - log2Norm = FALSE, - threads = threads, - ), sparse = TRUE) - matrices$"GeneScoreMatrix" <- colorMatGSM - - #GIM - colorMatGIM <- Matrix(.getMatrixValues( - ArchRProj = ArchRProj, - name = gene_names_GIM, - matrixName = "GeneIntegrationMatrix", - log2Norm = FALSE, - threads = threads - ),sparse = TRUE) - matrices$"GeneIntegrationMatrix" <- colorMatGIM - colorMatMM <- Matrix(.getMatrixValues( - ArchRProj = ArchRProj, - #name = getFeatures(ArchRProj, "MotifMatrix") - name = paste0("deviations:", motif_names), #used deviations: - matrixName = "MotifMatrix", - log2Norm = FALSE, - threads = threads - ), sparse = TRUE) - matrices$"MotifMatrix" <- colorMatMM + saveRDS(umaps, paste0("./", outputDir, "/", subOutputDir,"/umaps.rds")) - matrices$allColorBy=c(.availableArrays(head(getArrowFiles(ArchRProj), 2))) - saveRDS(matrices, paste0("./", outputDir, "/", subOutputDir,"/matrices.rds")) }else{ - message("matrices already exist...") - matrices <- readRDS(paste0("./", outputDir, "/", subOutputDir,"/matrices.rds")) + message("umaps already exists...") + umaps <- readRDS(paste0("./", outputDir, "/", subOutputDir,"/umaps.rds")) } - ## Impute Weights ------------------------------------------------------------ + + + allMatrices <- getAvailableMatrices(ArchRProj) + matrices <- list() + imputeMatricesList <- list() imputeWeights <- getImputeWeights(ArchRProj = ArchRProj) - if(!is.null(imputeWeights)) { - df <- getEmbedding(ArchRProj, embedding = "UMAP", returnDF = TRUE) + df <- getEmbedding(ArchRProj, embedding = "UMAP", returnDF = TRUE) + + for(allmatrices in allMatrices){ + print(allmatrices) + name <- paste0(allmatrices, "_names") + result = assign(name, getFeatures(ArchRProj = ArchRProj, useMatrix = allmatrices)) + saveRDS(result, paste0("./", outputDir, "/", subOutputDir, "/", allmatrices,"_names.rds")) - if(!file.exists(paste0("./", outputDir, "/", subOutputDir,"/imputeMatricesList.rds"))){ - imputeMatricesList <- list() - # colorMats for each colorBy - - # GSM - # colorMatGSM <- matrices$"GeneScoreMatrix" - # colorMatGSM <- colorMatGSM[,rownames(df), drop=FALSE] - colorMatGSM <- matrices[["GeneScoreMatrix"]][,rownames(df), drop=FALSE] - - - - .logThis(colorMatGSM, "colorMatGSM-Before-Impute", logFile = logFile) - - if(getArchRVerbose()) message("Imputing Matrix") - colorMatGSM_Impute <- imputeMatrix(mat = as.matrix(colorMatGSM), imputeWeights = imputeWeights, logFile = logFile) - if(!inherits(colorMatGSM_Impute, "matrix")){ - colorMatGSM_Impute <- matrix(colorMatGSM_Impute, ncol = nrow(df)) - colnames(colorMatGSM_Impute) <- rownames(df) - } - - # .logThis(colorMat_Impute, "colorMatGSM-After-Impute", logFile = logFile) - - imputeMatricesList$"GeneScoreMatrix" <- colorMatGSM_Impute - - # GIM - # colorMatGIM <- matrices$"GeneIntegrationMatrix" - # colorMatGIM <- colorMatGIM[,rownames(df), drop=FALSE] - colorMatGIM <- matrices[["GeneIntegrationMatrix"]][,rownames(df), drop=FALSE] + if(!is.null(result)){ + # nameColor <- paste0("colorMat", allmatrices) + matrix = Matrix(.getMatrixValues( + ArchRProj = ArchRProj, + name = result, + matrixName = allmatrices, + log2Norm = FALSE, + threads = threads), sparse = TRUE) + matrices[[allmatrices]] = matrix - .logThis(colorMatGIM, "colorMatGIM-Before-Impute", logFile = logFile) + matList = matrix[,rownames(df), drop=FALSE] + # assign(nameColor, matList) + .logThis(matList, paste0(allmatrices,"-Before-Impute"), logFile = logFile) if(getArchRVerbose()) message("Imputing Matrix") - colorMatGIM_Impute <- imputeMatrix(mat = as.matrix(colorMatGIM), imputeWeights = imputeWeights, logFile = logFile) - if(!inherits(colorMatGIM_Impute, "matrix")){ - colorMatGIM_Impute <- matrix(colorMatGIM_Impute, ncol = nrow(df)) - colnames(colorMatGIM_Impute) <- rownames(df) - } - - .logThis(colorMatGIM_Impute, "colorMatGIM-After-Impute", logFile = logFile) - - imputeMatricesList$"GeneIntegrationMatrix" <- colorMatGIM_Impute - - # Motif Matrix - # colorMatMM <- matrices$"MotifMatrix" - # colorMatMM <- colorMatMM[,rownames(df), drop=FALSE] - colorMatMM <- matrices[["MotifMatrix"]][,rownames(df), drop=FALSE] - - .logThis(colorMatMM, "colorMatMM-Before-Impute", logFile = logFile) + colorImputeMat <- imputeMatrix(mat = as.matrix(matList), imputeWeights = imputeWeights, logFile = logFile) + # assign(paste0(nameColor, "_Impute"), imputeMat) - if(getArchRVerbose()) message("Imputing Matrix") - colorMatMM_Impute <- imputeMatrix(mat = as.matrix(colorMatMM), imputeWeights = imputeWeights, logFile = logFile) - if(!inherits(colorMatMM_Impute, "matrix")){ - colorMatMM_Impute <- matrix(colorMatMM_Impute, ncol = nrow(df)) - colnames(colorMatMM_Impute) <- rownames(df) + if(!inherits(colorImputeMat, "matrix")){ + colorImputeMat <- matrix(colorImputeMat, ncol = nrow(df)) + colnames(colorImputeMat) <- rownames(df) } + imputeMatricesList[[allmatrices]] <- colorImputeMat - .logThis(colorMatMM_Impute, "colorMatMM-After-Impute", logFile = logFile) - - imputeMatricesList$"MotifMatrix" <- colorMatMM_Impute - saveRDS(imputeMatricesList,paste0("./", outputDir, "/", subOutputDir,"/imputeMatricesList.rds")) }else{ - message("imputeMatricesList already exists...") - imputeMatricesList <- readRDS(paste0("./", outputDir, "/", subOutputDir,"/imputeMatricesList.rds")) + message(allmatrices, " is NULL.") } } - # Create an HDF5 containing the nativeRaster vectors for the main matrices - if (!file.exists(file.path(outputDir, subOutputDir, "mainEmbeds.h5"))) { - - mainEmbed(ArchRProj = ArchRProj, - outDirEmbed = file.path(outputDir, subOutputDir), - names = colnames(ArchRProjShiny@cellColData), - matrices = matrices, - imputeMatricesList = imputeMatricesList, - Shiny = ShinyArchR - ) - } else{ - message("H5 for main embeds already exists...") - } - - - if(!file.exists(paste0("./", outputDir, "/", subOutputDir,"/plotBlank72.h5"))){ - - shinyRasterUMAPs( - ArchRProj = ArchRProj, - outputDirUmaps = paste0(outputDir,"/", subOutputDir), - threads = getArchRThreads(), - verbose = TRUE, - logFile = createLogFile("ShinyRasterUMAPs") - ) - - }else{ - - message("H5 file already exists...") - - } - ## delete unnecessary files ----------------------------------------------------------------- - unlink("./fragments", recursive = TRUE) - unlink("./ArchRLogs", recursive = TRUE) - - ## ready to launch --------------------------------------------------------------- - message("App created! To launch, + + saveRDS(matrices,paste0("./", outputDir, "/", subOutputDir,"/matrices.rds")) + saveRDS(imputeMatricesList,paste0("./", outputDir, "/", subOutputDir,"/imputeMatricesList.rds")) + + matrices <- readRDS("Shiny/inputData/matrices.rds") + imputeMatricesList <- readRDS("Shiny/inputData/imputeMatricesList.rds") + +# Create an HDF5 containing the nativeRaster vectors for the main matrices +if (!file.exists(file.path(outputDir, subOutputDir, "mainEmbeds.h5"))) { + + mainEmbed(ArchRProj = ArchRProj, + outDirEmbed = file.path(outputDir, subOutputDir), + names = colnames(ArchRProjShiny@cellColData), + matrices = matrices, + imputeMatricesList = imputeMatricesList, + Shiny = ShinyArchR + ) +} else{ + message("H5 for main embeds already exists...") +} + + +if(!file.exists(paste0("./", outputDir, "/", subOutputDir,"/plotBlank72.h5"))){ + + shinyRasterUMAPs( + ArchRProj = ArchRProj, + outputDirUmaps = paste0(outputDir,"/", subOutputDir), + threads = getArchRThreads(), + verbose = TRUE, + logFile = createLogFile("ShinyRasterUMAPs") + ) + +}else{ + + message("H5 file already exists...") + +} +## delete unnecessary files ----------------------------------------------------------------- +unlink("./fragments", recursive = TRUE) +unlink("./ArchRLogs", recursive = TRUE) + +## ready to launch --------------------------------------------------------------- +message("App created! To launch, ArchRProj <- loadArchRProject('",getOutputDirectory(ArchRProj),"') and run shiny::runApp('", outputDir, "') from parent directory") - # runApp("myappdir") - +# runApp("myappdir") + } From 48834a52282c6eaef7dadae1cc8161d19911abe3 Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Mon, 19 Dec 2022 20:07:19 +0300 Subject: [PATCH 038/162] Hardcodings are removed. Available matrices used. --- R/ShinyRasterUMAPs.R | 305 ++++++++++++------------------------------- 1 file changed, 84 insertions(+), 221 deletions(-) diff --git a/R/ShinyRasterUMAPs.R b/R/ShinyRasterUMAPs.R index 8dfa6293..8b6c395f 100644 --- a/R/ShinyRasterUMAPs.R +++ b/R/ShinyRasterUMAPs.R @@ -23,7 +23,6 @@ shinyRasterUMAPs <- function( .validInput(input = verbose, name = "verbose", valid = c("boolean")) .validInput(input = logFile, name = "logFile", valid = c("character")) - shinyMatrices <- getAvailableMatrices(ArchRProj) if (file.exists(file.path(outputDirUmaps, "plotBlank72.h5"))){ @@ -31,252 +30,116 @@ shinyRasterUMAPs <- function( } - h5closeAll() - points <- H5Fcreate(name = file.path(outputDirUmaps,"plotBlank72.h5")) + umaps_min_max_list = list() + umaps_pal_list = list() - if("GeneScoreMatrix" %in% shinyMatrices){ - h5createGroup(file.path(outputDirUmaps, "plotBlank72.h5"),"GSM") - if(!exists("GSM_umaps_points")){ - - GSM_umaps_points <- ArchR:::.safelapply(1:length(gene_names_GSM), function(x){ - - print(paste0("Creating plots for GSM_umaps_points: ",x,": ",round((x/length(gene_names_GSM))*100,3), "%")) - - gene_plot <- plotEmbedding( - ArchRProj = ArchRProj, - colorBy = "GeneScoreMatrix", - name = gene_names_GSM[x], - embedding = "UMAP", - quantCut = c(0.01, 0.95), - imputeWeights = getImputeWeights(ArchRProj = ArchRProj), - plotAs = "points", - rastr = TRUE - ) - - if(!is.null(gene_plot)){ - - gene_plot_blank <- gene_plot + theme(axis.title.x = element_blank()) + - theme(axis.title.y = element_blank()) + - theme(axis.title = element_blank()) + - theme(legend.position = "none") + - theme( - panel.grid.major = element_blank(), - panel.grid.minor = element_blank(), - panel.border = element_blank(), - title=element_blank() - ) - - #save plot without axes etc as a jpg. - ggsave(filename = file.path(outputDirUmaps, "GSM_umaps", paste0(gene_names_GSM[x],"_blank72.jpg")), - plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) - - #read back in that jpg because we need vector in native format - blank_jpg72 <- readJPEG(source = file.path(outputDirUmaps, "GSM_umaps", - paste0(gene_names_GSM[x],"_blank72.jpg")), native = TRUE) - - res = list(list(plot=as.vector(blank_jpg72), min = round(min(gene_plot[[1]]$data$color),1), - max = round(max(gene_plot[[1]]$data$color),1), pal = gene_plot[[2]])) - - return(res) - } - }, threads = threads) - names(GSM_umaps_points) <- gene_names_GSM - }else{ - message("GSM_umaps_points already exists. Skipping the loop...") - } - - GSM_umaps_points = GSM_umaps_points[!unlist(lapply(GSM_umaps_points, is.null))] - - GSM_min_max <- data.frame(matrix(NA, 2, length(GSM_umaps_points))) - colnames(GSM_min_max) <- names(GSM_umaps_points)[which(!unlist(lapply(GSM_umaps_points, is.null)))] - rownames(GSM_min_max) <- c("min","max") - - for(i in 1:length(GSM_umaps_points)){ - - print(paste0("Getting H5 files for GSM_umaps_points: ",i,": ",round((i/length(GSM_umaps_points))*100,3), "%")) - - h5createDataset(file = points, dataset = paste0("GSM/", gene_names_GSM[i]), dims = c(46656,1), storage.mode = "integer") - h5writeDataset(obj = GSM_umaps_points[[i]][[1]]$plot, h5loc = points, name=paste0("GSM/", gene_names_GSM[i])) - - GSM_min_max[1,i] = GSM_umaps_points[[i]][[1]]$min - GSM_min_max[2,i] = GSM_umaps_points[[i]][[1]]$max - - } - - GSM_pal = GSM_umaps_points[[1]][[1]]$pal - - }else{ - - GSM_min_max = NULL - GSM_pal = NULL - } + shinyMatrices <- getAvailableMatrices(ArchRProj) - if("GeneIntegrationMatrix" %in% shinyMatrices){ + for(shinymatrices in shinyMatrices){ - h5createGroup(file.path(outputDirUmaps, "plotBlank72.h5"),"GIM") + print(shinymatrices) + matrixName = paste0(shinymatrices,"_names") - if(!exists("GIM_umaps_points")){ - GIM_umaps_points <- ArchR:::.safelapply(1:length(gene_names_GIM), function(x){ - - print(paste0("Creating plots for GIM_umaps_points: ",x,": ",round((x/length(gene_names_GIM))*100,3), "%")) + if(file.exists(paste0(outputDirUmaps, "/", matrixName, ".rds"))){ - gene_plot <- plotEmbedding( - ArchRProj = ArchRProj, - colorBy = "GeneIntegrationMatrix", - name = gene_names_GIM[x], - embedding = "UMAP", - embeddingDF = df, - quantCut = c(0.01, 0.95), - imputeWeights = getImputeWeights(ArchRProj = ArchRProj), - plotAs = "points", - rastr = TRUE - ) + geneMatrixNames <- readRDS(paste0(outputDirUmaps, "/", matrixName, ".rds")) - if(!is.null(gene_plot)){ - gene_plot_blank <- gene_plot + theme(axis.title.x = element_blank()) + - theme(axis.title.y = element_blank()) + - theme(axis.title = element_blank()) + - theme(legend.position = "none") + - theme( - panel.grid.major = element_blank(), - panel.grid.minor = element_blank(), - panel.border = element_blank(), - title=element_blank() - ) + if(!is.null(geneMatrixNames)){ - #save plot without axes etc as a jpg. - ggsave(filename = file.path(outputDirUmaps, "GIM_umaps", paste0(gene_names_GIM[x],"_blank72.jpg")), - plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) + umaps_points <- .safelapply(1:10, function(x){ + + print(paste0("Creating plots for ",shinymatrices,": ",x,": ",round((x/length(geneMatrixNames))*100,3), "%")) + + gene_plot <- plotEmbedding( + ArchRProj = ArchRProj, + colorBy = shinymatrices, + name = geneMatrixNames[x], + embedding = "UMAP", + quantCut = c(0.01, 0.95), + imputeWeights = getImputeWeights(ArchRProj = ArchRProj), + plotAs = "points", + matrices = matrices, + imputeMatricesList = imputeMatricesList, + rastr = TRUE + ) + + if(!is.null(gene_plot)){ + + gene_plot_blank <- gene_plot + theme(axis.title.x = element_blank()) + + theme(axis.title.y = element_blank()) + + theme(axis.title = element_blank()) + + theme(legend.position = "none") + + theme( + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.border = element_blank(), + title=element_blank() + ) + + #save plot without axes etc as a jpg. + ggsave(filename = file.path(outputDirUmaps, paste0(shinymatrices,"_umaps"), paste0(geneMatrixNames[x],"_blank72.jpg")), + plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) + + #read back in that jpg because we need vector in native format + blank_jpg72 <- readJPEG(source = file.path(outputDirUmaps, paste0(shinymatrices,"_umaps"), + paste0(geneMatrixNames[x],"_blank72.jpg")), native = TRUE) + + g <- ggplot_build(gene_plot) + + res = list(list(plot=as.vector(blank_jpg72), min = round(min(gene_plot$data$color),1), + max = round(max(gene_plot$data$color),1), pal = unique(g$data[[1]][,"colour"]))) + + return(res) + } + }, threads = threads) + names(umaps_points) <- geneMatrixNames[1:10] - #read back in that jpg because we need vector in native format - blank_jpg72 <- readJPEG(source = file.path(outputDirUmaps, "GIM_umaps", - paste0(gene_names_GIM[x],"_blank72.jpg")), native = TRUE) + }else{ + message(matrixName,".rds file is NULL") - res = list(list(plot=as.vector(blank_jpg72), min = round(min(gene_plot[[1]]$data$color),1), - max = round(max(gene_plot[[1]]$data$color),1), pal = gene_plot[[2]])) - return(res) } - - }, threads = threads) - names(GIM_umaps_points) <- gene_names_GIM - }else{ - message("GIM_umaps_points already exists. Skipping the loop...") - } - - GIM_umaps_points = GIM_umaps_points[!unlist(lapply(GIM_umaps_points, is.null))] - MM_umaps_points = MM_umaps_points[!unlist(lapply(MM_umaps_points, is.null))] - - GIM_min_max <- data.frame(matrix(NA, 2, length(GIM_umaps_points))) - colnames(GIM_min_max) <- names(GIM_umaps_points)[which(!unlist(lapply(GIM_umaps_points, is.null)))] - rownames(GIM_min_max) <- c("min","max") - - for(i in 1:length(GIM_umaps_points)){ - print(paste0("Getting H5 files for GIM_umaps_points: ",i,": ",round((i/length(GIM_umaps_points))*100,3), "%")) - - h5createDataset(file = points, dataset = paste0("GIM/", gene_names_GIM[i]), dims = c(46656,1), storage.mode = "integer") - h5writeDataset(obj = GIM_umaps_points[[i]][[1]]$plot, h5loc = points, name=paste0("GIM/", gene_names_GIM[i])) - - GIM_min_max[1,i] = GIM_umaps_points[[i]][[1]]$min - GIM_min_max[2,i] = GIM_umaps_points[[i]][[1]]$max + }else{ + + message(matrixName,".rds file does not exist") + } - } - - GIM_pal = GIM_umaps_points[[1]][[1]]$pal - - }else{ - - GIM_min_max = NULL - GIM_pal = NULL - } - - if("MotifMatrix" %in% shinyMatrices){ - - h5createGroup(file.path(outputDirUmaps, "plotBlank72.h5"),"MM") - - if(!exists("MM_umaps_points")){ - - MM_umaps_points <- ArchR:::.safelapply(1:length(motif_names), function(x){ + umaps_points = umaps_points[!unlist(lapply(umaps_points, is.null))] - print(paste0("Creating plots for MM_umaps_points: ",x,": ",round((x/length(motif_names))*100,3), "%")) + umaps_min_max <- data.frame(matrix(NA, 2, length(umaps_points))) + colnames(umaps_min_max) <- names(umaps_points)[which(!unlist(lapply(umaps_points, is.null)))] + rownames(umaps_min_max) <- c("min","max") - gene_plot <- plotEmbedding( - ArchRProj = ArchRProj, - colorBy = "MotifMatrix", - name = motif_names[x], - embedding = "UMAP", - embeddingDF = df, - quantCut = c(0.01, 0.95), - imputeWeights = getImputeWeights(ArchRProj = ArchRProj), - plotAs = "points", - rastr = TRUE - ) + h5closeAll() + points <- H5Fcreate(name = file.path(outputDirUmaps,"plotBlank72.h5")) + h5createGroup(file.path(outputDirUmaps, "plotBlank72.h5"), shinymatrices) - if(!is.null(gene_plot)){ - gene_plot_blank <- gene_plot + theme(axis.title.x = element_blank()) + - theme(axis.title.y = element_blank()) + - theme(axis.title = element_blank()) + - theme(legend.position = "none") + - theme( - panel.grid.major = element_blank(), - panel.grid.minor = element_blank(), - panel.border = element_blank(), - title=element_blank() - ) + for(i in 1:length(umaps_points)){ - #save plot without axes etc as a jpg - ggsave(filename = file.path(outputDirUmaps, "MM_umaps", paste0(motif_names[x],"_blank72.jpg")), - plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) + print(paste0("Getting H5 files for umaps_points: ",i,": ",round((i/length(umaps_points))*100,3), "%")) + h5createDataset(file = points, dataset = paste0(shinymatrices,"/",geneMatrixNames[i]), dims = c(46656,1), storage.mode = "integer") + h5writeDataset(obj = umaps_points[[i]][[1]]$plot, h5loc = points, name=paste0(shinymatrices,"/",geneMatrixNames[i])) - #read back in that jpg because we need vector in native format - blank_jpg72 <- readJPEG(source = file.path(outputDirUmaps, "MM_umaps", - paste0(motif_names[x],"_blank72.jpg")), native = TRUE) + umaps_min_max[1,i] = umaps_points[[i]][[1]]$min + umaps_min_max[2,i] = umaps_points[[i]][[1]]$max - res = list(list(plot=as.vector(blank_jpg72), min = round(min(gene_plot[[1]]$data$color),1), - max = round(max(gene_plot[[1]]$data$color),1), pal = gene_plot[[2]])) - - names(res) = motif_names[x] - return(res) } - }, threads = threads) - names(MM_umaps_points) <- motif_names - }else{ - message("MM_umaps_points already exists. Skipping the loop...") - } - - MM_min_max <- data.frame(matrix(NA, 2, length(MM_umaps_points))) - colnames(MM_min_max) <- names(MM_umaps_points)[which(!unlist(lapply(MM_umaps_points, is.null)))] - rownames(MM_min_max) <- c("min","max") - - for(i in 1:length(MM_umaps_points)){ - - print(paste0("Getting H5 files for MM_umaps_points: ",i,": ",round((i/length(MM_umaps_points))*100,3), "%")) - h5createDataset(file = points, dataset = paste0("MM/", motif_names[i]), dims = c(46656,1), storage.mode = "integer") - h5writeDataset(obj = MM_umaps_points[[i]][[1]]$plot, h5loc = points, name=paste0("MM/", motif_names[i])) - MM_min_max[1,i] = MM_umaps_points[[i]][[1]]$min - MM_min_max[2,i] = MM_umaps_points[[i]][[1]]$max - - } - - MM_pal = MM_umaps_points[[1]][[1]]$pal - - }else{ - - MM_min_max = NULL - MM_pal = NULL - } + + umaps_min_max_list[[shinymatrices]] = umaps_min_max + umaps_pal_list[[shinymatrices]] = umaps_points[[1]][[1]]$pal + } - scale <- list(gsm = GSM_min_max, gim = GIM_min_max, mm = MM_min_max) - pal <- list(gsm = GSM_pal, gim = GIM_pal, mm = MM_pal) + scale <- umaps_min_max_list + pal <- umaps_pal_list saveRDS(scale, file.path(outputDirUmaps, "scale.rds")) saveRDS(pal, file.path(outputDirUmaps, "pal.rds")) - if(exists("GSM_umaps_points")){ rm(GSM_umaps_points) } - if(exists("GIM_umaps_points")){ rm(GIM_umaps_points) } - if(exists("MM_umaps_points")){ rm(MM_umaps_points) } + # if(exists("umaps_points")){ rm(umaps_points) } + # if(exists("GIM_umaps_points")){ rm(GIM_umaps_points) } + # if(exists("MM_umaps_points")){ rm(MM_umaps_points) } } From 4fd11f086fe2056b9fd578fbdc8cea2ebb45839d Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Mon, 19 Dec 2022 20:08:13 +0300 Subject: [PATCH 039/162] Minor bug fixed. --- R/MainEmbed.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/MainEmbed.R b/R/MainEmbed.R index 9a437223..ba5db10b 100644 --- a/R/MainEmbed.R +++ b/R/MainEmbed.R @@ -80,7 +80,8 @@ mainEmbed <- function( Shiny = ShinyArchR )+ggtitle(paste0("Colored by ", name))+theme(text = element_text(size=12), legend.title = element_text(size = 12),legend.text = element_text(size = 6)) - }, error = function(x) { + }, error = function(x){ + print(x) }) From 2d51d61c06ab2299de24872e0ae520956e3655de Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Mon, 19 Dec 2022 21:54:50 +0300 Subject: [PATCH 040/162] remove unnecessary lines --- R/exportShinyArchR.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/exportShinyArchR.R b/R/exportShinyArchR.R index 9203d206..1e850787 100644 --- a/R/exportShinyArchR.R +++ b/R/exportShinyArchR.R @@ -212,8 +212,6 @@ exportShinyArchR <- function( saveRDS(matrices,paste0("./", outputDir, "/", subOutputDir,"/matrices.rds")) saveRDS(imputeMatricesList,paste0("./", outputDir, "/", subOutputDir,"/imputeMatricesList.rds")) - matrices <- readRDS("Shiny/inputData/matrices.rds") - imputeMatricesList <- readRDS("Shiny/inputData/imputeMatricesList.rds") # Create an HDF5 containing the nativeRaster vectors for the main matrices if (!file.exists(file.path(outputDir, subOutputDir, "mainEmbeds.h5"))) { From 80ef7cdb01c832bfa18872e7a7e60d1aa62f9d80 Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Mon, 19 Dec 2022 22:10:25 +0300 Subject: [PATCH 041/162] availableArrays(head(getArrowFiles(ArchRProj), 2) --- R/VisualizeData.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/VisualizeData.R b/R/VisualizeData.R index cf2efcf7..fe6766a9 100644 --- a/R/VisualizeData.R +++ b/R/VisualizeData.R @@ -331,7 +331,7 @@ plotEmbedding <- function( if(length(colorBy) > 1){ stop("colorBy must be of length 1!") } - allColorBy <- c("colData", "cellColData", .availableArrays(head(getArrowFiles(ArchRProj), 2))) + allColorBy <- .availableArrays(head(getArrowFiles(ArchRProj), 2)) if(tolower(colorBy) %ni% tolower(allColorBy)){ stop("colorBy must be one of the following :\n", paste0(allColorBy, sep=", ")) } @@ -623,7 +623,7 @@ plotGroups <- function( if(length(colorBy) > 1){ stop("colorBy must be of length 1!") } - allColorBy <- c("colData", "cellColData", .availableArrays(head(getArrowFiles(ArchRProj), 2))) + allColorBy <- availableArrays(head(getArrowFiles(ArchRProj), 2)) if(tolower(colorBy) %ni% tolower(allColorBy)){ stop("colorBy must be one of the following :\n", paste0(allColorBy, sep=", ")) } From ca186d6ba170a8a2e5c80e130072587b8326d825 Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Mon, 19 Dec 2022 22:15:13 +0300 Subject: [PATCH 042/162] changed umap to embed --- R/exportShinyArchR.R | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/R/exportShinyArchR.R b/R/exportShinyArchR.R index 1e850787..cbb20e03 100644 --- a/R/exportShinyArchR.R +++ b/R/exportShinyArchR.R @@ -130,26 +130,26 @@ exportShinyArchR <- function( if(!file.exists(paste0("./", outputDir, "/", subOutputDir,"/umaps.rds"))){ umaps <- list() - umapNames <- colnames(ArchRProjShiny@cellColData) + embedNames <- colnames(ArchRProjShiny@cellColData) - for(x in 1:length(umapNames)){ + for(x in 1:length(embedNames)){ - print(umapNames[x]) + print(embedNames[x]) tryCatch({ - umap <- plotEmbedding( + embed <- plotEmbedding( ArchRProj = ArchRProjShiny, baseSize=12, colorBy = "cellColData", - name = umapNames[x], + name = embedNames[x], embedding = embedding, rastr = FALSE, 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)) - umaps[[umapNames[[x]]]] <- umap + umaps[[embedNames[[x]]]] <- embed }, error = function(e){ print(e) @@ -169,7 +169,7 @@ exportShinyArchR <- function( matrices <- list() imputeMatricesList <- list() imputeWeights <- getImputeWeights(ArchRProj = ArchRProj) - df <- getEmbedding(ArchRProj, embedding = "UMAP", returnDF = TRUE) + df <- getEmbedding(ArchRProj, embedding = "embed", returnDF = TRUE) for(allmatrices in allMatrices){ print(allmatrices) @@ -212,6 +212,8 @@ exportShinyArchR <- function( saveRDS(matrices,paste0("./", outputDir, "/", subOutputDir,"/matrices.rds")) saveRDS(imputeMatricesList,paste0("./", outputDir, "/", subOutputDir,"/imputeMatricesList.rds")) + matrices <- readRDS("Shiny/inputData/matrices.rds") + imputeMatricesList <- readRDS("Shiny/inputData/imputeMatricesList.rds") # Create an HDF5 containing the nativeRaster vectors for the main matrices if (!file.exists(file.path(outputDir, subOutputDir, "mainEmbeds.h5"))) { From e7e394d192518e3dddb617d386fd689940da2f96 Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Mon, 19 Dec 2022 22:17:30 +0300 Subject: [PATCH 043/162] change umap to embed --- R/VisualizeData.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/VisualizeData.R b/R/VisualizeData.R index fe6766a9..2479c905 100644 --- a/R/VisualizeData.R +++ b/R/VisualizeData.R @@ -288,7 +288,7 @@ plotEmbedding <- function( ############################## # Get Embedding ############################## - .logMessage("Getting UMAP Embedding", logFile = logFile) + .logMessage("Getting Embedding", logFile = logFile) df <- getEmbedding(ArchRProj, embedding = embedding, returnDF = TRUE) if(!all(rownames(df) %in% ArchRProj$cellNames)){ From db543471dd1330513726f9cfab12e47f40dda91d Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Mon, 19 Dec 2022 22:19:59 +0300 Subject: [PATCH 044/162] change umap to embed --- R/ShinyRasterUMAPs.R | 70 +++++++++++++++++++++++--------------------- 1 file changed, 36 insertions(+), 34 deletions(-) diff --git a/R/ShinyRasterUMAPs.R b/R/ShinyRasterUMAPs.R index 8b6c395f..3e5c6318 100644 --- a/R/ShinyRasterUMAPs.R +++ b/R/ShinyRasterUMAPs.R @@ -5,48 +5,50 @@ #' This function will be called by exportShinyArchR() #' #' @param ArchRProj An `ArchRProject` object loaded in the environment. Can do this using: loadArchRProject("path to ArchRProject/") -#' @param outputDirUmaps Where the HDF5 and the jpgs will be saved. +#' @param outputDirEmbeds Where the HDF5 and the jpgs will be saved. #' @param threads The number of threads to use for parallel execution. #' @param verbose A boolean value that determines whether standard output should be printed. #' @param logFile The path to a file to be used for logging ArchR output. #' shinyRasterUMAPs <- function( ArchRProj = NULL, - outputDirUmaps = NULL, + outputDirEmbeds = NULL, threads = getArchRThreads(), verbose = TRUE, logFile = createLogFile("ShinyRasterUMAPs") ){ .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) - .validInput(input = outputDirUmaps, name = "outputDirUmaps", valid = c("character")) + .validInput(input = outputDirEmbeds, name = "outputDirEmbeds", valid = c("character")) .validInput(input = threads, name = "threads", valid = c("numeric")) .validInput(input = verbose, name = "verbose", valid = c("boolean")) .validInput(input = logFile, name = "logFile", valid = c("character")) - if (file.exists(file.path(outputDirUmaps, "plotBlank72.h5"))){ + if (file.exists(file.path(outputDirEmbeds, "plotBlank72.h5"))){ - file.remove(file.path(outputDirUmaps, "plotBlank72.h5")) + file.remove(file.path(outputDirEmbeds, "plotBlank72.h5")) } - umaps_min_max_list = list() - umaps_pal_list = list() + embeds_min_max_list = list() + embeds_pal_list = list() shinyMatrices <- getAvailableMatrices(ArchRProj) for(shinymatrices in shinyMatrices){ + # shinymatrices = shinyMatrices[3] + print(shinymatrices) matrixName = paste0(shinymatrices,"_names") - if(file.exists(paste0(outputDirUmaps, "/", matrixName, ".rds"))){ + if(file.exists(paste0(outputDirEmbeds, "/", matrixName, ".rds"))){ - geneMatrixNames <- readRDS(paste0(outputDirUmaps, "/", matrixName, ".rds")) + geneMatrixNames <- readRDS(paste0(outputDirEmbeds, "/", matrixName, ".rds")) if(!is.null(geneMatrixNames)){ - umaps_points <- .safelapply(1:10, function(x){ + embeds_points <- .safelapply(1:10, function(x){ print(paste0("Creating plots for ",shinymatrices,": ",x,": ",round((x/length(geneMatrixNames))*100,3), "%")) @@ -54,7 +56,7 @@ shinyRasterUMAPs <- function( ArchRProj = ArchRProj, colorBy = shinymatrices, name = geneMatrixNames[x], - embedding = "UMAP", + embedding = "embed", quantCut = c(0.01, 0.95), imputeWeights = getImputeWeights(ArchRProj = ArchRProj), plotAs = "points", @@ -77,11 +79,11 @@ shinyRasterUMAPs <- function( ) #save plot without axes etc as a jpg. - ggsave(filename = file.path(outputDirUmaps, paste0(shinymatrices,"_umaps"), paste0(geneMatrixNames[x],"_blank72.jpg")), + ggsave(filename = file.path(outputDirEmbeds, paste0(shinymatrices,"_embeds"), paste0(geneMatrixNames[x],"_blank72.jpg")), plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) #read back in that jpg because we need vector in native format - blank_jpg72 <- readJPEG(source = file.path(outputDirUmaps, paste0(shinymatrices,"_umaps"), + blank_jpg72 <- readJPEG(source = file.path(outputDirEmbeds, paste0(shinymatrices,"_embeds"), paste0(geneMatrixNames[x],"_blank72.jpg")), native = TRUE) g <- ggplot_build(gene_plot) @@ -92,7 +94,7 @@ shinyRasterUMAPs <- function( return(res) } }, threads = threads) - names(umaps_points) <- geneMatrixNames[1:10] + names(embeds_points) <- geneMatrixNames[1:10] }else{ @@ -105,41 +107,41 @@ shinyRasterUMAPs <- function( message(matrixName,".rds file does not exist") } - umaps_points = umaps_points[!unlist(lapply(umaps_points, is.null))] + embeds_points = embeds_points[!unlist(lapply(embeds_points, is.null))] - umaps_min_max <- data.frame(matrix(NA, 2, length(umaps_points))) - colnames(umaps_min_max) <- names(umaps_points)[which(!unlist(lapply(umaps_points, is.null)))] - rownames(umaps_min_max) <- c("min","max") + embeds_min_max <- data.frame(matrix(NA, 2, length(embeds_points))) + colnames(embeds_min_max) <- names(embeds_points)[which(!unlist(lapply(embeds_points, is.null)))] + rownames(embeds_min_max) <- c("min","max") h5closeAll() - points <- H5Fcreate(name = file.path(outputDirUmaps,"plotBlank72.h5")) - h5createGroup(file.path(outputDirUmaps, "plotBlank72.h5"), shinymatrices) + points <- H5Fcreate(name = file.path(outputDirEmbeds,"plotBlank72.h5")) + h5createGroup(file.path(outputDirEmbeds, "plotBlank72.h5"), shinymatrices) - for(i in 1:length(umaps_points)){ + for(i in 1:length(embeds_points)){ - print(paste0("Getting H5 files for umaps_points: ",i,": ",round((i/length(umaps_points))*100,3), "%")) + print(paste0("Getting H5 files for embeds_points: ",i,": ",round((i/length(embeds_points))*100,3), "%")) h5createDataset(file = points, dataset = paste0(shinymatrices,"/",geneMatrixNames[i]), dims = c(46656,1), storage.mode = "integer") - h5writeDataset(obj = umaps_points[[i]][[1]]$plot, h5loc = points, name=paste0(shinymatrices,"/",geneMatrixNames[i])) + h5writeDataset(obj = embeds_points[[i]][[1]]$plot, h5loc = points, name=paste0(shinymatrices,"/",geneMatrixNames[i])) - umaps_min_max[1,i] = umaps_points[[i]][[1]]$min - umaps_min_max[2,i] = umaps_points[[i]][[1]]$max + embeds_min_max[1,i] = embeds_points[[i]][[1]]$min + embeds_min_max[2,i] = embeds_points[[i]][[1]]$max } - umaps_min_max_list[[shinymatrices]] = umaps_min_max - umaps_pal_list[[shinymatrices]] = umaps_points[[1]][[1]]$pal + embeds_min_max_list[[shinymatrices]] = embeds_min_max + embeds_pal_list[[shinymatrices]] = embeds_points[[1]][[1]]$pal } - scale <- umaps_min_max_list - pal <- umaps_pal_list + scale <- embeds_min_max_list + pal <- embeds_pal_list - saveRDS(scale, file.path(outputDirUmaps, "scale.rds")) - saveRDS(pal, file.path(outputDirUmaps, "pal.rds")) + saveRDS(scale, file.path(outputDirEmbeds, "scale.rds")) + saveRDS(pal, file.path(outputDirEmbeds, "pal.rds")) - # if(exists("umaps_points")){ rm(umaps_points) } - # if(exists("GIM_umaps_points")){ rm(GIM_umaps_points) } - # if(exists("MM_umaps_points")){ rm(MM_umaps_points) } + # if(exists("embeds_points")){ rm(embeds_points) } + # if(exists("GIM_embeds_points")){ rm(GIM_embeds_points) } + # if(exists("MM_embeds_points")){ rm(MM_embeds_points) } } From ce79920579349b97e116d06905bdd99e5d592b42 Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Thu, 29 Dec 2022 17:05:14 +0300 Subject: [PATCH 045/162] minor fixes --- R/VisualizeData.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/VisualizeData.R b/R/VisualizeData.R index 2479c905..54438eda 100644 --- a/R/VisualizeData.R +++ b/R/VisualizeData.R @@ -332,10 +332,10 @@ plotEmbedding <- function( stop("colorBy must be of length 1!") } allColorBy <- .availableArrays(head(getArrowFiles(ArchRProj), 2)) - if(tolower(colorBy) %ni% tolower(allColorBy)){ - stop("colorBy must be one of the following :\n", paste0(allColorBy, sep=", ")) - } - colorBy <- allColorBy[match(tolower(colorBy), tolower(allColorBy))] + # if(tolower(colorBy) %ni% tolower(allColorBy)){ + # stop("colorBy must be one of the following :\n", paste0(allColorBy, sep=", ")) + # } + # colorBy <- allColorBy[match(tolower(colorBy), tolower(allColorBy))] .logMessage(paste0("ColorBy = ", colorBy), logFile = logFile) From bacc77e94298a6b3d20f48009d1d33cea15efa9e Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Thu, 29 Dec 2022 17:06:22 +0300 Subject: [PATCH 046/162] minor fixes --- R/MainEmbed.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/MainEmbed.R b/R/MainEmbed.R index ba5db10b..1c4f644b 100644 --- a/R/MainEmbed.R +++ b/R/MainEmbed.R @@ -75,6 +75,7 @@ mainEmbed <- function( embedding = embedding, rastr = FALSE, size = 0.5, + imputeWeights = NULL, matrices = matrices, imputeMatricesList = imputeMatricesList, Shiny = ShinyArchR @@ -88,6 +89,7 @@ mainEmbed <- function( return(named_embed) }) + names(embeds) <- names saveRDS(embeds, file.path(outDirEmbed, "embeds.rds")) } else { From 5ff434dbea870506fba83a4cdef6129d8134e678 Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Thu, 29 Dec 2022 17:09:59 +0300 Subject: [PATCH 047/162] major improvements --- R/exportShinyArchR.R | 159 ++++++++++++++++++++++++------------------- 1 file changed, 88 insertions(+), 71 deletions(-) diff --git a/R/exportShinyArchR.R b/R/exportShinyArchR.R index cbb20e03..c5f7ed4c 100644 --- a/R/exportShinyArchR.R +++ b/R/exportShinyArchR.R @@ -1,7 +1,7 @@ # exportShiny function ----------------------------------------------------------- #' Export a Shiny App based on ArchRProj #' -#' Generate all files required for an autonomous Shiny app to display browser tracks and UMAPs. +#' Generate all files required for an autonomous Shiny app to display browser tracks and embeds. #' #' @param ArchRProj An `ArchRProject` object loaded in the environment. Can do this using: loadArchRProject("path to ArchRProject/") #' @param outputDir The name of the directory for the Shiny App files. @@ -37,6 +37,63 @@ exportShinyArchR <- function( .requirePackage("rhandsontable", installInfo = 'install.packages("rhandsontable")') + allMatrices <- getAvailableMatrices(ArchRProj) + matrices <- list() + imputeMatricesList <- list() + imputeWeights <- getImputeWeights(ArchRProj = ArchRProj) + df <- getEmbedding(ArchRProj, embedding = embedding, returnDF = TRUE) + + if(!file.exists(file.path(outputDir, subOutputDir, "matrices.rds")) && !file.exists(file.path(outputDir, subOutputDir, "imputeMatricesList.rds"))){ + for(allmatrices in allMatrices){ + print(allmatrices) + name <- paste0(allmatrices, "_names") + result = assign(name, getFeatures(ArchRProj = ArchRProj, useMatrix = allmatrices)) + saveRDS(result, paste0("./", outputDir, "/", subOutputDir, "/", allmatrices,"_names.rds")) + + if(!is.null(result)){ + # nameColor <- paste0("colorMat", allmatrices) + matrix = Matrix(.getMatrixValues( + ArchRProj = ArchRProj, + name = result, + matrixName = allmatrices, + log2Norm = FALSE, + threads = threads), sparse = TRUE) + + matrices[[allmatrices]] = matrix + + matList = matrix[,rownames(df), drop=FALSE] + + # assign(nameColor, matList) + .logThis(matList, paste0(allmatrices,"-Before-Impute"), logFile = logFile) + if(getArchRVerbose()) message("Imputing Matrix") + + colorImputeMat <- imputeMatrix(mat = as.matrix(matList), imputeWeights = imputeWeights, logFile = logFile) + # assign(paste0(nameColor, "_Impute"), imputeMat) + + if(!inherits(colorImputeMat, "matrix")){ + colorImputeMat <- matrix(colorImputeMat, ncol = nrow(df)) + colnames(colorImputeMat) <- rownames(df) + } + imputeMatricesList[[allmatrices]] <- colorImputeMat + + + }else{ + message(allmatrices, " is NULL.") + } + } + + saveRDS(matrices,paste0("./", outputDir, "/", subOutputDir,"/matrices.rds")) + saveRDS(imputeMatricesList,paste0("./", outputDir, "/", subOutputDir,"/imputeMatricesList.rds")) + }else{ + + message("matrices and imputeMatricesList already exist. reading from local files...") + + matrices <- readRDS(paste0(outputDir, "/", subOutputDir,"/matrices.rds")) + imputeMatricesList <- readRDS(paste0(outputDir, "/", subOutputDir,"/imputeMatricesList.rds")) + } + + + if(is.null(groupBy)){ stop("groupBy must be provided") } else if(groupBy %ni% colnames(getCellColData(ArchRProj))){ @@ -128,17 +185,14 @@ exportShinyArchR <- function( gene_names <- readRDS(paste0("./", outputDir, "/", subOutputDir,"/features.rds")) } - if(!file.exists(paste0("./", outputDir, "/", subOutputDir,"/umaps.rds"))){ - umaps <- list() - embedNames <- colnames(ArchRProjShiny@cellColData) + if(!file.exists(paste0("./", outputDir, "/", subOutputDir,"/embeddingMaps.rds"))){ + embeddingMaps <- list() + embedNames <- colnames(ArchRProjShiny@cellColData)[][colnames(ArchRProjShiny@cellColData) %in% groupBy] - for(x in 1:length(embedNames)){ - + embeddingMaps <- .safelapply(1:length(embedNames), function(x){ print(embedNames[x]) - tryCatch({ embed <- plotEmbedding( - ArchRProj = ArchRProjShiny, baseSize=12, colorBy = "cellColData", @@ -146,85 +200,45 @@ exportShinyArchR <- function( embedding = embedding, rastr = FALSE, size=0.5, + matrices = matrices, + imputeMatricesList = imputeMatricesList, )+ggtitle("Colored by scATAC-seq clusters")+theme(text=element_text(size=12), legend.title = element_text(size = 12),legend.text = element_text(size = 6)) - umaps[[embedNames[[x]]]] <- embed + embeddingMaps[[embedNames[[x]]]] <- embed }, - error = function(e){ - print(e) - }) - } + error = function(e){ + print(e) + }) + }) - saveRDS(umaps, paste0("./", outputDir, "/", subOutputDir,"/umaps.rds")) + saveRDS(embeddingMaps, paste0("./", outputDir, "/", subOutputDir,"/embeddingMaps.rds")) }else{ - message("umaps already exists...") - umaps <- readRDS(paste0("./", outputDir, "/", subOutputDir,"/umaps.rds")) + message("embeddingMaps already exists...") + embeddingMaps <- readRDS(paste0(outputDir, "/", subOutputDir,"/embeddingMaps.rds")) } - allMatrices <- getAvailableMatrices(ArchRProj) - matrices <- list() - imputeMatricesList <- list() - imputeWeights <- getImputeWeights(ArchRProj = ArchRProj) - df <- getEmbedding(ArchRProj, embedding = "embed", returnDF = TRUE) - - for(allmatrices in allMatrices){ - print(allmatrices) - name <- paste0(allmatrices, "_names") - result = assign(name, getFeatures(ArchRProj = ArchRProj, useMatrix = allmatrices)) - saveRDS(result, paste0("./", outputDir, "/", subOutputDir, "/", allmatrices,"_names.rds")) - - if(!is.null(result)){ - # nameColor <- paste0("colorMat", allmatrices) - matrix = Matrix(.getMatrixValues( - ArchRProj = ArchRProj, - name = result, - matrixName = allmatrices, - log2Norm = FALSE, - threads = threads), sparse = TRUE) - - matrices[[allmatrices]] = matrix - - matList = matrix[,rownames(df), drop=FALSE] - - # assign(nameColor, matList) - .logThis(matList, paste0(allmatrices,"-Before-Impute"), logFile = logFile) - if(getArchRVerbose()) message("Imputing Matrix") - - colorImputeMat <- imputeMatrix(mat = as.matrix(matList), imputeWeights = imputeWeights, logFile = logFile) - # assign(paste0(nameColor, "_Impute"), imputeMat) - - if(!inherits(colorImputeMat, "matrix")){ - colorImputeMat <- matrix(colorImputeMat, ncol = nrow(df)) - colnames(colorImputeMat) <- rownames(df) - } - imputeMatricesList[[allmatrices]] <- colorImputeMat - - - }else{ - message(allmatrices, " is NULL.") - } - } - - saveRDS(matrices,paste0("./", outputDir, "/", subOutputDir,"/matrices.rds")) - saveRDS(imputeMatricesList,paste0("./", outputDir, "/", subOutputDir,"/imputeMatricesList.rds")) - - matrices <- readRDS("Shiny/inputData/matrices.rds") - imputeMatricesList <- readRDS("Shiny/inputData/imputeMatricesList.rds") - # Create an HDF5 containing the nativeRaster vectors for the main matrices if (!file.exists(file.path(outputDir, subOutputDir, "mainEmbeds.h5"))) { + if(groupBy %in% colnames(ArchRProjShiny@cellColData)){ + mainEmbed(ArchRProj = ArchRProj, outDirEmbed = file.path(outputDir, subOutputDir), - names = colnames(ArchRProjShiny@cellColData), + names = groupBy, matrices = matrices, imputeMatricesList = imputeMatricesList, Shiny = ShinyArchR - ) + ) + }else{ + + message(groupBy, "is not defined in ArchRProj...") + + } + } else{ message("H5 for main embeds already exists...") } @@ -232,12 +246,15 @@ if (!file.exists(file.path(outputDir, subOutputDir, "mainEmbeds.h5"))) { if(!file.exists(paste0("./", outputDir, "/", subOutputDir,"/plotBlank72.h5"))){ - shinyRasterUMAPs( + matrixEmbeds( ArchRProj = ArchRProj, - outputDirUmaps = paste0(outputDir,"/", subOutputDir), + outputDirEmbeds = paste0(outputDir,"/", subOutputDir), + embedding = embedding, + matrices = matrices, + imputeMatricesList = imputeMatricesList, threads = getArchRThreads(), verbose = TRUE, - logFile = createLogFile("ShinyRasterUMAPs") + logFile = createLogFile("matrixEmbeds") ) }else{ From b5102845a98853a559462041081c37767ea889ec Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Thu, 29 Dec 2022 17:12:43 +0300 Subject: [PATCH 048/162] Update and rename shinyRasterUMAPs to matrixEmbeds --- R/{ShinyRasterUMAPs.R => matrixEmbeds.R} | 71 +++++++++++++----------- 1 file changed, 40 insertions(+), 31 deletions(-) rename R/{ShinyRasterUMAPs.R => matrixEmbeds.R} (70%) diff --git a/R/ShinyRasterUMAPs.R b/R/matrixEmbeds.R similarity index 70% rename from R/ShinyRasterUMAPs.R rename to R/matrixEmbeds.R index 3e5c6318..dd087704 100644 --- a/R/ShinyRasterUMAPs.R +++ b/R/matrixEmbeds.R @@ -1,4 +1,4 @@ -# shinyRasterUmaps function ----------------------------------------------------------- +# matrixEmbeds function ----------------------------------------------------------- #' #' #' Create an HDF5 containing the nativeRaster vectors for all features for all feature matrices. @@ -10,12 +10,15 @@ #' @param verbose A boolean value that determines whether standard output should be printed. #' @param logFile The path to a file to be used for logging ArchR output. #' -shinyRasterUMAPs <- function( +matrixEmbeds <- function( ArchRProj = NULL, outputDirEmbeds = NULL, + embedding = "UMAP", + matrices = NULL, + imputeMatricesList = NULL, threads = getArchRThreads(), verbose = TRUE, - logFile = createLogFile("ShinyRasterUMAPs") + logFile = createLogFile("matrixEmbeds") ){ .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) .validInput(input = outputDirEmbeds, name = "outputDirEmbeds", valid = c("character")) @@ -37,7 +40,7 @@ shinyRasterUMAPs <- function( for(shinymatrices in shinyMatrices){ - # shinymatrices = shinyMatrices[3] + # shinymatrices = shinyMatrices[2] print(shinymatrices) matrixName = paste0(shinymatrices,"_names") @@ -48,7 +51,7 @@ shinyRasterUMAPs <- function( if(!is.null(geneMatrixNames)){ - embeds_points <- .safelapply(1:10, function(x){ + embeds_points <- .safelapply(1:length(geneMatrixNames), function(x){ print(paste0("Creating plots for ",shinymatrices,": ",x,": ",round((x/length(geneMatrixNames))*100,3), "%")) @@ -56,7 +59,7 @@ shinyRasterUMAPs <- function( ArchRProj = ArchRProj, colorBy = shinymatrices, name = geneMatrixNames[x], - embedding = "embed", + embedding = embedding, quantCut = c(0.01, 0.95), imputeWeights = getImputeWeights(ArchRProj = ArchRProj), plotAs = "points", @@ -94,43 +97,49 @@ shinyRasterUMAPs <- function( return(res) } }, threads = threads) - names(embeds_points) <- geneMatrixNames[1:10] + + names(embeds_points) <- geneMatrixNames + + embeds_points = embeds_points[!unlist(lapply(embeds_points, is.null))] + + embeds_min_max <- data.frame(matrix(NA, 2, length(embeds_points))) + colnames(embeds_min_max) <- names(embeds_points)[which(!unlist(lapply(embeds_points, is.null)))] + rownames(embeds_min_max) <- c("min","max") + + h5closeAll() + points = H5Fcreate(name = file.path(outputDirEmbeds, paste0(shinymatrices,"_plotBlank72.h5"))) + h5createGroup(file.path(outputDirEmbeds, paste0(shinymatrices,"_plotBlank72.h5")), shinymatrices) + + for(i in 1:length(embeds_points)){ + + print(paste0("Getting H5 files for embeds_points: ",i,": ",round((i/length(embeds_points))*100,3), "%")) + + h5createDataset(file = points, dataset = paste0(shinymatrices,"/",geneMatrixNames[i]), dims = c(46656,1), storage.mode = "integer") + h5writeDataset(obj = embeds_points[[i]][[1]]$plot, h5loc = points, name=paste0(shinymatrices,"/",geneMatrixNames[i])) + + embeds_min_max[1,i] = embeds_points[[i]][[1]]$min + embeds_min_max[2,i] = embeds_points[[i]][[1]]$max + + } + + embeds_min_max_list[[shinymatrices]] = embeds_min_max + embeds_pal_list[[shinymatrices]] = embeds_points[[length(embeds_points)]][[1]]$pal + }else{ message(matrixName,".rds file is NULL") } + + }else{ message(matrixName,".rds file does not exist") } - embeds_points = embeds_points[!unlist(lapply(embeds_points, is.null))] - - embeds_min_max <- data.frame(matrix(NA, 2, length(embeds_points))) - colnames(embeds_min_max) <- names(embeds_points)[which(!unlist(lapply(embeds_points, is.null)))] - rownames(embeds_min_max) <- c("min","max") - - h5closeAll() - points <- H5Fcreate(name = file.path(outputDirEmbeds,"plotBlank72.h5")) - h5createGroup(file.path(outputDirEmbeds, "plotBlank72.h5"), shinymatrices) - - for(i in 1:length(embeds_points)){ - - print(paste0("Getting H5 files for embeds_points: ",i,": ",round((i/length(embeds_points))*100,3), "%")) - - h5createDataset(file = points, dataset = paste0(shinymatrices,"/",geneMatrixNames[i]), dims = c(46656,1), storage.mode = "integer") - h5writeDataset(obj = embeds_points[[i]][[1]]$plot, h5loc = points, name=paste0(shinymatrices,"/",geneMatrixNames[i])) - - embeds_min_max[1,i] = embeds_points[[i]][[1]]$min - embeds_min_max[2,i] = embeds_points[[i]][[1]]$max - - } - - embeds_min_max_list[[shinymatrices]] = embeds_min_max - embeds_pal_list[[shinymatrices]] = embeds_points[[1]][[1]]$pal + } scale <- embeds_min_max_list From 17d36da84642e3baa29d0027b099c65fee2181ac Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Tue, 3 Jan 2023 20:07:17 +0300 Subject: [PATCH 049/162] shiny files --- R/app.R | 6 + R/global.R | 264 ++++++++++++++++++++++++++++++++++++ R/server.R | 392 +++++++++++++++++++++++++++++++++++++++++++++++++++++ R/ui.R | 181 +++++++++++++++++++++++++ 4 files changed, 843 insertions(+) create mode 100644 R/app.R create mode 100644 R/global.R create mode 100644 R/server.R create mode 100644 R/ui.R diff --git a/R/app.R b/R/app.R new file mode 100644 index 00000000..8f60aec8 --- /dev/null +++ b/R/app.R @@ -0,0 +1,6 @@ +# Load libraries so they are available +# Run the app through this file. +source("ui.R") +source("server.R") +shinyApp(ui:ui, server:shinyServer) +# http://127.0.0.1:6747 \ No newline at end of file diff --git a/R/global.R b/R/global.R new file mode 100644 index 00000000..d8e6837d --- /dev/null +++ b/R/global.R @@ -0,0 +1,264 @@ +# Setting up ---------------------------------------------------------------------- + +library(shinycssloaders) +library(hexbin) +library(magick) +library(gridExtra) +library(grid) +library(patchwork) +library(shinybusy) +library(cowplot) +library(ggpubr) +library(farver) +library(rhdf5) +library(plotfunctions) +library(raster) +library(jpeg) +library(sparseMatrixStats) +library(BiocManager) +library(AnnotationDbi) +library(BSgenome) +library(Biobase) +library(BiocGenerics) +library(BiocParallel) +library(Biostrings) +library(CNEr) +library(ComplexHeatmap) +library(ArchR) + +#' # specify whether you use a local machine or the shiny app +#' ShinyArchR = TRUE +#' +#' # specify desired number of threads +#' addArchRThreads(threads = 1) +#' # specify genome version. Default hg19 set +#' addArchRGenome("hg19") +#' set.seed(1) +#' +#' ArchRProj=loadArchRProject(path = "Save-ArchRProjShiny/") +#' ArchRProj <- addImputeWeights(ArchRProj = ArchRProj) +#' +#' ############################################################ +#' +#' # myLoadArchRProject ----------------------------------- +#' #' Load Previous ArchRProject into R +#' #' +#' #' This function will load a previously saved ArchRProject and re-normalize paths for usage. +#' #' +#' #' @param path A character path to an `ArchRProject` directory that was previously saved using `saveArchRProject()`. +#' #' @param force A boolean value indicating whether missing optional `ArchRProject` components (i.e. peak annotations / +#' #' background peaks) should be ignored when re-normalizing file paths. If set to `FALSE` loading of the `ArchRProject` +#' #' will fail unless all components can be found. +#' #' @param showLogo A boolean value indicating whether to show the ascii ArchR logo after successful creation of an `ArchRProject`. +#' #' @export +#' myLoadArchRProject <- function(path = "./", +#' force = FALSE, +#' showLogo = TRUE) { +#' .validInput(input = path, +#' name = "path", +#' valid = "character") +#' .validInput(input = force, +#' name = "force", +#' valid = "boolean") +#' .validInput(input = showLogo, +#' name = "showLogo", +#' valid = "boolean") +#' +#' path2Proj <- file.path(path, "Save-ArchR-Project.rds") +#' +#' if (!file.exists(path2Proj)) { +#' stop("Could not find previously saved ArchRProject in the path specified!") +#' } +#' +#' ArchRProj <- recoverArchRProject(readRDS(path2Proj)) +#' outputDir <- getOutputDirectory(ArchRProj) +#' outputDirNew <- normalizePath(path) +#' +#' +#' ArchRProj@projectMetadata$outputDirectory <- outputDirNew +#' +#' message("Successfully loaded ArchRProject!") +#' if (showLogo) { +#' .ArchRLogo(ascii = "Logo") +#' } +#' +#' ArchRProj +#' +#' } +#' +#' +#' ## Create fragment files ----------------------------------------------------------- +#' .getGroupFragsFromProj <- function(ArchRProj = NULL, +#' groupBy = NULL, +#' outDir = file.path("Shiny", "fragments")) { +#' dir.create(outDir, showWarnings = FALSE) +#' +#' # find barcodes of cells in that groupBy. +#' groups <- getCellColData(ArchRProj, select = groupBy, drop = TRUE) +#' cells <- ArchRProj$cellNames +#' cellGroups <- split(cells, groups) +#' +#' # outputs unique cell groups/clusters. +#' clusters <- names(cellGroups) +#' +#' +#' for (cluster in clusters) { +#' cat("Making fragment file for cluster:", cluster, "\n") +#' # get GRanges with all fragments for that cluster +#' cellNames = cellGroups[[cluster]] +#' fragments <- +#' getFragmentsFromProject(ArchRProj = ArchRProj, cellNames = cellNames) +#' fragments <- unlist(fragments, use.names = FALSE) +#' # filter Fragments +#' fragments <- +#' GenomeInfoDb::keepStandardChromosomes(fragments, pruning.mode = "coarse") +#' saveRDS(fragments, file.path(outDir, paste0(cluster, "_cvg.rds"))) +#' } +#' } +#' +#' +#' .getClusterCoverage <- function(ArchRProj = NULL, +#' tileSize = 100, +#' scaleFactor = 1, +#' groupBy = "Clusters", +#' outDir = file.path("Shiny", "coverage")) { +#' fragfiles = list.files(path = file.path("Shiny", "fragments"), +#' full.names = TRUE) +#' dir.create(outDir, showWarnings = FALSE) +#' +#' # find barcodes of cells in that groupBy. +#' groups <- getCellColData(ArchRProj, select = groupBy, drop = TRUE) +#' cells <- ArchRProj$cellNames +#' cellGroups <- split(cells, groups) +#' +#' # outputs unique cell groups/clusters. +#' clusters <- names(cellGroups) +#' +#' chrRegions <- getChromSizes(ArchRProj) +#' genome <- getGenome(ArchRProj) +#' +#' for (file in fragfiles) { +#' fragments <- readRDS(file) +#' #fragmentsToInsertions() +#' left <- GRanges(seqnames = seqnames(fragments), +#' ranges = IRanges(start(fragments), width = 1)) +#' right <- GRanges(seqnames = seqnames(fragments), +#' ranges = IRanges(end(fragments), width = 1)) +#' # call sort() after sortSeqlevels() to sort also the ranges in addition +#' # to the chromosomes. +#' insertions <- c(left, right) %>% sortSeqlevels() %>% +#' sort() +#' +#' cluster <- file %>% basename() %>% gsub("_.*", "", .) +#' #binnedCoverage +#' # message("Creating bins for cluster ",clusters[clusteridx], "...") +#' bins <- +#' unlist(slidingWindows(chrRegions, width = tileSize, step = tileSize)) +#' # message("Counting overlaps for cluster ",clusters[clusteridx], "...") +#' bins$reads <- +#' countOverlaps( +#' bins, +#' insertions, +#' maxgap = -1L, +#' minoverlap = 0L, +#' type = "any" +#' ) +#' addSeqLengths(bins, genome) +#' # message("Creating binned coverage for cluster ",clusters[clusteridx], "...") +#' #each value is multiplied by that weight. +#' # TODO add scaleFactor +#' # allCells as.vector(ArchRProj@cellColData$Sample, mode="any") +#' clusterReadsInTSS <- +#' ArchRProj@cellColData$ReadsInTSS[cells %in% cellGroups$cluster] +#' # scaleFactor <- 5e+06 / sum(clusterReadsInTSS) +#' binnedCoverage <- +#' coverage(bins, weight = bins$reads * scaleFactor) +#' saveRDS(binnedCoverage, file.path(outDir, paste0(cluster, "_cvg.rds"))) +#' } +#' +#' } +#' +#' +#' ############################################################# +#' +#' ArchRProj=loadArchRProject("~/Documents/upwork/Paulina Paiz/Shiny_28_11_2022/Save-ProjHeme5/") +#' +#' +#' # Load all hidden ArchR functions ------------------------------------------------ +#' fn <- unclass(lsf.str(envir = asNamespace("ArchR"), all = TRUE)) +#' for (i in seq_along(fn)) { +#' tryCatch({ +#' eval(parse(text = paste0(fn[i], "<-", fn[i]))) +#' }, error = function(x) { +#' }) +#' } + +# EMBED Visualization ------------------------------------------------------------ + +# create a list of dropdown options for EMBED tab +EMBEDs_dropdown=colnames(ArchRProj@cellColData)[colnames(ArchRProj@cellColData) %in% groupBy] +matrices_dropdown = names(readRDS(paste0("./", subOutputDir, "/scale.rds"))) + +for(i in 1:length(matrices_dropdown)){ + + if(file.exists(paste0(outputDir, "/", subOutputDir, "/", paste0(matrices_dropdown[i],"_names"), ".rds"))){ + + assign(paste0(matrices_dropdown[i], "_dropdown"), readRDS(paste0(outputDir, "/", subOutputDir, "/", paste0(matrices_dropdown[i],"_names"), ".rds"))) + + } + +} + +# if("MotifMatrix" %in% matrices_dropdown){ +# Feature_dropdown = readRDS(paste0(getOutputDirectory(ArchRProj),"/",outputDir, "/", subOutputDir, "/motif_names.rds")) +# } +# +# if("GeneScoreMatrix" %in% matrices_dropdown){ +# GSM_dropdown = readRDS(paste0(getOutputDirectory(ArchRProj),"/",outputDir, "/", subOutputDir, "/gene_names_GSM.rds")) +# } +# +# if("GeneIntegrationMatrix" %in% matrices_dropdown){ +# GIM_dropdown = readRDS(paste0(getOutputDirectory(ArchRProj),"/",outputDir, "/", subOutputDir, "/gene_names_GIM.rds")) +# } +embed_legend = readRDS(paste0(getOutputDirectory(ArchRProj),"/",outputDir, "/", subOutputDir, "/embed_legend_names.rds")) +color_embeddings = readRDS(paste0(getOutputDirectory(ArchRProj),"/",outputDir, "/", subOutputDir, "/embeddings.rds")) + + +# define a function to get the EMBED for a gene +getEMBEDplotWithCol<-function(gene,EMBEDList,scaffoldName,matrixType) +{ + gene_plot=EMBEDList[[gene]] + + p_template1=readRDS(paste0(getOutputDirectory(ArchRProj),"/",outputDir, "/", subOutputDir, "/" ,scaffoldName,".rds")) + + p_template1$scales$scales <- gene_plot$scale + + title=paste("EMBED of IterativeLSI colored by\n",matrixType," : ",sep="") + + p_template1$labels$title <- paste0(title, gene) + + return(p_template1) +} + + +# define a function to get the filename for a gene and then call get EMBED function +getEMBED<-function(gene,fileIndexer,folderName,scaffoldName,matrixType) +{ + # getFilename + for(file in names(fileIndexer)) + { + if(gene %in% fileIndexer[[file]]) + { + EMBEDs_data_subset=readRDS(paste(paste0(getOutputDirectory(ArchRProj),"/",outputDir, "/", subOutputDir, "/" ,folderName),file,sep="/")) + + return(getEMBEDplotWithCol(gene,EMBEDs_data_subset,scaffoldName,matrixType)) + } + } +} + +# PlotBrowser ------------------------------------------------------------------ + +# create a list of dropdown options for plotbroswer tab +gene_names=readRDS(paste0(getOutputDirectory(ArchRProj),"/",outputDir, "/", subOutputDir, "/features.rds")) + + diff --git a/R/server.R b/R/server.R new file mode 100644 index 00000000..022a781a --- /dev/null +++ b/R/server.R @@ -0,0 +1,392 @@ + +shinyServer <- function(input,output, session){ + + + # EMBEDS ------------------------------------------------------------------------------------ + + plot1 <- reactive({ + + availableMatrices <- getAvailableMatrices(ArchRProj) + + if(input$matrix_EMBED1_forComparison %in% availableMatrices){ + mat <- availableMatrices[ availableMatrices %in% input$matrix_EMBED1_forComparison] + + p_empty <- ggplot() + + xlab("Dimension 1") + ylab("Dimension 2") + theme_bw(base_size=10)+ + ggtitle(paste0("EMBED of IterativeLSI colored by \n", mat,": ",input$EMBED1_forComparison)) + + theme( + panel.background = element_rect(fill='transparent'), #transparent panel bg + plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg + panel.grid.major = element_blank(), #remove major gridlines + panel.grid.minor = element_blank(), #remove minor gridlines + legend.background = element_rect(fill='transparent'), #transparent legend bg + legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), + plot.title = element_text(size=16) + ) + + emptyPlot(0,0, axes=FALSE) + legend_plot <- gradientLegend(valRange=c(scale()[[mat]][,input$EMBED1_forComparison][1],scale()[[mat]][,input$EMBED1_forComparison][2]), + color = color()[[mat]], pos=.5, side=1) + + + p <- h5read(paste0("./",subOutputDir,"/",mat,"_plotBlank72.h5"), paste0(mat, "/", input$EMBED1_forComparison)) + temp_jpg <- t(matrix(decode_native(p), nrow = 216)) + + last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + + draw_plot(p_empty, scale = 0.8) + + draw_text("Log2(+1)", x = 0.35, y = 0.05, size = 12) + + print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) + }else{ + p_empty <- ggplot() + + xlab("Dimension 1") + ylab("Dimension 2") + theme_bw(base_size=10)+ + ggtitle(input$matrix_EMBED1_forComparison) + + theme( + panel.background = element_rect(fill='transparent'), #transparent panel bg + plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg + panel.grid.major = element_blank(), #remove major gridlines + panel.grid.minor = element_blank(), #remove minor gridlines + legend.background = element_rect(fill='transparent'), #transparent legend bg + legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), + plot.title = element_text(size=16) + ) + + emptyPlot(0,0, axes=FALSE) + + legend('bottom', legend=embed_legend[[1]], + pch=15, col = color_embeddings[[1]], + horiz = FALSE, x.intersp = 1, text.width=0.35, + cex = 0.7, bty="n", ncol = 4) + + p <- h5read(paste0("./",subOutputDir,"/mainEmbeds.h5"), input$matrix_EMBED1_forComparison)# input$EMBED1_forComparison)) + temp_jpg <- t(matrix(decode_native(p), nrow = 216)) + + last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.7) + + draw_plot(p_empty, scale = 0.7) + + draw_text("color", x = 0.1, y = 0.135, size = 12) + + print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) + } + + }) + + plot2 <- reactive({ + + availableMatrices <- getAvailableMatrices(ArchRProj) + + if(input$matrix_EMBED2_forComparison %in% availableMatrices){ + mat <- availableMatrices[ availableMatrices %in% input$matrix_EMBED2_forComparison] + + p_empty <- ggplot() + + xlab("Dimension 1") + ylab("Dimension 2") + theme_bw(base_size=10)+ + ggtitle(paste0("EMBED of IterativeLSI colored by \n", mat,": ",input$EMBED2_forComparison)) + + theme( + panel.background = element_rect(fill='transparent'), #transparent panel bg + plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg + panel.grid.major = element_blank(), #remove major gridlines + panel.grid.minor = element_blank(), #remove minor gridlines + legend.background = element_rect(fill='transparent'), #transparent legend bg + legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), + plot.title = element_text(size=16) + ) + + emptyPlot(0,0, axes=FALSE) + legend_plot <- gradientLegend(valRange=c(scale()[[mat]][,input$EMBED2_forComparison][1],scale()[[mat]][,input$EMBED2_forComparison][2]), + color = color()[[mat]], pos=.5, side=1) + + p <- h5read(paste0("./",subOutputDir,"/",mat,"_plotBlank72.h5"), paste0(mat, "/", input$EMBED2_forComparison)) + temp_jpg <- t(matrix(decode_native(p), nrow = 216)) + last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + + draw_plot(p_empty, scale = 0.8) + + draw_text("Log2(+1)", x = 0.35, y = 0.05, size = 12) + + print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) + }else{ + + + p_empty <- ggplot() + + xlab("Dimension 1") + ylab("Dimension 2") + theme_bw(base_size=10)+ + ggtitle(input$matrix_EMBED2_forComparison) + + theme( + panel.background = element_rect(fill='transparent'), #transparent panel bg + plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg + panel.grid.major = element_blank(), #remove major gridlines + panel.grid.minor = element_blank(), #remove minor gridlines + legend.background = element_rect(fill='transparent'), #transparent legend bg + legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), + plot.title = element_text(size=16) + ) + + emptyPlot(0,0, axes=FALSE) + + legend('bottom', legend=embed_legend[[1]], + pch=15, col = color_embeddings[[1]], + horiz = FALSE, x.intersp = 1, text.width=0.35, + cex = 0.7, bty="n", ncol = 4) + + p <- h5read(paste0("./",subOutputDir,"/mainEmbeds.h5"), input$matrix_EMBED2_forComparison)# input$EMBED2_forComparison)) + temp_jpg <- t(matrix(decode_native(p), nrow = 216)) + + last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.7) + + draw_plot(p_empty, scale = 0.7) + + draw_text("color", x = 0.1, y = 0.135, size = 12) + + print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) + + } + + }) + + + #Output Handler: Downloads EMBEDS + output$download_EMBED1<-downloadHandler( + filename <- function(){ + paste0("EMBED-",paste(input$matrix_EMBED1_forComparison,input$EMBED1_forComparison,sep="-"),input$plot_choice_download_EMBED1) + }, + content = function(file){ + if(input$plot_choice_download_EMBED1==".pdf") + {pdf(file = file,onefile=FALSE, width = input$EMBED1_plot_width, height = input$EMBED1_plot_height)} + + else if(input$plot_choice_download_EMBED1==".png") + {png(file = file, width = input$EMBED1_plot_width, height = input$EMBED1_plot_height,units="in",res=1000)} + + else + {tiff(file = file, width = input$EMBED1_plot_width, height = input$EMBED1_plot_height,units="in",res=1000)} + + plot1 = plot1() + + + grid.arrange(plot1) + dev.off() + } + ) + + + + + output$download_EMBED2<-downloadHandler( + filename <- function(){ + paste0("EMBED-",paste(input$matrix_EMBED2_forComparison,input$EMBED2_forComparison,sep="-"),input$plot_choice_download_EMBED2) + }, + content = function(file){ + + if(input$plot_choice_download_EMBED2==".pdf") + {pdf(file = file,onefile=FALSE, width = input$EMBED2_plot_width, height = input$EMBED2_plot_height)} + + else if(input$plot_choice_download_EMBED2==".png") + {png(file = file, width = input$EMBED2_plot_width, height = input$EMBED2_plot_height,units="in",res=1000)} + + else + {tiff(file = file, width = input$EMBED2_plot_width, height = input$EMBED2_plot_height,units="in",res=1000)} + + + plot2 <- plot2() + + grid.arrange(plot2) + dev.off() + } + ) + + output$EMBED_plot_1 <- DT::renderDT(NULL) + output$EMBED_plot_2 <- DT::renderDT(NULL) + + color <- reactive({readRDS(paste0("./",subOutputDir,"/pal.rds"))}) + scale <- reactive({readRDS(paste0("./",subOutputDir,"/scale.rds"))}) + + #plot EMBED1 + output$EMBED_plot_1<- renderPlot({ + + plot1() + + }, height = 450,width=450) + + # #plot EMBED2 + output$EMBED_plot_2<- renderPlot({ + + plot2() + + } ,height = 450,width=450) + + #update EMBED dropdown based on selected Matrix-------------------------------- + + + + #Update dropdown for EMBED1 + # + + featureNames1 <- reactive({ + + if(!(input$matrix_EMBED1_forComparison %in% groupBy)){ + availableMatrices <- getAvailableMatrices(ArchRProj) + matName <- availableMatrices[ availableMatrices %in% input$matrix_EMBED1_forComparison] + featureNames <- h5read(file = paste0(getOutputDirectory(ArchRProj), "/",outputDir, "/", subOutputDir, "/", matName, "_plotBlank72.h5"), + name = matName) + Feature_dropdown1 = names(featureNames) + return(Feature_dropdown1) + } + + }) + + observeEvent(input$matrix_EMBED1_forComparison,{ + + if(!(input$matrix_EMBED1_forComparison %in% groupBy)){ + updateSelectizeInput(session, 'EMBED1_forComparison', label = 'Feature Name', + choices = sort(featureNames1()), + server = TRUE,selected =sort(featureNames1())[1]) + } + }) + + # }) + + + featureNames2 <- reactive({ + + if(!(input$matrix_EMBED2_forComparison %in% groupBy)){ + + availableMatrices <- getAvailableMatrices(ArchRProj) + matName <- availableMatrices[ availableMatrices %in% input$matrix_EMBED2_forComparison] + featureNames <- h5read(file = paste0(getOutputDirectory(ArchRProj), "/",outputDir, "/", subOutputDir, "/", matName, "_plotBlank72.h5"), + name = matName) + + Feature_dropdown2 = names(featureNames) + return(Feature_dropdown2) + + } + + }) + + observeEvent(input$matrix_EMBED2_forComparison,{ + if(!(input$matrix_EMBED2_forComparison %in% groupBy)){ + updateSelectizeInput(session, 'EMBED2_forComparison', label = 'Feature Name', + choices = sort(featureNames2()), + server = TRUE,selected =sort(featureNames2())[1]) + } + }) + + #Update dropdown for EMBED2 + # observeEvent(input$matrix_EMBED2_forComparison,{ + # if(isolate(input$matrix_EMBED2_forComparison)=="Motif Matrix") + # { + # + # updateSelectizeInput(session, 'EMBED2_forComparison', label = 'Feature Name', + # choices = sort(MM_dropdown), + # server = TRUE,selected =sort(MM_dropdown)[2]) + # } + # + # else if(isolate(input$matrix_EMBED2_forComparison)=="Gene Score Matrix") + # { + # updateSelectizeInput(session, 'EMBED2_forComparison', label = 'Feature Name', + # choices = sort(GSM_dropdown), + # server = TRUE,selected =sort(GSM_dropdown)[2]) + # } + # else if(isolate(input$matrix_EMBED2_forComparison)=="Gene Integration Matrix") + # { + # + # updateSelectizeInput(session, 'EMBED2_forComparison', label = 'Feature Name', + # choices = sort(GIM_dropdown), + # server = TRUE,selected =sort(GIM_dropdown)[2]) + # } + # + # }) + + # Plot Browser ---------------------------------------------------------------- + + # Observe the inputs for ATAC-Seq Explorer + observeEvent(input$range_min, { + updateSliderInput(session, "range", + value = c(input$range_min,max(input$range))) + }) + + observeEvent(input$range_max, { + updateSliderInput(session, "range", + value = c(input$range_min,input$range_max)) + }) + + 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) + }, + 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 = ArchRProj, + # ShinyArchR = ShinyArchR, + plotSummary = c("bulkTrack", input$selectPlotSummary), + baseSize = 11, + facetbaseSize = 11, + groupBy = input$browserContent, + geneSymbol = isolate(input$gene_name), + 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(ArchRProj) + + )[[input$gene_name]] + + + grid.arrange(p_browser_atacClusters) + + dev.off() + } + ) + output$browser_atacClusters <- DT::renderDT(NULL) + + #handles error + restartFN <- observeEvent(input$restartButton, { + 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() + print(p) + }) + }else{ + + # Plots scATACSeq clusters + output$browser_atacClusters<- renderPlot({ + grid::grid.newpage() + + p_browser_atacClusters<- plotBrowserTrack( + ArchRProj = ArchRProj, + # ShinyArchR = ShinyArchR, + plotSummary = c("bulkTrack", input$selectPlotSummary), + baseSize = 11, + facetbaseSize = 11, + groupBy = input$browserContent, + geneSymbol = isolate(input$gene_name), + 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(ArchRProj) + + )[[input$gene_name]] + + + grid::grid.draw(p_browser_atacClusters) + + },height = 900) + + } + }) +} diff --git a/R/ui.R b/R/ui.R new file mode 100644 index 00000000..973f2eb6 --- /dev/null +++ b/R/ui.R @@ -0,0 +1,181 @@ +library(shinybusy) + +# This file contains UI widgets. + +# EMBEDING plotting ---------------------------------------------------------------------- +EMBED_panel <- tabPanel(id="EMBED_panel", + + titlePanel(h5("scClusters")), + sidebarPanel( + titlePanel(h3('EMBEDDING 1', align = 'center')), + width = 3, + h4(''), + hr(style = "border-color: grey"), + + selectizeInput( + 'matrix_EMBED1_forComparison', + label = 'EMBEDDING type', + choices = c(EMBEDs_dropdown, matrices_dropdown), + selected = NULL + ), + + conditionalPanel( + condition = '!(input.matrix_EMBED1_forComparison %in% EMBEDs_dropdown)', + selectizeInput( + 'EMBED1_forComparison', + label = 'EMBEDDING 1', + choices = "", + selected = NULL + )), + + splitLayout(cellWidths = c("30%","30%","40%"), + numericInput("EMBED1_plot_width", "Width", min = 0, max = 250, value = 8), + numericInput("EMBED1_plot_height", "Height", min = 0, max = 250, value = 12), + selectizeInput( + 'plot_choice_download_EMBED1', + label = "Format", + choices = c(".pdf",".png",".tiff"), + selected = ".pdf"), + tags$head(tags$style(HTML(" + .shiny-split-layout > div { + overflow: visible;}"))) + ), + + downloadButton(outputId = "download_EMBED1", label = "Download EMBEDDING 1"), + + titlePanel(h3('EMBEDDING 2', align = 'center')), + hr(style = "border-color: grey"), + selectizeInput( + 'matrix_EMBED2_forComparison', + label = 'EMBEDDING type', + choices = c(EMBEDs_dropdown, matrices_dropdown), + selected =NULL + ), + + conditionalPanel(condition = '!(input.matrix_EMBED2_forComparison %in% EMBEDs_dropdown)', + selectizeInput( + 'EMBED2_forComparison', + label = 'EMBEDDING 2', + choices ="", + selected = NULL + )), + + + splitLayout(cellWidths = c("30%","30%","40%"), + numericInput("EMBED2_plot_width", "Width", min = 0, max = 250, value = 8), + numericInput("EMBED2_plot_height", "Height", min = 0, max = 250, value = 12), + selectizeInput( + 'plot_choice_download_EMBED2', + label = "Format", + choices = c(".pdf",".png",".tiff"), + selected = ".pdf"), + tags$head(tags$style(HTML(" + .shiny-split-layout > div { + overflow: visible;}"))) + ), + downloadButton(outputId = "download_EMBED2", label = "Download EMBEDDING 2"), + + ), + + mainPanel( + verbatimTextOutput("feat"), + verbatimTextOutput("text"), + fluidRow(h5("Dimension Reduction scClusters EMBEDs" + )), + fluidRow(helpText("Users can view and compare side-by-side EMBEDs' 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("EMBED_plot_1")), ##%>% withSpinner(color="#0dc5c1") + column(6,plotOutput("EMBED_plot_2")) + ) + ) +) + +# Plot Browser:scATAC Clusters -------------------------------------------------------- + +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")), + + + checkboxGroupInput(inputId = "selectPlotSummary", label = "Select track plots", + choices = c("Feature" = "featureTrack", "Loop" = "loopTrack", "Gene" = "geneTrack"), + selected = c("featureTrack", "loopTrack", "geneTrack"), + inline = TRUE), + + selectizeInput( + 'browserContent', + label = 'Type', + choices = EMBEDs_dropdown, + selected = EMBEDs_dropdown[1] + ), + + selectizeInput( + 'gene_name', + label = 'Gene Name', + choices = sort(gene_names), + selected = sort(sort(gene_names))[1] + ), + + 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%"), + numericInput("tile_size", "TileSize:", min = 10, max = 5000, value = 250), + numericInput("ymax", "Y-Max (0,1):", min = 0, max = 1, value = 0.99) + ), + + hr(style = "border-color: grey"), + + 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"), + 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" + )), + plotOutput("browser_atacClusters") + ) +) + +ui <- shinyUI(fluidPage( + add_busy_spinner(spin = "radar", color = "#CCCCCC", onstart = TRUE, height = "55px", width = "55px"), + + navbarPage( + EMBED_panel, + scATACbrowser_panel, + title ="ShinyArchR Export", + tags$head(tags$style(".shiny-output-error{color: grey;}")) + ), + + tags$footer(HTML("

This webpage was made using ArchR Browser.

"), + align = "left", style = " + position:relative; + bottom:0; + color: black; + padding: 10px; + z-index: 1000;") +) +) From 5b6d19b1cbffc162b107b2360321995af3a9d7c1 Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Tue, 3 Jan 2023 14:09:49 -0600 Subject: [PATCH 050/162] remove duplicate myloadarchrproj --- Shiny/global.R | 48 +----------------------------------------------- 1 file changed, 1 insertion(+), 47 deletions(-) diff --git a/Shiny/global.R b/Shiny/global.R index 28fd6ee8..47da8033 100644 --- a/Shiny/global.R +++ b/Shiny/global.R @@ -19,7 +19,7 @@ library(ArchR) # specify desired number of threads addArchRThreads(threads = 1) -# specify genome version. Default hg19 set +# specify genome version. # addArchRGenome("hg19") set.seed(1) @@ -32,52 +32,6 @@ for (i in seq_along(fn)) { }) } -#' Load Previous ArchRProject into R -#' -#' This function will load a previously saved ArchRProject and re-normalize paths for usage. -#' -#' @param path A character path to an `ArchRProject` directory that was previously saved using `saveArchRProject()`. -#' @param force A boolean value indicating whether missing optional `ArchRProject` components (i.e. peak annotations / -#' background peaks) should be ignored when re-normalizing file paths. If set to `FALSE` loading of the `ArchRProject` -#' will fail unless all components can be found. -#' @param showLogo A boolean value indicating whether to show the ascii ArchR logo after successful creation of an `ArchRProject`. -#' @export -myLoadArchRProject <- function( - path = "./", - force = FALSE, - showLogo = TRUE -){ - - .validInput(input = path, name = "path", valid = "character") - .validInput(input = force, name = "force", valid = "boolean") - .validInput(input = showLogo, name = "showLogo", valid = "boolean") - - path2Proj <- file.path(path, "Save-ArchR-Project.rds") - - if(!file.exists(path2Proj)){ - stop("Could not find previously saved ArchRProject in the path specified!, - Please ") - } - - ArchRProj <- recoverArchRProject(readRDS(path2Proj)) - outputDir <- getOutputDirectory(ArchRProj) - outputDirNew <- normalizePath(path) - - - ArchRProj@projectMetadata$outputDirectory <- outputDirNew - - message("Successfully loaded ArchRProject!") - if(showLogo){ - .ArchRLogo(ascii = "Logo") - } - - ArchRProj - -} -print("start") -ArchRProj=myLoadArchRProject("./inputData/") -print("load") - # UMAP Visualization ------------------------------------------------------------ # create a list of dropdown options for umap tab From 80e8ed0ea03ce0180e960820698573ce42327334 Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Tue, 3 Jan 2023 16:21:14 -0600 Subject: [PATCH 051/162] moving shiny files to shiny dir --- R/app.R | 6 - R/global.R | 264 ------------ R/server.R | 392 ------------------ R/ui.R | 181 -------- Shiny/global.R | 999 ++------------------------------------------ Shiny/server.R | 1074 +++++++++--------------------------------------- Shiny/ui.R | 70 ++-- 7 files changed, 262 insertions(+), 2724 deletions(-) delete mode 100644 R/app.R delete mode 100644 R/global.R delete mode 100644 R/server.R delete mode 100644 R/ui.R diff --git a/R/app.R b/R/app.R deleted file mode 100644 index 8f60aec8..00000000 --- a/R/app.R +++ /dev/null @@ -1,6 +0,0 @@ -# Load libraries so they are available -# Run the app through this file. -source("ui.R") -source("server.R") -shinyApp(ui:ui, server:shinyServer) -# http://127.0.0.1:6747 \ No newline at end of file diff --git a/R/global.R b/R/global.R deleted file mode 100644 index d8e6837d..00000000 --- a/R/global.R +++ /dev/null @@ -1,264 +0,0 @@ -# Setting up ---------------------------------------------------------------------- - -library(shinycssloaders) -library(hexbin) -library(magick) -library(gridExtra) -library(grid) -library(patchwork) -library(shinybusy) -library(cowplot) -library(ggpubr) -library(farver) -library(rhdf5) -library(plotfunctions) -library(raster) -library(jpeg) -library(sparseMatrixStats) -library(BiocManager) -library(AnnotationDbi) -library(BSgenome) -library(Biobase) -library(BiocGenerics) -library(BiocParallel) -library(Biostrings) -library(CNEr) -library(ComplexHeatmap) -library(ArchR) - -#' # specify whether you use a local machine or the shiny app -#' ShinyArchR = TRUE -#' -#' # specify desired number of threads -#' addArchRThreads(threads = 1) -#' # specify genome version. Default hg19 set -#' addArchRGenome("hg19") -#' set.seed(1) -#' -#' ArchRProj=loadArchRProject(path = "Save-ArchRProjShiny/") -#' ArchRProj <- addImputeWeights(ArchRProj = ArchRProj) -#' -#' ############################################################ -#' -#' # myLoadArchRProject ----------------------------------- -#' #' Load Previous ArchRProject into R -#' #' -#' #' This function will load a previously saved ArchRProject and re-normalize paths for usage. -#' #' -#' #' @param path A character path to an `ArchRProject` directory that was previously saved using `saveArchRProject()`. -#' #' @param force A boolean value indicating whether missing optional `ArchRProject` components (i.e. peak annotations / -#' #' background peaks) should be ignored when re-normalizing file paths. If set to `FALSE` loading of the `ArchRProject` -#' #' will fail unless all components can be found. -#' #' @param showLogo A boolean value indicating whether to show the ascii ArchR logo after successful creation of an `ArchRProject`. -#' #' @export -#' myLoadArchRProject <- function(path = "./", -#' force = FALSE, -#' showLogo = TRUE) { -#' .validInput(input = path, -#' name = "path", -#' valid = "character") -#' .validInput(input = force, -#' name = "force", -#' valid = "boolean") -#' .validInput(input = showLogo, -#' name = "showLogo", -#' valid = "boolean") -#' -#' path2Proj <- file.path(path, "Save-ArchR-Project.rds") -#' -#' if (!file.exists(path2Proj)) { -#' stop("Could not find previously saved ArchRProject in the path specified!") -#' } -#' -#' ArchRProj <- recoverArchRProject(readRDS(path2Proj)) -#' outputDir <- getOutputDirectory(ArchRProj) -#' outputDirNew <- normalizePath(path) -#' -#' -#' ArchRProj@projectMetadata$outputDirectory <- outputDirNew -#' -#' message("Successfully loaded ArchRProject!") -#' if (showLogo) { -#' .ArchRLogo(ascii = "Logo") -#' } -#' -#' ArchRProj -#' -#' } -#' -#' -#' ## Create fragment files ----------------------------------------------------------- -#' .getGroupFragsFromProj <- function(ArchRProj = NULL, -#' groupBy = NULL, -#' outDir = file.path("Shiny", "fragments")) { -#' dir.create(outDir, showWarnings = FALSE) -#' -#' # find barcodes of cells in that groupBy. -#' groups <- getCellColData(ArchRProj, select = groupBy, drop = TRUE) -#' cells <- ArchRProj$cellNames -#' cellGroups <- split(cells, groups) -#' -#' # outputs unique cell groups/clusters. -#' clusters <- names(cellGroups) -#' -#' -#' for (cluster in clusters) { -#' cat("Making fragment file for cluster:", cluster, "\n") -#' # get GRanges with all fragments for that cluster -#' cellNames = cellGroups[[cluster]] -#' fragments <- -#' getFragmentsFromProject(ArchRProj = ArchRProj, cellNames = cellNames) -#' fragments <- unlist(fragments, use.names = FALSE) -#' # filter Fragments -#' fragments <- -#' GenomeInfoDb::keepStandardChromosomes(fragments, pruning.mode = "coarse") -#' saveRDS(fragments, file.path(outDir, paste0(cluster, "_cvg.rds"))) -#' } -#' } -#' -#' -#' .getClusterCoverage <- function(ArchRProj = NULL, -#' tileSize = 100, -#' scaleFactor = 1, -#' groupBy = "Clusters", -#' outDir = file.path("Shiny", "coverage")) { -#' fragfiles = list.files(path = file.path("Shiny", "fragments"), -#' full.names = TRUE) -#' dir.create(outDir, showWarnings = FALSE) -#' -#' # find barcodes of cells in that groupBy. -#' groups <- getCellColData(ArchRProj, select = groupBy, drop = TRUE) -#' cells <- ArchRProj$cellNames -#' cellGroups <- split(cells, groups) -#' -#' # outputs unique cell groups/clusters. -#' clusters <- names(cellGroups) -#' -#' chrRegions <- getChromSizes(ArchRProj) -#' genome <- getGenome(ArchRProj) -#' -#' for (file in fragfiles) { -#' fragments <- readRDS(file) -#' #fragmentsToInsertions() -#' left <- GRanges(seqnames = seqnames(fragments), -#' ranges = IRanges(start(fragments), width = 1)) -#' right <- GRanges(seqnames = seqnames(fragments), -#' ranges = IRanges(end(fragments), width = 1)) -#' # call sort() after sortSeqlevels() to sort also the ranges in addition -#' # to the chromosomes. -#' insertions <- c(left, right) %>% sortSeqlevels() %>% -#' sort() -#' -#' cluster <- file %>% basename() %>% gsub("_.*", "", .) -#' #binnedCoverage -#' # message("Creating bins for cluster ",clusters[clusteridx], "...") -#' bins <- -#' unlist(slidingWindows(chrRegions, width = tileSize, step = tileSize)) -#' # message("Counting overlaps for cluster ",clusters[clusteridx], "...") -#' bins$reads <- -#' countOverlaps( -#' bins, -#' insertions, -#' maxgap = -1L, -#' minoverlap = 0L, -#' type = "any" -#' ) -#' addSeqLengths(bins, genome) -#' # message("Creating binned coverage for cluster ",clusters[clusteridx], "...") -#' #each value is multiplied by that weight. -#' # TODO add scaleFactor -#' # allCells as.vector(ArchRProj@cellColData$Sample, mode="any") -#' clusterReadsInTSS <- -#' ArchRProj@cellColData$ReadsInTSS[cells %in% cellGroups$cluster] -#' # scaleFactor <- 5e+06 / sum(clusterReadsInTSS) -#' binnedCoverage <- -#' coverage(bins, weight = bins$reads * scaleFactor) -#' saveRDS(binnedCoverage, file.path(outDir, paste0(cluster, "_cvg.rds"))) -#' } -#' -#' } -#' -#' -#' ############################################################# -#' -#' ArchRProj=loadArchRProject("~/Documents/upwork/Paulina Paiz/Shiny_28_11_2022/Save-ProjHeme5/") -#' -#' -#' # Load all hidden ArchR functions ------------------------------------------------ -#' fn <- unclass(lsf.str(envir = asNamespace("ArchR"), all = TRUE)) -#' for (i in seq_along(fn)) { -#' tryCatch({ -#' eval(parse(text = paste0(fn[i], "<-", fn[i]))) -#' }, error = function(x) { -#' }) -#' } - -# EMBED Visualization ------------------------------------------------------------ - -# create a list of dropdown options for EMBED tab -EMBEDs_dropdown=colnames(ArchRProj@cellColData)[colnames(ArchRProj@cellColData) %in% groupBy] -matrices_dropdown = names(readRDS(paste0("./", subOutputDir, "/scale.rds"))) - -for(i in 1:length(matrices_dropdown)){ - - if(file.exists(paste0(outputDir, "/", subOutputDir, "/", paste0(matrices_dropdown[i],"_names"), ".rds"))){ - - assign(paste0(matrices_dropdown[i], "_dropdown"), readRDS(paste0(outputDir, "/", subOutputDir, "/", paste0(matrices_dropdown[i],"_names"), ".rds"))) - - } - -} - -# if("MotifMatrix" %in% matrices_dropdown){ -# Feature_dropdown = readRDS(paste0(getOutputDirectory(ArchRProj),"/",outputDir, "/", subOutputDir, "/motif_names.rds")) -# } -# -# if("GeneScoreMatrix" %in% matrices_dropdown){ -# GSM_dropdown = readRDS(paste0(getOutputDirectory(ArchRProj),"/",outputDir, "/", subOutputDir, "/gene_names_GSM.rds")) -# } -# -# if("GeneIntegrationMatrix" %in% matrices_dropdown){ -# GIM_dropdown = readRDS(paste0(getOutputDirectory(ArchRProj),"/",outputDir, "/", subOutputDir, "/gene_names_GIM.rds")) -# } -embed_legend = readRDS(paste0(getOutputDirectory(ArchRProj),"/",outputDir, "/", subOutputDir, "/embed_legend_names.rds")) -color_embeddings = readRDS(paste0(getOutputDirectory(ArchRProj),"/",outputDir, "/", subOutputDir, "/embeddings.rds")) - - -# define a function to get the EMBED for a gene -getEMBEDplotWithCol<-function(gene,EMBEDList,scaffoldName,matrixType) -{ - gene_plot=EMBEDList[[gene]] - - p_template1=readRDS(paste0(getOutputDirectory(ArchRProj),"/",outputDir, "/", subOutputDir, "/" ,scaffoldName,".rds")) - - p_template1$scales$scales <- gene_plot$scale - - title=paste("EMBED of IterativeLSI colored by\n",matrixType," : ",sep="") - - p_template1$labels$title <- paste0(title, gene) - - return(p_template1) -} - - -# define a function to get the filename for a gene and then call get EMBED function -getEMBED<-function(gene,fileIndexer,folderName,scaffoldName,matrixType) -{ - # getFilename - for(file in names(fileIndexer)) - { - if(gene %in% fileIndexer[[file]]) - { - EMBEDs_data_subset=readRDS(paste(paste0(getOutputDirectory(ArchRProj),"/",outputDir, "/", subOutputDir, "/" ,folderName),file,sep="/")) - - return(getEMBEDplotWithCol(gene,EMBEDs_data_subset,scaffoldName,matrixType)) - } - } -} - -# PlotBrowser ------------------------------------------------------------------ - -# create a list of dropdown options for plotbroswer tab -gene_names=readRDS(paste0(getOutputDirectory(ArchRProj),"/",outputDir, "/", subOutputDir, "/features.rds")) - - diff --git a/R/server.R b/R/server.R deleted file mode 100644 index 022a781a..00000000 --- a/R/server.R +++ /dev/null @@ -1,392 +0,0 @@ - -shinyServer <- function(input,output, session){ - - - # EMBEDS ------------------------------------------------------------------------------------ - - plot1 <- reactive({ - - availableMatrices <- getAvailableMatrices(ArchRProj) - - if(input$matrix_EMBED1_forComparison %in% availableMatrices){ - mat <- availableMatrices[ availableMatrices %in% input$matrix_EMBED1_forComparison] - - p_empty <- ggplot() + - xlab("Dimension 1") + ylab("Dimension 2") + theme_bw(base_size=10)+ - ggtitle(paste0("EMBED of IterativeLSI colored by \n", mat,": ",input$EMBED1_forComparison)) + - theme( - panel.background = element_rect(fill='transparent'), #transparent panel bg - plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg - panel.grid.major = element_blank(), #remove major gridlines - panel.grid.minor = element_blank(), #remove minor gridlines - legend.background = element_rect(fill='transparent'), #transparent legend bg - legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), - plot.title = element_text(size=16) - ) - - emptyPlot(0,0, axes=FALSE) - legend_plot <- gradientLegend(valRange=c(scale()[[mat]][,input$EMBED1_forComparison][1],scale()[[mat]][,input$EMBED1_forComparison][2]), - color = color()[[mat]], pos=.5, side=1) - - - p <- h5read(paste0("./",subOutputDir,"/",mat,"_plotBlank72.h5"), paste0(mat, "/", input$EMBED1_forComparison)) - temp_jpg <- t(matrix(decode_native(p), nrow = 216)) - - last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + - draw_plot(p_empty, scale = 0.8) + - draw_text("Log2(+1)", x = 0.35, y = 0.05, size = 12) - - print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) - }else{ - p_empty <- ggplot() + - xlab("Dimension 1") + ylab("Dimension 2") + theme_bw(base_size=10)+ - ggtitle(input$matrix_EMBED1_forComparison) + - theme( - panel.background = element_rect(fill='transparent'), #transparent panel bg - plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg - panel.grid.major = element_blank(), #remove major gridlines - panel.grid.minor = element_blank(), #remove minor gridlines - legend.background = element_rect(fill='transparent'), #transparent legend bg - legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), - plot.title = element_text(size=16) - ) - - emptyPlot(0,0, axes=FALSE) - - legend('bottom', legend=embed_legend[[1]], - pch=15, col = color_embeddings[[1]], - horiz = FALSE, x.intersp = 1, text.width=0.35, - cex = 0.7, bty="n", ncol = 4) - - p <- h5read(paste0("./",subOutputDir,"/mainEmbeds.h5"), input$matrix_EMBED1_forComparison)# input$EMBED1_forComparison)) - temp_jpg <- t(matrix(decode_native(p), nrow = 216)) - - last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.7) + - draw_plot(p_empty, scale = 0.7) + - draw_text("color", x = 0.1, y = 0.135, size = 12) - - print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) - } - - }) - - plot2 <- reactive({ - - availableMatrices <- getAvailableMatrices(ArchRProj) - - if(input$matrix_EMBED2_forComparison %in% availableMatrices){ - mat <- availableMatrices[ availableMatrices %in% input$matrix_EMBED2_forComparison] - - p_empty <- ggplot() + - xlab("Dimension 1") + ylab("Dimension 2") + theme_bw(base_size=10)+ - ggtitle(paste0("EMBED of IterativeLSI colored by \n", mat,": ",input$EMBED2_forComparison)) + - theme( - panel.background = element_rect(fill='transparent'), #transparent panel bg - plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg - panel.grid.major = element_blank(), #remove major gridlines - panel.grid.minor = element_blank(), #remove minor gridlines - legend.background = element_rect(fill='transparent'), #transparent legend bg - legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), - plot.title = element_text(size=16) - ) - - emptyPlot(0,0, axes=FALSE) - legend_plot <- gradientLegend(valRange=c(scale()[[mat]][,input$EMBED2_forComparison][1],scale()[[mat]][,input$EMBED2_forComparison][2]), - color = color()[[mat]], pos=.5, side=1) - - p <- h5read(paste0("./",subOutputDir,"/",mat,"_plotBlank72.h5"), paste0(mat, "/", input$EMBED2_forComparison)) - temp_jpg <- t(matrix(decode_native(p), nrow = 216)) - last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + - draw_plot(p_empty, scale = 0.8) + - draw_text("Log2(+1)", x = 0.35, y = 0.05, size = 12) - - print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) - }else{ - - - p_empty <- ggplot() + - xlab("Dimension 1") + ylab("Dimension 2") + theme_bw(base_size=10)+ - ggtitle(input$matrix_EMBED2_forComparison) + - theme( - panel.background = element_rect(fill='transparent'), #transparent panel bg - plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg - panel.grid.major = element_blank(), #remove major gridlines - panel.grid.minor = element_blank(), #remove minor gridlines - legend.background = element_rect(fill='transparent'), #transparent legend bg - legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), - plot.title = element_text(size=16) - ) - - emptyPlot(0,0, axes=FALSE) - - legend('bottom', legend=embed_legend[[1]], - pch=15, col = color_embeddings[[1]], - horiz = FALSE, x.intersp = 1, text.width=0.35, - cex = 0.7, bty="n", ncol = 4) - - p <- h5read(paste0("./",subOutputDir,"/mainEmbeds.h5"), input$matrix_EMBED2_forComparison)# input$EMBED2_forComparison)) - temp_jpg <- t(matrix(decode_native(p), nrow = 216)) - - last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.7) + - draw_plot(p_empty, scale = 0.7) + - draw_text("color", x = 0.1, y = 0.135, size = 12) - - print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) - - } - - }) - - - #Output Handler: Downloads EMBEDS - output$download_EMBED1<-downloadHandler( - filename <- function(){ - paste0("EMBED-",paste(input$matrix_EMBED1_forComparison,input$EMBED1_forComparison,sep="-"),input$plot_choice_download_EMBED1) - }, - content = function(file){ - if(input$plot_choice_download_EMBED1==".pdf") - {pdf(file = file,onefile=FALSE, width = input$EMBED1_plot_width, height = input$EMBED1_plot_height)} - - else if(input$plot_choice_download_EMBED1==".png") - {png(file = file, width = input$EMBED1_plot_width, height = input$EMBED1_plot_height,units="in",res=1000)} - - else - {tiff(file = file, width = input$EMBED1_plot_width, height = input$EMBED1_plot_height,units="in",res=1000)} - - plot1 = plot1() - - - grid.arrange(plot1) - dev.off() - } - ) - - - - - output$download_EMBED2<-downloadHandler( - filename <- function(){ - paste0("EMBED-",paste(input$matrix_EMBED2_forComparison,input$EMBED2_forComparison,sep="-"),input$plot_choice_download_EMBED2) - }, - content = function(file){ - - if(input$plot_choice_download_EMBED2==".pdf") - {pdf(file = file,onefile=FALSE, width = input$EMBED2_plot_width, height = input$EMBED2_plot_height)} - - else if(input$plot_choice_download_EMBED2==".png") - {png(file = file, width = input$EMBED2_plot_width, height = input$EMBED2_plot_height,units="in",res=1000)} - - else - {tiff(file = file, width = input$EMBED2_plot_width, height = input$EMBED2_plot_height,units="in",res=1000)} - - - plot2 <- plot2() - - grid.arrange(plot2) - dev.off() - } - ) - - output$EMBED_plot_1 <- DT::renderDT(NULL) - output$EMBED_plot_2 <- DT::renderDT(NULL) - - color <- reactive({readRDS(paste0("./",subOutputDir,"/pal.rds"))}) - scale <- reactive({readRDS(paste0("./",subOutputDir,"/scale.rds"))}) - - #plot EMBED1 - output$EMBED_plot_1<- renderPlot({ - - plot1() - - }, height = 450,width=450) - - # #plot EMBED2 - output$EMBED_plot_2<- renderPlot({ - - plot2() - - } ,height = 450,width=450) - - #update EMBED dropdown based on selected Matrix-------------------------------- - - - - #Update dropdown for EMBED1 - # - - featureNames1 <- reactive({ - - if(!(input$matrix_EMBED1_forComparison %in% groupBy)){ - availableMatrices <- getAvailableMatrices(ArchRProj) - matName <- availableMatrices[ availableMatrices %in% input$matrix_EMBED1_forComparison] - featureNames <- h5read(file = paste0(getOutputDirectory(ArchRProj), "/",outputDir, "/", subOutputDir, "/", matName, "_plotBlank72.h5"), - name = matName) - Feature_dropdown1 = names(featureNames) - return(Feature_dropdown1) - } - - }) - - observeEvent(input$matrix_EMBED1_forComparison,{ - - if(!(input$matrix_EMBED1_forComparison %in% groupBy)){ - updateSelectizeInput(session, 'EMBED1_forComparison', label = 'Feature Name', - choices = sort(featureNames1()), - server = TRUE,selected =sort(featureNames1())[1]) - } - }) - - # }) - - - featureNames2 <- reactive({ - - if(!(input$matrix_EMBED2_forComparison %in% groupBy)){ - - availableMatrices <- getAvailableMatrices(ArchRProj) - matName <- availableMatrices[ availableMatrices %in% input$matrix_EMBED2_forComparison] - featureNames <- h5read(file = paste0(getOutputDirectory(ArchRProj), "/",outputDir, "/", subOutputDir, "/", matName, "_plotBlank72.h5"), - name = matName) - - Feature_dropdown2 = names(featureNames) - return(Feature_dropdown2) - - } - - }) - - observeEvent(input$matrix_EMBED2_forComparison,{ - if(!(input$matrix_EMBED2_forComparison %in% groupBy)){ - updateSelectizeInput(session, 'EMBED2_forComparison', label = 'Feature Name', - choices = sort(featureNames2()), - server = TRUE,selected =sort(featureNames2())[1]) - } - }) - - #Update dropdown for EMBED2 - # observeEvent(input$matrix_EMBED2_forComparison,{ - # if(isolate(input$matrix_EMBED2_forComparison)=="Motif Matrix") - # { - # - # updateSelectizeInput(session, 'EMBED2_forComparison', label = 'Feature Name', - # choices = sort(MM_dropdown), - # server = TRUE,selected =sort(MM_dropdown)[2]) - # } - # - # else if(isolate(input$matrix_EMBED2_forComparison)=="Gene Score Matrix") - # { - # updateSelectizeInput(session, 'EMBED2_forComparison', label = 'Feature Name', - # choices = sort(GSM_dropdown), - # server = TRUE,selected =sort(GSM_dropdown)[2]) - # } - # else if(isolate(input$matrix_EMBED2_forComparison)=="Gene Integration Matrix") - # { - # - # updateSelectizeInput(session, 'EMBED2_forComparison', label = 'Feature Name', - # choices = sort(GIM_dropdown), - # server = TRUE,selected =sort(GIM_dropdown)[2]) - # } - # - # }) - - # Plot Browser ---------------------------------------------------------------- - - # Observe the inputs for ATAC-Seq Explorer - observeEvent(input$range_min, { - updateSliderInput(session, "range", - value = c(input$range_min,max(input$range))) - }) - - observeEvent(input$range_max, { - updateSliderInput(session, "range", - value = c(input$range_min,input$range_max)) - }) - - 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) - }, - 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 = ArchRProj, - # ShinyArchR = ShinyArchR, - plotSummary = c("bulkTrack", input$selectPlotSummary), - baseSize = 11, - facetbaseSize = 11, - groupBy = input$browserContent, - geneSymbol = isolate(input$gene_name), - 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(ArchRProj) - - )[[input$gene_name]] - - - grid.arrange(p_browser_atacClusters) - - dev.off() - } - ) - output$browser_atacClusters <- DT::renderDT(NULL) - - #handles error - restartFN <- observeEvent(input$restartButton, { - 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() - print(p) - }) - }else{ - - # Plots scATACSeq clusters - output$browser_atacClusters<- renderPlot({ - grid::grid.newpage() - - p_browser_atacClusters<- plotBrowserTrack( - ArchRProj = ArchRProj, - # ShinyArchR = ShinyArchR, - plotSummary = c("bulkTrack", input$selectPlotSummary), - baseSize = 11, - facetbaseSize = 11, - groupBy = input$browserContent, - geneSymbol = isolate(input$gene_name), - 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(ArchRProj) - - )[[input$gene_name]] - - - grid::grid.draw(p_browser_atacClusters) - - },height = 900) - - } - }) -} diff --git a/R/ui.R b/R/ui.R deleted file mode 100644 index 973f2eb6..00000000 --- a/R/ui.R +++ /dev/null @@ -1,181 +0,0 @@ -library(shinybusy) - -# This file contains UI widgets. - -# EMBEDING plotting ---------------------------------------------------------------------- -EMBED_panel <- tabPanel(id="EMBED_panel", - - titlePanel(h5("scClusters")), - sidebarPanel( - titlePanel(h3('EMBEDDING 1', align = 'center')), - width = 3, - h4(''), - hr(style = "border-color: grey"), - - selectizeInput( - 'matrix_EMBED1_forComparison', - label = 'EMBEDDING type', - choices = c(EMBEDs_dropdown, matrices_dropdown), - selected = NULL - ), - - conditionalPanel( - condition = '!(input.matrix_EMBED1_forComparison %in% EMBEDs_dropdown)', - selectizeInput( - 'EMBED1_forComparison', - label = 'EMBEDDING 1', - choices = "", - selected = NULL - )), - - splitLayout(cellWidths = c("30%","30%","40%"), - numericInput("EMBED1_plot_width", "Width", min = 0, max = 250, value = 8), - numericInput("EMBED1_plot_height", "Height", min = 0, max = 250, value = 12), - selectizeInput( - 'plot_choice_download_EMBED1', - label = "Format", - choices = c(".pdf",".png",".tiff"), - selected = ".pdf"), - tags$head(tags$style(HTML(" - .shiny-split-layout > div { - overflow: visible;}"))) - ), - - downloadButton(outputId = "download_EMBED1", label = "Download EMBEDDING 1"), - - titlePanel(h3('EMBEDDING 2', align = 'center')), - hr(style = "border-color: grey"), - selectizeInput( - 'matrix_EMBED2_forComparison', - label = 'EMBEDDING type', - choices = c(EMBEDs_dropdown, matrices_dropdown), - selected =NULL - ), - - conditionalPanel(condition = '!(input.matrix_EMBED2_forComparison %in% EMBEDs_dropdown)', - selectizeInput( - 'EMBED2_forComparison', - label = 'EMBEDDING 2', - choices ="", - selected = NULL - )), - - - splitLayout(cellWidths = c("30%","30%","40%"), - numericInput("EMBED2_plot_width", "Width", min = 0, max = 250, value = 8), - numericInput("EMBED2_plot_height", "Height", min = 0, max = 250, value = 12), - selectizeInput( - 'plot_choice_download_EMBED2', - label = "Format", - choices = c(".pdf",".png",".tiff"), - selected = ".pdf"), - tags$head(tags$style(HTML(" - .shiny-split-layout > div { - overflow: visible;}"))) - ), - downloadButton(outputId = "download_EMBED2", label = "Download EMBEDDING 2"), - - ), - - mainPanel( - verbatimTextOutput("feat"), - verbatimTextOutput("text"), - fluidRow(h5("Dimension Reduction scClusters EMBEDs" - )), - fluidRow(helpText("Users can view and compare side-by-side EMBEDs' 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("EMBED_plot_1")), ##%>% withSpinner(color="#0dc5c1") - column(6,plotOutput("EMBED_plot_2")) - ) - ) -) - -# Plot Browser:scATAC Clusters -------------------------------------------------------- - -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")), - - - checkboxGroupInput(inputId = "selectPlotSummary", label = "Select track plots", - choices = c("Feature" = "featureTrack", "Loop" = "loopTrack", "Gene" = "geneTrack"), - selected = c("featureTrack", "loopTrack", "geneTrack"), - inline = TRUE), - - selectizeInput( - 'browserContent', - label = 'Type', - choices = EMBEDs_dropdown, - selected = EMBEDs_dropdown[1] - ), - - selectizeInput( - 'gene_name', - label = 'Gene Name', - choices = sort(gene_names), - selected = sort(sort(gene_names))[1] - ), - - 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%"), - numericInput("tile_size", "TileSize:", min = 10, max = 5000, value = 250), - numericInput("ymax", "Y-Max (0,1):", min = 0, max = 1, value = 0.99) - ), - - hr(style = "border-color: grey"), - - 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"), - 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" - )), - plotOutput("browser_atacClusters") - ) -) - -ui <- shinyUI(fluidPage( - add_busy_spinner(spin = "radar", color = "#CCCCCC", onstart = TRUE, height = "55px", width = "55px"), - - navbarPage( - EMBED_panel, - scATACbrowser_panel, - title ="ShinyArchR Export", - tags$head(tags$style(".shiny-output-error{color: grey;}")) - ), - - tags$footer(HTML("

This webpage was made using ArchR Browser.

"), - align = "left", style = " - position:relative; - bottom:0; - color: black; - padding: 10px; - z-index: 1000;") -) -) diff --git a/Shiny/global.R b/Shiny/global.R index 47da8033..9d275595 100644 --- a/Shiny/global.R +++ b/Shiny/global.R @@ -14,44 +14,47 @@ library(rhdf5) library(plotfunctions) library(raster) library(jpeg) +library(sparseMatrixStats) +library(BiocManager) +library(AnnotationDbi) +library(BSgenome) +library(Biobase) +library(BiocGenerics) +library(BiocParallel) +library(Biostrings) +library(CNEr) +library(ComplexHeatmap) library(ArchR) +# EMBED Visualization ------------------------------------------------------------ -# specify desired number of threads -addArchRThreads(threads = 1) -# specify genome version. -# addArchRGenome("hg19") -set.seed(1) +# create a list of dropdown options for EMBED tab +EMBEDs_dropdown=colnames(ArchRProj@cellColData)[colnames(ArchRProj@cellColData) %in% groupBy] +matrices_dropdown = names(readRDS(paste0("./", subOutputDir, "/scale.rds"))) -# Load all hidden ArchR functions ------------------------------------------------ -fn <- unclass(lsf.str(envir = asNamespace("ArchR"), all = TRUE)) -for (i in seq_along(fn)) { - tryCatch({ - eval(parse(text = paste0(fn[i], "<-", fn[i]))) - }, error = function(x) { - }) +for(i in 1:length(matrices_dropdown)){ + + if(file.exists(paste0(outputDir, "/", subOutputDir, "/", paste0(matrices_dropdown[i],"_names"), ".rds"))){ + + assign(paste0(matrices_dropdown[i], "_dropdown"), readRDS(paste0(outputDir, "/", subOutputDir, "/", paste0(matrices_dropdown[i],"_names"), ".rds"))) + + } + } -# UMAP Visualization ------------------------------------------------------------ - -# create a list of dropdown options for umap tab -Umaps_dropdown=c("Clusters","Sample","Unconstrained","Constrained","Constrained remap") -MM_dropdown=readRDS("./inputData/motif_names.rds") -GSM_dropdown=readRDS("./inputData/gene_names_GSM.rds") -GIM_dropdown=readRDS("./inputData/gene_names_GIM.rds") -umap_legend_names = readRDS("./inputData/umap_legend_names.rds") -color_umaps=readRDS("./inputData/color_umaps.rds") +embed_legend = readRDS(paste0(getOutputDirectory(ArchRProj),"/",outputDir, "/", subOutputDir, "/embed_legend_names.rds")) +color_embeddings = readRDS(paste0(getOutputDirectory(ArchRProj),"/",outputDir, "/", subOutputDir, "/embeddings.rds")) - -# define a function to get the umap for a gene -getUMAPplotWithCol<-function(gene,umapList,scaffoldName,matrixType) +# define a function to get the EMBED for a feature/gene +getEMBEDplotWithCol<-function(gene,EMBEDList,scaffoldName,matrixType) { - gene_plot=umapList[[gene]] + gene_plot=EMBEDList[[gene]] + + p_template1=readRDS(paste0(getOutputDirectory(ArchRProj),"/",outputDir, "/", subOutputDir, "/" ,scaffoldName,".rds")) - p_template1=readRDS(paste("./inputData/",scaffoldName,".rds",sep="")) p_template1$scales$scales <- gene_plot$scale - title=paste("UMAP of IterativeLSI colored by\n",matrixType," : ",sep="") + title=paste("EMBED of IterativeLSI colored by\n",matrixType," : ",sep="") p_template1$labels$title <- paste0(title, gene) @@ -59,16 +62,17 @@ getUMAPplotWithCol<-function(gene,umapList,scaffoldName,matrixType) } -# define a function to get the filename for a gene and then call get umap function -getUmap<-function(gene,fileIndexer,folderName,scaffoldName,matrixType) +# define a function to get the filename for a gene and then call get EMBED function +getEMBED<-function(gene,fileIndexer,folderName,scaffoldName,matrixType) { # getFilename for(file in names(fileIndexer)) { if(gene %in% fileIndexer[[file]]) { - Umaps_data_subset=readRDS(paste(paste0("./inputData/",folderName),file,sep="/")) - return(getUMAPplotWithCol(gene,Umaps_data_subset,scaffoldName,matrixType)) + EMBEDs_data_subset=readRDS(paste(paste0(getOutputDirectory(ArchRProj),"/",outputDir, "/", subOutputDir, "/" ,folderName),file,sep="/")) + + return(getEMBEDplotWithCol(gene,EMBEDs_data_subset,scaffoldName,matrixType)) } } } @@ -76,937 +80,6 @@ getUmap<-function(gene,fileIndexer,folderName,scaffoldName,matrixType) # PlotBrowser ------------------------------------------------------------------ # create a list of dropdown options for plotbroswer tab -gene_names=readRDS("./inputData/gene_names.rds") - -#Extend where upstream can be negative for browser -extendGR2 <- function(gr = NULL, upstream = NULL, downstream = NULL){ - .validInput(input = gr, name = "gr", valid = c("GRanges")) - .validInput(input = upstream, name = "upstream", valid = c("integer")) - .validInput(input = downstream, name = "downstream", valid = c("integer")) - #Get Info From gr - st <- start(gr) - ed <- end(gr) - #https://bioinformatics.stackexchange.com/questions/4390/expand-granges-object-different-amounts-upstream-vs-downstream - isMinus <- BiocGenerics::which(strand(gr) == "-") - isOther <- BiocGenerics::which(strand(gr) != "-") - #Forward - st[isOther] <- st[isOther] - upstream - ed[isOther] <- ed[isOther] + downstream - #Reverse - ed[isMinus] <- ed[isMinus] + upstream - st[isMinus] <- st[isMinus] - downstream - #If Any extensions now need to be flipped. - end(gr) <- pmax(st, ed) - start(gr) <- pmin(st, ed) - return(gr) -} - -.subsetSeqnamesGR <- function(gr = NULL, names = NULL){ - .validInput(input = gr, name = "gr", valid = c("GRanges")) - .validInput(input = names, name = "names", valid = c("character")) - gr <- gr[which(as.character(seqnames(gr)) %in% names),] - seqlevels(gr) <- as.character(unique(seqnames(gr))) - return(gr) -} - -.myQuantileCut <- function(x = NULL, lo = 0.025, hi = 0.975, maxIf0 = TRUE, na.rm = TRUE){ - q <- quantile(x, probs = c(lo,hi), na.rm = TRUE) - if(q[2] == 0){ - if(maxIf0){ - q[2] <- max(x) - } - } - x[x < q[1]] <- q[1] - x[x > q[2]] <- q[2] - return(x) -} - -#' Plot an ArchR Region Track -#' -#' This function will plot the coverage at an input region in the style of a browser track. It allows for normalization of the signal -#' which enables direct comparison across samples. -#' -#' @param ArchRProj An `ArchRProject` object. -#' @param region A `GRanges` region that indicates the region to be plotted. If more than one region exists in the `GRanges` object, -#' all will be plotted. If no region is supplied, then the `geneSymbol` argument can be used to center the plot window at the -#' transcription start site of the supplied gene. -#' @param groupBy A string that indicates how cells should be grouped. This string corresponds to one of the standard or -#' user-supplied `cellColData` metadata columns (for example, "Clusters"). Cells with the same value annotated in this metadata -#' column will be grouped together and the average signal will be plotted. -#' @param useGroups A character vector that is used to select a subset of groups by name from the designated `groupBy` column in -#' `cellColData`. This limits the groups to be plotted. -#' @param plotSummary A character vector containing the features to be potted. Possible values include "bulkTrack" (the ATAC-seq signal), -#' "scTrack" (scATAC-seq signal), "featureTrack" (i.e. the peak regions), "geneTrack" (line diagrams of genes with introns and exons shown. -#' Blue-colored genes are on the minus strand and red-colored genes are on the plus strand), and "loopTrack" (links between a peak and a gene). -#' @param sizes A numeric vector containing up to 3 values that indicate the sizes of the individual components passed to `plotSummary`. -#' The order must be the same as `plotSummary`. -#' @param features A `GRanges` object containing the "features" to be plotted via the "featureTrack". This should be thought of as a -#' bed track. i.e. the set of peaks obtained using `getPeakSet(ArchRProj))`. -#' @param loops A `GRanges` object containing the "loops" to be plotted via the "loopTrack". -#' This `GRanges` object start represents the center position of one loop anchor and the end represents the center position of another loop anchor. -#' A "loopTrack" draws an arc between two genomic regions that show some type of interaction. This type of track can be used -#' to display chromosome conformation capture data or co-accessibility links obtained using `getCoAccessibility()`. -#' @param geneSymbol If `region` is not supplied, plotting can be centered at the transcription start site corresponding to the gene symbol(s) passed here. -#' @param useMatrix If supplied geneSymbol, one can plot the corresponding GeneScores/GeneExpression within this matrix. I.E. "GeneScoreMatrix" -#' @param log2Norm If supplied geneSymbol, Log2 normalize the corresponding GeneScores/GeneExpression matrix before plotting. -#' @param upstream The number of basepairs upstream of the transcription start site of `geneSymbol` to extend the plotting window. -#' If `region` is supplied, this argument is ignored. -#' @param downstream The number of basepairs downstream of the transcription start site of `geneSymbol` to extend the plotting window. -#' If `region` is supplied, this argument is ignored. -#' @param tileSize The numeric width of the tile/bin in basepairs for plotting ATAC-seq signal tracks. All insertions in a single bin will be summed. -#' @param minCells The minimum number of cells contained within a cell group to allow for this cell group to be plotted. This argument can be -#' used to exclude pseudo-bulk replicates generated from low numbers of cells. -#' @param normMethod The name of the column in `cellColData` by which normalization should be performed. The recommended and default value -#' is "ReadsInTSS" which simultaneously normalizes tracks based on sequencing depth and sample data quality. -#' @param threads The number of threads to use for parallel execution. -#' @param ylim The numeric quantile y-axis limit to be used for for "bulkTrack" plotting. If not provided, the y-axis limit will be c(0, 0.999). -#' @param pal A custom palette (see `paletteDiscrete` or `ArchRPalettes`) used to override coloring for groups. -#' @param baseSize The numeric font size to be used in the plot. This applies to all plot labels. -#' @param scTileSize The width of the tiles in scTracks. Larger numbers may make cells overlap more. Default is 0.5 for about 100 cells. -#' @param scCellsMax The maximum number of cells for scTracks. -#' @param borderWidth The numeric line width to be used for plot borders. -#' @param tickWidth The numeric line width to be used for axis tick marks. -#' @param facetbaseSize The numeric font size to be used in the facets (gray boxes used to provide track labels) of the plot. -#' @param geneAnnotation The `geneAnnotation` object to be used for plotting the "geneTrack" object. See `createGeneAnnotation()` for more info. -#' @param title The title to add at the top of the plot next to the plot's genomic coordinates. -#' @param verbose A boolean value that determines whether standard output should be printed. -#' @param logFile The path to a file to be used for logging ArchR output. -#' @export -plotBrowserTrack_Test <- function( - ArchRProj = NULL, - region = NULL, - groupBy = "Clusters", - useGroups = NULL, - plotSummary = c("bulkTrack", "featureTrack", "loopTrack", "geneTrack"), - sizes = c(10, 1.5, 3, 4), - features = getPeakSet(ArchRProj), - loops = getCoAccessibility(ArchRProj), - geneSymbol = NULL, - useMatrix = NULL, - log2Norm = TRUE, - upstream = 50000, - downstream = 50000, - tileSize = 100, - minCells = 25, - normMethod = "ReadsInTSS", - threads = getArchRThreads(), - ylim = NULL, - pal = NULL, - baseSize = 7, - scTileSize = 0.5, - scCellsMax = 100, - borderWidth = 0.4, - tickWidth = 0.4, - facetbaseSize = 7, - geneAnnotation = getGeneAnnotation(ArchRProj), - title = "", - verbose = TRUE, - logFile = createLogFile("plotBrowserTrack") -){ - - .validInput(input = ArchRProj, name = "ArchRProj", valid = "ArchRProj") - .validInput(input = region, name = "region", valid = c("granges","null")) - .validInput(input = groupBy, name = "groupBy", valid = "character") - .validInput(input = useGroups, name = "useGroups", valid = c("character", "null")) - .validInput(input = plotSummary, name = "plotSummary", valid = "character") - .validInput(input = sizes, name = "sizes", valid = "numeric") - .validInput(input = features, name = "features", valid = c("granges", "grangeslist", "null")) - .validInput(input = loops, name = "loops", valid = c("granges", "grangeslist", "null")) - .validInput(input = geneSymbol, name = "geneSymbol", valid = c("character", "null")) - .validInput(input = useMatrix, name = "useMatrix", valid = c("character", "null")) - .validInput(input = log2Norm, name = "log2Norm", valid = c("boolean")) - .validInput(input = upstream, name = "upstream", valid = c("integer")) - .validInput(input = downstream, name = "downstream", valid = c("integer")) - .validInput(input = tileSize, name = "tileSize", valid = c("integer")) - .validInput(input = minCells, name = "minCells", valid = c("integer")) - .validInput(input = normMethod, name = "normMethod", valid = c("character")) - .validInput(input = threads, name = "threads", valid = c("integer")) - .validInput(input = ylim, name = "ylim", valid = c("numeric", "null")) - .validInput(input = pal, name = "pal", valid = c("palette", "null")) - .validInput(input = baseSize, name = "baseSize", valid = "numeric") - .validInput(input = scTileSize, name = "scTileSize", valid = "numeric") - .validInput(input = scCellsMax, name = "scCellsMax", valid = "integer") - .validInput(input = borderWidth, name = "borderWidth", valid = "numeric") - .validInput(input = tickWidth, name = "tickWidth", valid = "numeric") - .validInput(input = facetbaseSize, name = "facetbaseSize", valid = "numeric") - geneAnnotation <- .validGeneAnnotation(geneAnnotation) - .validInput(input = title, name = "title", valid = "character") - - tstart <- Sys.time() - .startLogging(logFile=logFile) - .logThis(mget(names(formals()),sys.frame(sys.nframe())), "plotBrowserTrack Input-Parameters", logFile = logFile) - - - # Get Region Where Plot Will Occur (GenomicRanges) ------------------------------------------------------------------ - .logDiffTime("Validating Region", t1=tstart, verbose=verbose, logFile=logFile) - if(is.null(region)){ - if(!is.null(geneSymbol)){ - region <- geneAnnotation$genes - region <- region[which(tolower(mcols(region)$symbol) %in% tolower(geneSymbol))] - region <- region[order(match(tolower(mcols(region)$symbol), tolower(geneSymbol)))] - print(region) - region <- resize(region, 1, "start") - strand(region) <- "*" - region <- extendGR(region, upstream = upstream, downstream = downstream) - } - } - region <- .validGRanges(region) - .logThis(region, "region", logFile = logFile) - - if(is.null(geneSymbol)){ - useMatrix <- NULL - } - - if(!is.null(useMatrix)){ - featureMat <- .getMatrixValues( - ArchRProj = ArchRProj, - matrixName = useMatrix, - name = mcols(region)$symbol - ) - if(log2Norm){ - featureMat <- log2(featureMat + 1) - } - featureMat <- data.frame(t(featureMat)) - featureMat$Group <- getCellColData(ArchRProj, groupBy, drop = FALSE)[rownames(featureMat), 1] - } - - ggList <- lapply(seq_along(region), function(x){ - - plotList <- list() - - - # Bulk Tracks ------------------------------------------------------------------ - - if("bulktrack" %in% tolower(plotSummary)){ - .logDiffTime(sprintf("Adding Bulk Tracks (%s of %s)",x,length(region)), t1=tstart, verbose=verbose, logFile=logFile) - plotList$bulktrack <- .bulkTracks( - ArchRProj = ArchRProj, - region = region[x], - tileSize = tileSize, - groupBy = groupBy, - threads = threads, - minCells = minCells, - pal = pal, - ylim = ylim, - baseSize = baseSize, - borderWidth = borderWidth, - tickWidth = tickWidth, - facetbaseSize = facetbaseSize, - normMethod = normMethod, - geneAnnotation = geneAnnotation, - title = title, - useGroups = useGroups, - tstart = tstart, - logFile = logFile) + theme(plot.margin = unit(c(0.35, 0.75, 0.35, 0.75), "cm")) - } - - - # Feature Tracks ------------------------------------------------------------------ - - if("featuretrack" %in% tolower(plotSummary)){ - if(!is.null(features)){ - .logDiffTime(sprintf("Adding Feature Tracks (%s of %s)",x,length(region)), t1=tstart, verbose=verbose, logFile=logFile) - plotList$featuretrack <- .featureTracks( - features = features, - region = region[x], - facetbaseSize = facetbaseSize, - hideX = TRUE, - title = "Peaks", - logFile = logFile) + theme(plot.margin = unit(c(0.1, 0.75, 0.1, 0.75), "cm")) - } - } - - - # Loop Tracks ------------------------------------------------------------------ - if("looptrack" %in% tolower(plotSummary)){ - if(!is.null(loops)){ - .logDiffTime(sprintf("Adding Loop Tracks (%s of %s)",x,length(region)), t1=tstart, verbose=verbose, logFile=logFile) - plotList$looptrack <- .loopTracks( - loops = loops, - region = region[x], - facetbaseSize = facetbaseSize, - hideX = TRUE, - hideY = TRUE, - title = "Loops", - logFile = logFile) + theme(plot.margin = unit(c(0.1, 0.75, 0.1, 0.75), "cm")) - } - } - - - # Gene Tracks ------------------------------------------------------------------ - if("genetrack" %in% tolower(plotSummary)){ - .logDiffTime(sprintf("Adding Gene Tracks (%s of %s)",x,length(region)), t1=tstart, verbose=verbose, logFile=logFile) - plotList$genetrack <- .geneTracks( - geneAnnotation = geneAnnotation, - region = region[x], - facetbaseSize = facetbaseSize, - title = "Genes", - logFile = logFile) + theme(plot.margin = unit(c(0.1, 0.75, 0.1, 0.75), "cm")) - } - - # Time to plot ------------------------------------------------------------------ - plotSummary <- tolower(plotSummary) - names(sizes) <- plotSummary - sizes <- sizes[order(plotSummary)] - plotSummary <- plotSummary[order(plotSummary)] - - sizes <- sizes[tolower(names(plotList))] - - if(!is.null(useMatrix)){ - - suppressWarnings(.combinedFeaturePlot( - plotList = plotList, - log2Norm = log2Norm, - featureMat = featureMat, - feature = region[x]$symbol[[1]], - useMatrix = useMatrix, - pal = pal, - sizes = sizes, - baseSize = baseSize, - facetbaseSize = facetbaseSize, - borderWidth = borderWidth, - tickWidth = tickWidth - )) - - }else{ - - .logThis(names(plotList), sprintf("(%s of %s) names(plotList)",x,length(region)), logFile=logFile) - .logThis(sizes, sprintf("(%s of %s) sizes",x,length(region)), logFile=logFile) - .logDiffTime("Plotting", t1=tstart, verbose=verbose, logFile=logFile) - - tryCatch({ - suppressWarnings(ggAlignPlots(plotList = plotList, sizes=sizes, draw = FALSE)) - }, error = function(e){ - .logMessage("Error with plotting, diagnosing each element", verbose = TRUE, logFile = logFile) - for(i in seq_along(plotList)){ - tryCatch({ - print(plotList[[i]]) - }, error = function(f){ - .logError(f, fn = names(plotList)[i], info = "", errorList = NULL, logFile = logFile) - }) - } - .logError(e, fn = "ggAlignPlots", info = "", errorList = NULL, logFile = logFile) - }) - - } - - }) - - if(!is.null(mcols(region)$symbol)){ - names(ggList) <- mcols(region)$symbol - }else{ - if(length(ggList) == 1){ - ggList <- ggList[[1]] - } - } - - .endLogging(logFile=logFile) - - ggList - -} +gene_names=readRDS(paste0(getOutputDirectory(ArchRProj),"/",outputDir, "/", subOutputDir, "/features.rds")) -# Bulk Aggregated ATAC Track Methods -------------------------------------------- -.bulkTracks <- function( - ArchRProj = NULL, - region = NULL, - tileSize = 100, - minCells = 25, - groupBy = "Clusters", - useGroups = NULL, - normMethod = "ReadsInTSS", - threads = 1, - ylim = NULL, - baseSize = 7, - borderWidth = 0.4, - tickWidth = 0.4, - facetbaseSize = 7, - geneAnnotation = getGeneAnnotation(ArchRProj), - title = "", - pal = NULL, - tstart = NULL, - verbose = FALSE, - logFile = NULL -){ - - .requirePackage("ggplot2", source = "cran") - - if(is.null(tstart)){ - tstart <- Sys.time() - } - - df <- .groupRegionSumCvg( - ArchRProj = ArchRProj, - groupBy = groupBy, - normMethod = normMethod, - useGroups = useGroups, - minCells = minCells, - region = region, - tileSize = tileSize, - threads = threads, - verbose = verbose, - logFile = logFile - ) - .logThis(split(df, df[,3]), ".bulkTracks df", logFile = logFile) - - # Plot Track ------------------------------------------------------------------ - if(!is.null(ylim)){ - ylim <- quantile(df$y, ylim) - df$y[df$y < ylim[1]] <- ylim[1] - df$y[df$y > ylim[2]] <- ylim[2] - }else{ - ylim <- c(0,quantile(df$y, probs=c(0.999))) - df$y[df$y < ylim[1]] <- ylim[1] - df$y[df$y > ylim[2]] <- ylim[2] - } - uniqueGroups <- gtools::mixedsort(unique(paste0(df$group))) - if(!is.null(useGroups)){ - uniqueGroups <- unique(useGroups) - } - df$group <- factor(df$group, levels = uniqueGroups) - title <- paste0(as.character(seqnames(region)),":", start(region)-1, "-", end(region), " ", title) - - allGroups <- gtools::mixedsort(unique(getCellColData(ArchRProj = ArchRProj, select = groupBy, drop = TRUE))) - - if(is.null(pal)){ - pal <- suppressWarnings(paletteDiscrete(values = allGroups)) - } - - p <- ggplot(df, aes_string("x","y", color = "group", fill = "group")) + - geom_area(stat = "identity") + - facet_wrap(facets = ~group, strip.position = 'right', ncol = 1) + - ylab(sprintf("Coverage\n(Norm. ATAC Signal Range (%s-%s) by %s)", round(min(ylim),2), round(max(ylim),2), normMethod)) + - scale_color_manual(values = pal) + - scale_fill_manual(values = pal) + - scale_x_continuous(limits = c(start(region), end(region)), expand = c(0,0)) + - scale_y_continuous(limits = ylim, expand = c(0,0)) + - theme_ArchR(baseSize = baseSize, - baseRectSize = borderWidth, - baseLineSize = tickWidth, - legendPosition = "right", - axisTickCm = 0.1) + - theme(panel.spacing= unit(0, "lines"), - axis.title.x=element_blank(), - axis.text.y=element_blank(), - axis.ticks.y=element_blank(), - strip.text = element_text( - size = facetbaseSize, - color = "black", - margin = margin(0,0.35,0,0.35, "cm")), - strip.text.y = element_text(angle = 0), - strip.background = element_rect(color="black")) + - guides(fill = FALSE, colour = FALSE) + ggtitle(title) - - p - -} -# Create Average Tracks from Coverage Objects ----------------------------------- -.groupRegionSumCvg <- function( - ArchRProj = NULL, - useGroups = NULL, - groupBy = NULL, - region = NULL, - tileSize = NULL, - normMethod = NULL, - verbose = FALSE, - minCells = 25, - maxCells = 500, - threads = NULL, - logFile = NULL -){ - - # Group Info - cellGroups <- getCellColData(ArchRProj, groupBy, drop = TRUE) - tabGroups <- table(cellGroups) - - - groupsBySample <- split(cellGroups, getCellColData(ArchRProj, "Sample", drop = TRUE)) - uniqueGroups <- gtools::mixedsort(unique(cellGroups)) - - # Tile Region - regionTiles <- (seq(trunc(start(region) / tileSize), - trunc(end(region) / tileSize) + 1) * tileSize) + 1 - allRegionTilesGR <- GRanges( - seqnames = seqnames(region), - ranges = IRanges(start = regionTiles, width=100) - ) - - cvgObjs = list.files(path = "./coverage", full.names = TRUE) - allCvgGR = c() - for(i in seq_along(cvgObjs)) { - cvgrds <- readRDS(cvgObjs[[i]]) - gr <- GRanges(cvgrds) - allCvgGR = c(allCvgGR, gr) - } - - groupMat <- .safelapply(seq_along(allCvgGR), function(i){ - .logMessage(sprintf("Getting Region From Coverage Objects %s of %s", i, length(allCvgGR)), logFile = logFile) - tryCatch({ - .regionSumCvg( - cvgObj = allCvgGR[[i]], - region = region, - regionTiles = regionTiles, - allRegionTilesGR = allRegionTilesGR, - tileSize = tileSize, - ) - }, error = function(e){ - errorList <- list( - cvgObj = allCvgGR[[i]], - region = region, - regionTiles = regionTiles, - allRegionTilesGR = allRegionTilesGR, - tileSize = tileSize, - ) - }) - }, threads = threads) %>% do.call(cbind, .) - - # Plot DF ------------------------------------------------------------------ - df <- data.frame(which(groupMat > 0, arr.ind=TRUE)) - # df$y stores the non-zero scores. - df$y <- groupMat[cbind(df[,1], df[,2])] - - #Minus 1 Tile Size - dfm1 <- df - dfm1$row <- dfm1$row - 1 - dfm1$y <- 0 - - #Plus 1 Size - dfp1 <- df - dfp1$row <- dfp1$row + 1 - dfp1$y <- 0 - - #Create plot DF - df <- rbind(df, dfm1, dfp1) - df <- df[!duplicated(df[,1:2]),] - df <- df[df$row > 0,] - # df$x are the regionTiles that have a non-zero score. - df$x <- regionTiles[df$row] - #NA from below - df$group <- uniqueGroups[df$col] - - #Add In Ends - dfs <- data.frame( - col = seq_along(uniqueGroups), - row = 1, - y = 0, - x = start(region), - group = uniqueGroups - ) - - dfe <- data.frame( - col = seq_along(uniqueGroups), - row = length(regionTiles), - y = 0, - x = end(region), - group = uniqueGroups - ) - - # Final output - plotDF <- rbind(df,dfs,dfe) - plotDF <- df[order(df$group,df$x),] - plotDF <- df[,c("x", "y", "group")] - - # Normalization - g <- getCellColData(ArchRProj, groupBy, drop = TRUE) - - if(tolower(normMethod) %in% c("readsintss","readsinpromoter", "nfrags")) { - v <- getCellColData(ArchRProj, normMethod, drop = TRUE) - groupNormFactors <- unlist(lapply(split(v, g), sum)) - }else if(tolower(normMethod) == "ncells"){ - groupNormFactors <- table(g) - }else if(tolower(normMethod) == "none"){ - groupNormFactors <- rep(10^4, length(g)) - names(groupNormFactors) <- g - }else{ - stop("Norm Method Not Recognized : ", normMethod) - } - - # Scale with Norm Factors - scaleFactors <- 10^4 / groupNormFactors - matchGroup <- match(paste0(plotDF$group), names(scaleFactors)) - plotDF$y <- plotDF$y * as.vector(scaleFactors[matchGroup]) - - return(plotDF) - -} - -.regionSumCvg <- function( - cvgObj = NULL, - region = NULL, - regionTiles = NULL, - allRegionTilesGR = NULL, - tileSize = NULL, - logFile = NULL -){ - - hits <- findOverlaps(query = allRegionTilesGR, subject = cvgObj) - clusterVector <- cvgObj$score[subjectHits(hits)] - - return(clusterVector) - -} - -# Gene Tracks ------------------------------------------------------------------ - -.geneTracks <- function( - geneAnnotation = NULL, - region = NULL, - baseSize = 9, - borderWidth = 0.4, - title = "Genes", - geneWidth = 2, - exonWidth = 4, - labelSize = 2, - facetbaseSize, - colorMinus = "dodgerblue2", - colorPlus = "red", - logFile = NULL -){ - - .requirePackage("ggplot2", source = "cran") - .requirePackage("ggrepel", source = "cran") - - # only take first region - region <- .validGRanges(region) - region <- .subsetSeqnamesGR(region[1], as.character(seqnames(region[1]))) - - genes <- sort(sortSeqlevels(geneAnnotation$genes), ignore.strand = TRUE) - exons <- sort(sortSeqlevels(geneAnnotation$exons), ignore.strand = TRUE) - genesO <- data.frame(subsetByOverlaps(genes, region, ignore.strand = TRUE)) - - if(nrow(genesO) > 0){ - - # Identify Info for Exons and Genes - exonsO <- data.frame(subsetByOverlaps(exons, region, ignore.strand = TRUE)) - exonsO <- exonsO[which(exonsO$symbol %in% genesO$symbol),] - genesO$facet = title - genesO$start <- matrixStats::rowMaxs(cbind(genesO$start, start(region))) - genesO$end <- matrixStats::rowMins(cbind(genesO$end, end(region))) - - # Collapse Iteratively - # backwards iteration so that the last value chosen is the lowest cluster possible to fit in. - genesO$cluster <- 0 - for(i in seq_len(nrow(genesO))){ - if(i==1){ - genesO$cluster[i] <- 1 - }else{ - for(j in seq_len(max(genesO$cluster))){ - jEnd <- rev(genesO$end)[match(rev(seq_len(max(genesO$cluster)))[j], rev(genesO$cluster))] - if(genesO$start[i] > jEnd + median(genesO$width)){ - genesO$cluster[i] <- rev(genesO$cluster)[match(rev(seq_len(max(genesO$cluster)))[j],rev(genesO$cluster))] - } - } - if(genesO$cluster[i]==0){ - genesO$cluster[i] <- genesO$cluster[i-1] + 1 - } - } - } - exonsO$cluster <- genesO$cluster[match(exonsO$symbol, genesO$symbol)] - pal <- c("-"=colorMinus,"+"=colorPlus,"*"=colorPlus) - - p <- ggplot(data = genesO, aes(color = strand, fill = strand)) + - facet_grid(facet~.) + - - # Limits - ylim(c(0.5, max(genesO$cluster) + 0.5)) + - scale_x_continuous(limits = c(start(region), end(region)), expand = c(0,0)) + - - # Segment for Not Minus Stranded - geom_segment(data = genesO[which(as.character(genesO$strand)!="-"),], - aes(x = start, xend = end, y = cluster, yend = cluster, color = strand),size=geneWidth) + - - # Segment for Minus Stranded - geom_segment(data = genesO[which(as.character(genesO$strand)=="-"),], - aes(x = end, xend = start, y = cluster, yend = cluster, color = strand),size=geneWidth) + - - # Segement for Exons - geom_segment(data = exonsO, aes(x = start, xend = end, y = cluster, - yend = cluster, color = strand),size=exonWidth) + - - # Colors - scale_color_manual(values = pal, guide = FALSE) + - scale_fill_manual(values = pal) + - - # Theme - theme_ArchR(baseSize = baseSize, baseLineSize = borderWidth, baseRectSize = borderWidth) + - theme(axis.title.x=element_blank(), axis.text.x=element_blank(),axis.ticks.x=element_blank()) + - theme(axis.title.y=element_blank(), axis.text.y=element_blank(),axis.ticks.y=element_blank()) + - theme(legend.text = element_text(size = baseSize), strip.text.y = element_text(size = facetbaseSize, angle = 0)) + - guides(fill = guide_legend(override.aes = list(colour = NA, shape = "c", size=3)), color = FALSE) + - theme(legend.position="bottom") + - theme(legend.title=element_text(size=5), legend.text=element_text(size=7), - legend.key.size = unit(0.75,"line"), legend.background = element_rect(color =NA), strip.background = element_blank()) - - # Add Labels if There are Genes with this orientation! - if(length(which(genesO$strand!="-")) > 0){ - p <- p + ggrepel::geom_label_repel(data=genesO[which(genesO$strand!="-"),], - aes(x = start, y = cluster, label = symbol, color = strand), - segment.color = "grey", nudge_x = -0.01*(end(region) - start(region)), nudge_y = -0.25, - size = labelSize, direction = "x", inherit.aes=FALSE) - } - - # Add Labels if There are Genes with this orientation! - if(length(which(genesO$strand=="-")) > 0){ - p <- p + ggrepel::geom_label_repel(data=genesO[which(genesO$strand=="-"),], - aes(x = end, y = cluster, label = symbol, color = strand), - segment.color = "grey", nudge_x = +0.01*(end(region) - start(region)), nudge_y = 0.25, - size = labelSize, direction = "x", inherit.aes=FALSE) - } - - p <- p + theme(legend.justification = c(0, 1), - legend.background = element_rect(colour = NA, fill = NA), legend.position="none") - - }else{ - - # create empty plot - df <- data.frame(facet = "GeneTrack", start = 0, end = 0, strand = "*", symbol = "none") - pal <- c("*"=colorPlus) - p <- ggplot(data = df, aes(start, end, fill = strand)) + geom_point() + - facet_grid(facet~.) + - theme_ArchR(baseSize = baseSize, baseLineSize = borderWidth, baseRectSize = borderWidth) + - scale_color_manual(values = pal) + - scale_x_continuous(limits = c(start(region), end(region)), expand = c(0,0)) + - theme(axis.title.x=element_blank(), axis.text.x=element_blank(),axis.ticks.x=element_blank()) + - theme(axis.title.y=element_blank(), axis.text.y=element_blank(),axis.ticks.y=element_blank()) - - } - - if(!is.ggplot(p)){ - .logError("geneTrack is not a ggplot!", fn = ".geneTracks", info = "", errorList = NULL, logFile = logFile) - } - - return(p) - -} - -# Feature Tracks ------------------------------------------------------------------ - -.featureTracks <- function( - features = NULL, - region = NULL, - title = "FeatureTrack", - pal = NULL, - baseSize = 9, - facetbaseSize = NULL, - featureWidth = 2, - borderWidth = 0.4, - hideX = FALSE, - hideY = FALSE, - logFile = NULL -){ - - .requirePackage("ggplot2", source = "cran") - - # only take first region - region <- .validGRanges(region) - region <- .subsetSeqnamesGR(region[1], as.character(seqnames(region[1]))) - - if(!is.null(features)){ - - if(!.isGRList(features)){ - features <- .validGRanges(features) - featureList <- SimpleList(FeatureTrack = features) - hideY <- TRUE - }else{ - featureList <- features - hideY <- FALSE - } - featureList <- featureList[rev(seq_along(featureList))] - - featureO <- lapply(seq_along(featureList), function(x){ - featurex <- featureList[[x]] - namex <- names(featureList)[x] - mcols(featurex) <- NULL - sub <- subsetByOverlaps(featurex, region, ignore.strand = TRUE) - if(length(sub) > 0){ - data.frame(sub, name = namex) - }else{ - empty <- GRanges(as.character(seqnames(region[1])), ranges = IRanges(0,0)) - data.frame(empty, name = namex) - } - - }) - - featureO <- Reduce("rbind", featureO) - - .logThis(featureO, "featureO", logFile = logFile) - - featureO$facet <- title - - if(is.null(pal)){ - pal <- paletteDiscrete(set = "stallion", values = rev(unique(paste0(featureO$name)))) - } - - featureO$name <- factor(paste0(featureO$name), levels=names(featureList)) - - p <- ggplot(data = featureO, aes(color = name)) + - facet_grid(facet~.) + - geom_segment(data = featureO, aes(x = start, xend = end, y = name, yend = name, color = name), size=featureWidth) + - ylab("") + xlab("") + - scale_x_continuous(limits = c(start(region), end(region)), expand = c(0,0)) + - scale_color_manual(values = pal) + - theme(legend.text = element_text(size = baseSize)) + - theme_ArchR(baseSize = baseSize, baseLineSize = borderWidth, baseRectSize = borderWidth) + - guides(color = FALSE, fill = FALSE) + theme(strip.text.y = element_text(size = facetbaseSize, angle = 0), strip.background = element_blank()) - - }else{ - - # create empty plot - df <- data.frame(facet = "FeatureTrack", start = 0, end = 0, strand = "*", symbol = "none") - p <- ggplot(data = df, aes(start, end)) + - geom_point() + - facet_grid(facet~.) + - theme_ArchR(baseSize = baseSize, baseLineSize = borderWidth, baseRectSize = borderWidth) + - scale_x_continuous(limits = c(start(region), end(region)), expand = c(0,0)) + - theme(axis.title.x=element_blank(), axis.text.x=element_blank(),axis.ticks.x=element_blank()) + - theme(axis.title.y=element_blank(), axis.text.y=element_blank(),axis.ticks.y=element_blank()) - - } - - if(hideX){ - p <- p + theme(axis.title.x=element_blank(), axis.text.x=element_blank(), axis.ticks.x=element_blank()) - } - - if(hideY){ - p <- p + theme(axis.title.y=element_blank(), axis.text.y=element_blank(), axis.ticks.y=element_blank()) - } - - if(!is.ggplot(p)){ - .logError("featureTrack is not a ggplot!", fn = ".featureTracks", info = "", errorList = NULL, logFile = logFile) - } - - return(p) - -} - -# Loop Tracks -.loopTracks <- function( - loops = NULL, - region = NULL, - title = "LoopTrack", - pal = NULL, - baseSize = 9, - facetbaseSize = 9, - featureWidth = 2, - borderWidth = 0.4, - hideX = FALSE, - hideY = FALSE, - logFile = NULL -){ - - getArchDF <- function(lp, r = 100){ - angles <- seq(pi, 2*pi,length.out=100) - rx <- (end(lp)-start(lp))/2 - rscale <- r * (rx/max(rx)) - cx <- start(lp) + rx - if(is.null(mcols(lp)$value)){ - mcols(lp)$value <- 1 - } - df <- lapply(seq_along(cx), function(z){ - xz <- rx[z]*cos(angles)+cx[z] - dfz <- DataFrame(x=xz, y=rscale[z]*sin(angles), id=Rle(paste0("l",z)), value = mcols(lp)$value[z]) - }) %>% Reduce("rbind",.) - return(df) - } - - if(!is.null(loops)){ - - if(is(loops, "GRanges")){ - loops <- SimpleList(Loops = loops) - }else if(.isGRList(loops)){ - }else{ - stop("Loops is not a GRanges or a list of GRanges! Please supply valid input!") - } - - valueMin <- min(unlist(lapply(loops, function(x) min(x$value)))) - valueMax <- max(unlist(lapply(loops, function(x) max(x$value)))) - - loopO <- lapply(seq_along(loops), function(x){ - subLoops <- subsetByOverlaps(loops[[x]], region, ignore.strand = TRUE, type = "within") - if(length(subLoops)>0){ - dfx <- getArchDF(subLoops) - dfx$name <- Rle(paste0(names(loops)[x])) - dfx - }else{ - NULL - } - }) %>% Reduce("rbind",.) - .logThis(loopO, "loopO", logFile = logFile) - - testDim <- tryCatch({ - if(is.null(loopO)){ - FALSE - } - if(nrow(loopO) > 0){ - TRUE - }else{ - FALSE - } - }, error = function(x){ - FALSE - }) - - if(testDim){ - - loopO$facet <- title - if(is.null(pal)){ - pal <- colorRampPalette(c("#E6E7E8","#3A97FF","#8816A7","black"))(100) - } - - p <- ggplot(data = data.frame(loopO), aes(x = x, y = y, group = id, color = value)) + - geom_line() + - facet_grid(name ~ .) + - ylab("") + - coord_cartesian(ylim = c(-100,0)) + - scale_x_continuous(limits = c(start(region), end(region)), expand = c(0,0)) + - scale_color_gradientn(colors = pal, limits = c(valueMin, valueMax)) + - theme(legend.text = element_text(size = baseSize)) + - theme_ArchR(baseSize = baseSize, baseLineSize = borderWidth, baseRectSize = borderWidth, legendPosition = "right") + - theme(strip.text.y = element_text(size = facetbaseSize, angle = 0), strip.background = element_blank(), - legend.box.background = element_rect(color = NA)) + - guides(color= guide_colorbar(barwidth = 0.75, barheight = 3)) - - }else{ - - # create empty plot - df <- data.frame(facet = "LoopTrack", start = 0, end = 0, strand = "*", symbol = "none") - p <- ggplot(data = df, aes(start, end)) + - geom_point() + - facet_grid(facet~.) + - theme_ArchR(baseSize = baseSize, baseLineSize = borderWidth, baseRectSize = borderWidth) + - scale_x_continuous(limits = c(start(region), end(region)), expand = c(0,0)) + - theme(axis.title.x=element_blank(), axis.text.x=element_blank(),axis.ticks.x=element_blank()) + - theme(axis.title.y=element_blank(), axis.text.y=element_blank(),axis.ticks.y=element_blank()) - - } - - }else{ - - # create empty plot - df <- data.frame(facet = "LoopTrack", start = 0, end = 0, strand = "*", symbol = "none") - p <- ggplot(data = df, aes(start, end)) + - geom_point() + - facet_grid(facet~.) + - theme_ArchR(baseSize = baseSize, baseLineSize = borderWidth, baseRectSize = borderWidth) + - scale_x_continuous(limits = c(start(region), end(region)), expand = c(0,0)) + - theme(axis.title.x=element_blank(), axis.text.x=element_blank(),axis.ticks.x=element_blank()) + - theme(axis.title.y=element_blank(), axis.text.y=element_blank(),axis.ticks.y=element_blank()) - - } - - if(hideX){ - p <- p + theme(axis.title.x=element_blank(), axis.text.x=element_blank(), axis.ticks.x=element_blank()) - } - - if(hideY){ - p <- p + theme(axis.title.y=element_blank(), axis.text.y=element_blank(), axis.ticks.y=element_blank()) - } - - if(!is.ggplot(p)){ - .logError("loopTracks is not a ggplot!", fn = ".loopTracks", info = "", errorList = NULL, logFile = logFile) - } - - return(p) - -} diff --git a/Shiny/server.R b/Shiny/server.R index 67f2eccc..ff5de96f 100644 --- a/Shiny/server.R +++ b/Shiny/server.R @@ -2,509 +2,18 @@ shinyServer <- function(input,output, session){ - # UMAPS ------------------------------------------------------------------------------------ + # EMBEDS ------------------------------------------------------------------------------------ - #Output Handler: Downloads UMAPS - output$download_UMAP1<-downloadHandler( - filename <- function(){ - paste0("UMAP-",paste(input$matrix_UMAP1_forComparison,input$UMAP1_forComparison,sep="-"),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)} - - if((input$matrix_UMAP1_forComparison)=="Gene Score Matrix") - { - p_empty <- ggplot() + - xlab("UMAP Dimension 1") + ylab("UMAP Dimension 2") + theme_bw(base_size=10)+ - ggtitle(paste0("UMAP of IterativeLSI colored by \n GeneScoreMatrix: ",input$UMAP1_forComparison)) + - theme( - panel.background = element_rect(fill='transparent'), #transparent panel bg - plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg - panel.grid.major = element_blank(), #remove major gridlines - panel.grid.minor = element_blank(), #remove minor gridlines - legend.background = element_rect(fill='transparent'), #transparent legend bg - legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), - plot.title = element_text(size=16) - ) - - emptyPlot(0,0, axes=FALSE) - legend_plot <- gradientLegend(valRange=c(scale()$gsm[,input$UMAP1_forComparison][1],scale()$gsm[,input$UMAP1_forComparison][2]), - color = color()$gsm, pos=.5, side=1) - - - p <- h5read("./inputData/plotBlank72.h5", paste0("GSM/", input$UMAP1_forComparison)) - temp_jpg <- t(matrix(decode_native(p), nrow = 216)) - - - last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + - draw_plot(p_empty, scale = 0.8) + - draw_text("Log2(+1)", x = 0.35, y = 0.05, size = 12) - - plot1 = print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) - - } - - else if((input$matrix_UMAP1_forComparison)=="Gene Integration Matrix") - { - p_empty <- ggplot() + - xlab("UMAP Dimension 1") + ylab("UMAP Dimension 2") + theme_bw(base_size=10)+ - ggtitle(paste0("UMAP of IterativeLSI colored by \n GeneIntegrationMatrix: ",input$UMAP1_forComparison)) + - theme( - panel.background = element_rect(fill='transparent'), #transparent panel bg - plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg - panel.grid.major = element_blank(), #remove major gridlines - panel.grid.minor = element_blank(), #remove minor gridlines - legend.background = element_rect(fill='transparent'), #transparent legend bg - legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), - plot.title = element_text(size=16) - ) - - emptyPlot(0,0, axes=FALSE) - legend_plot <- gradientLegend(valRange=c(scale()$gim[,input$UMAP1_forComparison][1],scale()$gim[,input$UMAP1_forComparison][2]), - color = color()$gim, pos=.5, side=1) - - p <- h5read("./inputData/plotBlank72.h5", paste0("GIM/", input$UMAP1_forComparison)) - temp_jpg <- t(matrix(decode_native(p), nrow = 216)) - - - last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + - draw_plot(p_empty, scale = 0.8) + - draw_text("Log2(+1)", x = 0.35, y = 0.05, size = 12) - - plot1 = print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) - - - } - - else if((input$matrix_UMAP1_forComparison)=="Motif Matrix") - { - p_empty <- ggplot() + - xlab("UMAP Dimension 1") + ylab("UMAP Dimension 2") + theme_bw(base_size=10)+ - ggtitle(paste0("UMAP of IterativeLSI colored by \n MotifMatrix: ",input$UMAP1_forComparison)) + - theme( - panel.background = element_rect(fill='transparent'), #transparent panel bg - plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg - panel.grid.major = element_blank(), #remove major gridlines - panel.grid.minor = element_blank(), #remove minor gridlines - legend.background = element_rect(fill='transparent'), #transparent legend bg - legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), - plot.title = element_text(size=16) - ) - - emptyPlot(0,0, axes=FALSE) - legend_plot <- gradientLegend(valRange=c(scale()$mm[,input$UMAP1_forComparison][1],scale()$mm[,input$UMAP1_forComparison][2]), - color = color()$mm, pos=.5, side=1) - - p <- h5read("./inputData/plotBlank72.h5", paste0("MM/", input$UMAP1_forComparison)) - - temp_jpg <- t(matrix(decode_native(p), nrow = 216)) - - last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + - draw_plot(p_empty, scale = 0.8) + - draw_text("Log2(+1)", x = 0.35, y = 0.05, size = 12) - - plot1 = print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) - } - - else - { - - - if((input$matrix_UMAP1_forComparison)=="Clusters"){ - - title = "Colored by scATAC-seq clusters" - - } - - if((input$matrix_UMAP1_forComparison)=="Constrained"){ - - title = "UMAP: constrained integration" - - } - - if((input$matrix_UMAP1_forComparison)=="Constrained remap"){ - - title = "UMAP: Constrained remmaped clusters" - - } - - if((input$matrix_UMAP1_forComparison)=="Sample"){ - - title = "Colored by original identity" - - } - - if((input$matrix_UMAP1_forComparison)=="Unconstrained"){ - - title = "UMAP: unconstrained integration" - - } - - p_empty <- ggplot() + - xlab("UMAP Dimension 1") + ylab("UMAP Dimension 2") + theme_bw(base_size=10)+ - ggtitle(title) + - theme( - panel.background = element_rect(fill='transparent'), #transparent panel bg - plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg - panel.grid.major = element_blank(), #remove major gridlines - panel.grid.minor = element_blank(), #remove minor gridlines - legend.background = element_rect(fill='transparent'), #transparent legend bg - legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), - plot.title = element_text(size=16) - ) - - emptyPlot(0,0, axes=FALSE) - - if((input$matrix_UMAP1_forComparison)=="Clusters"){ - - legend('bottom', legend=umap_legend_names$Clusters, - pch=15, col = color_umaps$Clusters, - horiz = FALSE, x.intersp = 1, text.width=0.35, - cex = 0.7, bty="n", ncol = 4) - - - - } - - if((input$matrix_UMAP1_forComparison)=="Sample"){ - legend('bottom', legend=umap_legend_names$Sample, pch=15, - col = color, - horiz = TRUE, x.intersp = 1, text.width=0.6, - cex = 0.7, bty="n") - } - - if((input$matrix_UMAP1_forComparison)=="Constrained"){ - - legend('bottom', legend=umap_legend_names$Constrained, - pch=15, col = color_umaps$Constrained, - horiz = FALSE, x.intersp = 1, text.width=0.35, - cex = 0.5, bty="n", ncol = 5) - - - } - - - if((input$matrix_UMAP1_forComparison)=="Unconstrained"){ - legend('bottom', legend=umap_legend_names$unconstrained, - pch=15, col = color_umaps$unconstrained, - horiz = FALSE, x.intersp = 1, text.width=0.35, - cex = 0.5, bty="n", ncol = 5) - } - - - if((input$matrix_UMAP1_forComparison)=="Constrained remap"){ - legend('bottom', legend=umap_legend_names$`Constrained remap`, - pch=15, col = color_umaps$`Constrained remap`, - horiz = FALSE, x.intersp = 1, text.width=0.35, - cex = 0.7, bty="n", ncol = 4) - } - - # p <- h5read("./inputData/mainUMAPs.h5", input$matrix_UMAP1_forComparison) - - if(input$matrix_UMAP1_forComparison == "Unconstrained"){p <- h5read("./inputData/mainUMAPs.h5", "unconstrained")}else{ - p <- h5read("./inputData/mainUMAPs.h5", input$matrix_UMAP1_forComparison) - } - - temp_jpg <- t(matrix(decode_native(p), nrow = 216)) - - last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.7) + - draw_plot(p_empty, scale = 0.7) + - draw_text("color", x = 0.1, y = 0.135, size = 12) - - plot1 = print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) - } - - - grid.arrange(plot1) - dev.off() - } - ) - - output$download_UMAP2<-downloadHandler( - filename <- function(){ - paste0("UMAP-",paste(input$matrix_UMAP2_forComparison,input$UMAP2_forComparison,sep="-"),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)} - - - - - if((input$matrix_UMAP2_forComparison)=="Gene Score Matrix") - { - p_empty <- ggplot() + - xlab("UMAP Dimension 1") + ylab("UMAP Dimension 2") + theme_bw(base_size=10)+ - ggtitle(paste0("UMAP of IterativeLSI colored by \n GeneScoreMatrix: ",input$UMAP1_forComparison)) + - theme( - panel.background = element_rect(fill='transparent'), #transparent panel bg - plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg - panel.grid.major = element_blank(), #remove major gridlines - panel.grid.minor = element_blank(), #remove minor gridlines - legend.background = element_rect(fill='transparent'), #transparent legend bg - legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), - plot.title = element_text(size=16) - ) - - emptyPlot(0,0, axes=FALSE) - legend_plot <- gradientLegend(valRange=c(scale()$gsm[,input$UMAP1_forComparison][1],scale()$gsm[,input$UMAP1_forComparison][2]), - color = color()$gsm, pos=.5, side=1) - - - p <- h5read("./inputData/plotBlank72.h5", paste0("GSM/", input$UMAP1_forComparison)) - temp_jpg <- t(matrix(decode_native(p), nrow = 216)) - - - last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + - draw_plot(p_empty, scale = 0.8) + - draw_text("Log2(+1)", x = 0.35, y = 0.05, size = 12) - - plot2 = print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) - - } - - else if((input$matrix_UMAP2_forComparison)=="Gene Integration Matrix") - { - p_empty <- ggplot() + - xlab("UMAP Dimension 1") + ylab("UMAP Dimension 2") + theme_bw(base_size=10)+ - ggtitle(paste0("UMAP of IterativeLSI colored by \n GeneIntegrationMatrix: ",input$UMAP1_forComparison)) + - theme( - panel.background = element_rect(fill='transparent'), #transparent panel bg - plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg - panel.grid.major = element_blank(), #remove major gridlines - panel.grid.minor = element_blank(), #remove minor gridlines - legend.background = element_rect(fill='transparent'), #transparent legend bg - legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), - plot.title = element_text(size=16) - ) - - emptyPlot(0,0, axes=FALSE) - legend_plot <- gradientLegend(valRange=c(scale()$gim[,input$UMAP1_forComparison][1],scale()$gim[,input$UMAP1_forComparison][2]), - color = color()$gim, pos=.5, side=1) - - p <- h5read("./inputData/plotBlank72.h5", paste0("GIM/", input$UMAP1_forComparison)) - temp_jpg <- t(matrix(decode_native(p), nrow = 216)) - - - last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + - draw_plot(p_empty, scale = 0.8) + - draw_text("Log2(+1)", x = 0.35, y = 0.05, size = 12) - - plot2 = print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) - - - } - - else if((input$matrix_UMAP2_forComparison)=="Motif Matrix") - { - p_empty <- ggplot() + - xlab("UMAP Dimension 1") + ylab("UMAP Dimension 2") + theme_bw(base_size=10)+ - ggtitle(paste0("UMAP of IterativeLSI colored by \n MotifMatrix: ",input$UMAP1_forComparison)) + - theme( - panel.background = element_rect(fill='transparent'), #transparent panel bg - plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg - panel.grid.major = element_blank(), #remove major gridlines - panel.grid.minor = element_blank(), #remove minor gridlines - legend.background = element_rect(fill='transparent'), #transparent legend bg - legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), - plot.title = element_text(size=16) - ) - - emptyPlot(0,0, axes=FALSE) - legend_plot <- gradientLegend(valRange=c(scale()$mm[,input$UMAP1_forComparison][1],scale()$mm[,input$UMAP1_forComparison][2]), - color = color()$mm, pos=.5, side=1) - - p <- h5read("./inputData/plotBlank72.h5", paste0("MM/", input$UMAP1_forComparison)) - - temp_jpg <- t(matrix(decode_native(p), nrow = 216)) - - last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + - draw_plot(p_empty, scale = 0.8) + - draw_text("Log2(+1)", x = 0.35, y = 0.05, size = 12) - - plot2 = print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) - - - } - - else - { - - if((input$matrix_UMAP2_forComparison)=="Clusters"){ - - title = "Colored by scATAC-seq clusters" - - } - - if((input$matrix_UMAP2_forComparison)=="Constrained"){ - - title = "UMAP: constrained integration" - - } - - if((input$matrix_UMAP2_forComparison)=="Constrained remap"){ - - title = "UMAP: Constrained remmaped clusters" - - } - - if((input$matrix_UMAP2_forComparison)=="Sample"){ - - title = "Colored by original identity" - - } - - if((input$matrix_UMAP2_forComparison)=="Unconstrained"){ - - title = "UMAP: unconstrained integration" - - } - - p_empty <- ggplot() + - xlab("UMAP Dimension 1") + ylab("UMAP Dimension 2") + theme_bw(base_size=10)+ - ggtitle(title) + - theme( - panel.background = element_rect(fill='transparent'), #transparent panel bg - plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg - panel.grid.major = element_blank(), #remove major gridlines - panel.grid.minor = element_blank(), #remove minor gridlines - legend.background = element_rect(fill='transparent'), #transparent legend bg - legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), - plot.title = element_text(size=16) - ) - - emptyPlot(0,0, axes=FALSE) - - if((input$matrix_UMAP2_forComparison)=="Clusters"){ - - legend('bottom', legend=umap_legend_names$Clusters, - pch=15, col = color_umaps$Clusters, - horiz = FALSE, x.intersp = 1, text.width=0.35, - cex = 0.7, bty="n", ncol = 4) - - - - } - - if((input$matrix_UMAP2_forComparison)=="Sample"){ - legend('bottom', legend=umap_legend_names$Sample, pch=15, - col = color_umaps$Sample, - horiz = TRUE, x.intersp = 1, text.width=0.6, - cex = 0.7, bty="n") - } - - if((input$matrix_UMAP2_forComparison)=="Constrained"){ - - legend('bottom', legend=umap_legend_names$Constrained, - pch=15, col = color_umaps$Constrained, - horiz = FALSE, x.intersp = 1, text.width=0.35, - cex = 0.5, bty="n", ncol = 5) - - - } - - - if((input$matrix_UMAP2_forComparison)=="Unconstrained"){ - legend('bottom', legend=umap_legend_names$unconstrained, - pch=15, col = color_umaps$unconstrained, - horiz = FALSE, x.intersp = 1, text.width=0.35, - cex = 0.5, bty="n", ncol = 5) - } - - - if((input$matrix_UMAP2_forComparison)=="Constrained remap"){ - legend('bottom', legend=umap_legend_names$`Constrained remap`, - pch=15, col = color_umaps$`Constrained remap`, - horiz = FALSE, x.intersp = 1, text.width=0.35, - cex = 0.7, bty="n", ncol = 4) - } - - # p <- h5read("./inputData/mainUMAPs.h5", input$matrix_UMAP2_forComparison) - - if(input$matrix_UMAP2_forComparison == "Unconstrained"){p <- h5read("./inputData/mainUMAPs.h5", "unconstrained")}else{ - p <- h5read("./inputData/mainUMAPs.h5", input$matrix_UMAP2_forComparison) - } - - temp_jpg <- t(matrix(decode_native(p), nrow = 216)) - - last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.7) + - draw_plot(p_empty, scale = 0.7) + - draw_text("color", x = 0.1, y = 0.135, size = 12) - - plot2 = print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) - } - - - grid.arrange(plot2) - dev.off() - } - ) - - output$UMAP_plot_1 <- DT::renderDT(NULL) - output$UMAP_plot_2 <- DT::renderDT(NULL) - - color <- reactive({readRDS("./inputData/pal.rds")}) - scale <- reactive({readRDS("./inputData/scale.rds")}) - - #plot UMAP1 - output$UMAP_plot_1<- renderPlot({ + plot1 <- reactive({ + availableMatrices <- getAvailableMatrices(ArchRProj) - if((input$matrix_UMAP1_forComparison)=="Gene Score Matrix") - { - - p_empty <- ggplot() + - xlab("UMAP Dimension 1") + ylab("UMAP Dimension 2") + theme_bw(base_size=10)+ - ggtitle(paste0("UMAP of IterativeLSI colored by \n GeneScoreMatrix: ",input$UMAP1_forComparison)) + - theme( - panel.background = element_rect(fill='transparent'), #transparent panel bg - plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg - panel.grid.major = element_blank(), #remove major gridlines - panel.grid.minor = element_blank(), #remove minor gridlines - legend.background = element_rect(fill='transparent'), #transparent legend bg - legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), - plot.title = element_text(size=16) - ) - - emptyPlot(0,0, axes=FALSE) - legend_plot <- gradientLegend(valRange=c(scale()$gsm[,input$UMAP1_forComparison][1],scale()$gsm[,input$UMAP1_forComparison][2]), - color = color()$gsm, pos=.5, side=1) - - - p <- h5read("./inputData/plotBlank72.h5", paste0("GSM/", input$UMAP1_forComparison)) - temp_jpg <- t(matrix(decode_native(p), nrow = 216)) - - - last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + - draw_plot(p_empty, scale = 0.8) + - draw_text("Log2(+1)", x = 0.35, y = 0.05, size = 12) - - print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) - - } - - else if((input$matrix_UMAP1_forComparison)=="Gene Integration Matrix") - { - # getUmap(input$UMAP1_forComparison,GSM_Umaps_data_fileIndexer,"GSM_Umaps_data","plot_scaffold_GSM",isolate(input$matrix_UMAP1_forComparison)) - + if(input$matrix_EMBED1_forComparison %in% availableMatrices){ + mat <- availableMatrices[ availableMatrices %in% input$matrix_EMBED1_forComparison] p_empty <- ggplot() + - xlab("UMAP Dimension 1") + ylab("UMAP Dimension 2") + theme_bw(base_size=10)+ - ggtitle(paste0("UMAP of IterativeLSI colored by \n GeneIntegrationMatrix: ",input$UMAP1_forComparison)) + + xlab("Dimension 1") + ylab("Dimension 2") + theme_bw(base_size=10)+ + ggtitle(paste0("EMBED of IterativeLSI colored by \n", mat,": ",input$EMBED1_forComparison)) + theme( panel.background = element_rect(fill='transparent'), #transparent panel bg plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg @@ -516,429 +25,263 @@ shinyServer <- function(input,output, session){ ) emptyPlot(0,0, axes=FALSE) - legend_plot <- gradientLegend(valRange=c(scale()$gim[,input$UMAP1_forComparison][1],scale()$gim[,input$UMAP1_forComparison][2]), - color = color()$gim, pos=.5, side=1) - - p <- h5read("./inputData/plotBlank72.h5", paste0("GIM/", input$UMAP1_forComparison)) - temp_jpg <- t(matrix(decode_native(p), nrow = 216)) + legend_plot <- gradientLegend(valRange=c(scale()[[mat]][,input$EMBED1_forComparison][1],scale()[[mat]][,input$EMBED1_forComparison][2]), + color = color()[[mat]], pos=.5, side=1) - last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + - draw_plot(p_empty, scale = 0.8) + - draw_text("Log2(+1)", x = 0.35, y = 0.05, size = 12) - - print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) - - - } - - else if((input$matrix_UMAP1_forComparison)=="Motif Matrix") - { - p_empty <- ggplot() + - xlab("UMAP Dimension 1") + ylab("UMAP Dimension 2") + theme_bw(base_size=10)+ - ggtitle(paste0("UMAP of IterativeLSI colored by \n MotifMatrix: ",input$UMAP1_forComparison)) + - theme( - panel.background = element_rect(fill='transparent'), #transparent panel bg - plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg - panel.grid.major = element_blank(), #remove major gridlines - panel.grid.minor = element_blank(), #remove minor gridlines - legend.background = element_rect(fill='transparent'), #transparent legend bg - legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), - plot.title = element_text(size=16) - ) - - emptyPlot(0,0, axes=FALSE) - legend_plot <- gradientLegend(valRange=c(scale()$mm[,input$UMAP1_forComparison][1],scale()$mm[,input$UMAP1_forComparison][2]), - color = color()$mm, pos=.5, side=1) - - p <- h5read("./inputData/plotBlank72.h5", paste0("MM/", input$UMAP1_forComparison)) - + p <- h5read(paste0("./",subOutputDir,"/",mat,"_plotBlank72.h5"), paste0(mat, "/", input$EMBED1_forComparison)) temp_jpg <- t(matrix(decode_native(p), nrow = 216)) last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + draw_plot(p_empty, scale = 0.8) + draw_text("Log2(+1)", x = 0.35, y = 0.05, size = 12) - print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) - - - } - - else - { - - - if((input$matrix_UMAP1_forComparison)=="Clusters"){ - - title = "Colored by scATAC-seq clusters" - - } - - if((input$matrix_UMAP1_forComparison)=="Constrained"){ - - title = "UMAP: constrained integration" - - } - - if((input$matrix_UMAP1_forComparison)=="Constrained remap"){ - - title = "UMAP: Constrained remmaped clusters" - - } - - if((input$matrix_UMAP1_forComparison)=="Sample"){ - - title = "Colored by original identity" - - } - - if((input$matrix_UMAP1_forComparison)=="Unconstrained"){ - - title = "UMAP: unconstrained integration" - - } - + print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) + }else{ p_empty <- ggplot() + - xlab("UMAP Dimension 1") + ylab("UMAP Dimension 2") + theme_bw(base_size=10)+ - ggtitle(title) + + xlab("Dimension 1") + ylab("Dimension 2") + theme_bw(base_size=10)+ + ggtitle(input$matrix_EMBED1_forComparison) + theme( panel.background = element_rect(fill='transparent'), #transparent panel bg plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg panel.grid.major = element_blank(), #remove major gridlines panel.grid.minor = element_blank(), #remove minor gridlines legend.background = element_rect(fill='transparent'), #transparent legend bg - legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), + legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), plot.title = element_text(size=16) ) emptyPlot(0,0, axes=FALSE) - if((input$matrix_UMAP1_forComparison)=="Clusters"){ - - legend('bottom', legend=umap_legend_names$Clusters, - pch=15, col = color_umaps$Clusters, - horiz = FALSE, x.intersp = 1, text.width=0.35, - cex = 0.7, bty="n", ncol = 4) - - - - } - - if((input$matrix_UMAP1_forComparison)=="Sample"){ - legend('bottom', legend=umap_legend_names$Sample, pch=15, - col = color_umaps$Sample, - horiz = TRUE, x.intersp = 1, text.width=0.6, - cex = 0.7, bty="n") - } - - if((input$matrix_UMAP1_forComparison)=="Constrained"){ - - legend('bottom', legend=umap_legend_names$Constrained, - pch=15, col = color_umaps$Constrained, - horiz = FALSE, x.intersp = 1, text.width=0.35, - cex = 0.5, bty="n", ncol = 5) - - - } - - - if((input$matrix_UMAP1_forComparison)=="Unconstrained"){ - legend('bottom', legend=umap_legend_names$unconstrained, - pch=15, col = color_umaps$unconstrained, - horiz = FALSE, x.intersp = 1, text.width=0.35, - cex = 0.5, bty="n", ncol = 5) - } - - - if((input$matrix_UMAP1_forComparison)=="Constrained remap"){ - legend('bottom', legend=umap_legend_names$`Constrained remap`, - pch=15, col = color_umaps$`Constrained remap`, - horiz = FALSE, x.intersp = 1, text.width=0.35, - cex = 0.7, bty="n", ncol = 4) - } - - if(input$matrix_UMAP1_forComparison == "Unconstrained"){p <- h5read("./inputData/mainUMAPs.h5", "unconstrained")}else{ - p <- h5read("./inputData/mainUMAPs.h5", input$matrix_UMAP1_forComparison) - } + legend('bottom', legend=embed_legend[[1]], + pch=15, col = color_embeddings[[1]], + horiz = FALSE, x.intersp = 1, text.width=0.35, + cex = 0.7, bty="n", ncol = 4) + p <- h5read(paste0("./",subOutputDir,"/mainEmbeds.h5"), input$matrix_EMBED1_forComparison)# input$EMBED1_forComparison)) temp_jpg <- t(matrix(decode_native(p), nrow = 216)) - last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.7) + + last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.7) + draw_plot(p_empty, scale = 0.7) + draw_text("color", x = 0.1, y = 0.135, size = 12) - print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) - - # umaps[input$matrix_UMAP1_forComparison] - - + print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) } - }, height = 450,width=450) + }) - # #plot UMAP2 - output$UMAP_plot_2<- renderPlot({ - if((input$matrix_UMAP2_forComparison)=="Gene Score Matrix") - { - - p_empty <- ggplot() + - xlab("UMAP Dimension 1") + ylab("UMAP Dimension 2") + theme_bw(base_size=10)+ - ggtitle(paste0("UMAP of IterativeLSI colored by \n GeneScoreMatrix: ",input$UMAP2_forComparison)) + - theme( - panel.background = element_rect(fill='transparent'), #transparent panel bg - plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg - panel.grid.major = element_blank(), #remove major gridlines - panel.grid.minor = element_blank(), #remove minor gridlines - legend.background = element_rect(fill='transparent'), #transparent legend bg - legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), plot.title = element_text(size=16) - ) - - emptyPlot(0,0, axes=FALSE) - legend_plot <- gradientLegend(valRange=c(scale()$gsm[,input$UMAP2_forComparison][1],scale()$gsm[,input$UMAP2_forComparison][2]), - color = color()$gsm, pos=.5, side=1) - - p <- h5read("./inputData/plotBlank72.h5", paste0("GSM/", input$UMAP2_forComparison))# input$UMAP1_forComparison)) - temp_jpg <- t(matrix(decode_native(p), nrow = 216)) - - last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + - draw_plot(p_empty, scale = 0.8) + - draw_text("Log2(+1)", x = 0.35, y = 0.05, size = 12) - - print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) - - } + plot2 <- reactive({ - else if((input$matrix_UMAP2_forComparison)=="Gene Integration Matrix") - { - # getUmap(input$UMAP2_forComparison,GSM_Umaps_data_fileIndexer,"GSM_Umaps_data","plot_scaffold_GSM",isolate(input$matrix_UMAP2_forComparison)) - - p_empty <- ggplot() + - xlab("UMAP Dimension 1") + ylab("UMAP Dimension 2") + theme_bw(base_size=10)+ - ggtitle(paste0("UMAP of IterativeLSI colored by \n GeneIntegrationMatrix: ",input$UMAP2_forComparison)) + - theme( - panel.background = element_rect(fill='transparent'), #transparent panel bg - plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg - panel.grid.major = element_blank(), #remove major gridlines - panel.grid.minor = element_blank(), #remove minor gridlines - legend.background = element_rect(fill='transparent'), #transparent legend bg - legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), - plot.title = element_text(size=16) - ) - - emptyPlot(0,0, axes=FALSE) - legend_plot <- gradientLegend(valRange=c(scale()$gim[,input$UMAP2_forComparison][1],scale()$gim[,input$UMAP2_forComparison][2]), - color = color()$gim, pos=.5, side=1) - - p <- h5read("./inputData/plotBlank72.h5", paste0("GIM/", input$UMAP2_forComparison))# input$UMAP1_forComparison)) - temp_jpg <- t(matrix(decode_native(p), nrow = 216)) - - last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + - draw_plot(p_empty, scale = 0.8) + - draw_text("Log2(+1)", x = 0.35, y = 0.05, size = 12) - - print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) - - - } + availableMatrices <- getAvailableMatrices(ArchRProj) - else if((input$matrix_UMAP2_forComparison)=="Motif Matrix") - { - # getUmap(input$UMAP2_forComparison,MM_Umaps_data_fileIndexer,"MM_Umaps_data","plot_scaffold_MM",isolate(input$matrix_UMAP2_forComparison)) + if(input$matrix_EMBED2_forComparison %in% availableMatrices){ + mat <- availableMatrices[ availableMatrices %in% input$matrix_EMBED2_forComparison] p_empty <- ggplot() + - xlab("UMAP Dimension 1") + ylab("UMAP Dimension 2") + theme_bw(base_size=10)+ - ggtitle(paste0("UMAP of IterativeLSI colored by \n MotifMatrix: ",input$UMAP2_forComparison)) + + xlab("Dimension 1") + ylab("Dimension 2") + theme_bw(base_size=10)+ + ggtitle(paste0("EMBED of IterativeLSI colored by \n", mat,": ",input$EMBED2_forComparison)) + theme( panel.background = element_rect(fill='transparent'), #transparent panel bg plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg panel.grid.major = element_blank(), #remove major gridlines panel.grid.minor = element_blank(), #remove minor gridlines legend.background = element_rect(fill='transparent'), #transparent legend bg - legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), + legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), plot.title = element_text(size=16) ) emptyPlot(0,0, axes=FALSE) - legend_plot <- gradientLegend(valRange=c(scale()$mm[,input$UMAP2_forComparison][1],scale()$mm[,input$UMAP2_forComparison][2]), - color = color()$mm, pos=.5, side=1) + legend_plot <- gradientLegend(valRange=c(scale()[[mat]][,input$EMBED2_forComparison][1],scale()[[mat]][,input$EMBED2_forComparison][2]), + color = color()[[mat]], pos=.5, side=1) - p <- h5read("./inputData/plotBlank72.h5", paste0("MM/", input$UMAP2_forComparison))# input$UMAP1_forComparison)) + p <- h5read(paste0("./",subOutputDir,"/",mat,"_plotBlank72.h5"), paste0(mat, "/", input$EMBED2_forComparison)) temp_jpg <- t(matrix(decode_native(p), nrow = 216)) - - last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + draw_plot(p_empty, scale = 0.8) + draw_text("Log2(+1)", x = 0.35, y = 0.05, size = 12) - print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) - - - } - - else - { - # umaps[input$matrix_UMAP2_forComparison] - - - if((input$matrix_UMAP2_forComparison)=="Clusters"){ - - title = "Colored by scATAC-seq clusters" - - } - - if((input$matrix_UMAP2_forComparison)=="Constrained"){ - - title = "UMAP: constrained integration" - - } - - if((input$matrix_UMAP2_forComparison)=="Constrained remap"){ - - title = "UMAP: Constrained remmaped clusters" - - } - - if((input$matrix_UMAP2_forComparison)=="Sample"){ - - title = "Colored by original identity" - - } + print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) + }else{ - if((input$matrix_UMAP2_forComparison)=="Unconstrained"){ - - title = "UMAP: unconstrained integration" - - } p_empty <- ggplot() + - xlab("UMAP Dimension 1") + ylab("UMAP Dimension 2") + theme_bw(base_size=10)+ - ggtitle(title) + + xlab("Dimension 1") + ylab("Dimension 2") + theme_bw(base_size=10)+ + ggtitle(input$matrix_EMBED2_forComparison) + theme( panel.background = element_rect(fill='transparent'), #transparent panel bg plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg panel.grid.major = element_blank(), #remove major gridlines panel.grid.minor = element_blank(), #remove minor gridlines legend.background = element_rect(fill='transparent'), #transparent legend bg - legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), + legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), plot.title = element_text(size=16) ) emptyPlot(0,0, axes=FALSE) - if((input$matrix_UMAP2_forComparison)=="Clusters"){ - - legend('bottom', legend=umap_legend_names$Clusters, - pch=15, col = color_umaps$Clusters, - horiz = FALSE, x.intersp = 1, text.width=0.35, - cex = 0.7, bty="n", ncol = 4) - - - - } - - if((input$matrix_UMAP2_forComparison)=="Sample"){ - legend('bottom', legend=umap_legend_names$Sample, pch=15, - col = color_umaps$Sample, - horiz = TRUE, x.intersp = 1, text.width=0.6, - cex = 0.7, bty="n") - } - - if((input$matrix_UMAP2_forComparison)=="Constrained"){ - - legend('bottom', legend=umap_legend_names$Constrained, - pch=15, col = color_umaps$Constrained, - horiz = FALSE, x.intersp = 1, text.width=0.35, - cex = 0.5, bty="n", ncol = 5) - - - } - - - if((input$matrix_UMAP2_forComparison)=="Unconstrained"){ - legend('bottom', legend=umap_legend_names$unconstrained, - pch=15, col = color_umaps$unconstrained, - horiz = FALSE, x.intersp = 1, text.width=0.35, - cex = 0.5, bty="n", ncol = 5) - } - - - if((input$matrix_UMAP2_forComparison)=="Constrained remap"){ - legend('bottom', legend=umap_legend_names$`Constrained remap`, - pch=15, col = color_umaps$`Constrained remap`, - horiz = FALSE, x.intersp = 1, text.width=0.35, - cex = 0.7, bty="n", ncol = 4) - } - - # p <- h5read("./inputData/mainUMAPs.h5", input$matrix_UMAP2_forComparison) - - if(input$matrix_UMAP2_forComparison == "Unconstrained"){p <- h5read("./inputData/mainUMAPs.h5", "unconstrained")}else{ - p <- h5read("./inputData/mainUMAPs.h5", input$matrix_UMAP2_forComparison) - } + legend('bottom', legend=embed_legend[[1]], + pch=15, col = color_embeddings[[1]], + horiz = FALSE, x.intersp = 1, text.width=0.35, + cex = 0.7, bty="n", ncol = 4) + p <- h5read(paste0("./",subOutputDir,"/mainEmbeds.h5"), input$matrix_EMBED2_forComparison)# input$EMBED2_forComparison)) temp_jpg <- t(matrix(decode_native(p), nrow = 216)) - last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.7) + + last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.7) + draw_plot(p_empty, scale = 0.7) + draw_text("color", x = 0.1, y = 0.135, size = 12) - print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) + print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) } - } ,height = 450,width=450) + }) + + + #Output Handler: Downloads EMBEDS + output$download_EMBED1<-downloadHandler( + filename <- function(){ + paste0("EMBED-",paste(input$matrix_EMBED1_forComparison,input$EMBED1_forComparison,sep="-"),input$plot_choice_download_EMBED1) + }, + content = function(file){ + if(input$plot_choice_download_EMBED1==".pdf") + {pdf(file = file,onefile=FALSE, width = input$EMBED1_plot_width, height = input$EMBED1_plot_height)} + + else if(input$plot_choice_download_EMBED1==".png") + {png(file = file, width = input$EMBED1_plot_width, height = input$EMBED1_plot_height,units="in",res=1000)} + + else + {tiff(file = file, width = input$EMBED1_plot_width, height = input$EMBED1_plot_height,units="in",res=1000)} + + plot1 = plot1() + - #update Umap dropdown based on selected Matrix-------------------------------- + grid.arrange(plot1) + dev.off() + } + ) - #Update dropdown for UMAP1 - observeEvent(input$matrix_UMAP1_forComparison,{ - if(isolate(input$matrix_UMAP1_forComparison)=="Motif Matrix") - { - updateSelectizeInput(session, 'UMAP1_forComparison', label = 'Feature Name', - choices = sort(MM_dropdown), - server = TRUE,selected =sort(MM_dropdown)[1]) + output$download_EMBED2<-downloadHandler( + filename <- function(){ + paste0("EMBED-",paste(input$matrix_EMBED2_forComparison,input$EMBED2_forComparison,sep="-"),input$plot_choice_download_EMBED2) + }, + content = function(file){ + + if(input$plot_choice_download_EMBED2==".pdf") + {pdf(file = file,onefile=FALSE, width = input$EMBED2_plot_width, height = input$EMBED2_plot_height)} + + else if(input$plot_choice_download_EMBED2==".png") + {png(file = file, width = input$EMBED2_plot_width, height = input$EMBED2_plot_height,units="in",res=1000)} + + else + {tiff(file = file, width = input$EMBED2_plot_width, height = input$EMBED2_plot_height,units="in",res=1000)} + + + plot2 <- plot2() + + grid.arrange(plot2) + dev.off() } + ) + + output$EMBED_plot_1 <- DT::renderDT(NULL) + output$EMBED_plot_2 <- DT::renderDT(NULL) + + color <- reactive({readRDS(paste0("./",subOutputDir,"/pal.rds"))}) + scale <- reactive({readRDS(paste0("./",subOutputDir,"/scale.rds"))}) + + #plot EMBED1 + output$EMBED_plot_1<- renderPlot({ - else if(isolate(input$matrix_UMAP1_forComparison)=="Gene Score Matrix") - { - updateSelectizeInput(session, 'UMAP1_forComparison', label = 'Feature Name', - choices = sort(GSM_dropdown), - server = TRUE,selected =sort(GSM_dropdown)[1]) - } - else if(isolate(input$matrix_UMAP1_forComparison)=="Gene Integration Matrix") - { - updateSelectizeInput(session, 'UMAP1_forComparison', label = 'Feature Name', - choices = sort(GIM_dropdown), - server = TRUE,selected =sort(GIM_dropdown)[1]) + plot1() + + }, height = 450,width=450) + + # #plot EMBED2 + output$EMBED_plot_2<- renderPlot({ + + plot2() + + } ,height = 450,width=450) + + #update EMBED dropdown based on selected Matrix-------------------------------- + + #Update dropdown for EMBED1 + featureNames1 <- reactive({ + + if(!(input$matrix_EMBED1_forComparison %in% groupBy)){ + availableMatrices <- getAvailableMatrices(ArchRProj) + matName <- availableMatrices[ availableMatrices %in% input$matrix_EMBED1_forComparison] + featureNames <- h5read(file = paste0(getOutputDirectory(ArchRProj), "/",outputDir, "/", subOutputDir, "/", matName, "_plotBlank72.h5"), + name = matName) + Feature_dropdown1 = names(featureNames) + return(Feature_dropdown1) } }) + + observeEvent(input$matrix_EMBED1_forComparison,{ + + if(!(input$matrix_EMBED1_forComparison %in% groupBy)){ + updateSelectizeInput(session, 'EMBED1_forComparison', label = 'Feature Name', + choices = sort(featureNames1()), + server = TRUE,selected =sort(featureNames1())[1]) + } + }) + + # }) - #Update dropdown for UMAP2 - observeEvent(input$matrix_UMAP2_forComparison,{ - if(isolate(input$matrix_UMAP2_forComparison)=="Motif Matrix") - { - - updateSelectizeInput(session, 'UMAP2_forComparison', label = 'Feature Name', - choices = sort(MM_dropdown), - server = TRUE,selected =sort(MM_dropdown)[2]) - } + + featureNames2 <- reactive({ + + if(!(input$matrix_EMBED2_forComparison %in% groupBy)){ + + availableMatrices <- getAvailableMatrices(ArchRProj) + matName <- availableMatrices[ availableMatrices %in% input$matrix_EMBED2_forComparison] + featureNames <- h5read(file = paste0(getOutputDirectory(ArchRProj), "/",outputDir, "/", subOutputDir, "/", matName, "_plotBlank72.h5"), + name = matName) + + Feature_dropdown2 = names(featureNames) + return(Feature_dropdown2) - else if(isolate(input$matrix_UMAP2_forComparison)=="Gene Score Matrix") - { - updateSelectizeInput(session, 'UMAP2_forComparison', label = 'Feature Name', - choices = sort(GSM_dropdown), - server = TRUE,selected =sort(GSM_dropdown)[2]) - } - else if(isolate(input$matrix_UMAP2_forComparison)=="Gene Integration Matrix") - { - - updateSelectizeInput(session, 'UMAP2_forComparison', label = 'Feature Name', - choices = sort(GIM_dropdown), - server = TRUE,selected =sort(GIM_dropdown)[2]) } - + }) - + + observeEvent(input$matrix_EMBED2_forComparison,{ + if(!(input$matrix_EMBED2_forComparison %in% groupBy)){ + updateSelectizeInput(session, 'EMBED2_forComparison', label = 'Feature Name', + choices = sort(featureNames2()), + server = TRUE,selected =sort(featureNames2())[1]) + } + }) + + #Update dropdown for EMBED2 + # observeEvent(input$matrix_EMBED2_forComparison,{ + # if(isolate(input$matrix_EMBED2_forComparison)=="Motif Matrix") + # { + # + # updateSelectizeInput(session, 'EMBED2_forComparison', label = 'Feature Name', + # choices = sort(MM_dropdown), + # server = TRUE,selected =sort(MM_dropdown)[2]) + # } + # + # else if(isolate(input$matrix_EMBED2_forComparison)=="Gene Score Matrix") + # { + # updateSelectizeInput(session, 'EMBED2_forComparison', label = 'Feature Name', + # choices = sort(GSM_dropdown), + # server = TRUE,selected =sort(GSM_dropdown)[2]) + # } + # else if(isolate(input$matrix_EMBED2_forComparison)=="Gene Integration Matrix") + # { + # + # updateSelectizeInput(session, 'EMBED2_forComparison', label = 'Feature Name', + # choices = sort(GIM_dropdown), + # server = TRUE,selected =sort(GIM_dropdown)[2]) + # } + # + # }) + # Plot Browser ---------------------------------------------------------------- # Observe the inputs for ATAC-Seq Explorer @@ -975,15 +318,14 @@ shinyServer <- function(input,output, session){ else {tiff(file = file, width = input$plot_width, height = input$plot_height,units="in",res=1000)} - - if(isolate(input$browserContent)=="Unconstrained") - { - p_browser_atacClusters<- plotBrowserTrack_Test( + + p_browser_atacClusters<- plotBrowserTrack( ArchRProj = ArchRProj, + # ShinyArchR = ShinyArchR, plotSummary = c("bulkTrack", input$selectPlotSummary), baseSize = 11, facetbaseSize = 11, - groupBy = "Clusters", + groupBy = input$browserContent, geneSymbol = isolate(input$gene_name), upstream = -min(isolate(input$range))*1000, downstream = max(isolate(input$range))*1000, @@ -992,24 +334,7 @@ shinyServer <- function(input,output, session){ loops = getCoAccessibility(ArchRProj) )[[input$gene_name]] - } - else - { - - p_browser_atacClusters <- plotBrowserTrack_Test( - ArchRProj = ArchRProj, - plotSummary = c("bulkTrack", input$selectPlotSummary), - groupBy = "Clusters", - baseSize = 11, - facetbaseSize = 11, - geneSymbol = isolate(input$gene_name), - upstream =-min(isolate(input$range))*1000 , - downstream = max(isolate(input$range))*1000, - tileSize = isolate(input$tile_size), - ylim = c(0, isolate(input$ymax)), - loops = getPeak2GeneLinks(ArchRProj) - )[[input$gene_name]] - } + grid.arrange(p_browser_atacClusters) @@ -1033,15 +358,14 @@ shinyServer <- function(input,output, session){ # Plots scATACSeq clusters output$browser_atacClusters<- renderPlot({ grid::grid.newpage() - - if(isolate(input$browserContent)=="Unconstrained") - { - p_browser_atacClusters<- plotBrowserTrack_Test( + + p_browser_atacClusters<- plotBrowserTrack( ArchRProj = ArchRProj, + # ShinyArchR = ShinyArchR, plotSummary = c("bulkTrack", input$selectPlotSummary), baseSize = 11, facetbaseSize = 11, - groupBy = "Clusters", + groupBy = input$browserContent, geneSymbol = isolate(input$gene_name), upstream = -min(isolate(input$range))*1000, downstream = max(isolate(input$range))*1000, @@ -1050,24 +374,6 @@ shinyServer <- function(input,output, session){ loops = getCoAccessibility(ArchRProj) )[[input$gene_name]] - } - else - { - p_browser_atacClusters <- plotBrowserTrack_Test( - ArchRProj = ArchRProj, - plotSummary = c("bulkTrack", input$selectPlotSummary), - groupBy = "Clusters", - baseSize = 11, - facetbaseSize = 11, - geneSymbol = isolate(input$gene_name), - upstream =-min(isolate(input$range))*1000 , - downstream = max(isolate(input$range))*1000, - tileSize = isolate(input$tile_size), - ylim = c(0, isolate(input$ymax)), - loops = getPeak2GeneLinks(ArchRProj) - )[[input$gene_name]] - } - grid::grid.draw(p_browser_atacClusters) diff --git a/Shiny/ui.R b/Shiny/ui.R index 49b1bbca..973f2eb6 100644 --- a/Shiny/ui.R +++ b/Shiny/ui.R @@ -1,37 +1,38 @@ library(shinybusy) -# This file contain UI widgets. +# This file contains UI widgets. -# Umap plotting ---------------------------------------------------------------------- -umap_panel <- tabPanel(id="umap_panel", +# EMBEDING plotting ---------------------------------------------------------------------- +EMBED_panel <- tabPanel(id="EMBED_panel", titlePanel(h5("scClusters")), sidebarPanel( - titlePanel(h3('UMAP 1', align = 'center')), + titlePanel(h3('EMBEDDING 1', align = 'center')), width = 3, h4(''), hr(style = "border-color: grey"), selectizeInput( - 'matrix_UMAP1_forComparison', - label = 'UMAP type', - choices = c("Clusters","Constrained","Constrained remap","Sample","Unconstrained","Gene Score Matrix","Gene Integration Matrix","Motif Matrix"), - selected ="Clusters" + 'matrix_EMBED1_forComparison', + label = 'EMBEDDING type', + choices = c(EMBEDs_dropdown, matrices_dropdown), + selected = NULL ), - conditionalPanel(condition = "input.matrix_UMAP1_forComparison=='Gene Score Matrix' ||input.matrix_UMAP1_forComparison=='Gene Integration Matrix' || input.matrix_UMAP1_forComparison=='Motif Matrix'", + conditionalPanel( + condition = '!(input.matrix_EMBED1_forComparison %in% EMBEDs_dropdown)', selectizeInput( - 'UMAP1_forComparison', - label = 'UMAP 1', + 'EMBED1_forComparison', + label = 'EMBEDDING 1', choices = "", selected = NULL )), 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), + numericInput("EMBED1_plot_width", "Width", min = 0, max = 250, value = 8), + numericInput("EMBED1_plot_height", "Height", min = 0, max = 250, value = 12), selectizeInput( - 'plot_choice_download_UMAP1', + 'plot_choice_download_EMBED1', label = "Format", choices = c(".pdf",".png",".tiff"), selected = ".pdf"), @@ -40,31 +41,31 @@ umap_panel <- tabPanel(id="umap_panel", overflow: visible;}"))) ), - downloadButton(outputId = "download_UMAP1", label = "Download UMAP 1"), + downloadButton(outputId = "download_EMBED1", label = "Download EMBEDDING 1"), - titlePanel(h3('UMAP 2', align = 'center')), + titlePanel(h3('EMBEDDING 2', align = 'center')), hr(style = "border-color: grey"), selectizeInput( - 'matrix_UMAP2_forComparison', - label = 'UMAP type', - choices = c("Clusters","Constrained","Constrained remap","Sample","Unconstrained","Gene Score Matrix","Gene Integration Matrix","Motif Matrix"), - selected ="Clusters" + 'matrix_EMBED2_forComparison', + label = 'EMBEDDING type', + choices = c(EMBEDs_dropdown, matrices_dropdown), + selected =NULL ), - conditionalPanel(condition = "input.matrix_UMAP2_forComparison=='Gene Score Matrix' ||input.matrix_UMAP2_forComparison=='Gene Integration Matrix' || input.matrix_UMAP2_forComparison=='Motif Matrix'", + conditionalPanel(condition = '!(input.matrix_EMBED2_forComparison %in% EMBEDs_dropdown)', selectizeInput( - 'UMAP2_forComparison', - label = 'UMAP 2', + 'EMBED2_forComparison', + label = 'EMBEDDING 2', choices ="", selected = NULL )), 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), + numericInput("EMBED2_plot_width", "Width", min = 0, max = 250, value = 8), + numericInput("EMBED2_plot_height", "Height", min = 0, max = 250, value = 12), selectizeInput( - 'plot_choice_download_UMAP2', + 'plot_choice_download_EMBED2', label = "Format", choices = c(".pdf",".png",".tiff"), selected = ".pdf"), @@ -72,20 +73,21 @@ umap_panel <- tabPanel(id="umap_panel", .shiny-split-layout > div { overflow: visible;}"))) ), - downloadButton(outputId = "download_UMAP2", label = "Download UMAP 2"), + downloadButton(outputId = "download_EMBED2", label = "Download EMBEDDING 2"), ), mainPanel( + verbatimTextOutput("feat"), verbatimTextOutput("text"), - fluidRow(h5("Dimension Reduction scClusters UMAPs" + fluidRow(h5("Dimension Reduction scClusters EMBEDs" )), - fluidRow(helpText("Users can view and compare side-by-side UMAPs' representing identified scATAC-seq clusters, + fluidRow(helpText("Users can view and compare side-by-side EMBEDs' 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("EMBED_plot_1")), ##%>% withSpinner(color="#0dc5c1") + column(6,plotOutput("EMBED_plot_2")) ) ) ) @@ -113,8 +115,8 @@ scATACbrowser_panel <- tabPanel( selectizeInput( 'browserContent', label = 'Type', - choices = c("Unconstrained","Constrained"), - selected = "Unconstrained" + choices = EMBEDs_dropdown, + selected = EMBEDs_dropdown[1] ), selectizeInput( @@ -162,7 +164,7 @@ ui <- shinyUI(fluidPage( add_busy_spinner(spin = "radar", color = "#CCCCCC", onstart = TRUE, height = "55px", width = "55px"), navbarPage( - umap_panel, + EMBED_panel, scATACbrowser_panel, title ="ShinyArchR Export", tags$head(tags$style(".shiny-output-error{color: grey;}")) From f5110b85c1c6149394a5469f78426cc79a6e3ce8 Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Thu, 5 Jan 2023 16:15:41 +0300 Subject: [PATCH 052/162] fixed a minor issue --- R/matrixEmbeds.R | 92 +++++++++++++++++++++++++----------------------- 1 file changed, 47 insertions(+), 45 deletions(-) diff --git a/R/matrixEmbeds.R b/R/matrixEmbeds.R index dd087704..f38822dc 100644 --- a/R/matrixEmbeds.R +++ b/R/matrixEmbeds.R @@ -40,7 +40,7 @@ matrixEmbeds <- function( for(shinymatrices in shinyMatrices){ - # shinymatrices = shinyMatrices[2] + # shinymatrices = shinyMatrices[3] print(shinymatrices) matrixName = paste0(shinymatrices,"_names") @@ -55,47 +55,55 @@ matrixEmbeds <- function( print(paste0("Creating plots for ",shinymatrices,": ",x,": ",round((x/length(geneMatrixNames))*100,3), "%")) - gene_plot <- plotEmbedding( - ArchRProj = ArchRProj, - colorBy = shinymatrices, - name = geneMatrixNames[x], - embedding = embedding, - quantCut = c(0.01, 0.95), - imputeWeights = getImputeWeights(ArchRProj = ArchRProj), - plotAs = "points", - matrices = matrices, - imputeMatricesList = imputeMatricesList, - rastr = TRUE - ) + if(!is.na(matrices[[shinymatrices]][x])){ + + gene_plot <- plotEmbedding( + ArchRProj = ArchRProj, + colorBy = shinymatrices, + name = geneMatrixNames[x], + embedding = embedding, + quantCut = c(0.01, 0.95), + imputeWeights = getImputeWeights(ArchRProj = ArchRProj), + plotAs = "points", + matrices = matrices, + imputeMatricesList = imputeMatricesList, + rastr = TRUE + ) + }else{ - if(!is.null(gene_plot)){ - - gene_plot_blank <- gene_plot + theme(axis.title.x = element_blank()) + - theme(axis.title.y = element_blank()) + - theme(axis.title = element_blank()) + - theme(legend.position = "none") + - theme( - panel.grid.major = element_blank(), - panel.grid.minor = element_blank(), - panel.border = element_blank(), - title=element_blank() - ) - - #save plot without axes etc as a jpg. - ggsave(filename = file.path(outputDirEmbeds, paste0(shinymatrices,"_embeds"), paste0(geneMatrixNames[x],"_blank72.jpg")), - plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) - - #read back in that jpg because we need vector in native format - blank_jpg72 <- readJPEG(source = file.path(outputDirEmbeds, paste0(shinymatrices,"_embeds"), - paste0(geneMatrixNames[x],"_blank72.jpg")), native = TRUE) - - g <- ggplot_build(gene_plot) + gene_plot = NULL + } - res = list(list(plot=as.vector(blank_jpg72), min = round(min(gene_plot$data$color),1), - max = round(max(gene_plot$data$color),1), pal = unique(g$data[[1]][,"colour"]))) + if(!is.null(gene_plot)){ + + gene_plot_blank <- gene_plot + theme(axis.title.x = element_blank()) + + theme(axis.title.y = element_blank()) + + theme(axis.title = element_blank()) + + theme(legend.position = "none") + + theme( + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.border = element_blank(), + title=element_blank() + ) + + #save plot without axes etc as a jpg. + ggsave(filename = file.path(outputDirEmbeds, paste0(shinymatrices,"_embeds"), paste0(geneMatrixNames[x],"_blank72.jpg")), + plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) + + #read back in that jpg because we need vector in native format + blank_jpg72 <- readJPEG(source = file.path(outputDirEmbeds, paste0(shinymatrices,"_embeds"), + paste0(geneMatrixNames[x],"_blank72.jpg")), native = TRUE) + + g <- ggplot_build(gene_plot) + + res = list(list(plot=as.vector(blank_jpg72), min = round(min(gene_plot$data$color),1), + max = round(max(gene_plot$data$color),1), pal = unique(g$data[[1]][,"colour"]))) + + return(res) + } - return(res) - } + }, threads = threads) names(embeds_points) <- geneMatrixNames @@ -113,10 +121,8 @@ matrixEmbeds <- function( for(i in 1:length(embeds_points)){ print(paste0("Getting H5 files for embeds_points: ",i,": ",round((i/length(embeds_points))*100,3), "%")) - h5createDataset(file = points, dataset = paste0(shinymatrices,"/",geneMatrixNames[i]), dims = c(46656,1), storage.mode = "integer") h5writeDataset(obj = embeds_points[[i]][[1]]$plot, h5loc = points, name=paste0(shinymatrices,"/",geneMatrixNames[i])) - embeds_min_max[1,i] = embeds_points[[i]][[1]]$min embeds_min_max[2,i] = embeds_points[[i]][[1]]$max @@ -148,9 +154,5 @@ matrixEmbeds <- function( saveRDS(scale, file.path(outputDirEmbeds, "scale.rds")) saveRDS(pal, file.path(outputDirEmbeds, "pal.rds")) - # if(exists("embeds_points")){ rm(embeds_points) } - # if(exists("GIM_embeds_points")){ rm(GIM_embeds_points) } - # if(exists("MM_embeds_points")){ rm(MM_embeds_points) } - } From 93a8a7e4e0009ea831c6fb0e94466771322dbe5c Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Thu, 5 Jan 2023 11:28:22 -0800 Subject: [PATCH 053/162] update shiny variable name and desc --- R/AllClasses.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/AllClasses.R b/R/AllClasses.R index a78e7e07..1204d108 100644 --- a/R/AllClasses.R +++ b/R/AllClasses.R @@ -379,8 +379,8 @@ recoverArchRProject <- function(ArchRProj){ #' background peaks) should be ignored when re-normalizing file paths. If set to `FALSE` loading of the `ArchRProject` #' will fail unless all components can be found. #' @param showLogo A boolean value indicating whether to show the ascii ArchR logo after successful creation of an `ArchRProject`. -#' @param Shiny A boolean value indicating whether an ArchR project will be used for deploying on Shiny Apps. `TRUE` if the project -#' won't have any arrow files. +#' @param shiny A boolean value indicating whether an ArchR project will be used for deploying on Shiny Apps. This option should not really +#' be used by end-users and is only meant to enable loading of a project lacking Arrow Files as part of the ShinyArchR process. #' #' @examples #' @@ -404,13 +404,13 @@ loadArchRProject <- function( path = "./", force = FALSE, showLogo = TRUE - Shiny = FALSE + shiny = FALSE ){ .validInput(input = path, name = "path", valid = "character") .validInput(input = force, name = "force", valid = "boolean") .validInput(input = showLogo, name = "showLogo", valid = "boolean") - .validInput(input = Shiny, name = "Shiny", valid = "boolean") + .validInput(input = shiny, name = "shiny", valid = "boolean") path2Proj <- file.path(path, "Save-ArchR-Project.rds") if(!file.exists(path2Proj)){ @@ -421,7 +421,7 @@ loadArchRProject <- function( outputDir <- getOutputDirectory(ArchRProj) outputDirNew <- normalizePath(path) -if (Shiny == FALSE) { +if (!shiny) { #1. Arrows Paths ArrowFilesNew <- file.path(outputDirNew, "ArrowFiles", basename(ArchRProj@sampleColData$ArrowFiles)) if(!all(file.exists(ArrowFilesNew))){ From 4b58f4451682b54c39873e188176b8a438353338 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Thu, 5 Jan 2023 11:34:28 -0800 Subject: [PATCH 054/162] fix incorrect conflict resolution some conflict seems to have been improperly resolved and caused removal of the #4 Group Coverages section that I recently added. --- R/AllClasses.R | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/R/AllClasses.R b/R/AllClasses.R index 1204d108..1f9752bc 100644 --- a/R/AllClasses.R +++ b/R/AllClasses.R @@ -504,9 +504,21 @@ if (!shiny) { } } -} - #4. Set Output Directory + #4. Group Coverages + + #update paths for group coverage files in project metadata + if(length(ArchRProj@projectMetadata$GroupCoverages) > 0) { + groupC <- length(ArchRProj@projectMetadata$GroupCoverages) + for(z in seq_len(groupC)){ + zdata <- ArchRProj@projectMetadata$GroupCoverages[[z]]$coverageMetadata + zfiles <- gsub(outputDir, outputDirNew, zdata$File) + ArchRProj@projectMetadata$GroupCoverages[[z]]$coverageMetadata$File <- zfiles + stopifnot(all(file.exists(zfiles))) + } + } + #5. Set Output Directory + ArchRProj@projectMetadata$outputDirectory <- outputDirNew message("Successfully loaded ArchRProject!") From 0ff7fd5c193dc45f6d08f92326f17432deb44f55 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Thu, 5 Jan 2023 11:53:33 -0800 Subject: [PATCH 055/162] bugfix in example --- R/GroupExport.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/GroupExport.R b/R/GroupExport.R index 77ffa1d4..77a3c62a 100644 --- a/R/GroupExport.R +++ b/R/GroupExport.R @@ -582,7 +582,7 @@ getGroupFragments <- function( #' proj <- getTestProject() #' #' # Create directory for fragments -#' getGroupFragmentsFromProj(proj, groupBy = "Clusters", outDir = "./Shiny/Fragments") +#' ArchR:::.getGroupFragmentsFromProj(proj, groupBy = "Clusters", outDir = "./Shiny/Fragments") #' .getGroupFragsFromProj <- function(ArchRProj = NULL, groupBy = NULL, From 88c2be10b6cfdf91ed2f6c03f602471749b73be1 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Thu, 5 Jan 2023 12:01:19 -0800 Subject: [PATCH 056/162] change default outDir I dont think the default should mention "Shiny" --- R/GroupExport.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/GroupExport.R b/R/GroupExport.R index 77a3c62a..74092875 100644 --- a/R/GroupExport.R +++ b/R/GroupExport.R @@ -586,7 +586,7 @@ getGroupFragments <- function( #' .getGroupFragsFromProj <- function(ArchRProj = NULL, groupBy = NULL, - outDir = file.path("Shiny", "fragments")) { + outDir = file.path(getOutputDirectory(ArchRProj), "fragments")) { dir.create(outDir, showWarnings = FALSE) # find barcodes of cells in that groupBy. @@ -630,7 +630,7 @@ getGroupFragments <- function( tileSize = 100, scaleFactor = 1, groupBy = "Clusters", - outDir = file.path(getOutputDirectory(ArchRProj), "Shiny", "coverage")) { + outDir = file.path(getOutputDirectory(ArchRProj), "coverage")) { fragFiles = list.files(path = file.path(getOutputDirectory(ArchRProj), "Shiny", "fragments"), full.names = TRUE) dir.create(outDir, showWarnings = FALSE) From 9499c5be4693188b781e781aaebb6a6534f1802d Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Thu, 5 Jan 2023 12:10:29 -0800 Subject: [PATCH 057/162] fix fragDir and frag file extension fragFiles cannot be hardcoded to search in a specific directory --- R/GroupExport.R | 31 ++++++++++++++++++++----------- 1 file changed, 20 insertions(+), 11 deletions(-) diff --git a/R/GroupExport.R b/R/GroupExport.R index 74092875..bf5e1ef6 100644 --- a/R/GroupExport.R +++ b/R/GroupExport.R @@ -584,9 +584,11 @@ getGroupFragments <- function( #' # Create directory for fragments #' ArchR:::.getGroupFragmentsFromProj(proj, groupBy = "Clusters", outDir = "./Shiny/Fragments") #' -.getGroupFragsFromProj <- function(ArchRProj = NULL, - groupBy = NULL, - outDir = file.path(getOutputDirectory(ArchRProj), "fragments")) { +.getGroupFragsFromProj <- function( + ArchRProj = NULL, + groupBy = NULL, + outDir = file.path(getOutputDirectory(ArchRProj), "fragments") +){ dir.create(outDir, showWarnings = FALSE) # find barcodes of cells in that groupBy. @@ -608,7 +610,7 @@ getGroupFragments <- function( # filter Fragments fragments <- GenomeInfoDb::keepStandardChromosomes(fragments, pruning.mode = "coarse") - saveRDS(fragments, file.path(outDir, paste0(groupIDs[x], "_cvg.rds"))) + saveRDS(fragments, file.path(outDir, paste0(groupIDs[x], "_frags.rds"))) } } @@ -624,14 +626,21 @@ getGroupFragments <- function( #' @param groupBy A string that indicates how cells should be grouped. This string corresponds to one of the standard or #' user-supplied `cellColData` metadata columns (for example, "Clusters"). Cells with the same value annotated in this metadata #' column will be grouped together and the average signal will be plotted. -#' @param outDir the directory to output the group fragment files. +#' @param fragDir The path to the directory containing fragment files. +#' @param outDir The path to the desired output directory for storage of coverage files. #' -.getClusterCoverage <- function(ArchRProj = NULL, - tileSize = 100, - scaleFactor = 1, - groupBy = "Clusters", - outDir = file.path(getOutputDirectory(ArchRProj), "coverage")) { - fragFiles = list.files(path = file.path(getOutputDirectory(ArchRProj), "Shiny", "fragments"), full.names = TRUE) +.getClusterCoverage <- function( + ArchRProj = NULL, + tileSize = 100, + scaleFactor = 1, + groupBy = "Clusters", + fragDir = file.path(getOutputDirectory(ArchRProj), "fragments")) + outDir = file.path(getOutputDirectory(ArchRProj), "coverage") +){ + fragFiles = list.files(path = fragDir, pattern = "_frags.rds", full.names = TRUE) + if(length(fragFiles) < 1){ + stop(paste0("No fragment files found in fragDir - ", fragDir)) + } dir.create(outDir, showWarnings = FALSE) # find barcodes of cells in that groupBy. From 6132875eaca42f8198b637e3fe2e783a9163a545 Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Wed, 11 Jan 2023 11:12:51 -0600 Subject: [PATCH 058/162] cleaning up --- R/exportShinyArchR.R | 47 ++++++++++++++++++++------------------------ 1 file changed, 21 insertions(+), 26 deletions(-) diff --git a/R/exportShinyArchR.R b/R/exportShinyArchR.R index c5f7ed4c..8ec7f93e 100644 --- a/R/exportShinyArchR.R +++ b/R/exportShinyArchR.R @@ -29,14 +29,15 @@ exportShinyArchR <- function( .validInput(input = tileSize, name = "tileSize", valid = c("integer")) .validInput(input = threads, name = "threads", valid = c("integer")) .validInput(input = logFile, name = "logFile", valid = c("character")) - + .startLogging(logFile=logFile) .logThis(mget(names(formals()),sys.frame(sys.nframe())), "exportShinyArchR Input-Parameters", logFile = logFile) .requirePackage("shiny", installInfo = 'install.packages("shiny")') .requirePackage("rhandsontable", installInfo = 'install.packages("rhandsontable")') - + mainDir <- getOutputDirectory(ArchRProj) + allMatrices <- getAvailableMatrices(ArchRProj) matrices <- list() imputeMatricesList <- list() @@ -81,19 +82,16 @@ exportShinyArchR <- function( message(allmatrices, " is NULL.") } } - - saveRDS(matrices,paste0("./", outputDir, "/", subOutputDir,"/matrices.rds")) - saveRDS(imputeMatricesList,paste0("./", outputDir, "/", subOutputDir,"/imputeMatricesList.rds")) + saveRDS(matrices, paste0(file.path(mainDir, outputDir, subOutputDir, "matrices.rds"))) + saveRDS(imputeMatricesList, paste0(file.path(mainDir, outputDir, subOutputDir, "/imputeMatricesList.rds"))) }else{ message("matrices and imputeMatricesList already exist. reading from local files...") - matrices <- readRDS(paste0(outputDir, "/", subOutputDir,"/matrices.rds")) - imputeMatricesList <- readRDS(paste0(outputDir, "/", subOutputDir,"/imputeMatricesList.rds")) + matrices <- readRDS(file.path(mainDir, outputDir, subOutputDir, "matrices.rds")) + imputeMatricesList <- readRDS(file.path(mainDir, outputDir, subOutputDir, "/imputeMatricesList.rds")) } - - if(is.null(groupBy)){ stop("groupBy must be provided") } else if(groupBy %ni% colnames(getCellColData(ArchRProj))){ @@ -101,6 +99,7 @@ exportShinyArchR <- function( }else{ print(paste0("groupBy:", groupBy)) } + # Check that the embedding exists in ArchRProj@embeddings if(embedding %ni% names(ArchRProj@embeddings)){ stop("embedding doesn't exist in ArchRProj@embeddings") @@ -111,7 +110,7 @@ exportShinyArchR <- function( # Make directory for Shiny App if(!dir.exists(outputDir)) { - dir.create(outputDir) + dir.create(file.path(mainDir, outputDir), showWarnings = TRUE) ## Check the links for the files filesUrl <- data.frame( @@ -129,20 +128,20 @@ exportShinyArchR <- function( stringsAsFactors = FALSE ) - .downloadFiles(filesUrl = filesUrl, pathDownload = outputDir, threads = threads) + .downloadFiles(filesUrl = filesUrl, pathDownload = file.path(mainDir, outputDir), threads = threads) }else{ message("Using existing Shiny files...") } - # Create a copy of the ArchRProj object + # Create a copy of the ArchRProj ArchRProjShiny <- ArchRProj + # Add metadata to ArchRProjShiny if (groupBy %ni% colnames(ArchRProjShiny@cellColData)) { stop("groupBy is not part of cellColData") } else if ((any(is.na(paste0("ArchRProj$", groupBy))))) { - stop("Some entries in the column indicated by groupBy have NA values. - This is not allowed. Please subset your project using subsetArchRProject() to only contain cells with values for groupBy") + stop("Some entries in the column indicated by groupBy have NA values. Please subset your project using subsetArchRProject() to only contain cells with values for groupBy") } else { ArchRProjShiny@projectMetadata[["groupBy"]] <- groupBy } @@ -153,10 +152,8 @@ exportShinyArchR <- function( "values" }) ArchRProjShiny@projectMetadata[["units"]] <- units - - # The following gives error: Error in file.copy(oldPath, outputDirectory, recursive = TRUE, overwrite = overwrite) : - # attempt to copy a directory to itself (That is why I commented it out) - # ArchrProjShiny <- saveArchRProject(ArchRProj = ArchRProjShiny, outputDirectory = "Save-ArchRProjShiny", dropCells = TRUE, overwrite = TRUE) + ArchrProjShiny <- saveArchRProject(ArchRProj = ArchRProjShiny, outputDirectory = + file.path(mainDir, outputDir, "Save-ArchRProjShiny"), dropCells = TRUE, overwrite = TRUE) # Create fragment files if(length(list.files(file.path(outputDir, "fragments"))) == 0){ @@ -169,23 +166,21 @@ exportShinyArchR <- function( if(length(list.files(file.path(outputDir, "coverage"))) == 0){ .getClusterCoverage(ArchRProj = ArchRProj, tileSize = tileSize, groupBy = groupBy, outDir = file.path(outputDir, "coverage")) }else{ - message("Coverage files already exist...") - } - dir.create(file.path(getOutputDirectory(ArchRProj), outputDir, subOutputDir), showWarnings = TRUE) - + # Create directory to save everything that will be preprocessed + dir.create(file.path(mainDir, outputDir, subOutputDir), showWarnings = TRUE) - if(!file.exists(file.path(getOutputDirectory(ArchRProj), outputDir, subOutputDir, "features.rds"))){ + if(!file.exists(file.path(mainDir, outputDir, subOutputDir, "features.rds"))){ gene_names <- getFeatures(ArchRProj = ArchRProj) - saveRDS(gene_names, paste0("./", outputDir, "/", subOutputDir,"/features.rds")) + saveRDS(gene_names, file.path(mainDir, outputDir, subOutputDir, "features.rds")) }else{ message("gene_names already exists...") - gene_names <- readRDS(paste0("./", outputDir, "/", subOutputDir,"/features.rds")) + gene_names <- readRDS(file.path(mainDir, outputDir, subOutputDir, "features.rds")) } - if(!file.exists(paste0("./", outputDir, "/", subOutputDir,"/embeddingMaps.rds"))){ + if(!file.exists(file.path(mainDir, outputDir, subOutputDir, "/embeddingMaps.rds"))){ embeddingMaps <- list() embedNames <- colnames(ArchRProjShiny@cellColData)[][colnames(ArchRProjShiny@cellColData) %in% groupBy] From 1f9e56ae37d2843c535cbe99382886c51b5fee17 Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Wed, 11 Jan 2023 22:02:05 -0600 Subject: [PATCH 059/162] clean up --- R/MainEmbed.R | 10 +++--- R/VisualizeData.R | 8 +---- R/exportShinyArchR.R | 74 +++++++++---------------------------------- R/matrixEmbeds.R | 1 - docs/.DS_Store | Bin 10244 -> 10244 bytes man/.DS_Store | Bin 6148 -> 6148 bytes 6 files changed, 20 insertions(+), 73 deletions(-) diff --git a/R/MainEmbed.R b/R/MainEmbed.R index 1c4f644b..749ef773 100644 --- a/R/MainEmbed.R +++ b/R/MainEmbed.R @@ -44,10 +44,10 @@ mainEmbed <- function( .startLogging(logFile=logFile) .logThis(mget(names(formals()),sys.frame(sys.nframe())), "exportShinyArchR Input-Parameters", logFile = logFile) -# check to see if the matrix exists using getAvailableMatrices() +# check to see if the matrix exists using getAvailableMatrices() ---- This is done in exportShinyArchR() # Check if colorBy is cellColData or Matrix (e.g. GSM, GIM, or MM) -# Check if embedding exists in ArchRProj@embeddings -# Check all names exist +# Check if embedding exists in ArchRProj@embeddings ---- This is done in exportShinyArchR() +# Check all names exist --- DONE if(!file.exists(file.path(outDirEmbed, "embeds.rds"))){ @@ -78,14 +78,12 @@ mainEmbed <- function( imputeWeights = NULL, matrices = matrices, imputeMatricesList = imputeMatricesList, - Shiny = ShinyArchR + Shiny = TRUE )+ggtitle(paste0("Colored by ", name))+theme(text = element_text(size=12), legend.title = element_text(size = 12),legend.text = element_text(size = 6)) }, error = function(x){ print(x) }) - - return(named_embed) }) diff --git a/R/VisualizeData.R b/R/VisualizeData.R index 54438eda..3524ff76 100644 --- a/R/VisualizeData.R +++ b/R/VisualizeData.R @@ -210,9 +210,7 @@ plotPDF <- function( #' @param baseSize The base font size to use in the plot. #' @param plotAs A string that indicates whether points ("points") should be plotted or a hexplot ("hex") should be plotted. By default #' if `colorBy` is numeric, then `plotAs` is set to "hex". -#' @param Shiny A boolean value that tells the function is calling for Shiny or not. -#' @param matrices A list that contains color matrices for genes. -#' @param imputeMatricesList A list that contains color matrices for genes after imputation. +#' @param Shiny A boolean value that tells the function is calling for Shiny or not. #' @param threads The number of threads to be used for parallel computing. #' @param logFile The path to a file to be used for logging ArchR output. #' @param ... Additional parameters to pass to `ggPoint()` or `ggHex()`. @@ -249,8 +247,6 @@ plotEmbedding <- function( baseSize = 10, plotAs = NULL, Shiny = FALSE, - matrices = NULL, - imputeMatricesList = NULL, threads = getArchRThreads(), logFile = createLogFile("plotEmbedding"), ... @@ -275,8 +271,6 @@ plotEmbedding <- function( .validInput(input = baseSize, name = "baseSize", valid = c("numeric")) .validInput(input = plotAs, name = "plotAs", valid = c("character", "null")) .validInput(input = Shiny, name = "Shiny", valid = c("boolean")) - .validInput(input = matrices, name = "matrices", valid = c("list")) - .validInput(input = imputeMatricesList, name = "imputeMatricesList", valid = c("list")) .validInput(input = threads, name = "threads", valid = c("integer")) .validInput(input = logFile, name = "logFile", valid = c("character")) diff --git a/R/exportShinyArchR.R b/R/exportShinyArchR.R index 8ec7f93e..4caa4de8 100644 --- a/R/exportShinyArchR.R +++ b/R/exportShinyArchR.R @@ -49,10 +49,10 @@ exportShinyArchR <- function( print(allmatrices) name <- paste0(allmatrices, "_names") result = assign(name, getFeatures(ArchRProj = ArchRProj, useMatrix = allmatrices)) - saveRDS(result, paste0("./", outputDir, "/", subOutputDir, "/", allmatrices,"_names.rds")) + saveRDS(result, file.path(outputDir, subOutputDir, allmatrices, "_names.rds")) if(!is.null(result)){ - # nameColor <- paste0("colorMat", allmatrices) + matrix = Matrix(.getMatrixValues( ArchRProj = ArchRProj, name = result, @@ -63,13 +63,11 @@ exportShinyArchR <- function( matrices[[allmatrices]] = matrix matList = matrix[,rownames(df), drop=FALSE] - - # assign(nameColor, matList) .logThis(matList, paste0(allmatrices,"-Before-Impute"), logFile = logFile) + if(getArchRVerbose()) message("Imputing Matrix") colorImputeMat <- imputeMatrix(mat = as.matrix(matList), imputeWeights = imputeWeights, logFile = logFile) - # assign(paste0(nameColor, "_Impute"), imputeMat) if(!inherits(colorImputeMat, "matrix")){ colorImputeMat <- matrix(colorImputeMat, ncol = nrow(df)) @@ -82,8 +80,8 @@ exportShinyArchR <- function( message(allmatrices, " is NULL.") } } - saveRDS(matrices, paste0(file.path(mainDir, outputDir, subOutputDir, "matrices.rds"))) - saveRDS(imputeMatricesList, paste0(file.path(mainDir, outputDir, subOutputDir, "/imputeMatricesList.rds"))) + saveRDS(matrices, file.path(outputDir, subOutputDir, "matrices.rds")) + saveRDS(imputeMatricesList, file.path(outputDir, subOutputDir, "imputeMatricesList.rds")) }else{ message("matrices and imputeMatricesList already exist. reading from local files...") @@ -163,8 +161,8 @@ exportShinyArchR <- function( } # Create coverage objects - if(length(list.files(file.path(outputDir, "coverage"))) == 0){ - .getClusterCoverage(ArchRProj = ArchRProj, tileSize = tileSize, groupBy = groupBy, outDir = file.path(outputDir, "coverage")) + if(length(list.files(file.path(mainDir, outputDir, "coverage"))) == 0){ + .getClusterCoverage(ArchRProj = ArchRProj, tileSize = tileSize, groupBy = groupBy, outDir = file.path(mainDir, outputDir, "coverage")) }else{ message("Coverage files already exist...") } @@ -179,67 +177,26 @@ exportShinyArchR <- function( message("gene_names already exists...") gene_names <- readRDS(file.path(mainDir, outputDir, subOutputDir, "features.rds")) } - - if(!file.exists(file.path(mainDir, outputDir, subOutputDir, "/embeddingMaps.rds"))){ - embeddingMaps <- list() - embedNames <- colnames(ArchRProjShiny@cellColData)[][colnames(ArchRProjShiny@cellColData) %in% groupBy] - - embeddingMaps <- .safelapply(1:length(embedNames), function(x){ - print(embedNames[x]) - tryCatch({ - embed <- plotEmbedding( - ArchRProj = ArchRProjShiny, - baseSize=12, - colorBy = "cellColData", - name = embedNames[x], - embedding = embedding, - rastr = FALSE, - size=0.5, - matrices = matrices, - imputeMatricesList = imputeMatricesList, - )+ggtitle("Colored by scATAC-seq clusters")+theme(text=element_text(size=12), - legend.title = element_text(size = 12),legend.text = element_text(size = 6)) - - embeddingMaps[[embedNames[[x]]]] <- embed - }, - error = function(e){ - print(e) - }) - }) - - saveRDS(embeddingMaps, paste0("./", outputDir, "/", subOutputDir,"/embeddingMaps.rds")) - - - }else{ - message("embeddingMaps already exists...") - embeddingMaps <- readRDS(paste0(outputDir, "/", subOutputDir,"/embeddingMaps.rds")) - } - -# Create an HDF5 containing the nativeRaster vectors for the main matrices -if (!file.exists(file.path(outputDir, subOutputDir, "mainEmbeds.h5"))) { - +# mainEmbed will create an HDF5 containing the nativeRaster vectors for the main matrices +if (!file.exists(file.path(mainDir, outputDir, subOutputDir, "mainEmbeds.h5"))) { if(groupBy %in% colnames(ArchRProjShiny@cellColData)){ - mainEmbed(ArchRProj = ArchRProj, - outDirEmbed = file.path(outputDir, subOutputDir), + outDirEmbed = file.path(mainDir, outputDir, subOutputDir), + colorBy = "cellColData", names = groupBy, matrices = matrices, imputeMatricesList = imputeMatricesList, - Shiny = ShinyArchR + Shiny = TRUE ) }else{ - message(groupBy, "is not defined in ArchRProj...") - } - } else{ - message("H5 for main embeds already exists...") + message("H5 for main embeddings already exists...") } - -if(!file.exists(paste0("./", outputDir, "/", subOutputDir,"/plotBlank72.h5"))){ +if(!file.exists(file.path(outputDir, subOutputDir, "plotBlank72.h5"))){ matrixEmbeds( ArchRProj = ArchRProj, @@ -263,10 +220,9 @@ unlink("./ArchRLogs", recursive = TRUE) ## ready to launch --------------------------------------------------------------- message("App created! To launch, - ArchRProj <- loadArchRProject('",getOutputDirectory(ArchRProj),"') and + ArchRProj <- loadArchRProject('", mainDir,"') and run shiny::runApp('", outputDir, "') from parent directory") # runApp("myappdir") - } diff --git a/R/matrixEmbeds.R b/R/matrixEmbeds.R index f38822dc..403181ca 100644 --- a/R/matrixEmbeds.R +++ b/R/matrixEmbeds.R @@ -155,4 +155,3 @@ matrixEmbeds <- function( saveRDS(pal, file.path(outputDirEmbeds, "pal.rds")) } - diff --git a/docs/.DS_Store b/docs/.DS_Store index c76c5c78d3a3aa7481ae1d0f94e484acb55bfce1..563d15d89d46502ce0d6e61a752911c68db4283a 100644 GIT binary patch delta 128 zcmZn(XbIR5AjZMK(4Z|h?TF)K12M75d172_5P{8gVl8YS_5`+RlR0GNU`!p^HlP*; hb5@X+39=GGDK1Gl`AI+_WMQ$*zhuKW@R;4k2mr$JBB=lX delta 128 zcmZn(XbIR5Aja`)-rMUu7DpT>8;FTb&J*Keg9vP{6Ki2(D|egA#$z#=LskyP)RArD m$iF`iC<@dvK~_R2#U&{xKZ${X0a;jV^Do&j4m@VJF#-Ur-7aMS diff --git a/man/.DS_Store b/man/.DS_Store index c1cc8fd8122674b61fe90df5f64fca2f20a895e8..a9630a4cdd6b992771a3b769f7ca7baea67b4cef 100644 GIT binary patch delta 34 kcmZoMXffEJ!pz3Nz+lcgZE^s!$YeWa9w>Kn0P_|R0EPMom;e9( delta 34 kcmZoMXffEJ!p!!!XFeN`#pD2Hk;!( Date: Thu, 12 Jan 2023 11:26:46 -0600 Subject: [PATCH 060/162] changing imputeMatricesList to imputMatrices --- R/VisualizeData.R | 16 ++++++++++++---- R/matrixEmbeds.R | 13 +++++-------- 2 files changed, 17 insertions(+), 12 deletions(-) diff --git a/R/VisualizeData.R b/R/VisualizeData.R index 3524ff76..b751a95c 100644 --- a/R/VisualizeData.R +++ b/R/VisualizeData.R @@ -247,6 +247,7 @@ plotEmbedding <- function( baseSize = 10, plotAs = NULL, Shiny = FALSE, + embeddingDF = NULL, threads = getArchRThreads(), logFile = createLogFile("plotEmbedding"), ... @@ -283,8 +284,12 @@ plotEmbedding <- function( # Get Embedding ############################## .logMessage("Getting Embedding", logFile = logFile) - df <- getEmbedding(ArchRProj, embedding = embedding, returnDF = TRUE) - + if(Shiny){ + df <- embeddingDF + } else{ + df <- getEmbedding(ArchRProj, embedding = embedding, returnDF = TRUE) + } + if(!all(rownames(df) %in% ArchRProj$cellNames)){ stop("Not all cells in embedding are present in ArchRProject!") } @@ -293,7 +298,7 @@ plotEmbedding <- function( if(!is.null(sampleCells)){ if(sampleCells < nrow(df)){ if(!is.null(imputeWeights)){ - stop("Cannot sampleCells with imputeWeights not equalt to NULL at this time!") + stop("Cannot sampleCells with imputeWeights not equal to NULL at this time!") } df <- df[sort(sample(seq_len(nrow(df)), sampleCells)), , drop = FALSE] } @@ -313,7 +318,7 @@ plotEmbedding <- function( plotParams$size <- size plotParams$randomize <- randomize - #Check if Cells To Be Highlighed + #Check if Cells To Be Highlighted if(!is.null(highlightCells)){ highlightPoints <- match(highlightCells, rownames(df), nomatch = 0) if(any(highlightPoints==0)){ @@ -325,6 +330,9 @@ plotEmbedding <- function( if(length(colorBy) > 1){ stop("colorBy must be of length 1!") } + if(Shiny){ + allColorBy <- matrices$allColorBy + } allColorBy <- .availableArrays(head(getArrowFiles(ArchRProj), 2)) # if(tolower(colorBy) %ni% tolower(allColorBy)){ # stop("colorBy must be one of the following :\n", paste0(allColorBy, sep=", ")) diff --git a/R/matrixEmbeds.R b/R/matrixEmbeds.R index 403181ca..1baed22c 100644 --- a/R/matrixEmbeds.R +++ b/R/matrixEmbeds.R @@ -38,12 +38,9 @@ matrixEmbeds <- function( shinyMatrices <- getAvailableMatrices(ArchRProj) - for(shinymatrices in shinyMatrices){ + for(matrix in shinyMatrices){ - # shinymatrices = shinyMatrices[3] - - print(shinymatrices) - matrixName = paste0(shinymatrices,"_names") + matrixName = paste0(matrix,"_names") if(file.exists(paste0(outputDirEmbeds, "/", matrixName, ".rds"))){ @@ -53,13 +50,13 @@ matrixEmbeds <- function( embeds_points <- .safelapply(1:length(geneMatrixNames), function(x){ - print(paste0("Creating plots for ",shinymatrices,": ",x,": ",round((x/length(geneMatrixNames))*100,3), "%")) + print(paste0("Creating plots for ", matrix,": ",x,": ",round((x/length(geneMatrixNames))*100,3), "%")) - if(!is.na(matrices[[shinymatrices]][x])){ + if(!is.na(matrices[[matrix]][x])){ gene_plot <- plotEmbedding( ArchRProj = ArchRProj, - colorBy = shinymatrices, + colorBy = matrix, name = geneMatrixNames[x], embedding = embedding, quantCut = c(0.01, 0.95), From 67eee172220c75160ffce01548b7a773dc2ff4da Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Thu, 12 Jan 2023 12:46:24 -0600 Subject: [PATCH 061/162] merging plotEmbedding --- R/MainEmbed.R | 21 ++++++--------------- 1 file changed, 6 insertions(+), 15 deletions(-) diff --git a/R/MainEmbed.R b/R/MainEmbed.R index 749ef773..8564e48c 100644 --- a/R/MainEmbed.R +++ b/R/MainEmbed.R @@ -12,7 +12,7 @@ #' is "GeneScoreMatrix" then `name` refers to a gene name which can be listed by `getFeatures(ArchRProj, useMatrix = "GeneScoreMatrix")`. #' @param embedding The embedding to use. Default is "UMAP". #' @param Shiny A boolean value that tells the function is calling for Shiny or not. -#' @param matrices A list that contains color matrices for genes. +#' @param matrices A list that contains color matrices for features. #' @param imputeMatricesList A list that contains color matrices for genes after imputation. #' @param threads The number of threads to use for parallel execution. #' @param logFile The path to a file to be used for logging ArchR output. @@ -44,27 +44,17 @@ mainEmbed <- function( .startLogging(logFile=logFile) .logThis(mget(names(formals()),sys.frame(sys.nframe())), "exportShinyArchR Input-Parameters", logFile = logFile) -# check to see if the matrix exists using getAvailableMatrices() ---- This is done in exportShinyArchR() # Check if colorBy is cellColData or Matrix (e.g. GSM, GIM, or MM) -# Check if embedding exists in ArchRProj@embeddings ---- This is done in exportShinyArchR() -# Check all names exist --- DONE if(!file.exists(file.path(outDirEmbed, "embeds.rds"))){ # check all names exist in ArchRProj - ccd <- getCellColData(ArchRProj) - discreteCols <- lapply(seq_len(ncol(ccd)), function(x){ - .isDiscrete(ccd[, x]) - }) %>% unlist %>% {colnames(ccd)[.]} - if("Clusters" %in% discreteCols){ - selectCols <- "Clusters" - }else{ - selectCols <- "Sample" + if(names %ni% colnames(ArchRProjShiny@cellColData)){ + stop("All columns should be presented in cellColData") } embeds <- .safelapply(1:length(names), function(x){ name <- names[[x]] - print(name) tryCatch({ named_embed <- plotEmbedding( @@ -72,12 +62,14 @@ mainEmbed <- function( baseSize = 12, colorBy = colorBy, name = name, + allNames = names, embedding = embedding, + embeddingDF = df, rastr = FALSE, size = 0.5, imputeWeights = NULL, matrices = matrices, - imputeMatricesList = imputeMatricesList, + imputeMatrices = imputeMatrices, Shiny = TRUE )+ggtitle(paste0("Colored by ", name))+theme(text = element_text(size=12), legend.title = element_text(size = 12),legend.text = element_text(size = 6)) @@ -96,7 +88,6 @@ mainEmbed <- function( } h5closeAll() - points <- H5Fcreate(name = file.path(outDirEmbed, "mainEmbeds.h5")) embed_legend <- list() From 3d283c55d5ad2206bc8647ca9e57d13cf46833d0 Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Thu, 12 Jan 2023 16:22:16 -0600 Subject: [PATCH 062/162] exportShinyArchR --- R/VisualizeData.R | 723 +++------------------------------------------- 1 file changed, 44 insertions(+), 679 deletions(-) diff --git a/R/VisualizeData.R b/R/VisualizeData.R index b751a95c..4917174d 100644 --- a/R/VisualizeData.R +++ b/R/VisualizeData.R @@ -1,172 +1,3 @@ -#################################################################### -# Save Visualization Methods -#################################################################### - -#' Plot PDF in outputDirectory of an ArchRProject -#' -#' This function will save a plot or set of plots as a PDF file in the outputDirectory of a given ArchRProject. -#' -#' @param ... vector of plots to be plotted (if input is a list use plotList instead) -#' @param name The file name to be used for the output PDF file. -#' @param width The width in inches to be used for the output PDF file. -#' @param height The height in inches to be used for the output PDF. -#' @param ArchRProj An `ArchRProject` object to be used for retrieving the desired `outputDirectory` which will be used to store the output -#' plots in a subfolder called "plots". -#' @param addDOC A boolean variable that determines whether to add the date of creation to the end of the PDF file name. This is useful -#' for preventing overwritting of old plots. -#' @param useDingbats A boolean variable that determines wheter to use dingbats characters for plotting points. -#' @param plotList A `list` of plots to be printed to the output PDF file. Each element of `plotList` should be a printable plot formatted -#' object (ggplot2, plot, heatmap, etc). -#' -#' @examples -#' -#' #Get Test Project -#' proj <- getTestProject() -#' -#' #Plot UMAP -#' p <- plotEmbedding(proj, name = "Clusters") -#' -#' #PDF -#' plotPDF(p, name = "UMAP-Clusters", ArchRProj = proj) -#' -#' @export -plotPDF <- function( - ..., - name = "Plot", - width = 6, - height = 6, - ArchRProj = NULL, - addDOC = TRUE, - useDingbats = FALSE, - plotList = NULL -){ - - #Validate - .validInput(input = name, name = "name", valid = "character") - .validInput(input = width, name = "width", valid = "numeric") - .validInput(input = height, name = "height", valid = "numeric") - .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProject", "null")) - .validInput(input = addDOC, name = "addDOC", valid = "boolean") - .validInput(input = useDingbats, name = "useDingbats", valid = "boolean") - .validInput(input = plotList, name = "plotList", valid = c("list","null")) - ######### - - if(is.null(plotList)){ - plotList <- list(...) - plotList2 <- list() - for(i in seq_along(plotList)){ - if(inherits(plotList[[i]], "list")){ - for(j in seq_along(plotList[[i]])){ - plotList2[[length(plotList2) + 1]] <- plotList[[i]][[j]] - } - }else{ - plotList2[[length(plotList2) + 1]] <- plotList[[i]] - } - } - plotList <- plotList2 - rm(plotList2) - gc() - }else{ - plotList2 <- list() - for(i in seq_along(plotList)){ - if(inherits(plotList[[i]], "list")){ - for(j in seq_along(plotList[[i]])){ - plotList2[[length(plotList2) + 1]] <- plotList[[i]][[j]] - } - }else{ - plotList2[[length(plotList2) + 1]] <- plotList[[i]] - } - } - plotList <- plotList2 - rm(plotList2) - gc() - } - - name <- gsub("\\.pdf", "", name) - if(is.null(ArchRProj)){ - outDir <- "Plots" - }else{ - .validInput(input = ArchRProj, name = "ArchRProj", valid = "ArchRProject") - outDir <- file.path(getOutputDirectory(ArchRProj), "Plots") - } - - dir.create(outDir, showWarnings = FALSE) - if(addDOC){ - doc <- gsub(":","-",stringr::str_split(Sys.time(), pattern=" ",simplify=TRUE)[1,2]) - filename <- file.path(outDir, paste0(name, "_Date-", Sys.Date(), "_Time-", doc, ".pdf")) - }else{ - filename <- file.path(outDir, paste0(name, ".pdf")) - } - - o <- suppressWarnings(tryCatch({ - - pdf(filename, width = width, height = height, useDingbats = useDingbats) - for(i in seq_along(plotList)){ - - if(inherits(plotList[[i]], "gg")){ - - if(inherits(plotList[[i]], "patchwork")){ - - if(getArchRVerbose()) message("Plotting Patchwork!") - print(plotList[[i]]) - - }else{ - - if(getArchRVerbose()) message("Plotting Ggplot!") - - if(!is.null(attr(plotList[[i]], "ratioYX"))){ - .fixPlotSize(plotList[[i]], plotWidth = width, plotHeight = height, height = attr(plotList[[i]], "ratioYX"), newPage = FALSE) - }else{ - .fixPlotSize(plotList[[i]], plotWidth = width, plotHeight = height, newPage = FALSE) - } - - } - - if(i != length(plotList)){ - grid::grid.newpage() - } - - }else if(inherits(plotList[[i]], "gtable")){ - - if(getArchRVerbose()) message("Plotting Gtable!") - - print(grid::grid.draw(plotList[[i]])) - if(i != length(plotList)){ - grid::grid.newpage() - } - }else if(inherits(plotList[[i]], "HeatmapList") | inherits(plotList[[i]], "Heatmap") ){ - - if(getArchRVerbose()) message("Plotting ComplexHeatmap!") - - padding <- 15 - draw(plotList[[i]], - padding = unit(c(padding, padding, padding, padding), "mm"), - heatmap_legend_side = "bot", - annotation_legend_side = "bot" - ) - - }else{ - - if(getArchRVerbose()) message("Plotting Other") - - print(plotList[[i]]) - - } - - } - dev.off() - - - }, error = function(x){ - - if(getArchRVerbose()) message(x) - - })) - - return(invisible(0)) - -} - #################################################################### # Visualization Methods #################################################################### @@ -247,6 +78,8 @@ plotEmbedding <- function( baseSize = 10, plotAs = NULL, Shiny = FALSE, + matrices = NULL, + imputeMatrices = NULL, embeddingDF = NULL, threads = getArchRThreads(), logFile = createLogFile("plotEmbedding"), @@ -293,8 +126,8 @@ plotEmbedding <- function( if(!all(rownames(df) %in% ArchRProj$cellNames)){ stop("Not all cells in embedding are present in ArchRProject!") } - .logThis(df, name = "Embedding data.frame", logFile = logFile) + if(!is.null(sampleCells)){ if(sampleCells < nrow(df)){ if(!is.null(imputeWeights)){ @@ -330,19 +163,19 @@ plotEmbedding <- function( if(length(colorBy) > 1){ stop("colorBy must be of length 1!") } - if(Shiny){ + + if(!Shiny){ + allColorBy <- .availableArrays(head(getArrowFiles(ArchRProj), 2)) + } else { allColorBy <- matrices$allColorBy } - allColorBy <- .availableArrays(head(getArrowFiles(ArchRProj), 2)) - # if(tolower(colorBy) %ni% tolower(allColorBy)){ - # stop("colorBy must be one of the following :\n", paste0(allColorBy, sep=", ")) - # } - # colorBy <- allColorBy[match(tolower(colorBy), tolower(allColorBy))] - + if(tolower(colorBy) %ni% tolower(allColorBy)){ + stop("colorBy must be one of the following :\n", paste0(allColorBy, sep=", ")) + } + colorBy <- allColorBy[match(tolower(colorBy), tolower(allColorBy))] .logMessage(paste0("ColorBy = ", colorBy), logFile = logFile) if(tolower(colorBy) == "coldata" | tolower(colorBy) == "cellcoldata"){ - colorList <- lapply(seq_along(name), function(x){ colorParams <- list() colorParams$color <- as.vector(getCellColData(ArchRProj, select = name[x], drop = FALSE)[rownames(df), 1]) @@ -368,18 +201,19 @@ plotEmbedding <- function( colorParams$color <- as.vector(colorMat) } colorParams - }) - - + }) }else{ - suppressMessages(message(logFile)) - units <- tryCatch({ + if(!Shiny){ + units <- tryCatch({ .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, "/Info/Units"))[1] },error=function(e){ "values" }) + }else{ + units <- ArchRProj@projectMetadata[["units"]] + } if(is.null(log2Norm) & tolower(colorBy) == "genescorematrix"){ log2Norm <- TRUE @@ -389,7 +223,8 @@ plotEmbedding <- function( log2Norm <- FALSE } - colorMat <- .getMatrixValues( + if(!Shiny){ + colorMat <- .getMatrixValues( ArchRProj = ArchRProj, name = name, matrixName = colorBy, @@ -397,6 +232,22 @@ plotEmbedding <- function( threads = threads, logFile = logFile ) + }else{ #plotting embedding for matrix instead of col in cellcoldata + #get values from pre-saved list + colorMat = tryCatch({ + t(as.matrix(matrices[[colorBy]][name,])) + }, warning = function(warning_condition) { + message(paste("name doesn't exist:", name)) + message(warning_condition) + return(NULL) + }, error = function(error_condition) { + message(paste("name doesn't exist:", name)) + message(error_condition) + return(NA) + }, finally={ + }) + rownames(colorMat)=name + } if(!all(rownames(df) %in% colnames(colorMat))){ .logMessage("Not all cells in embedding are present in feature matrix. This may be due to using a custom embedding.", logFile = logFile) @@ -409,11 +260,15 @@ plotEmbedding <- function( if(!is.null(imputeWeights)){ if(getArchRVerbose()) message("Imputing Matrix") - colorMat <- imputeMatrix(mat = as.matrix(colorMat), imputeWeights = imputeWeights, logFile = logFile) - if(!inherits(colorMat, "matrix")){ - colorMat <- matrix(colorMat, ncol = nrow(df)) - colnames(colorMat) <- rownames(df) - } + if(!Shiny){ + colorMat <- imputeMatrix(mat = as.matrix(colorMat), imputeWeights = imputeWeights, logFile = logFile) + }else{ + colorMat <- imputeMatricesList[[colorBy]][name,] + } + if(!inherits(colorMat, "matrix")){ + colorMat <- matrix(colorMat, ncol = nrow(df)) + colnames(colorMat) <- rownames(df) + } } .logThis(colorMat, "colorMat-After-Impute", logFile = logFile) @@ -439,7 +294,6 @@ plotEmbedding <- function( } colorParams }) - } if(getArchRVerbose()) message("Plotting Embedding") @@ -539,492 +393,3 @@ plotEmbedding <- function( } -#' Visualize Groups from ArchR Project -#' -#' This function will group, summarize and then plot data from an ArchRProject for visual comparison. -#' -#' @param ArchRProj An `ArchRProject` object. -#' @param groupBy The name of the column in `cellColData` to use for grouping cells together for summarizing and plotting. -#' @param colorBy A string indicating whether the numeric values to be used in the violin plot should be from a column in -#' `cellColData` ("cellColData") or from a data matrix in the ArrowFiles (i.e. "GeneScoreMatrix", "MotifMatrix", "PeakMatrix"). -#' @param name The name of the column in `cellColData` or the featureName/rowname of the data matrix to be used for plotting. -#' For example if `colorBy` is "cellColData" then `name` refers to a column name in the cellcoldata (see `getCellcoldata()`). If `colorBy` -#' is "GeneScoreMatrix" then `name` refers to a gene name which can be listed by `getFeatures(ArchRProj, useMatrix = "GeneScoreMatrix")`. -#' @param imputeWeights The weights to be used for imputing numerical values for each cell as a linear combination of other cells values. See `addImputationWeights()` and `getImutationWeights()` for more information. -#' @param maxCells The maximum cells to consider when making the plot. -#' @param quantCut If this is not null, a quantile cut is performed to threshold the top and bottom of the distribution of values. -#' This prevents skewed color scales caused by strong outliers. The format of this should be c(a,b) where `a` is the upper threshold and -#' `b` is the lower threshold. For example, quantCut = c(0.025,0.975) will take the top and bottom 2.5 percent of values and set them -#' to the value of the 97.5th and 2.5th percentile values respectively. -#' @param log2Norm A boolean value indicating whether a log2 transformation should be performed on the values (if continuous) in plotting. -#' @param pal A custom palette (see `paletteDiscrete` or `ArchRPalettes`) used to override discreteSet/continuousSet for coloring vector. -#' @param discreteSet The name of a discrete palette from `ArchRPalettes` for visualizing `colorBy` if a discrete color set is desired. -#' @param ylim A vector of two numeric values indicating the lower and upper bounds of the y-axis on the plot. -#' @param size The numeric size of the points to be plotted. -#' @param baseSize The base font size to use in the plot. -#' @param ratioYX The aspect ratio of the x and y axes on the plot. -#' @param ridgeScale The scale factor for the relative heights of each ridge when making a ridgeplot with `ggridges`. -#' @param plotAs A string that indicates whether a rigdge plot ("ridges") should be plotted or a violin plot ("violin") should be plotted. -#' @param threads The number of threads to be used for parallel computing. -#' @param ... Additional parameters to pass to `ggGroup()`. -#' -#' @examples -#' -#' #Get Test Project -#' proj <- getTestProject() -#' -#' #Plot Groups -#' p <- plotGroups(proj, groupBy = "Clusters", colorBy = "colData", name = "TSSEnrichment", plotAs = "violin", alpha = 0.5) -#' -#' #PDF -#' plotPDF(p, name = "Clusters-TSS", ArchRProj = proj) -#' -#' @export -plotGroups <- function( - ArchRProj = NULL, - groupBy = "Sample", - colorBy = "colData", - name = "TSSEnrichment", - imputeWeights = if(!grepl("coldata",tolower(colorBy[1]))) getImputeWeights(ArchRProj), - maxCells = 1000, - quantCut = c(0.002, 0.998), - log2Norm = NULL, - pal = NULL, - discreteSet = "stallion", - ylim = NULL, - size = 0.5, - baseSize = 6, - ratioYX = NULL, - ridgeScale = 2, - plotAs = "ridges", - threads = getArchRThreads(), - ... -){ - - .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) - .validInput(input = groupBy, name = "groupBy", valid = c("character")) - .validInput(input = colorBy, name = "colorBy", valid = c("character")) - .validInput(input = name, name = "name", valid = c("character")) - .validInput(input = imputeWeights, name = "imputeWeights", valid = c("list", "null")) - .validInput(input = maxCells, name = "maxCells", valid = c("integer")) - .validInput(input = quantCut, name = "quantCut", valid = c("numeric")) - .validInput(input = log2Norm, name = "log2Norm", valid = c("boolean", "null")) - .validInput(input = pal, name = "pal", valid = c("character", "null")) - .validInput(input = discreteSet, name = "discreteSet", valid = c("character")) - .validInput(input = ylim, name = "ylim", valid = c("numeric", "null")) - .validInput(input = size, name = "size", valid = c("numeric")) - .validInput(input = baseSize, name = "baseSize", valid = c("numeric")) - .validInput(input = ratioYX, name = "ratioYX", valid = c("numeric", "null")) - .validInput(input = ridgeScale, name = "ridgeScale", valid = c("numeric")) - .validInput(input = plotAs, name = "plotAs", valid = c("character")) - .validInput(input = threads, name = "threads", valid = c("integer")) - - .requirePackage("ggplot2", source = "cran") - - #Make Sure ColorBy is valid! - if(length(colorBy) > 1){ - stop("colorBy must be of length 1!") - } - allColorBy <- availableArrays(head(getArrowFiles(ArchRProj), 2)) - if(tolower(colorBy) %ni% tolower(allColorBy)){ - stop("colorBy must be one of the following :\n", paste0(allColorBy, sep=", ")) - } - colorBy <- allColorBy[match(tolower(colorBy), tolower(allColorBy))] - - groups <- getCellColData(ArchRProj, groupBy, drop = FALSE) - groupNames <- groups[,1] - names(groupNames) <- rownames(groups) - groupNames2 <- gtools::mixedsort(unique(groupNames)) - - - plotParams <- list(...) - - if(tolower(colorBy) == "coldata" | tolower(colorBy) == "cellcoldata"){ - - colorList <- lapply(seq_along(name), function(x){ - colorParams <- list() - colorParams$color <- as.vector(getCellColData(ArchRProj, select = name[x], drop = TRUE)) - if(!is.numeric(colorParams$color)){ - stop(paste0("colorBy = cellColData, name = ", name[x], " : name must correspond to a numeric column!")) - } - if(!is.null(discreteSet)){ - colorParams$pal <- paletteDiscrete(values = groupNames2, set = discreteSet) - } - if(!is.null(pal)){ - colorParams$pal <- pal - } - colorParams - }) - - }else{ - - units <- tryCatch({ - .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, "/Info/Units"))[1] - },error=function(e){ - "values" - }) - - if(is.null(log2Norm) & tolower(colorBy) == "genescorematrix"){ - log2Norm <- TRUE - } - - if(is.null(log2Norm)){ - log2Norm <- FALSE - } - - colorMat <- .getMatrixValues( - ArchRProj = ArchRProj, - name = name, - matrixName = colorBy, - log2Norm = FALSE, - threads = threads - ) - - if(!is.null(imputeWeights)){ - colorMat <- imputeMatrix(mat = as.matrix(colorMat), imputeWeights = imputeWeights) - if(!inherits(colorMat, "matrix")){ - colorMat <- matrix(colorMat, ncol = nCells(ArchRProj)) - colnames(colorMat) <- ArchRProj$cellNames - } - } - - colorList <- lapply(seq_len(nrow(colorMat)), function(x){ - colorParams <- list() - colorParams$color <- colorMat[x, ] - if(!is.null(discreteSet)){ - colorParams$pal <- suppressMessages(paletteDiscrete(values = groupNames2, set = discreteSet)) - } - if(!is.null(pal)){ - colorParams$pal <- pal - } - colorParams - }) - - } - - if(!is.null(maxCells)){ - splitGroup <- split(names(groupNames), groupNames) - useCells <- lapply(splitGroup, function(x){ - if(length(x) > maxCells){ - sample(x, maxCells) - }else{ - x - } - }) %>% unlist %>% as.vector - idx <- match(useCells, names(groupNames)) - }else{ - idx <- seq_along(groupNames) - } - - pl <- lapply(seq_along(colorList), function(x){ - - if(getArchRVerbose()) message(paste0(x, " "), appendLF = FALSE) - - if(is.null(ylim)){ - ylim <- range(colorList[[x]]$color,na.rm=TRUE) %>% extendrange(f = 0.05) - } - - plotParamsx <- plotParams - plotParamsx$x <- groupNames[idx] - if(!is.null(quantCut)){ - plotParamsx$y <- .quantileCut(colorList[[x]]$color[idx], min(quantCut), max(quantCut)) - }else{ - plotParamsx$y <- colorList[[x]]$color[idx] - } - plotParamsx$xlabel <- groupBy - plotParamsx$ylabel <- name[x] - plotParamsx$baseSize <- baseSize - plotParamsx$ridgeScale <- ridgeScale - plotParamsx$ratioYX <- ratioYX - plotParamsx$size <- size - plotParamsx$plotAs <- plotAs - plotParamsx$pal <- colorList[[x]]$pal - - p <- do.call(ggGroup, plotParamsx) - - p - - }) - - names(pl) <- name - if(getArchRVerbose()) message("") - - if(length(name)==1){ - pl[[1]] - }else{ - pl - } - -} - -.getMatrixValues <- function( - ArchRProj = NULL, - name = NULL, - matrixName = NULL, - log2Norm = FALSE, - threads = getArchRThreads(), - logFile = NULL -){ - - o <- h5closeAll() - - .logMessage("Getting Matrix Values...", verbose = TRUE, logFile = logFile) - - featureDF <- .getFeatureDF(head(getArrowFiles(ArchRProj), 2), matrixName) - .logThis(featureDF, "FeatureDF", logFile = logFile) - - matrixClass <- h5read(getArrowFiles(ArchRProj)[1], paste0(matrixName, "/Info/Class")) - - if(matrixClass == "Sparse.Assays.Matrix"){ - if(!all(unlist(lapply(name, function(x) grepl(":",x))))){ - .logMessage("When accessing features from a matrix of class Sparse.Assays.Matrix it requires seqnames\n(denoted by seqnames:name) specifying to which assay to pull the feature from.\nIf confused, try getFeatures(ArchRProj, useMatrix) to list out available formats for input!", logFile = logFile) - stop("When accessing features from a matrix of class Sparse.Assays.Matrix it requires seqnames\n(denoted by seqnames:name) specifying to which assay to pull the feature from.\nIf confused, try getFeatures(ArchRProj, useMatrix) to list out available formats for input!") - } - } - - if(grepl(":",name[1])){ - - sname <- stringr::str_split(name,pattern=":",simplify=TRUE)[,1] - name <- stringr::str_split(name,pattern=":",simplify=TRUE)[,2] - - idx <- lapply(seq_along(name), function(x){ - ix <- intersect(which(tolower(name[x]) == tolower(featureDF$name)), BiocGenerics::which(tolower(sname[x]) == tolower(featureDF$seqnames))) - if(length(ix)==0){ - .logStop(sprintf("FeatureName (%s) does not exist! See getFeatures", name[x]), logFile = logFile) - } - ix - }) %>% unlist - - }else{ - - idx <- lapply(seq_along(name), function(x){ - ix <- which(tolower(name[x]) == tolower(featureDF$name))[1] - if(length(ix)==0){ - .logStop(sprintf("FeatureName (%s) does not exist! See getFeatures", name[x]), logFile = logFile) - } - ix - }) %>% unlist - - } - .logThis(idx, "idx", logFile = logFile) - - if(any(is.na(idx))){ - .logStop(sprintf("FeatureName (%s) does not exist! See getFeatures", paste0(name[which(is.na(idx))], collapse=",")), logFile = logFile) - } - - featureDF <- featureDF[idx, ,drop=FALSE] - .logThis(featureDF, "FeatureDF-Subset", logFile = logFile) - - #Get Values for FeatureName - cellNamesList <- split(rownames(getCellColData(ArchRProj)), getCellColData(ArchRProj)$Sample) - - values <- .safelapply(seq_along(cellNamesList), function(x){ - if(getArchRVerbose()) message(x, " ", appendLF = FALSE) - valuesx <- tryCatch({ - o <- h5closeAll() - ArrowFile <- getSampleColData(ArchRProj)[names(cellNamesList)[x],"ArrowFiles"] - valuesx <- .getMatFromArrow( - ArrowFile = ArrowFile, - featureDF = featureDF, - binarize = FALSE, - useMatrix = matrixName, - cellNames = cellNamesList[[x]], - threads = 1 - ) - colnames(valuesx) <- cellNamesList[[x]] - valuesx - }, error = function(e){ - errorList <- list( - x = x, - ArrowFile = ArrowFile, - ArchRProj = ArchRProj, - cellNames = ArchRProj$cellNames, - cellNamesList = cellNamesList, - featureDF = featureDF - ) - .logError(e, fn = ".getMatFromArrow", info = "", errorList = errorList, logFile = logFile) - }) - valuesx - }, threads = threads) %>% Reduce("cbind", .) - values <- values[, ArchRProj$cellNames, drop = FALSE] - if(getArchRVerbose()) message("") - gc() - .logThis(values, "Feature-Matrix", logFile = logFile) - - if(!inherits(values, "matrix")){ - values <- matrix(as.matrix(values), ncol = nCells(ArchRProj)) - colnames(values) <- ArchRProj$cellNames - } - - #Values Summary - if(!is.null(log2Norm)){ - if(log2Norm){ - if(getArchRVerbose()) message("Log2 Normalizing...") - values <- log2(values + 1) - } - } - - rownames(values) <- name - - return(values) - -} - -.fixPlotSize <- function( - p = NULL, - plotWidth = unit(6, "in"), - plotHeight = unit(6, "in"), - margin = 0.25, - height = 1, - it = 0.05, - newPage = FALSE -){ - - .requirePackage("grid", source = "cran") - .requirePackage("gridExtra", source = "cran") - - if(!inherits(plotWidth, "unit")){ - plotWidth <- unit(plotWidth, "in") - } - - if(!inherits(plotHeight, "unit")){ - plotHeight <- unit(plotHeight, "in") - } - - #adapted from https://github.com/jwdink/egg/blob/master/R/set_panel_size.r - g <- ggplotGrob(p) - - legend <- grep("guide-box", g$layout$name) - if(length(legend)!=0){ - gl <- g$grobs[[legend]] - g <- ggplotGrob(p + theme(legend.position = "none")) - }else{ - gl <- NULL - g <- ggplotGrob(p) - } - - panels <- grep("panel", g$layout$name) - panel_index_w <- unique(g$layout$l[panels]) - panel_index_h <- unique(g$layout$t[panels]) - - nw <- length(panel_index_w) - nh <- length(panel_index_h) - - pw <- convertWidth(plotWidth, unitTo = "in", valueOnly = TRUE) - ph <- convertWidth(plotHeight, unitTo = "in", valueOnly = TRUE) - - pw <- pw * 0.95 - ph <- ph * 0.95 - - x <- 0 - width <- 1 - sm <- FALSE - - while(!sm){ - - x <- x + it - - w <- unit(x * width, "in") - h <- unit(x * height / width, "in") - m <- unit(x * margin / width, "in") - - g$widths[panel_index_w] <- rep(w, nw) - g$heights[panel_index_h] <- rep(h, nh) - - sw <- convertWidth( - x = sum(g$widths) + m, - unitTo = "in", - valueOnly = TRUE - ) - - sh <- convertHeight( - x = sum(g$heights) + m, - unitTo = "in", - valueOnly = TRUE - ) - - sm <- sw > pw | sh > ph - - } - - if(length(legend)!=0){ - - sgh <- convertHeight( - x = sum(g$heights), - unitTo = "in", - valueOnly = TRUE - ) - - sgw <- convertWidth( - x = sum(g$widths), - unitTo = "in", - valueOnly = TRUE - ) - - slh <- convertHeight( - x = sum(gl$heights), - unitTo = "in", - valueOnly = TRUE - ) - - slw <- convertWidth( - x = sum(gl$widths), - unitTo = "in", - valueOnly = TRUE - ) - - size <- 6 - wh <- 0.1 - it <- 0 - - while(slh > 0.2 * ph | slw > pw){ - - it <- it + 1 - - if(it > 3){ - break - } - - size <- size * 0.8 - wh <- wh * 0.8 - - gl <- ggplotGrob( - p + theme( - legend.key.width = unit(wh, "cm"), - legend.key.height = unit(wh, "cm"), - legend.spacing.x = unit(0, 'cm'), - legend.spacing.y = unit(0, 'cm'), - legend.text = element_text(size = max(size, 2)) - ) + .gg_guides(fill = guide_legend(ncol = 4), color = guide_legend(ncol = 4)) - )$grobs[[legend]] - - slh <- convertHeight( - x = sum(gl$heights), - unitTo = "in", - valueOnly = TRUE - ) - - slw <- convertWidth( - x = sum(gl$widths), - unitTo = "in", - valueOnly = TRUE - ) - - } - - p <- grid.arrange(g, gl, ncol=1, nrow=2, - heights = unit.c(unit(sgh,"in"), unit(min(slh, 0.2 * pw), "in")), - newpage = newPage - ) - - }else{ - - p <- grid.arrange(g, newpage = newPage) - - } - - - invisible(p) - -} - From 74a1492fa02dd21e267f7d26ee7f3e4320a81ea0 Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Thu, 12 Jan 2023 16:22:48 -0600 Subject: [PATCH 063/162] exportShinyArchR --- R/exportShinyArchR.R | 156 +++++++++++++++++++++---------------------- 1 file changed, 75 insertions(+), 81 deletions(-) diff --git a/R/exportShinyArchR.R b/R/exportShinyArchR.R index 4caa4de8..9a7346e4 100644 --- a/R/exportShinyArchR.R +++ b/R/exportShinyArchR.R @@ -37,74 +37,6 @@ exportShinyArchR <- function( .requirePackage("rhandsontable", installInfo = 'install.packages("rhandsontable")') mainDir <- getOutputDirectory(ArchRProj) - - allMatrices <- getAvailableMatrices(ArchRProj) - matrices <- list() - imputeMatricesList <- list() - imputeWeights <- getImputeWeights(ArchRProj = ArchRProj) - df <- getEmbedding(ArchRProj, embedding = embedding, returnDF = TRUE) - - if(!file.exists(file.path(outputDir, subOutputDir, "matrices.rds")) && !file.exists(file.path(outputDir, subOutputDir, "imputeMatricesList.rds"))){ - for(allmatrices in allMatrices){ - print(allmatrices) - name <- paste0(allmatrices, "_names") - result = assign(name, getFeatures(ArchRProj = ArchRProj, useMatrix = allmatrices)) - saveRDS(result, file.path(outputDir, subOutputDir, allmatrices, "_names.rds")) - - if(!is.null(result)){ - - matrix = Matrix(.getMatrixValues( - ArchRProj = ArchRProj, - name = result, - matrixName = allmatrices, - log2Norm = FALSE, - threads = threads), sparse = TRUE) - - matrices[[allmatrices]] = matrix - - matList = matrix[,rownames(df), drop=FALSE] - .logThis(matList, paste0(allmatrices,"-Before-Impute"), logFile = logFile) - - if(getArchRVerbose()) message("Imputing Matrix") - - colorImputeMat <- imputeMatrix(mat = as.matrix(matList), imputeWeights = imputeWeights, logFile = logFile) - - if(!inherits(colorImputeMat, "matrix")){ - colorImputeMat <- matrix(colorImputeMat, ncol = nrow(df)) - colnames(colorImputeMat) <- rownames(df) - } - imputeMatricesList[[allmatrices]] <- colorImputeMat - - - }else{ - message(allmatrices, " is NULL.") - } - } - saveRDS(matrices, file.path(outputDir, subOutputDir, "matrices.rds")) - saveRDS(imputeMatricesList, file.path(outputDir, subOutputDir, "imputeMatricesList.rds")) - }else{ - - message("matrices and imputeMatricesList already exist. reading from local files...") - - matrices <- readRDS(file.path(mainDir, outputDir, subOutputDir, "matrices.rds")) - imputeMatricesList <- readRDS(file.path(mainDir, outputDir, subOutputDir, "/imputeMatricesList.rds")) - } - - if(is.null(groupBy)){ - stop("groupBy must be provided") - } else if(groupBy %ni% colnames(getCellColData(ArchRProj))){ - stop("groupBy must be a column in cellColData") - }else{ - print(paste0("groupBy:", groupBy)) - } - - # Check that the embedding exists in ArchRProj@embeddings - if(embedding %ni% names(ArchRProj@embeddings)){ - stop("embedding doesn't exist in ArchRProj@embeddings") - }else{ - print(paste0("embedding:", embedding)) - } - # Make directory for Shiny App if(!dir.exists(outputDir)) { @@ -167,31 +99,93 @@ exportShinyArchR <- function( message("Coverage files already exist...") } - # Create directory to save everything that will be preprocessed + # Create directory to save input data to Shinyapps.io (everything that will be preprocessed) dir.create(file.path(mainDir, outputDir, subOutputDir), showWarnings = TRUE) - if(!file.exists(file.path(mainDir, outputDir, subOutputDir, "features.rds"))){ - gene_names <- getFeatures(ArchRProj = ArchRProj) - saveRDS(gene_names, file.path(mainDir, outputDir, subOutputDir, "features.rds")) + # if(!file.exists(file.path(mainDir, outputDir, subOutputDir, "features.rds"))){ + # gene_names <- getFeatures(ArchRProj = ArchRProj) + # saveRDS(gene_names, file.path(mainDir, outputDir, subOutputDir, "features.rds")) + # }else{ + # message("gene_names already exists...") + # gene_names <- readRDS(file.path(mainDir, outputDir, subOutputDir, "features.rds")) + # } + + allMatrices <- getAvailableMatrices(ArchRProj) + matrices <- list() + imputeMatrices <- list() + imputeWeights <- getImputeWeights(ArchRProj = ArchRProj) + df <- getEmbedding(ArchRProj, embedding = embedding, returnDF = TRUE) + + if(!file.exists(file.path(outputDir, subOutputDir, "matrices.rds")) && !file.exists(file.path(outputDir, subOutputDir, "imputeMatrices.rds"))){ + for(matName in allMatrices){ + matFeaturesNames <- paste0(matName, "_names") + result = assign(matFeaturesNames, getFeatures(ArchRProj = ArchRProj, useMatrix = matName)) + saveRDS(result, file.path(outputDir, subOutputDir, matName, "_names.rds")) + + if(!is.null(result)){ + + mat = Matrix(.getMatrixValues( + ArchRProj = ArchRProj, + name = result, + matrixName = mat, + log2Norm = FALSE, + threads = threads), sparse = TRUE) + + matrices[[matName]] = mat + matList = mat[,rownames(df), drop=FALSE] + .logThis(matList, paste0(matName,"-Before-Impute"), logFile = logFile) + + if(getArchRVerbose()) message("Imputing Matrix") + imputeMat <- imputeMatrix(mat = as.matrix(matList), imputeWeights = imputeWeights, logFile = logFile) + + if(!inherits(imputeMat, "matrix")){ + imputeMat <- mat(imputeMat, ncol = nrow(df)) + colnames(imputeMat) <- rownames(df) + } + imputeMatrices[[matName]] <- imputeMat + + + }else{ + message(matName, " is NULL.") + } + } + matrices$allColorBy= .availableArrays(head(getArrowFiles(ArchRProj), 2)) + saveRDS(matrices, file.path(outputDir, subOutputDir, "matrices.rds")) + saveRDS(imputeMatrices, file.path(outputDir, subOutputDir, "imputeMatrices.rds")) + }else{ + + message("matrices and imputeMatrices already exist. reading from local files...") + + matrices <- readRDS(file.path(mainDir, outputDir, subOutputDir, "matrices.rds")) + imputeMatrices <- readRDS(file.path(mainDir, outputDir, subOutputDir, "imputeMatrices.rds")) + } + + if(is.null(groupBy)){ + stop("groupBy must be provided") + } else if(groupBy %ni% colnames(getCellColData(ArchRProj))){ + stop("groupBy must be a column in cellColData") }else{ - message("gene_names already exists...") - gene_names <- readRDS(file.path(mainDir, outputDir, subOutputDir, "features.rds")) + print(paste0("groupBy:", groupBy)) } + # Check that the embedding exists in ArchRProj@embeddings + if(embedding %ni% names(ArchRProj@embeddings)){ + stop("embedding doesn't exist in ArchRProj@embeddings") + }else{ + print(paste0("embedding:", embedding)) + } + # mainEmbed will create an HDF5 containing the nativeRaster vectors for the main matrices if (!file.exists(file.path(mainDir, outputDir, subOutputDir, "mainEmbeds.h5"))) { - if(groupBy %in% colnames(ArchRProjShiny@cellColData)){ mainEmbed(ArchRProj = ArchRProj, outDirEmbed = file.path(mainDir, outputDir, subOutputDir), colorBy = "cellColData", names = groupBy, + embeddingDF = df, matrices = matrices, - imputeMatricesList = imputeMatricesList, + imputeMatrices = imputeMatrices, Shiny = TRUE ) - }else{ - message(groupBy, "is not defined in ArchRProj...") - } } else{ message("H5 for main embeddings already exists...") } @@ -200,10 +194,10 @@ if(!file.exists(file.path(outputDir, subOutputDir, "plotBlank72.h5"))){ matrixEmbeds( ArchRProj = ArchRProj, - outputDirEmbeds = paste0(outputDir,"/", subOutputDir), + outputDirEmbed = file.path(mainDir, outputDir, subOutputDir), embedding = embedding, matrices = matrices, - imputeMatricesList = imputeMatricesList, + imputeMatrices = imputeMatrices, threads = getArchRThreads(), verbose = TRUE, logFile = createLogFile("matrixEmbeds") From e50904ec052753a5f121358c5d0c0bc9a497d413 Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Thu, 12 Jan 2023 22:01:12 -0600 Subject: [PATCH 064/162] update plotembedding for shiny --- R/matrixEmbeds.R | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/R/matrixEmbeds.R b/R/matrixEmbeds.R index 1baed22c..5dfba7ad 100644 --- a/R/matrixEmbeds.R +++ b/R/matrixEmbeds.R @@ -5,6 +5,8 @@ #' This function will be called by exportShinyArchR() #' #' @param ArchRProj An `ArchRProject` object loaded in the environment. Can do this using: loadArchRProject("path to ArchRProject/") +#' @param colorBy A string indicating whether points in the plot should be colored by a column in `cellColData` ("cellColData") or by +#' a data matrix in the corresponding ArrowFiles (i.e. "GeneScoreMatrix", "MotifMatrix", "PeakMatrix"). #' @param outputDirEmbeds Where the HDF5 and the jpgs will be saved. #' @param threads The number of threads to use for parallel execution. #' @param verbose A boolean value that determines whether standard output should be printed. @@ -63,7 +65,8 @@ matrixEmbeds <- function( imputeWeights = getImputeWeights(ArchRProj = ArchRProj), plotAs = "points", matrices = matrices, - imputeMatricesList = imputeMatricesList, + embeddingDF = df, + imputeMatrices = imputeMatrices, rastr = TRUE ) }else{ From c3cd3b828dfdcad879eb7781ab7d996e7144c740 Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Thu, 12 Jan 2023 22:01:32 -0600 Subject: [PATCH 065/162] update plotembedding --- R/MainEmbed.R | 15 +++------------ R/VisualizeData.R | 6 +++--- R/exportShinyArchR.R | 2 +- 3 files changed, 7 insertions(+), 16 deletions(-) diff --git a/R/MainEmbed.R b/R/MainEmbed.R index 8564e48c..44b5814c 100644 --- a/R/MainEmbed.R +++ b/R/MainEmbed.R @@ -5,15 +5,12 @@ #' #' @param ArchRProj An `ArchRProject` object loaded in the environment. Can do this using: loadArchRProject("path to ArchRProject/") #' @param outDirEmbed Where the HDF5 and the jpgs will be saved. -#' @param colorBy A string indicating whether points in the plot should be colored by a column in `cellColData` ("cellColData") or by -#' a data matrix in the corresponding ArrowFiles (i.e. "GeneScoreMatrix", "MotifMatrix", "PeakMatrix"). +#' @param colorBy `cellColData` ("cellColData") only. #' @param names A list of the names of the columns in `cellColData` or the featureName/rowname of the data matrix to be used for plotting. #' For example if colorBy is "cellColData" then `names` refers to a column names in the `cellcoldata` (see `getCellcoldata()`). If `colorBy` #' is "GeneScoreMatrix" then `name` refers to a gene name which can be listed by `getFeatures(ArchRProj, useMatrix = "GeneScoreMatrix")`. #' @param embedding The embedding to use. Default is "UMAP". -#' @param Shiny A boolean value that tells the function is calling for Shiny or not. -#' @param matrices A list that contains color matrices for features. -#' @param imputeMatricesList A list that contains color matrices for genes after imputation. +#' @param Shiny A boolean value that tells the function is calling for Shiny or not. #' @param threads The number of threads to use for parallel execution. #' @param logFile The path to a file to be used for logging ArchR output. #' @export @@ -24,8 +21,6 @@ mainEmbed <- function( names = NULL, embedding = "UMAP", Shiny = FALSE, - matrices = matrices, - imputeMatricesList = imputeMatricesList, threads = getArchRThreads(), logFile = createLogFile("mainEmbeds") ){ @@ -36,8 +31,6 @@ mainEmbed <- function( .validInput(input = names, name = "names", valid = c("character")) .validInput(input = embedding, name = "embedding", valid = c("character")) .validInput(input = Shiny, name = "Shiny", valid = c("boolean")) - .validInput(input = matrices, name = "matrices", valid = c("list")) - .validInput(input = imputeMatricesList, name = "imputeMatricesList", valid = c("list")) .validInput(input = threads, name = "threads", valid = c("numeric")) .validInput(input = logFile, name = "logFile", valid = c("character")) @@ -68,8 +61,6 @@ mainEmbed <- function( rastr = FALSE, size = 0.5, imputeWeights = NULL, - matrices = matrices, - imputeMatrices = imputeMatrices, Shiny = TRUE )+ggtitle(paste0("Colored by ", name))+theme(text = element_text(size=12), legend.title = element_text(size = 12),legend.text = element_text(size = 6)) @@ -109,7 +100,7 @@ mainEmbed <- function( title=element_blank() ) - #save plot without axes etc as a jpg. + #save plot without axes etc as a jpg ggsave(filename = file.path(outDirEmbed, paste0(names(embeds)[i],"_blank72.jpg")), plot = embed_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) diff --git a/R/VisualizeData.R b/R/VisualizeData.R index 4917174d..60add723 100644 --- a/R/VisualizeData.R +++ b/R/VisualizeData.R @@ -202,7 +202,7 @@ plotEmbedding <- function( } colorParams }) - }else{ + }else{# plotting embedding for matrix instead of col in cellcoldata suppressMessages(message(logFile)) if(!Shiny){ @@ -232,7 +232,7 @@ plotEmbedding <- function( threads = threads, logFile = logFile ) - }else{ #plotting embedding for matrix instead of col in cellcoldata + }else{ #get values from pre-saved list colorMat = tryCatch({ t(as.matrix(matrices[[colorBy]][name,])) @@ -263,7 +263,7 @@ plotEmbedding <- function( if(!Shiny){ colorMat <- imputeMatrix(mat = as.matrix(colorMat), imputeWeights = imputeWeights, logFile = logFile) }else{ - colorMat <- imputeMatricesList[[colorBy]][name,] + colorMat <- imputeMatrices[[colorBy]][name,] } if(!inherits(colorMat, "matrix")){ colorMat <- matrix(colorMat, ncol = nrow(df)) diff --git a/R/exportShinyArchR.R b/R/exportShinyArchR.R index 9a7346e4..13b4c768 100644 --- a/R/exportShinyArchR.R +++ b/R/exportShinyArchR.R @@ -175,7 +175,7 @@ exportShinyArchR <- function( print(paste0("embedding:", embedding)) } -# mainEmbed will create an HDF5 containing the nativeRaster vectors for the main matrices +# mainEmbed will create an HDF5 containing the nativeRaster vectors for cellColData if (!file.exists(file.path(mainDir, outputDir, subOutputDir, "mainEmbeds.h5"))) { mainEmbed(ArchRProj = ArchRProj, outDirEmbed = file.path(mainDir, outputDir, subOutputDir), From 884b86deca40786b1e506ca917a9e7d5516c2e42 Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Fri, 13 Jan 2023 18:01:30 -0600 Subject: [PATCH 066/162] fixing MatrixEmbeds --- R/MainEmbed.R | 2 -- R/exportShinyArchR.R | 1 + R/matrixEmbeds.R | 15 ++++++++------- 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/R/MainEmbed.R b/R/MainEmbed.R index 44b5814c..55b403d6 100644 --- a/R/MainEmbed.R +++ b/R/MainEmbed.R @@ -36,8 +36,6 @@ mainEmbed <- function( .startLogging(logFile=logFile) .logThis(mget(names(formals()),sys.frame(sys.nframe())), "exportShinyArchR Input-Parameters", logFile = logFile) - -# Check if colorBy is cellColData or Matrix (e.g. GSM, GIM, or MM) if(!file.exists(file.path(outDirEmbed, "embeds.rds"))){ diff --git a/R/exportShinyArchR.R b/R/exportShinyArchR.R index 13b4c768..d757ac5a 100644 --- a/R/exportShinyArchR.R +++ b/R/exportShinyArchR.R @@ -195,6 +195,7 @@ if(!file.exists(file.path(outputDir, subOutputDir, "plotBlank72.h5"))){ matrixEmbeds( ArchRProj = ArchRProj, outputDirEmbed = file.path(mainDir, outputDir, subOutputDir), + colorBy = "GeneScoreMatrix", embedding = embedding, matrices = matrices, imputeMatrices = imputeMatrices, diff --git a/R/matrixEmbeds.R b/R/matrixEmbeds.R index 5dfba7ad..691ff933 100644 --- a/R/matrixEmbeds.R +++ b/R/matrixEmbeds.R @@ -15,6 +15,7 @@ matrixEmbeds <- function( ArchRProj = NULL, outputDirEmbeds = NULL, + colorBy = c("GeneScoreMatrix", "GeneIntegrationMatrix", "MotifMatrix"), embedding = "UMAP", matrices = NULL, imputeMatricesList = NULL, @@ -30,24 +31,24 @@ matrixEmbeds <- function( if (file.exists(file.path(outputDirEmbeds, "plotBlank72.h5"))){ - file.remove(file.path(outputDirEmbeds, "plotBlank72.h5")) - } embeds_min_max_list = list() embeds_pal_list = list() shinyMatrices <- getAvailableMatrices(ArchRProj) - - for(matrix in shinyMatrices){ - + + for(matrix in colorBy){ + if(matrix %ni% shinyMatrices){ + stop(matrix,"not in ArchRProj") + } matrixName = paste0(matrix,"_names") if(file.exists(paste0(outputDirEmbeds, "/", matrixName, ".rds"))){ - geneMatrixNames <- readRDS(paste0(outputDirEmbeds, "/", matrixName, ".rds")) - + geneMatrixNames <- readRDS(file.path(outputDir, subOutputDir, matName, "_names.rds")) + if(!is.null(geneMatrixNames)){ embeds_points <- .safelapply(1:length(geneMatrixNames), function(x){ From 75afaba37a7fcf85943529ac99531b7c7d0306d9 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Mon, 16 Jan 2023 15:22:02 -0800 Subject: [PATCH 067/162] Update ArchRBrowser.R -remove hardcoding of "Sample" -standardize relative path of "coverage" directory rather than relative to current working dir. Make it relative to the outputDirectory of the ArchRProj. I'm not sure why `dir.create()` was called for the coverage files? they should already have been present? In general, the output directory structure here is very hectic. In exportShinyArchR(), you allow the user to define the ouputDir but then here you assume it is the working directory etc. I'll try to unify throughout other commits --- R/ArchRBrowser.R | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/R/ArchRBrowser.R b/R/ArchRBrowser.R index d083a2ab..871f1557 100644 --- a/R/ArchRBrowser.R +++ b/R/ArchRBrowser.R @@ -649,8 +649,6 @@ ArchRBrowserTrack <- function(...){ #' (i.e. the `BSgenome` object you used) so they may not match other online genome browsers that use different gene annotations. #' #' @param ArchRProj An `ArchRProject` object. -#' @param ShinyArchR A boolean value indicating whether to use coverage RLEs or Arrow Files for browser track plotting. -#' This parameter is not meant to be controlled by the end user and is only meant to be used as part of an exported ShinyArchR app. #' @param region A `GRanges` region that indicates the region to be plotted. If more than one region exists in the `GRanges` object, #' all will be plotted. If no region is supplied, then the `geneSymbol` argument can be used to center the plot window at the #' transcription start site of the supplied gene. @@ -700,6 +698,8 @@ ArchRBrowserTrack <- function(...){ #' @param tickWidth The numeric line width to be used for axis tick marks. #' @param facetbaseSize The numeric font size to be used in the facets (gray boxes used to provide track labels) of the plot. #' @param geneAnnotation The `geneAnnotation` object to be used for plotting the "geneTrack" object. See `createGeneAnnotation()` for more info. +#' @param ShinyArchR A boolean value indicating whether to use coverage RLEs or Arrow Files for browser track plotting. +#' This parameter is not meant to be controlled by the end user and is only meant to be used as part of an exported ShinyArchR app. #' @param title The title to add at the top of the plot next to the plot's genomic coordinates. #' @param verbose A boolean value that determines whether standard output should be printed. #' @param logFile The path to a file to be used for logging ArchR output. @@ -722,7 +722,6 @@ ArchRBrowserTrack <- function(...){ #' @export plotBrowserTrack <- function( ArchRProj = NULL, - ShinyArchR = FALSE, region = NULL, groupBy = "Clusters", useGroups = NULL, @@ -751,6 +750,7 @@ plotBrowserTrack <- function( tickWidth = 0.4, facetbaseSize = 7, geneAnnotation = getGeneAnnotation(ArchRProj), + ShinyArchR = FALSE, title = "", verbose = TRUE, logFile = createLogFile("plotBrowserTrack") @@ -1063,6 +1063,7 @@ plotBrowserTrack <- function( groupBy = groupBy, normMethod = normMethod, useGroups = useGroups, + sampleLabels = sampleLabels, minCells = minCells, region = region, tileSize = tileSize, @@ -1356,6 +1357,7 @@ plotBrowserTrack <- function( ArchRProj = NULL, useGroups = NULL, groupBy = NULL, + sampleLabels = "Sample", region = NULL, tileSize = NULL, normMethod = NULL, @@ -1370,7 +1372,7 @@ plotBrowserTrack <- function( cellGroups <- getCellColData(ArchRProj, groupBy, drop = TRUE) tabGroups <- table(cellGroups) - groupsBySample <- split(cellGroups, getCellColData(ArchRProj, "Sample", drop = TRUE)) + groupsBySample <- split(cellGroups, getCellColData(ArchRProj, sampleLabels, drop = TRUE)) uniqueGroups <- gtools::mixedsort(unique(cellGroups)) # Tile Region @@ -1381,8 +1383,10 @@ plotBrowserTrack <- function( ranges = IRanges(start = regionTiles, width=100) ) - dir.create("coverage") - cvgObjs = list.files(path = "./coverage", pattern = "*_cvg.rds", full.names = TRUE) + cvgObjs = list.files(path = file.path(getOutputDirectory(ArchRProj),"ShinyCoverage",groupBy), pattern = "*_cvg.rds", full.names = TRUE) + if(length(cvgObjs == 0)) { + stop(paste0("No coverage files detected. You may not have created them via exportShinyArchR(). Please ensure that *_cvg.rds files exist within ", file.path(getOutputDirectory(ArchRProj),"ShinyCoverage",groupBy))) + } allCvgGR = c() for(i in seq_along(cvgObjs)) { cvgrds <- readRDS(cvgObjs[[i]]) From 5b639e42962052cf0551fc764cdbc51abced3a4a Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Mon, 16 Jan 2023 16:01:43 -0800 Subject: [PATCH 068/162] tidying code for legibility --- R/GroupExport.R | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/R/GroupExport.R b/R/GroupExport.R index bf5e1ef6..e71f5537 100644 --- a/R/GroupExport.R +++ b/R/GroupExport.R @@ -600,16 +600,14 @@ getGroupFragments <- function( groupIDs <- names(cellGroups) - .safelapply(seq_along(groupIDs), function(x)){ + .safelapply(seq_along(groupIDs), function(x)){ cat("Making fragment file for cluster:", groupIDs[x], "\n") # get GRanges with all fragments for that cluster - cellNames = cellGroups[[groupIDs[x]]] - fragments <- - getFragmentsFromProject(ArchRProj = ArchRProj, cellNames = cellNames) + cellNames <- cellGroups[[groupIDs[x]]] + fragments <- getFragmentsFromProject(ArchRProj = ArchRProj, cellNames = cellNames) fragments <- unlist(fragments, use.names = FALSE) # filter Fragments - fragments <- - GenomeInfoDb::keepStandardChromosomes(fragments, pruning.mode = "coarse") + fragments <- GenomeInfoDb::keepStandardChromosomes(fragments, pruning.mode = "coarse") saveRDS(fragments, file.path(outDir, paste0(groupIDs[x], "_frags.rds"))) } } From 4879cd9293d341915522dadd039767294957eec1 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Mon, 16 Jan 2023 16:05:54 -0800 Subject: [PATCH 069/162] change validInput for consistent format --- R/InputData.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/InputData.R b/R/InputData.R index 041b10f6..f35d3cd8 100644 --- a/R/InputData.R +++ b/R/InputData.R @@ -20,7 +20,7 @@ getTutorialData <- function( ){ #Validate - .validInput(input = tutorial, name = "tutorial", valid = "character") + .validInput(input = tutorial, name = "tutorial", valid = c("character")) .validInput(input = threads, name = "threads", valid = c("integer")) ######### From d20369327ce685e1a7b2da959112e7ea581ab6d7 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Mon, 16 Jan 2023 16:17:10 -0800 Subject: [PATCH 070/162] fix dir structure and consolidate shiny functions -standardize directory structures -fix file checks to be more robust -consolidate shiny export functions into a single R file -make mainEmbed and matrixEmbed hidden functions with "." --- R/ShinyArchRExports.R | 518 ++++++++++++++++++++++++++++++++++++++++++ R/exportShinyArchR.R | 223 ------------------ 2 files changed, 518 insertions(+), 223 deletions(-) create mode 100644 R/ShinyArchRExports.R delete mode 100644 R/exportShinyArchR.R diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R new file mode 100644 index 00000000..2d5835a8 --- /dev/null +++ b/R/ShinyArchRExports.R @@ -0,0 +1,518 @@ +# Functions for exporting a ArchR-based Shiny app ----------------------------------------------------------- +#' +#' Export a Shiny App based on ArchRProj +#' +#' Generate all files required for an autonomous Shiny app to display browser tracks and embeds. +#' +#' @param ArchRProj An `ArchRProject` object loaded in the environment. Can do this using: loadArchRProject("path to ArchRProject/") +#' @param outputDir The name of the directory for the Shiny App files. +#' @param groupBy The name of the column in cellColData to use for grouping cells together for generating sequencing tracks. Only one cell grouping is allowed. +#' defaults to "Clusters". +#' @param tileSize The numeric width of the tile/bin in basepairs for plotting ATAC-seq signal tracks. All insertions in a single bin will be summed. +#' @param force A boolean value that indicates whether to overwrite any relevant files during the `exportShinyArchR()` process. +#' @param threads The number of threads to use for parallel execution. +#' @param logFile The path to a file to be used for logging ArchR output. +#' @export +exportShinyArchR <- function( + ArchRProj = NULL, + outputDir = "Shiny", + subOutputDir = "inputData", + groupBy = "Clusters", + embedding = "UMAP", + tileSize = 100, + force = FALSE, + threads = getArchRThreads(), + logFile = createLogFile("exportShinyArchR") +){ + + .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) + .validInput(input = outputDir, name = "outputDir", valid = c("character")) + .validInput(input = outputDir, name = "subOutputDir", valid = c("character")) + .validInput(input = groupBy, name = "groupBy", valid = c("character")) + .validInput(input = embedding, name = "embedding", valid = c("character")) + .validInput(input = tileSize, name = "tileSize", valid = c("integer")) + .validInput(input = force, name = "force", valid = c("boolean")) + .validInput(input = threads, name = "threads", valid = c("integer")) + .validInput(input = logFile, name = "logFile", valid = c("character")) + + .startLogging(logFile=logFile) + .logThis(mget(names(formals()),sys.frame(sys.nframe())), "exportShinyArchR Input-Parameters", logFile = logFile) + + .requirePackage("shiny", installInfo = 'install.packages("shiny")') + .requirePackage("rhandsontable", installInfo = 'install.packages("rhandsontable")') + + mainDir <- getOutputDirectory(ArchRProj) + # Make directory for Shiny App + if(!dir.exists(outputDir)) { + + dir.create(file.path(mainDir, outputDir), showWarnings = TRUE) + + ## Check the links for the files + filesUrl <- data.frame( + fileUrl = c( + "https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/app.R", + "https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/global.R", + "https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/server.R", + "https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/ui.R" + ), + md5sum = c( + "77502e1f195e21d2f7a4e8ac9c96e65e", + "618613b486e4f8c0101f4c05c69723b0", + "a8d5ae747841055ef230ba496bcfe937" + ), + stringsAsFactors = FALSE + ) + + .downloadFiles(filesUrl = filesUrl, pathDownload = file.path(mainDir, outputDir), threads = threads) + + }else{ + message("Using existing Shiny files...") + } + + # Create a copy of the ArchRProj + ArchRProjShiny <- ArchRProj + + # Add metadata to ArchRProjShiny + if (groupBy %ni% colnames(ArchRProjShiny@cellColData)) { + stop("groupBy is not part of cellColData") + } else if ((any(is.na(paste0("ArchRProj$", groupBy))))) { + stop("Some entries in the column indicated by groupBy have NA values. Please subset your project using subsetArchRProject() to only contain cells with values for groupBy") + } else { + ArchRProjShiny@projectMetadata[["groupBy"]] <- groupBy + } + ArchRProjShiny@projectMetadata[["tileSize"]] <- tileSize + units <- tryCatch({ + .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, "/Info/Units"))[1] + },error=function(e){ + "values" + }) + ArchRProjShiny@projectMetadata[["units"]] <- units + ArchrProjShiny <- saveArchRProject(ArchRProj = ArchRProjShiny, outputDirectory = + file.path(mainDir, outputDir, "Save-ArchRProjShiny"), dropCells = TRUE, overwrite = TRUE) + + # Create fragment files + fragDir <- file.path(mainDir, "ShinyFragments", groupBy) + fragFiles <- list.files(path = file.path(fragDir, pattern = "\\_frags.rds$") + #this is still a slightly dangerous comparison, better would be to compare for explicitly the file names that are expected + if(length(fragFiles) == length(unique(ArchRProjShiny@cellColData[,groupBy]))){ + if(force){ + .getGroupFragsFromProj(ArchRProj = ArchRProj, groupBy = groupBy, outDir = fragDir) + } else{ + message("Fragment files already exist. Skipping fragment file generation...") + } + }else + .getGroupFragsFromProj(ArchRProj = ArchRProj, groupBy = groupBy, outDir = fragDir) + } + + # Create coverage objects + covDir <- file.path(mainDir, "ShinyCoverage", groupBy) + covFiles <- list.files(path = covDir, pattern = "\\_cvg.rds$") + #this is still a slightly dangerous comparison, better would be to compare for explicitly the file names that are expected + if(length(covFiles) == length(unique(ArchRProjShiny@cellColData[,groupBy]))){ + if(force){ + .getClusterCoverage(ArchRProj = ArchRProj, tileSize = tileSize, groupBy = groupBy, outDir = covDir) + } else{ + message("Coverage files already exist. Skipping fragment file generation...") + } + }else{ + .getClusterCoverage(ArchRProj = ArchRProj, tileSize = tileSize, groupBy = groupBy, outDir = covDir) + } + + # Create directory to save input data to Shinyapps.io (everything that will be preprocessed) + dir.create(file.path(mainDir, outputDir, subOutputDir), showWarnings = TRUE) + + # if(!file.exists(file.path(mainDir, outputDir, subOutputDir, "features.rds"))){ + # gene_names <- getFeatures(ArchRProj = ArchRProj) + # saveRDS(gene_names, file.path(mainDir, outputDir, subOutputDir, "features.rds")) + # }else{ + # message("gene_names already exists...") + # gene_names <- readRDS(file.path(mainDir, outputDir, subOutputDir, "features.rds")) + # } + + allMatrices <- getAvailableMatrices(ArchRProj) + matrices <- list() + imputeMatrices <- list() + imputeWeights <- getImputeWeights(ArchRProj = ArchRProj) + df <- getEmbedding(ArchRProj, embedding = embedding, returnDF = TRUE) + + if(!file.exists(file.path(outputDir, subOutputDir, "matrices.rds")) && !file.exists(file.path(outputDir, subOutputDir, "imputeMatrices.rds"))){ + for(matName in allMatrices){ + matFeaturesNames <- paste0(matName, "_names") + result = assign(matFeaturesNames, getFeatures(ArchRProj = ArchRProj, useMatrix = matName)) + saveRDS(result, file.path(outputDir, subOutputDir, matName, "_names.rds")) + + if(!is.null(result)){ + + mat = Matrix(.getMatrixValues( + ArchRProj = ArchRProj, + name = result, + matrixName = mat, + log2Norm = FALSE, + threads = threads), sparse = TRUE) + + matrices[[matName]] = mat + matList = mat[,rownames(df), drop=FALSE] + .logThis(matList, paste0(matName,"-Before-Impute"), logFile = logFile) + + if(getArchRVerbose()) message("Imputing Matrix") + imputeMat <- imputeMatrix(mat = as.matrix(matList), imputeWeights = imputeWeights, logFile = logFile) + + if(!inherits(imputeMat, "matrix")){ + imputeMat <- mat(imputeMat, ncol = nrow(df)) + colnames(imputeMat) <- rownames(df) + } + imputeMatrices[[matName]] <- imputeMat + + + }else{ + message(matName, " is NULL.") + } + } + matrices$allColorBy= .availableArrays(head(getArrowFiles(ArchRProj), 2)) + saveRDS(matrices, file.path(outputDir, subOutputDir, "matrices.rds")) + saveRDS(imputeMatrices, file.path(outputDir, subOutputDir, "imputeMatrices.rds")) + }else{ + + message("matrices and imputeMatrices already exist. reading from local files...") + + matrices <- readRDS(file.path(mainDir, outputDir, subOutputDir, "matrices.rds")) + imputeMatrices <- readRDS(file.path(mainDir, outputDir, subOutputDir, "imputeMatrices.rds")) + } + + if(is.null(groupBy)){ + stop("groupBy must be provided") + } else if(groupBy %ni% colnames(getCellColData(ArchRProj))){ + stop("groupBy must be a column in cellColData") + }else{ + print(paste0("groupBy:", groupBy)) + } + + # Check that the embedding exists in ArchRProj@embeddings + if(embedding %ni% names(ArchRProj@embeddings)){ + stop("embedding doesn't exist in ArchRProj@embeddings") + }else{ + print(paste0("embedding:", embedding)) + } + +# mainEmbed will create an HDF5 containing the nativeRaster vectors for cellColData +if (!file.exists(file.path(mainDir, outputDir, subOutputDir, "mainEmbeds.h5"))) { + mainEmbed(ArchRProj = ArchRProj, + outDirEmbed = file.path(mainDir, outputDir, subOutputDir), + colorBy = "cellColData", + names = groupBy, + embeddingDF = df, + matrices = matrices, + imputeMatrices = imputeMatrices, + Shiny = TRUE + ) +} else{ + message("H5 for main embeddings already exists...") +} + +if(!file.exists(file.path(outputDir, subOutputDir, "plotBlank72.h5"))){ + + matrixEmbeds( + ArchRProj = ArchRProj, + outputDirEmbed = file.path(mainDir, outputDir, subOutputDir), + colorBy = "GeneScoreMatrix", + embedding = embedding, + matrices = matrices, + imputeMatrices = imputeMatrices, + threads = getArchRThreads(), + verbose = TRUE, + logFile = createLogFile("matrixEmbeds") + ) + +}else{ + + message("H5 file already exists...") + +} +## delete unnecessary files ----------------------------------------------------------------- +unlink("./fragments", recursive = TRUE) +unlink("./ArchRLogs", recursive = TRUE) + +## ready to launch --------------------------------------------------------------- +message("App created! To launch, + ArchRProj <- loadArchRProject('", mainDir,"') and + run shiny::runApp('", outputDir, "') from parent directory") +# runApp("myappdir") + +} + +#' Create an HDF5, mainEmbeds.h5, containing the nativeRaster vectors for the 5 main embeddings. +#' This function will be called by exportShinyArchR() +#' +#' @param ArchRProj An `ArchRProject` object loaded in the environment. Can do this using: loadArchRProject("path to ArchRProject/") +#' @param outDirEmbed Where the HDF5 and the jpgs will be saved. +#' @param colorBy `cellColData` ("cellColData") only. +#' @param names A list of the names of the columns in `cellColData` or the featureName/rowname of the data matrix to be used for plotting. +#' For example if colorBy is "cellColData" then `names` refers to a column names in the `cellcoldata` (see `getCellcoldata()`). If `colorBy` +#' is "GeneScoreMatrix" then `name` refers to a gene name which can be listed by `getFeatures(ArchRProj, useMatrix = "GeneScoreMatrix")`. +#' @param embedding The embedding to use. Default is "UMAP". +#' @param Shiny A boolean value that tells the function is calling for Shiny or not. +#' @param threads The number of threads to use for parallel execution. +#' @param logFile The path to a file to be used for logging ArchR output. +#' +.mainEmbed <- function( + ArchRProj = NULL, + outDirEmbed = NULL, + colorBy = "cellColData", + names = NULL, + embedding = "UMAP", + Shiny = FALSE, + threads = getArchRThreads(), + logFile = createLogFile("mainEmbeds") +){ + + .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) + .validInput(input = outDirEmbed, name = "outDirEmbed", valid = c("character")) + .validInput(input = colorBy, name = "colorBy", valid = c("character")) + .validInput(input = names, name = "names", valid = c("character")) + .validInput(input = embedding, name = "embedding", valid = c("character")) + .validInput(input = Shiny, name = "Shiny", valid = c("boolean")) + .validInput(input = threads, name = "threads", valid = c("numeric")) + .validInput(input = logFile, name = "logFile", valid = c("character")) + + .startLogging(logFile=logFile) + .logThis(mget(names(formals()),sys.frame(sys.nframe())), "exportShinyArchR Input-Parameters", logFile = logFile) + + if(!file.exists(file.path(outDirEmbed, "embeds.rds"))){ + + # check all names exist in ArchRProj + if(names %ni% colnames(ArchRProjShiny@cellColData)){ + stop("All columns should be presented in cellColData") + } + + embeds <- .safelapply(1:length(names), function(x){ + name <- names[[x]] + + tryCatch({ + named_embed <- plotEmbedding( + ArchRProj = ArchRProj, + baseSize = 12, + colorBy = colorBy, + name = name, + allNames = names, + embedding = embedding, + embeddingDF = df, + rastr = FALSE, + size = 0.5, + imputeWeights = NULL, + Shiny = TRUE + )+ggtitle(paste0("Colored by ", name))+theme(text = element_text(size=12), + legend.title = element_text(size = 12),legend.text = element_text(size = 6)) + }, error = function(x){ + print(x) + }) + return(named_embed) + }) + + names(embeds) <- names + saveRDS(embeds, file.path(outDirEmbed, "embeds.rds")) + + } else { + message("embeddings already exist...") + embeds <- readRDS(file.path(outDirEmbed, "embeds.rds")) + } + + h5closeAll() + points <- H5Fcreate(name = file.path(outDirEmbed, "mainEmbeds.h5")) + + embed_legend <- list() + embed_color <- list() + + for(i in 1:length(embeds)){ + + embed_plot <- embeds[i] + + embed_plot[[1]]$labels$title <- NULL + embed_plot_blank <- embed_plot[[1]] + theme(axis.title.x = element_blank()) + + theme(axis.title.y = element_blank()) + + theme(axis.title = element_blank()) + + theme(legend.position = "none") + + theme( + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.border = element_blank(), + title=element_blank() + ) + + #save plot without axes etc as a jpg + ggsave(filename = file.path(outDirEmbed, paste0(names(embeds)[i],"_blank72.jpg")), + plot = embed_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) + + #read back in that jpg because we need vector in native format + blank_jpg72 <- readJPEG(source = file.path(outDirEmbed, paste0(names(embeds)[[i]],"_blank72.jpg")), native = TRUE) + + h5createDataset(file = points, dataset = names(embeds)[i], dims = c(46656,1), storage.mode = "integer") + h5writeDataset(obj = as.vector(blank_jpg72), h5loc = points, name= names[i]) + + embed_legend[[i]] <- levels(embed_plot[[1]]$data$color) + names(embed_legend)[[i]] <- names(embed_plot) + + + embed_color[[i]] <- unique(ggplot_build(embed_plot[[1]])$data[[1]][,"colour"]) + names(embed_color)[[i]] <- names(embed_plot) + + } + + saveRDS(embed_color, file.path(outDirEmbed, "embeddings.rds")) + saveRDS(embed_legend, file.path(outDirEmbed, "embed_legend_names.rds")) +} + +#' Create an HDF5 containing the nativeRaster vectors for all features for all feature matrices. +#' This function will be called by exportShinyArchR() +#' +#' @param ArchRProj An `ArchRProject` object loaded in the environment. Can do this using: loadArchRProject("path to ArchRProject/") +#' @param colorBy A string indicating whether points in the plot should be colored by a column in `cellColData` ("cellColData") or by +#' a data matrix in the corresponding ArrowFiles (i.e. "GeneScoreMatrix", "MotifMatrix", "PeakMatrix"). +#' @param outputDirEmbeds Where the HDF5 and the jpgs will be saved. +#' @param threads The number of threads to use for parallel execution. +#' @param verbose A boolean value that determines whether standard output should be printed. +#' @param logFile The path to a file to be used for logging ArchR output. +#' +.matrixEmbeds <- function( + ArchRProj = NULL, + outputDirEmbeds = NULL, + colorBy = c("GeneScoreMatrix", "GeneIntegrationMatrix", "MotifMatrix"), + embedding = "UMAP", + matrices = NULL, + imputeMatricesList = NULL, + threads = getArchRThreads(), + verbose = TRUE, + logFile = createLogFile("matrixEmbeds") +){ + .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) + .validInput(input = outputDirEmbeds, name = "outputDirEmbeds", valid = c("character")) + .validInput(input = threads, name = "threads", valid = c("numeric")) + .validInput(input = verbose, name = "verbose", valid = c("boolean")) + .validInput(input = logFile, name = "logFile", valid = c("character")) + + + if (file.exists(file.path(outputDirEmbeds, "plotBlank72.h5"))){ + file.remove(file.path(outputDirEmbeds, "plotBlank72.h5")) + } + + embeds_min_max_list = list() + embeds_pal_list = list() + + shinyMatrices <- getAvailableMatrices(ArchRProj) + + for(matrix in colorBy){ + if(matrix %ni% shinyMatrices){ + stop(matrix,"not in ArchRProj") + } + matrixName = paste0(matrix,"_names") + + if(file.exists(paste0(outputDirEmbeds, "/", matrixName, ".rds"))){ + + geneMatrixNames <- readRDS(file.path(outputDir, subOutputDir, matName, "_names.rds")) + + if(!is.null(geneMatrixNames)){ + + embeds_points <- .safelapply(1:length(geneMatrixNames), function(x){ + + print(paste0("Creating plots for ", matrix,": ",x,": ",round((x/length(geneMatrixNames))*100,3), "%")) + + if(!is.na(matrices[[matrix]][x])){ + + gene_plot <- plotEmbedding( + ArchRProj = ArchRProj, + colorBy = matrix, + name = geneMatrixNames[x], + embedding = embedding, + quantCut = c(0.01, 0.95), + imputeWeights = getImputeWeights(ArchRProj = ArchRProj), + plotAs = "points", + matrices = matrices, + embeddingDF = df, + imputeMatrices = imputeMatrices, + rastr = TRUE + ) + }else{ + + gene_plot = NULL + } + + if(!is.null(gene_plot)){ + + gene_plot_blank <- gene_plot + theme(axis.title.x = element_blank()) + + theme(axis.title.y = element_blank()) + + theme(axis.title = element_blank()) + + theme(legend.position = "none") + + theme( + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.border = element_blank(), + title=element_blank() + ) + + #save plot without axes etc as a jpg. + ggsave(filename = file.path(outputDirEmbeds, paste0(shinymatrices,"_embeds"), paste0(geneMatrixNames[x],"_blank72.jpg")), + plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) + + #read back in that jpg because we need vector in native format + blank_jpg72 <- readJPEG(source = file.path(outputDirEmbeds, paste0(shinymatrices,"_embeds"), + paste0(geneMatrixNames[x],"_blank72.jpg")), native = TRUE) + + g <- ggplot_build(gene_plot) + + res = list(list(plot=as.vector(blank_jpg72), min = round(min(gene_plot$data$color),1), + max = round(max(gene_plot$data$color),1), pal = unique(g$data[[1]][,"colour"]))) + + return(res) + } + + + }, threads = threads) + + names(embeds_points) <- geneMatrixNames + + embeds_points = embeds_points[!unlist(lapply(embeds_points, is.null))] + + embeds_min_max <- data.frame(matrix(NA, 2, length(embeds_points))) + colnames(embeds_min_max) <- names(embeds_points)[which(!unlist(lapply(embeds_points, is.null)))] + rownames(embeds_min_max) <- c("min","max") + + h5closeAll() + points = H5Fcreate(name = file.path(outputDirEmbeds, paste0(shinymatrices,"_plotBlank72.h5"))) + h5createGroup(file.path(outputDirEmbeds, paste0(shinymatrices,"_plotBlank72.h5")), shinymatrices) + + for(i in 1:length(embeds_points)){ + + print(paste0("Getting H5 files for embeds_points: ",i,": ",round((i/length(embeds_points))*100,3), "%")) + h5createDataset(file = points, dataset = paste0(shinymatrices,"/",geneMatrixNames[i]), dims = c(46656,1), storage.mode = "integer") + h5writeDataset(obj = embeds_points[[i]][[1]]$plot, h5loc = points, name=paste0(shinymatrices,"/",geneMatrixNames[i])) + embeds_min_max[1,i] = embeds_points[[i]][[1]]$min + embeds_min_max[2,i] = embeds_points[[i]][[1]]$max + + } + + embeds_min_max_list[[shinymatrices]] = embeds_min_max + embeds_pal_list[[shinymatrices]] = embeds_points[[length(embeds_points)]][[1]]$pal + + + }else{ + + message(matrixName,".rds file is NULL") + + } + + + + }else{ + + message(matrixName,".rds file does not exist") + } + + + } + + scale <- embeds_min_max_list + pal <- embeds_pal_list + + saveRDS(scale, file.path(outputDirEmbeds, "scale.rds")) + saveRDS(pal, file.path(outputDirEmbeds, "pal.rds")) + +} diff --git a/R/exportShinyArchR.R b/R/exportShinyArchR.R deleted file mode 100644 index d757ac5a..00000000 --- a/R/exportShinyArchR.R +++ /dev/null @@ -1,223 +0,0 @@ -# exportShiny function ----------------------------------------------------------- -#' Export a Shiny App based on ArchRProj -#' -#' Generate all files required for an autonomous Shiny app to display browser tracks and embeds. -#' -#' @param ArchRProj An `ArchRProject` object loaded in the environment. Can do this using: loadArchRProject("path to ArchRProject/") -#' @param outputDir The name of the directory for the Shiny App files. -#' @param groupBy The name of the column in cellColData to use for grouping cells together for generating sequencing tracks. Only one cell grouping is allowed. -#' defaults to "Clusters". -#' @param tileSize The numeric width of the tile/bin in basepairs for plotting ATAC-seq signal tracks. All insertions in a single bin will be summed. -#' @param threads The number of threads to use for parallel execution. -#' @param logFile The path to a file to be used for logging ArchR output. -#' @export -exportShinyArchR <- function( - ArchRProj = NULL, - outputDir = "Shiny", - subOutputDir = "inputData", - groupBy = "Clusters", - embedding = "UMAP", - tileSize = 100, - threads = getArchRThreads(), - logFile = createLogFile("exportShinyArchR") -){ - - .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) - .validInput(input = outputDir, name = "outputDir", valid = c("character")) - .validInput(input = groupBy, name = "groupBy", valid = c("character")) - .validInput(input = embedding, name = "embedding", valid = c("character")) - .validInput(input = tileSize, name = "tileSize", valid = c("integer")) - .validInput(input = threads, name = "threads", valid = c("integer")) - .validInput(input = logFile, name = "logFile", valid = c("character")) - - .startLogging(logFile=logFile) - .logThis(mget(names(formals()),sys.frame(sys.nframe())), "exportShinyArchR Input-Parameters", logFile = logFile) - - .requirePackage("shiny", installInfo = 'install.packages("shiny")') - .requirePackage("rhandsontable", installInfo = 'install.packages("rhandsontable")') - - mainDir <- getOutputDirectory(ArchRProj) - # Make directory for Shiny App - if(!dir.exists(outputDir)) { - - dir.create(file.path(mainDir, outputDir), showWarnings = TRUE) - - ## Check the links for the files - filesUrl <- data.frame( - fileUrl = c( - "https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/app.R", - "https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/global.R", - "https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/server.R", - "https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/ui.R" - ), - md5sum = c( - "77502e1f195e21d2f7a4e8ac9c96e65e", - "618613b486e4f8c0101f4c05c69723b0", - "a8d5ae747841055ef230ba496bcfe937" - ), - stringsAsFactors = FALSE - ) - - .downloadFiles(filesUrl = filesUrl, pathDownload = file.path(mainDir, outputDir), threads = threads) - - }else{ - message("Using existing Shiny files...") - } - - # Create a copy of the ArchRProj - ArchRProjShiny <- ArchRProj - - # Add metadata to ArchRProjShiny - if (groupBy %ni% colnames(ArchRProjShiny@cellColData)) { - stop("groupBy is not part of cellColData") - } else if ((any(is.na(paste0("ArchRProj$", groupBy))))) { - stop("Some entries in the column indicated by groupBy have NA values. Please subset your project using subsetArchRProject() to only contain cells with values for groupBy") - } else { - ArchRProjShiny@projectMetadata[["groupBy"]] <- groupBy - } - ArchRProjShiny@projectMetadata[["tileSize"]] <- tileSize - units <- tryCatch({ - .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, "/Info/Units"))[1] - },error=function(e){ - "values" - }) - ArchRProjShiny@projectMetadata[["units"]] <- units - ArchrProjShiny <- saveArchRProject(ArchRProj = ArchRProjShiny, outputDirectory = - file.path(mainDir, outputDir, "Save-ArchRProjShiny"), dropCells = TRUE, overwrite = TRUE) - - # Create fragment files - if(length(list.files(file.path(outputDir, "fragments"))) == 0){ - .getGroupFragsFromProj(ArchRProj = ArchRProj, groupBy = groupBy, outDir = file.path(outputDir, "fragments")) - }else{ - message("Fragment files already exist...") - } - - # Create coverage objects - if(length(list.files(file.path(mainDir, outputDir, "coverage"))) == 0){ - .getClusterCoverage(ArchRProj = ArchRProj, tileSize = tileSize, groupBy = groupBy, outDir = file.path(mainDir, outputDir, "coverage")) - }else{ - message("Coverage files already exist...") - } - - # Create directory to save input data to Shinyapps.io (everything that will be preprocessed) - dir.create(file.path(mainDir, outputDir, subOutputDir), showWarnings = TRUE) - - # if(!file.exists(file.path(mainDir, outputDir, subOutputDir, "features.rds"))){ - # gene_names <- getFeatures(ArchRProj = ArchRProj) - # saveRDS(gene_names, file.path(mainDir, outputDir, subOutputDir, "features.rds")) - # }else{ - # message("gene_names already exists...") - # gene_names <- readRDS(file.path(mainDir, outputDir, subOutputDir, "features.rds")) - # } - - allMatrices <- getAvailableMatrices(ArchRProj) - matrices <- list() - imputeMatrices <- list() - imputeWeights <- getImputeWeights(ArchRProj = ArchRProj) - df <- getEmbedding(ArchRProj, embedding = embedding, returnDF = TRUE) - - if(!file.exists(file.path(outputDir, subOutputDir, "matrices.rds")) && !file.exists(file.path(outputDir, subOutputDir, "imputeMatrices.rds"))){ - for(matName in allMatrices){ - matFeaturesNames <- paste0(matName, "_names") - result = assign(matFeaturesNames, getFeatures(ArchRProj = ArchRProj, useMatrix = matName)) - saveRDS(result, file.path(outputDir, subOutputDir, matName, "_names.rds")) - - if(!is.null(result)){ - - mat = Matrix(.getMatrixValues( - ArchRProj = ArchRProj, - name = result, - matrixName = mat, - log2Norm = FALSE, - threads = threads), sparse = TRUE) - - matrices[[matName]] = mat - matList = mat[,rownames(df), drop=FALSE] - .logThis(matList, paste0(matName,"-Before-Impute"), logFile = logFile) - - if(getArchRVerbose()) message("Imputing Matrix") - imputeMat <- imputeMatrix(mat = as.matrix(matList), imputeWeights = imputeWeights, logFile = logFile) - - if(!inherits(imputeMat, "matrix")){ - imputeMat <- mat(imputeMat, ncol = nrow(df)) - colnames(imputeMat) <- rownames(df) - } - imputeMatrices[[matName]] <- imputeMat - - - }else{ - message(matName, " is NULL.") - } - } - matrices$allColorBy= .availableArrays(head(getArrowFiles(ArchRProj), 2)) - saveRDS(matrices, file.path(outputDir, subOutputDir, "matrices.rds")) - saveRDS(imputeMatrices, file.path(outputDir, subOutputDir, "imputeMatrices.rds")) - }else{ - - message("matrices and imputeMatrices already exist. reading from local files...") - - matrices <- readRDS(file.path(mainDir, outputDir, subOutputDir, "matrices.rds")) - imputeMatrices <- readRDS(file.path(mainDir, outputDir, subOutputDir, "imputeMatrices.rds")) - } - - if(is.null(groupBy)){ - stop("groupBy must be provided") - } else if(groupBy %ni% colnames(getCellColData(ArchRProj))){ - stop("groupBy must be a column in cellColData") - }else{ - print(paste0("groupBy:", groupBy)) - } - - # Check that the embedding exists in ArchRProj@embeddings - if(embedding %ni% names(ArchRProj@embeddings)){ - stop("embedding doesn't exist in ArchRProj@embeddings") - }else{ - print(paste0("embedding:", embedding)) - } - -# mainEmbed will create an HDF5 containing the nativeRaster vectors for cellColData -if (!file.exists(file.path(mainDir, outputDir, subOutputDir, "mainEmbeds.h5"))) { - mainEmbed(ArchRProj = ArchRProj, - outDirEmbed = file.path(mainDir, outputDir, subOutputDir), - colorBy = "cellColData", - names = groupBy, - embeddingDF = df, - matrices = matrices, - imputeMatrices = imputeMatrices, - Shiny = TRUE - ) -} else{ - message("H5 for main embeddings already exists...") -} - -if(!file.exists(file.path(outputDir, subOutputDir, "plotBlank72.h5"))){ - - matrixEmbeds( - ArchRProj = ArchRProj, - outputDirEmbed = file.path(mainDir, outputDir, subOutputDir), - colorBy = "GeneScoreMatrix", - embedding = embedding, - matrices = matrices, - imputeMatrices = imputeMatrices, - threads = getArchRThreads(), - verbose = TRUE, - logFile = createLogFile("matrixEmbeds") - ) - -}else{ - - message("H5 file already exists...") - -} -## delete unnecessary files ----------------------------------------------------------------- -unlink("./fragments", recursive = TRUE) -unlink("./ArchRLogs", recursive = TRUE) - -## ready to launch --------------------------------------------------------------- -message("App created! To launch, - ArchRProj <- loadArchRProject('", mainDir,"') and - run shiny::runApp('", outputDir, "') from parent directory") -# runApp("myappdir") - -} - From f5357555e46daf06ae311c7a53236fa9fd519220 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Mon, 16 Jan 2023 16:17:48 -0800 Subject: [PATCH 071/162] Delete matrixEmbeds.R consolidated into ShinyArchRExports.R --- R/matrixEmbeds.R | 158 ----------------------------------------------- 1 file changed, 158 deletions(-) delete mode 100644 R/matrixEmbeds.R diff --git a/R/matrixEmbeds.R b/R/matrixEmbeds.R deleted file mode 100644 index 691ff933..00000000 --- a/R/matrixEmbeds.R +++ /dev/null @@ -1,158 +0,0 @@ -# matrixEmbeds function ----------------------------------------------------------- -#' -#' -#' Create an HDF5 containing the nativeRaster vectors for all features for all feature matrices. -#' This function will be called by exportShinyArchR() -#' -#' @param ArchRProj An `ArchRProject` object loaded in the environment. Can do this using: loadArchRProject("path to ArchRProject/") -#' @param colorBy A string indicating whether points in the plot should be colored by a column in `cellColData` ("cellColData") or by -#' a data matrix in the corresponding ArrowFiles (i.e. "GeneScoreMatrix", "MotifMatrix", "PeakMatrix"). -#' @param outputDirEmbeds Where the HDF5 and the jpgs will be saved. -#' @param threads The number of threads to use for parallel execution. -#' @param verbose A boolean value that determines whether standard output should be printed. -#' @param logFile The path to a file to be used for logging ArchR output. -#' -matrixEmbeds <- function( - ArchRProj = NULL, - outputDirEmbeds = NULL, - colorBy = c("GeneScoreMatrix", "GeneIntegrationMatrix", "MotifMatrix"), - embedding = "UMAP", - matrices = NULL, - imputeMatricesList = NULL, - threads = getArchRThreads(), - verbose = TRUE, - logFile = createLogFile("matrixEmbeds") -){ - .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) - .validInput(input = outputDirEmbeds, name = "outputDirEmbeds", valid = c("character")) - .validInput(input = threads, name = "threads", valid = c("numeric")) - .validInput(input = verbose, name = "verbose", valid = c("boolean")) - .validInput(input = logFile, name = "logFile", valid = c("character")) - - - if (file.exists(file.path(outputDirEmbeds, "plotBlank72.h5"))){ - file.remove(file.path(outputDirEmbeds, "plotBlank72.h5")) - } - - embeds_min_max_list = list() - embeds_pal_list = list() - - shinyMatrices <- getAvailableMatrices(ArchRProj) - - for(matrix in colorBy){ - if(matrix %ni% shinyMatrices){ - stop(matrix,"not in ArchRProj") - } - matrixName = paste0(matrix,"_names") - - if(file.exists(paste0(outputDirEmbeds, "/", matrixName, ".rds"))){ - - geneMatrixNames <- readRDS(file.path(outputDir, subOutputDir, matName, "_names.rds")) - - if(!is.null(geneMatrixNames)){ - - embeds_points <- .safelapply(1:length(geneMatrixNames), function(x){ - - print(paste0("Creating plots for ", matrix,": ",x,": ",round((x/length(geneMatrixNames))*100,3), "%")) - - if(!is.na(matrices[[matrix]][x])){ - - gene_plot <- plotEmbedding( - ArchRProj = ArchRProj, - colorBy = matrix, - name = geneMatrixNames[x], - embedding = embedding, - quantCut = c(0.01, 0.95), - imputeWeights = getImputeWeights(ArchRProj = ArchRProj), - plotAs = "points", - matrices = matrices, - embeddingDF = df, - imputeMatrices = imputeMatrices, - rastr = TRUE - ) - }else{ - - gene_plot = NULL - } - - if(!is.null(gene_plot)){ - - gene_plot_blank <- gene_plot + theme(axis.title.x = element_blank()) + - theme(axis.title.y = element_blank()) + - theme(axis.title = element_blank()) + - theme(legend.position = "none") + - theme( - panel.grid.major = element_blank(), - panel.grid.minor = element_blank(), - panel.border = element_blank(), - title=element_blank() - ) - - #save plot without axes etc as a jpg. - ggsave(filename = file.path(outputDirEmbeds, paste0(shinymatrices,"_embeds"), paste0(geneMatrixNames[x],"_blank72.jpg")), - plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) - - #read back in that jpg because we need vector in native format - blank_jpg72 <- readJPEG(source = file.path(outputDirEmbeds, paste0(shinymatrices,"_embeds"), - paste0(geneMatrixNames[x],"_blank72.jpg")), native = TRUE) - - g <- ggplot_build(gene_plot) - - res = list(list(plot=as.vector(blank_jpg72), min = round(min(gene_plot$data$color),1), - max = round(max(gene_plot$data$color),1), pal = unique(g$data[[1]][,"colour"]))) - - return(res) - } - - - }, threads = threads) - - names(embeds_points) <- geneMatrixNames - - embeds_points = embeds_points[!unlist(lapply(embeds_points, is.null))] - - embeds_min_max <- data.frame(matrix(NA, 2, length(embeds_points))) - colnames(embeds_min_max) <- names(embeds_points)[which(!unlist(lapply(embeds_points, is.null)))] - rownames(embeds_min_max) <- c("min","max") - - h5closeAll() - points = H5Fcreate(name = file.path(outputDirEmbeds, paste0(shinymatrices,"_plotBlank72.h5"))) - h5createGroup(file.path(outputDirEmbeds, paste0(shinymatrices,"_plotBlank72.h5")), shinymatrices) - - for(i in 1:length(embeds_points)){ - - print(paste0("Getting H5 files for embeds_points: ",i,": ",round((i/length(embeds_points))*100,3), "%")) - h5createDataset(file = points, dataset = paste0(shinymatrices,"/",geneMatrixNames[i]), dims = c(46656,1), storage.mode = "integer") - h5writeDataset(obj = embeds_points[[i]][[1]]$plot, h5loc = points, name=paste0(shinymatrices,"/",geneMatrixNames[i])) - embeds_min_max[1,i] = embeds_points[[i]][[1]]$min - embeds_min_max[2,i] = embeds_points[[i]][[1]]$max - - } - - embeds_min_max_list[[shinymatrices]] = embeds_min_max - embeds_pal_list[[shinymatrices]] = embeds_points[[length(embeds_points)]][[1]]$pal - - - }else{ - - message(matrixName,".rds file is NULL") - - } - - - - }else{ - - message(matrixName,".rds file does not exist") - } - - - } - - scale <- embeds_min_max_list - pal <- embeds_pal_list - - saveRDS(scale, file.path(outputDirEmbeds, "scale.rds")) - saveRDS(pal, file.path(outputDirEmbeds, "pal.rds")) - -} From fdd8a33cb83cc9b303b24cc5d9a4c54e9114cceb Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Mon, 16 Jan 2023 16:18:08 -0800 Subject: [PATCH 072/162] Delete MainEmbed.R consolidated into ShinyArchRExports.R --- R/MainEmbed.R | 122 -------------------------------------------------- 1 file changed, 122 deletions(-) delete mode 100644 R/MainEmbed.R diff --git a/R/MainEmbed.R b/R/MainEmbed.R deleted file mode 100644 index 55b403d6..00000000 --- a/R/MainEmbed.R +++ /dev/null @@ -1,122 +0,0 @@ -# mainEmbed function ----------------------------------------------------------- -#' -#' Create an HDF5, mainEmbeds.h5, containing the nativeRaster vectors for the 5 main embeddings. -#' This function will be called by exportShinyArchR() -#' -#' @param ArchRProj An `ArchRProject` object loaded in the environment. Can do this using: loadArchRProject("path to ArchRProject/") -#' @param outDirEmbed Where the HDF5 and the jpgs will be saved. -#' @param colorBy `cellColData` ("cellColData") only. -#' @param names A list of the names of the columns in `cellColData` or the featureName/rowname of the data matrix to be used for plotting. -#' For example if colorBy is "cellColData" then `names` refers to a column names in the `cellcoldata` (see `getCellcoldata()`). If `colorBy` -#' is "GeneScoreMatrix" then `name` refers to a gene name which can be listed by `getFeatures(ArchRProj, useMatrix = "GeneScoreMatrix")`. -#' @param embedding The embedding to use. Default is "UMAP". -#' @param Shiny A boolean value that tells the function is calling for Shiny or not. -#' @param threads The number of threads to use for parallel execution. -#' @param logFile The path to a file to be used for logging ArchR output. -#' @export -mainEmbed <- function( - ArchRProj = NULL, - outDirEmbed = NULL, - colorBy = "cellColData", - names = NULL, - embedding = "UMAP", - Shiny = FALSE, - threads = getArchRThreads(), - logFile = createLogFile("mainEmbeds") -){ - - .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) - .validInput(input = outDirEmbed, name = "outDirEmbed", valid = c("character")) - .validInput(input = colorBy, name = "colorBy", valid = c("character")) - .validInput(input = names, name = "names", valid = c("character")) - .validInput(input = embedding, name = "embedding", valid = c("character")) - .validInput(input = Shiny, name = "Shiny", valid = c("boolean")) - .validInput(input = threads, name = "threads", valid = c("numeric")) - .validInput(input = logFile, name = "logFile", valid = c("character")) - - .startLogging(logFile=logFile) - .logThis(mget(names(formals()),sys.frame(sys.nframe())), "exportShinyArchR Input-Parameters", logFile = logFile) - - if(!file.exists(file.path(outDirEmbed, "embeds.rds"))){ - - # check all names exist in ArchRProj - if(names %ni% colnames(ArchRProjShiny@cellColData)){ - stop("All columns should be presented in cellColData") - } - - embeds <- .safelapply(1:length(names), function(x){ - name <- names[[x]] - - tryCatch({ - named_embed <- plotEmbedding( - ArchRProj = ArchRProj, - baseSize = 12, - colorBy = colorBy, - name = name, - allNames = names, - embedding = embedding, - embeddingDF = df, - rastr = FALSE, - size = 0.5, - imputeWeights = NULL, - Shiny = TRUE - )+ggtitle(paste0("Colored by ", name))+theme(text = element_text(size=12), - legend.title = element_text(size = 12),legend.text = element_text(size = 6)) - }, error = function(x){ - print(x) - }) - return(named_embed) - }) - - names(embeds) <- names - saveRDS(embeds, file.path(outDirEmbed, "embeds.rds")) - - } else { - message("embeddings already exist...") - embeds <- readRDS(file.path(outDirEmbed, "embeds.rds")) - } - - h5closeAll() - points <- H5Fcreate(name = file.path(outDirEmbed, "mainEmbeds.h5")) - - embed_legend <- list() - embed_color <- list() - - for(i in 1:length(embeds)){ - - embed_plot <- embeds[i] - - embed_plot[[1]]$labels$title <- NULL - embed_plot_blank <- embed_plot[[1]] + theme(axis.title.x = element_blank()) + - theme(axis.title.y = element_blank()) + - theme(axis.title = element_blank()) + - theme(legend.position = "none") + - theme( - panel.grid.major = element_blank(), - panel.grid.minor = element_blank(), - panel.border = element_blank(), - title=element_blank() - ) - - #save plot without axes etc as a jpg - ggsave(filename = file.path(outDirEmbed, paste0(names(embeds)[i],"_blank72.jpg")), - plot = embed_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) - - #read back in that jpg because we need vector in native format - blank_jpg72 <- readJPEG(source = file.path(outDirEmbed, paste0(names(embeds)[[i]],"_blank72.jpg")), native = TRUE) - - h5createDataset(file = points, dataset = names(embeds)[i], dims = c(46656,1), storage.mode = "integer") - h5writeDataset(obj = as.vector(blank_jpg72), h5loc = points, name= names[i]) - - embed_legend[[i]] <- levels(embed_plot[[1]]$data$color) - names(embed_legend)[[i]] <- names(embed_plot) - - - embed_color[[i]] <- unique(ggplot_build(embed_plot[[1]])$data[[1]][,"colour"]) - names(embed_color)[[i]] <- names(embed_plot) - - } - - saveRDS(embed_color, file.path(outDirEmbed, "embeddings.rds")) - saveRDS(embed_legend, file.path(outDirEmbed, "embed_legend_names.rds")) -} From 437db7369ad6a6253a09773fb5273ee87cdd9b84 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Mon, 16 Jan 2023 16:21:27 -0800 Subject: [PATCH 073/162] Delete .DS_Store --- docs/.DS_Store | Bin 10244 -> 0 bytes 1 file changed, 0 insertions(+), 0 deletions(-) delete mode 100644 docs/.DS_Store diff --git a/docs/.DS_Store b/docs/.DS_Store deleted file mode 100644 index 563d15d89d46502ce0d6e61a752911c68db4283a..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 10244 zcmeI1Yitx%6vyvr3!NP(og!?RrO=gHD5cQdQd-K(ZM#qkBFMJ1JePe8Wn_1z?CiFb zQc^^XiHP`u_(~N02FfRlAcIYHL44o`jgiDJMx%)zjGlY%?6SLE5aI(9W|EmR zd+)h3_n!IB`OUpc2!WPF*iDF&5F+4Ctuz)7IW}5P_Yqs3Suz1FV0%JBBtjHo1pAHN z5#CmT6#**(Rs^gFSP`%y@PCK^GMjF~7;dej6#**(Rs>QJp!vaxJGCCu4s**=2OiiI z0Br#lvklL29>Cf-P3tl3Ft@BJUX#xrz-$WU6a#p3tanm(v>wwAbIY3(;LQn`cLsBY z0_^VC&dJ;fc(}EWRs^gFjEn%Cy9*>hVkAz~^!a-*q6e|={a|lIHR3MUXONd)Fluz6 zAc%rkByRR?*ZY0(Ks;fz1Y#TMuQh@A_Mmy*q3e;Rr>wXgjQXP2UJaovBqjx zL6=QksutG!Tl9n$HrRE1yh0Fcg3T{Y8XTP4RA1wq*DzG$9CW+ft{P{3gKKEWCX`mX z7q@SX4(uM>Gqm?vJ~lA(11ZiL>vOpV8tHNSLVA=fR^-heFmn1BeXTqgc>~E{TuKJR zCXTT$YZKf3()d0cWdVn*_FFV<$SwE2?JK zH7;ttP&BSsDj6?|8!&uYT-~NBvCe)q9N)e^V1yJctZF@7eX5}bBT9!Bh$3c`9?+Z+yKuPQuMTmx*l zwhE8Sl!QQJG6%V`oNU6?s$R0693ThD*m=6nJAuNKWuo70my|5a(VJie71Yw9m9}K{5 z7=#DmDR>4B!x4B1UWTJ^9A1Mr;4L`AdzP0J?+UZ0rh#*KGU6?b7=68_Ft_9qreoiSkED^SVk$wIE1&yk@qe)`l9E@_AjISTCSj zrBS@LQEalIo}~g_yGUFjplqelytY|vwb3_AA~&zUqvRMljoLd;E}`PSB|o6%enY(# zLJ8B`WGI8FFatGL4YOc2G(aOXq3&A2i@IxrHE=G=ba8}jSjo|cN6 zSPw=hzRwraBD&Utwe(FHjl_x~yLysq&Srm3CEtdN$uwOkj1h7W>z|+$gOoftIM3Bo z<7}MEAmy%WsByYot_Dh}i50aA*ZOxvqMH6F8y2PzZb^}8ljZ=PWDF{uPx<$s**Bv8 zDw~cZ2c6C)xqZb-@n1>-DG=p=6lc?vY17%O?`5g~=Glbrc#-Uo%dYi~k7U-=a`_s} zswkJ`^z33XYetov#jKjy+01g+iE z(VdQ}da)rLRZZf;bW|-7JtnF+x+oBZENb0=0y(wbAs^t^(nZFt8>1HeR$2zjp&d2Y z0iDo=UrZa=_Y&2hip(+~fnQF$kXa9)5+8;~Of7P19m`T)E^1{Y(=1{g8qJB7<�H zoIdHK%GW)#8yVNgqLdBiRtnjMJGC0lv6S?*PVC=Z!7JqO%Iq&`9L4*a(=)x-*Yiy8 zJ8`gi5ADCT-Hs8+=Yw|A_5Y>U{{R1W42?BrD+0Go1fam{^S0n{lk<}7k<+zyC+=Hu zryKPf=9V?V19hS0Y&jl((B*ix{DNi4br)LiG5v From 9c04fe6d06cf69c7f10d7d57f9248f2cb527c7f4 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Mon, 16 Jan 2023 16:22:07 -0800 Subject: [PATCH 074/162] Delete .DS_Store --- man/.DS_Store | Bin 6148 -> 0 bytes 1 file changed, 0 insertions(+), 0 deletions(-) delete mode 100644 man/.DS_Store diff --git a/man/.DS_Store b/man/.DS_Store deleted file mode 100644 index a9630a4cdd6b992771a3b769f7ca7baea67b4cef..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 6148 zcmeHK&2HL25S}F@7@ zbLkJ%)X%!vByDxa=d?OeDh?L&Zg3j)rk(2RLzQIRDCv!LLKOBe(1bkB5o+VaOEt-D!Dc zaREPZ@?>9e-}S$$;Yf!Rf4^Ie7^-$Vi1p6tgKuvCy8XN^DttlIXs}%Enu Date: Mon, 16 Jan 2023 16:22:58 -0800 Subject: [PATCH 075/162] Delete .DS_Store --- data/.DS_Store | Bin 8196 -> 0 bytes 1 file changed, 0 insertions(+), 0 deletions(-) delete mode 100644 data/.DS_Store diff --git a/data/.DS_Store b/data/.DS_Store deleted file mode 100644 index 3048b847659779cad34dba6ccab803b0a105f899..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 8196 zcmeHMOK=oL818=(NY8}8Btt?XwPa1e!kEA&1fn3Yd4WhYkj<0VGMgEbk=dEBGrJ4K zXijJ;RccxIy87h8!745B0#RgWjv6xLJD&N!kj=bGXxO|@Y&HW%GC+P zg$&COfe?Y)5nygpPC7AOcQ9&S9KU<1yf>Ay-4tqEN=@08=f`66AeEFZTV6)XXgNKa zm~`_AU-z?Km!3JyT7#}@rwVmFHEfyrq`JD>b$s1&%nUcM3=>t3j98B0=DXaiV|d&) zAqJ>S<)m6SJ>Ay6t+hECn`w?tx3+b3G)G%wTer^4$h5j~^NxY!2|Mk$&xsvDa4V3C zTXuM^`1b6H*2K7*o)Q+d>>eosgze?J1rQ~b1t7jI03j>o+R(5vI%9Q zBC!vf2Qp?35f~YF?QGidl4|9+ZjWbe-8VaJn<;yvzIn=LwL_kp@w>TVQdP5_Ibfom zl{0%#8%?X&m-?rC%XPeAGvlFbjK{>{<%=t-BMtZ57u&jhSNGoi{c{y7SE-d%nsNvs zb$shF%ghYrEyJH2)4g%iF)U|dBxiY6$~FfbJ#AJ(GnMBmYSz@&-KA;8R7bNZ>txpQ zPpgfT&Z#R`RVek^-Lm>VJ!0S@A8`#flfg%{dTj%xhgpAj#>7%|D;u>YS=H&Fhg%k( zXi+xHswWSgKt2f5Hl>}ahCF2JDbp5R9m)e#-7k;i#Lh)$m9mq{qj-jC+@vS^;#wC~ zKc&am#C^Kw_fMHlVM%dq52c5^Nj+os=aG#Ci-#%Yhlc&kq}Q-~H^b5BtJkzK_Nh+8 zFb&*vZOxhr?Vy&R>KACET29VF{^MB)H=vF2CUGPjR(Z8(ER^h(t0N7hojgbmkTGJA zJUK_slb6X`l$;3S-ZX_$d0;Ve84FTjiNI=lgI!rSl;d;pi>3VaM# z;Y*l@uiz*68E(LD@VitdQAv@?rFBxhv{7o2Hi@-M1qT~j*bA>nyHON(o8bPC>^r$l zq<4?<&_C)n*H#3MvbuU*WC+P^ zo+{>8Y8g79Oy`((eN>64%aHz}xqbsSmm~E>^WLUNM3vCvM03;Th@zIDKgry7OA|IB zXms4KC~7HsmONLtrnW{|8`&jOm2ky)Cw_+c3H|$wy+Gb0ACfENDl+yv@;&*H{0an? z!wO{RI*1}m*TV*6X$;z63$(*d*bSY~g`Dk!N8tb*gaJ4VMP9w*`kX0MJ|zXY}c7Uje=J(?WIp8V#-<;|MwRE{eS5f7S0$V5F)T-2ta91 zqNfX|D|Q{RSUZaOIA)fZ-mH+^1PdOHqvYW@%7uRzVm*qg%qAYlSs}3p(~|!Xu;|a` U@cj?pf23fMcRKC Date: Mon, 16 Jan 2023 16:23:23 -0800 Subject: [PATCH 076/162] Delete .DS_Store --- src/.DS_Store | Bin 6148 -> 0 bytes 1 file changed, 0 insertions(+), 0 deletions(-) delete mode 100644 src/.DS_Store diff --git a/src/.DS_Store b/src/.DS_Store deleted file mode 100644 index 5008ddfcf53c02e82d7eee2e57c38e5672ef89f6..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 6148 zcmeH~Jr2S!425mzP>H1@V-^m;4Wg<&0T*E43hX&L&p$$qDprKhvt+--jT7}7np#A3 zem<@ulZcFPQ@L2!n>{z**++&mCkOWA81W14cNZlEfg7;MkzE(HCqgga^y>{tEnwC%0;vJ&^%eQ zLs35+`xjp>T0 Date: Mon, 16 Jan 2023 16:23:52 -0800 Subject: [PATCH 077/162] Delete .DS_Store --- docs/articles/.DS_Store | Bin 8196 -> 0 bytes 1 file changed, 0 insertions(+), 0 deletions(-) delete mode 100644 docs/articles/.DS_Store diff --git a/docs/articles/.DS_Store b/docs/articles/.DS_Store deleted file mode 100644 index 48fc8ecd21d55e7a3f7027cd96359ceda92704cd..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 8196 zcmeHLUu+ab7@w~#Fx$0sTPrOK?VXfbzzTP1X#msq+B-~3i$$)`LV>b(yV8w&yXWoR zl~Rk1z8FxStcrg^;)5~b0}oac|2-I^5E4zKiNS;iW8#a6CTfiFMZcNZBhVK0$q?8{ zX1<;IzHer~-~MLiz9WP{PhO7_Qb!1(SeaC0Y?dfY&+4L5;*T&Tpg$pLViAM5sR=i` z$T}DZ5C{+m5C{+m5C{;s6%fEXn-zMKdtYdSHb5Xi;EqIqoeyEGOvZdUBP2gMu;D2H z$}$}01)nhw;67nr#(X&=BzMI*MfL!`EBGk}2zS(nnK{asFK2`l?gWH80e@xiGZf&f zqhFYt6Nm{Jv;hJE0*et4$$dA;5s#SH=kF=YNul}0RMs+GFB16%N=nO?Enh)tIW4a! zKb#zQCX$}!<=q}FH_Cc@G;ciRKMy&Mb?sS8?Kh2yF{LK%*q&zEMvgn1x`8H#hD}>{ zCVHH_t-E}lq)<>QQE5!6o0@9f-qsS{+CJS9o{C1Ik(O{VgvttAe9SZeFgiJEC|#(7EPv|4F9vDWZRC}C2ib7T!2w>z6i#*MKGjtS*}of z`+9fv4~!{F-Zl0bmgboSBcXYQJEl~+h)iGFvG?SR0-`XScC38HMom>(v(kAqHo7e< zX`T?)>6~L(dmPvFOvgSj;u*(1rehP`pc*;oIyo=SCmS(weqmM3))>q(XLrAmb5Tmt zxs|nR?`_(&rEPm>e7;hts+McyRl^0-HB*+cZ^G2Q@dKKhHf-Irj~ztxZO?qvG;&fE zj7dYbmNDk5m8#0R)v7v@PnnPBO>a_Zq?C`=H>mO<9i!Oo=*&x3=BUIq>l##blxgBQ z16v&(_~Om#MoH1=kc)ANkrsKgq`1=1V@L%)qDJLbs_4=_OG_D+7;2ZdQKerRE{L$i z;Dd4pt%4S51ixYi-`nLYcg0lo2wQnTbG^Z=VdGm}@RwH`)Q2cNz_i`Ej&IdiBuZm! zgLvd2H^w5Or?9K3ohg9RCIAPWU}5@z5jcp6T_ z3or{W!x?x3&cO%p5qu1vz!z`ntFi#hKWvOb?@ zm*#Vb^LgVf%jYXA8ISI+xo1^vxM|bo)@>a<*S`OP&wc|luO}mCpP(0~U6EFT?nw1D zYwP9EJ|v`ZeBl-;ZXIO>qaK}Kvs$eStqZNENHRrq<>nBQe2yw0w9TOhC{;@4*~D8S zAz3NK9U$>;+g3TGEJLzW-rc@KmX$Kx4MN-5h1%uFd!dadP)pdpl>U{t|47@5Qbc5IEjRRBhfFF zOK0zwKkHuFPXAAK+41WS{`2e=7HyP5GG|+keGGNQ4aV$lpHeD9sbl&7&YS=LfBOU+ zL=qqnAg~AlC`%+0Jve-`V~*w8VXQ~7vcl|Ugyb&R@N^s{PsdUE={UCyqbc)=`Eo`` Z9KrIx{}CX5j0X3AaQ|OR{O-j2|8J0mWXS*k From de512c7f780772f589c9fe87270f2bd3771775a7 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Mon, 16 Jan 2023 16:24:01 -0800 Subject: [PATCH 078/162] Delete .DS_Store --- docs/articles/Articles/.DS_Store | Bin 6148 -> 0 bytes 1 file changed, 0 insertions(+), 0 deletions(-) delete mode 100644 docs/articles/Articles/.DS_Store diff --git a/docs/articles/Articles/.DS_Store b/docs/articles/Articles/.DS_Store deleted file mode 100644 index 5008ddfcf53c02e82d7eee2e57c38e5672ef89f6..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 6148 zcmeH~Jr2S!425mzP>H1@V-^m;4Wg<&0T*E43hX&L&p$$qDprKhvt+--jT7}7np#A3 zem<@ulZcFPQ@L2!n>{z**++&mCkOWA81W14cNZlEfg7;MkzE(HCqgga^y>{tEnwC%0;vJ&^%eQ zLs35+`xjp>T0 Date: Mon, 16 Jan 2023 16:24:23 -0800 Subject: [PATCH 079/162] Delete .DS_Store --- R/.DS_Store | Bin 10244 -> 0 bytes 1 file changed, 0 insertions(+), 0 deletions(-) delete mode 100644 R/.DS_Store diff --git a/R/.DS_Store b/R/.DS_Store deleted file mode 100644 index f00a9343cb1c206a5a68f34118645b3058421346..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 10244 zcmeHM%Tg0T6ulE!VC6xeigKGJD@)gIB7|3!SQzlJG%qnSW~eYhaFvb!;4kD{l_8=5n0AXS+C$082p`AVU+AQ8;}X` zBB^xb9G?NMI3fd)fyh8)ATkgc_!k+#JDX#a&3fH5>tYVu>ItrmUpnw4vIg7; zpG

`*RuMX(YSY{qwtzkOdvd7qsTGqhmFw;}F=6oZ=KAsG;=6(NKeivGnAnlDs^t4$k*6fdZ}@zK~H}!z`X{32yB2O<@u`Rt0)U`V5M@fFSN1U}Lp?T+N67-#YT{<^po;4;|FfH_1yQlN9yF()q` zx(f6d2v)|xVXWY9LY`c^b!oxoM7q}Exf~&0dckw00$%gu;>)s)>g!^5AD=nVl4Y+F ztFnW+spV)3X!b|v|umlNQ~axS-2lZUJWNmN%e(}KV6 z@WeXFLtc|54_^bm4FvrpuM2D|SC?Kz?jlm==uB(m0vg89Wi%Bsq>Q%Et+@ArMyvcXE=y0jol)}e>2$Uf|xAxd|BD@3Qvx)#g8 zjV!JOZ;39Tl+zy$r|XJhube2CtReEsHI}`1g&Yk-nN@aOO*LpToo-fTYI%kp+An%R zeiIj4#mo#IFq7kjY;h%bk##xH%$zE62X|VZKufS|m2DTlruZE5ho}hF^97zv1k81y z6P0;ahw)*i<5nM-1Mgkp`(WN=gT<>4+4po*y*Q2$1J})f_vGF~)^Duu2f*ccuVtv+ z5FQzj4X1+Y@&bIbR`_PQ(#{;=iJg`Pa*ulV>{qcK^ia2FSU>;tWWX|c_mJyA4uGSj zK78oG1G9S1-sDFbORx({-@O>x@*FkK4)S|}HBiKpeHUMmV|dY#**lW!%A8fg!>!6I z%Us{7xkal5*!MK7Km+@8mVwWRcy9Nz`aLvK8AoIwG7uSv3`7R*gn@g;N`vSB+w=eb ze{&x lQF7q9Y30;Ne1mc4{|pG8>%{#(QW5w6JaI5*5dZc5|2H0RNn!v1 From 1681eb2d7009ff5718516c1dc9935e1eda1a2ac0 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Mon, 16 Jan 2023 16:29:06 -0800 Subject: [PATCH 080/162] harmonize mainEmbeds and matrixEmbeds --- R/ShinyArchRExports.R | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 2d5835a8..bdaad050 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -2,7 +2,7 @@ #' #' Export a Shiny App based on ArchRProj #' -#' Generate all files required for an autonomous Shiny app to display browser tracks and embeds. +#' Generate all files required for an autonomous Shiny app to display browser tracks and embeddings. #' #' @param ArchRProj An `ArchRProject` object loaded in the environment. Can do this using: loadArchRProject("path to ArchRProject/") #' @param outputDir The name of the directory for the Shiny App files. @@ -194,16 +194,17 @@ exportShinyArchR <- function( print(paste0("embedding:", embedding)) } -# mainEmbed will create an HDF5 containing the nativeRaster vectors for cellColData +# mainEmbeds will create an HDF5 containing the nativeRaster vectors for cellColData if (!file.exists(file.path(mainDir, outputDir, subOutputDir, "mainEmbeds.h5"))) { - mainEmbed(ArchRProj = ArchRProj, + .mainEmbeds(ArchRProj = ArchRProj, outDirEmbed = file.path(mainDir, outputDir, subOutputDir), colorBy = "cellColData", names = groupBy, embeddingDF = df, matrices = matrices, imputeMatrices = imputeMatrices, - Shiny = TRUE + Shiny = TRUE, + logFile = createLogFile("mainEmbeds") ) } else{ message("H5 for main embeddings already exists...") @@ -211,7 +212,7 @@ if (!file.exists(file.path(mainDir, outputDir, subOutputDir, "mainEmbeds.h5"))) if(!file.exists(file.path(outputDir, subOutputDir, "plotBlank72.h5"))){ - matrixEmbeds( + .matrixEmbeds( ArchRProj = ArchRProj, outputDirEmbed = file.path(mainDir, outputDir, subOutputDir), colorBy = "GeneScoreMatrix", @@ -254,7 +255,7 @@ message("App created! To launch, #' @param threads The number of threads to use for parallel execution. #' @param logFile The path to a file to be used for logging ArchR output. #' -.mainEmbed <- function( +.mainEmbeds <- function( ArchRProj = NULL, outDirEmbed = NULL, colorBy = "cellColData", From 99915f278c541646102dd660d56383c11039f342 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Tue, 17 Jan 2023 06:45:22 -0800 Subject: [PATCH 081/162] partial update to exportShinyArchR -make subOutputDir hardcoded to "inputData" -commented out "units". I'm not sure what this line is meant to achieve but `colorBy` isnt defined so this will always fail. The units will be different for every matrix so I'm not sure this is needed? It doesnt look like this is used elsewhere. if that is true, then please delete. otherwise, needs to be fixed. -remove groupBy checks since .validInput checks for NULL and other relevant checks already happen above -add `cellColEmbeddings` param because otherwise `groupBy` was being used to define which mainEmbeds get made and this doesnt work -fix issue with the colorBy param for matrixEmbeds. It was hardcoded as GSM in the function call but should be the intersection of all matrices with the supported matrices. Should also consider making GeneExpressionMatrix supported. --- R/ShinyArchRExports.R | 196 ++++++++++++++++++++++-------------------- 1 file changed, 104 insertions(+), 92 deletions(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index bdaad050..d26af6d4 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -1,13 +1,16 @@ -# Functions for exporting a ArchR-based Shiny app ----------------------------------------------------------- +# Functions for exporting an ArchR-based Shiny app ----------------------------------------------------------- #' -#' Export a Shiny App based on ArchRProj +#' Export a Shiny App based on an ArchRProj #' #' Generate all files required for an autonomous Shiny app to display browser tracks and embeddings. #' -#' @param ArchRProj An `ArchRProject` object loaded in the environment. Can do this using: loadArchRProject("path to ArchRProject/") -#' @param outputDir The name of the directory for the Shiny App files. -#' @param groupBy The name of the column in cellColData to use for grouping cells together for generating sequencing tracks. Only one cell grouping is allowed. -#' defaults to "Clusters". +#' @param ArchRProj An `ArchRProject` object. +#' @param outputDir The name (not the path!) of the directory for the Shiny App files. This will become a sub-directory of the ArchRProj output directory +#' given by `getOutputDirectory(ArchRProj)`. +#' @param groupBy The name of the column in `cellColData` to use for grouping cells together for generating BigWig-style sequencing tracks. +#' Only one cell grouping is allowed. +#' @param cellColEmbeddings A character vector of columns in `cellColData` to plot as part of the Shiny app. No default is provided so this must be set. +#' For ex. `c("Sample","Clusters","TSSEnrichment","nFrags")`. #' @param tileSize The numeric width of the tile/bin in basepairs for plotting ATAC-seq signal tracks. All insertions in a single bin will be summed. #' @param force A boolean value that indicates whether to overwrite any relevant files during the `exportShinyArchR()` process. #' @param threads The number of threads to use for parallel execution. @@ -16,8 +19,8 @@ exportShinyArchR <- function( ArchRProj = NULL, outputDir = "Shiny", - subOutputDir = "inputData", groupBy = "Clusters", + cellColEmbeddings = NULL, embedding = "UMAP", tileSize = 100, force = FALSE, @@ -29,6 +32,7 @@ exportShinyArchR <- function( .validInput(input = outputDir, name = "outputDir", valid = c("character")) .validInput(input = outputDir, name = "subOutputDir", valid = c("character")) .validInput(input = groupBy, name = "groupBy", valid = c("character")) + .validInput(input = cellColEmbeddings, name = "groupBy", valid = c("character", "null")) .validInput(input = embedding, name = "embedding", valid = c("character")) .validInput(input = tileSize, name = "tileSize", valid = c("integer")) .validInput(input = force, name = "force", valid = c("boolean")) @@ -41,6 +45,31 @@ exportShinyArchR <- function( .requirePackage("shiny", installInfo = 'install.packages("shiny")') .requirePackage("rhandsontable", installInfo = 'install.packages("rhandsontable")') + if(length(groupBy) > 1){ + stop("Only one value is allowed for groupBy".) + } + + if(is.null(cellColEmbeddings)){ + stop("The cellColEmbeddings parameter must be defined! Please see function input definitions.") + } else if(!all(cellColEmbeddings %in% colnames(ArchRProj@cellColData)){ + stop("Not all entries in cellColEmbeddings exist in the cellColData of your ArchRProj. Please check provided inputs.") + } + + # Check that the embedding exists in ArchRProj@embeddings + if(embedding %ni% names(ArchRProj@embeddings)){ + stop("embedding doesn't exist in ArchRProj@embeddings") + }else{ + print(paste0("embedding:", embedding)) + } + + #check that groupBy column exists and doesnt have NA values + if (groupBy %ni% colnames(ArchRProjShiny@cellColData)) { + stop("groupBy is not part of cellColData") + } else if ((any(is.na(paste0("ArchRProj$", groupBy))))) { + stop("Some entries in the column indicated by groupBy have NA values. Please subset your project using subsetArchRProject() to only contain cells with values for groupBy") + } + + subOutputDir <- "inputData" #hardcoded mainDir <- getOutputDirectory(ArchRProj) # Make directory for Shiny App if(!dir.exists(outputDir)) { @@ -73,49 +102,45 @@ exportShinyArchR <- function( ArchRProjShiny <- ArchRProj # Add metadata to ArchRProjShiny - if (groupBy %ni% colnames(ArchRProjShiny@cellColData)) { - stop("groupBy is not part of cellColData") - } else if ((any(is.na(paste0("ArchRProj$", groupBy))))) { - stop("Some entries in the column indicated by groupBy have NA values. Please subset your project using subsetArchRProject() to only contain cells with values for groupBy") - } else { - ArchRProjShiny@projectMetadata[["groupBy"]] <- groupBy - } + ArchRProjShiny@projectMetadata[["groupBy"]] <- groupBy ArchRProjShiny@projectMetadata[["tileSize"]] <- tileSize - units <- tryCatch({ - .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, "/Info/Units"))[1] - },error=function(e){ - "values" - }) - ArchRProjShiny@projectMetadata[["units"]] <- units - ArchrProjShiny <- saveArchRProject(ArchRProj = ArchRProjShiny, outputDirectory = - file.path(mainDir, outputDir, "Save-ArchRProjShiny"), dropCells = TRUE, overwrite = TRUE) + #units <- tryCatch({ + # .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, "/Info/Units"))[1] + #},error=function(e){ + # "values" + #}) + #ArchRProjShiny@projectMetadata[["units"]] <- units + ArchRProjShiny <- saveArchRProject(ArchRProj = ArchRProjShiny, outputDirectory = + file.path(mainDir, outputDir, "Save-ArchRProjShiny"), dropCells = TRUE, overwrite = TRUE, load = TRUE) - # Create fragment files - fragDir <- file.path(mainDir, "ShinyFragments", groupBy) + projDir <- getOutputDirectory(ArchRProj = ArchRProjShiny) + + # Create fragment files - should be saved within a dir called ShinyFragments within the ArchRProjShiny output directory + fragDir <- file.path(projDir, "ShinyFragments", groupBy) fragFiles <- list.files(path = file.path(fragDir, pattern = "\\_frags.rds$") #this is still a slightly dangerous comparison, better would be to compare for explicitly the file names that are expected if(length(fragFiles) == length(unique(ArchRProjShiny@cellColData[,groupBy]))){ if(force){ - .getGroupFragsFromProj(ArchRProj = ArchRProj, groupBy = groupBy, outDir = fragDir) + .getGroupFragsFromProj(ArchRProj = ArchRProjShiny, groupBy = groupBy, outDir = fragDir) } else{ message("Fragment files already exist. Skipping fragment file generation...") } }else - .getGroupFragsFromProj(ArchRProj = ArchRProj, groupBy = groupBy, outDir = fragDir) + .getGroupFragsFromProj(ArchRProj = ArchRProjShiny, groupBy = groupBy, outDir = fragDir) } - # Create coverage objects - covDir <- file.path(mainDir, "ShinyCoverage", groupBy) + # Create coverage objects - should be saved within a dir called ShinyCoverage within the ArchRProjShiny output directory + covDir <- file.path(projDir, "ShinyCoverage", groupBy) covFiles <- list.files(path = covDir, pattern = "\\_cvg.rds$") #this is still a slightly dangerous comparison, better would be to compare for explicitly the file names that are expected if(length(covFiles) == length(unique(ArchRProjShiny@cellColData[,groupBy]))){ if(force){ - .getClusterCoverage(ArchRProj = ArchRProj, tileSize = tileSize, groupBy = groupBy, outDir = covDir) + .getClusterCoverage(ArchRProj = ArchRProjShiny, tileSize = tileSize, groupBy = groupBy, outDir = covDir) } else{ message("Coverage files already exist. Skipping fragment file generation...") } }else{ - .getClusterCoverage(ArchRProj = ArchRProj, tileSize = tileSize, groupBy = groupBy, outDir = covDir) + .getClusterCoverage(ArchRProj = ArchRProjShiny, tileSize = tileSize, groupBy = groupBy, outDir = covDir) } # Create directory to save input data to Shinyapps.io (everything that will be preprocessed) @@ -129,22 +154,22 @@ exportShinyArchR <- function( # gene_names <- readRDS(file.path(mainDir, outputDir, subOutputDir, "features.rds")) # } - allMatrices <- getAvailableMatrices(ArchRProj) + allMatrices <- getAvailableMatrices(ArchRProjShiny) matrices <- list() imputeMatrices <- list() - imputeWeights <- getImputeWeights(ArchRProj = ArchRProj) - df <- getEmbedding(ArchRProj, embedding = embedding, returnDF = TRUE) + imputeWeights <- getImputeWeights(ArchRProj = ArchRProjShiny) + df <- getEmbedding(ArchRProjShiny, embedding = embedding, returnDF = TRUE) if(!file.exists(file.path(outputDir, subOutputDir, "matrices.rds")) && !file.exists(file.path(outputDir, subOutputDir, "imputeMatrices.rds"))){ for(matName in allMatrices){ matFeaturesNames <- paste0(matName, "_names") - result = assign(matFeaturesNames, getFeatures(ArchRProj = ArchRProj, useMatrix = matName)) + result = assign(matFeaturesNames, getFeatures(ArchRProj = ArchRProjShiny, useMatrix = matName)) saveRDS(result, file.path(outputDir, subOutputDir, matName, "_names.rds")) if(!is.null(result)){ mat = Matrix(.getMatrixValues( - ArchRProj = ArchRProj, + ArchRProj = ArchRProjShiny, name = result, matrixName = mat, log2Norm = FALSE, @@ -168,7 +193,7 @@ exportShinyArchR <- function( message(matName, " is NULL.") } } - matrices$allColorBy= .availableArrays(head(getArrowFiles(ArchRProj), 2)) + matrices$allColorBy= .availableArrays(head(getArrowFiles(ArchRProjShiny), 2)) saveRDS(matrices, file.path(outputDir, subOutputDir, "matrices.rds")) saveRDS(imputeMatrices, file.path(outputDir, subOutputDir, "imputeMatrices.rds")) }else{ @@ -178,70 +203,57 @@ exportShinyArchR <- function( matrices <- readRDS(file.path(mainDir, outputDir, subOutputDir, "matrices.rds")) imputeMatrices <- readRDS(file.path(mainDir, outputDir, subOutputDir, "imputeMatrices.rds")) } - - if(is.null(groupBy)){ - stop("groupBy must be provided") - } else if(groupBy %ni% colnames(getCellColData(ArchRProj))){ - stop("groupBy must be a column in cellColData") - }else{ - print(paste0("groupBy:", groupBy)) + + # mainEmbeds will create an HDF5 file containing the nativeRaster vectors for data stored in cellColData + if (!file.exists(file.path(mainDir, outputDir, subOutputDir, "mainEmbeds.h5"))) { + .mainEmbeds(ArchRProj = ArchRProjShiny, + outDirEmbed = file.path(mainDir, outputDir, subOutputDir), + colorBy = "cellColData", + names = cellColEmbeddings, + embeddingDF = df, + matrices = matrices, + imputeMatrices = imputeMatrices, + Shiny = TRUE, + logFile = createLogFile("mainEmbeds") + ) + } else{ + message("H5 for main embeddings already exists...") } - # Check that the embedding exists in ArchRProj@embeddings - if(embedding %ni% names(ArchRProj@embeddings)){ - stop("embedding doesn't exist in ArchRProj@embeddings") + # matrixEmbeds will create an HDF5 file containing + supportedMatrices <- c("GeneScoreMatrix", "GeneIntegrationMatrix", "MotifMatrix") #only these matrices are currently supported for ShinyArchR + if(!file.exists(file.path(outputDir, subOutputDir, "plotBlank72.h5"))){ + + .matrixEmbeds( + ArchRProj = ArchRProj, + outputDirEmbed = file.path(mainDir, outputDir, subOutputDir), + colorBy = intersect(supportedMatrices, allMatrices), + embedding = embedding, + matrices = matrices, + imputeMatrices = imputeMatrices, + threads = getArchRThreads(), + verbose = TRUE, + logFile = createLogFile("matrixEmbeds") + ) + }else{ - print(paste0("embedding:", embedding)) - } - -# mainEmbeds will create an HDF5 containing the nativeRaster vectors for cellColData -if (!file.exists(file.path(mainDir, outputDir, subOutputDir, "mainEmbeds.h5"))) { - .mainEmbeds(ArchRProj = ArchRProj, - outDirEmbed = file.path(mainDir, outputDir, subOutputDir), - colorBy = "cellColData", - names = groupBy, - embeddingDF = df, - matrices = matrices, - imputeMatrices = imputeMatrices, - Shiny = TRUE, - logFile = createLogFile("mainEmbeds") - ) -} else{ - message("H5 for main embeddings already exists...") -} -if(!file.exists(file.path(outputDir, subOutputDir, "plotBlank72.h5"))){ - - .matrixEmbeds( - ArchRProj = ArchRProj, - outputDirEmbed = file.path(mainDir, outputDir, subOutputDir), - colorBy = "GeneScoreMatrix", - embedding = embedding, - matrices = matrices, - imputeMatrices = imputeMatrices, - threads = getArchRThreads(), - verbose = TRUE, - logFile = createLogFile("matrixEmbeds") - ) - -}else{ - - message("H5 file already exists...") - -} -## delete unnecessary files ----------------------------------------------------------------- -unlink("./fragments", recursive = TRUE) -unlink("./ArchRLogs", recursive = TRUE) + message("H5 file already exists...") + + } + ## delete unnecessary files ----------------------------------------------------------------- + unlink(file.path(projDir, "ShinyFragments"), recursive = TRUE) + #unlink("./ArchRLogs", recursive = TRUE) #this seems like a bad idea. ArchRLogs arent specific to an individual project so this would wipe all logs -## ready to launch --------------------------------------------------------------- -message("App created! To launch, - ArchRProj <- loadArchRProject('", mainDir,"') and - run shiny::runApp('", outputDir, "') from parent directory") -# runApp("myappdir") + ## ready to launch --------------------------------------------------------------- + message("App created! To launch, + ArchRProj <- loadArchRProject('", projDir,"') and + run shiny::runApp('", outputDir, "') from parent directory") + # runApp("myappdir") } -#' Create an HDF5, mainEmbeds.h5, containing the nativeRaster vectors for the 5 main embeddings. +#' Create an HDF5 file, mainEmbeds.h5, containing the nativeRaster vectors for the 5 main embeddings. #' This function will be called by exportShinyArchR() #' #' @param ArchRProj An `ArchRProject` object loaded in the environment. Can do this using: loadArchRProject("path to ArchRProject/") From d0de886dd2d1ba4cf24bd5c434ef43d96e474707 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Tue, 17 Jan 2023 09:28:48 -0800 Subject: [PATCH 082/162] additional shiny export edits -`Shiny` param to `.mainEmbeds` is not used so removed -`embedding` param to `exportShinyArchR` is not defined -change definition for the `names` param of `.mainEmbeds` (now called `cellColEmbeddings`) because I dont think this function is meant to be used for anything other than `cellColData` (i.e. no `GeneScoreMatrix`) -`shinymatrices` never defined. `shinyMatrices` was defined but this was a vector and didnt make sense. changed to `matrix` which I think is what you meant -`matName` not available in scope of `.matrixEmbeds` function and not defined -changes to indentation levels for legibility --- R/ShinyArchRExports.R | 177 +++++++++++++++++++----------------------- 1 file changed, 81 insertions(+), 96 deletions(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index d26af6d4..c2fb1539 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -11,6 +11,7 @@ #' Only one cell grouping is allowed. #' @param cellColEmbeddings A character vector of columns in `cellColData` to plot as part of the Shiny app. No default is provided so this must be set. #' For ex. `c("Sample","Clusters","TSSEnrichment","nFrags")`. +#' @param embedding The name of the embedding from `ArchRProj` to be used for plotting embeddings in the Shiny app. #' @param tileSize The numeric width of the tile/bin in basepairs for plotting ATAC-seq signal tracks. All insertions in a single bin will be summed. #' @param force A boolean value that indicates whether to overwrite any relevant files during the `exportShinyArchR()` process. #' @param threads The number of threads to use for parallel execution. @@ -209,7 +210,7 @@ exportShinyArchR <- function( .mainEmbeds(ArchRProj = ArchRProjShiny, outDirEmbed = file.path(mainDir, outputDir, subOutputDir), colorBy = "cellColData", - names = cellColEmbeddings, + cellColEmbeddings = cellColEmbeddings, embeddingDF = df, matrices = matrices, imputeMatrices = imputeMatrices, @@ -259,11 +260,9 @@ exportShinyArchR <- function( #' @param ArchRProj An `ArchRProject` object loaded in the environment. Can do this using: loadArchRProject("path to ArchRProject/") #' @param outDirEmbed Where the HDF5 and the jpgs will be saved. #' @param colorBy `cellColData` ("cellColData") only. -#' @param names A list of the names of the columns in `cellColData` or the featureName/rowname of the data matrix to be used for plotting. -#' For example if colorBy is "cellColData" then `names` refers to a column names in the `cellcoldata` (see `getCellcoldata()`). If `colorBy` -#' is "GeneScoreMatrix" then `name` refers to a gene name which can be listed by `getFeatures(ArchRProj, useMatrix = "GeneScoreMatrix")`. +#' @param cellColEmbeddings A character vector of columns in `cellColData` to plot as part of the Shiny app. No default is provided so this must be set. +#' For ex. `c("Sample","Clusters","TSSEnrichment","nFrags")`. #' @param embedding The embedding to use. Default is "UMAP". -#' @param Shiny A boolean value that tells the function is calling for Shiny or not. #' @param threads The number of threads to use for parallel execution. #' @param logFile The path to a file to be used for logging ArchR output. #' @@ -271,9 +270,8 @@ exportShinyArchR <- function( ArchRProj = NULL, outDirEmbed = NULL, colorBy = "cellColData", - names = NULL, + cellColEmbeddings = NULL, embedding = "UMAP", - Shiny = FALSE, threads = getArchRThreads(), logFile = createLogFile("mainEmbeds") ){ @@ -281,9 +279,8 @@ exportShinyArchR <- function( .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) .validInput(input = outDirEmbed, name = "outDirEmbed", valid = c("character")) .validInput(input = colorBy, name = "colorBy", valid = c("character")) - .validInput(input = names, name = "names", valid = c("character")) + .validInput(input = cellColEmbeddings, name = "cellColEmbeddings", valid = c("character")) .validInput(input = embedding, name = "embedding", valid = c("character")) - .validInput(input = Shiny, name = "Shiny", valid = c("boolean")) .validInput(input = threads, name = "threads", valid = c("numeric")) .validInput(input = logFile, name = "logFile", valid = c("character")) @@ -293,12 +290,12 @@ exportShinyArchR <- function( if(!file.exists(file.path(outDirEmbed, "embeds.rds"))){ # check all names exist in ArchRProj - if(names %ni% colnames(ArchRProjShiny@cellColData)){ - stop("All columns should be presented in cellColData") + if(cellColEmbeddings %ni% colnames(ArchRProj@cellColData)){ + stop("All columns should be present in cellColData") } - embeds <- .safelapply(1:length(names), function(x){ - name <- names[[x]] + embeds <- .safelapply(1:length(cellColEmbeddings), function(x){ + name <- cellColEmbeddings[[x]] tryCatch({ named_embed <- plotEmbedding( @@ -325,7 +322,7 @@ exportShinyArchR <- function( saveRDS(embeds, file.path(outDirEmbed, "embeds.rds")) } else { - message("embeddings already exist...") + message("Main embeddings already exist. Skipping generation and reading in embeds.rds file...") embeds <- readRDS(file.path(outDirEmbed, "embeds.rds")) } @@ -364,7 +361,6 @@ exportShinyArchR <- function( embed_legend[[i]] <- levels(embed_plot[[1]]$data$color) names(embed_legend)[[i]] <- names(embed_plot) - embed_color[[i]] <- unique(ggplot_build(embed_plot[[1]])$data[[1]][,"colour"]) names(embed_color)[[i]] <- names(embed_plot) @@ -377,9 +373,9 @@ exportShinyArchR <- function( #' Create an HDF5 containing the nativeRaster vectors for all features for all feature matrices. #' This function will be called by exportShinyArchR() #' -#' @param ArchRProj An `ArchRProject` object loaded in the environment. Can do this using: loadArchRProject("path to ArchRProject/") -#' @param colorBy A string indicating whether points in the plot should be colored by a column in `cellColData` ("cellColData") or by -#' a data matrix in the corresponding ArrowFiles (i.e. "GeneScoreMatrix", "MotifMatrix", "PeakMatrix"). +#' @param ArchRProj An `ArchRProject` object loaded in the environment. +#' @param colorBy A string indicating which matrices in the corresponding ArrowFiles should be used for plotting +#' features (i.e. "GeneScoreMatrix", "MotifMatrix", "PeakMatrix"). #' @param outputDirEmbeds Where the HDF5 and the jpgs will be saved. #' @param threads The number of threads to use for parallel execution. #' @param verbose A boolean value that determines whether standard output should be printed. @@ -410,117 +406,106 @@ exportShinyArchR <- function( embeds_min_max_list = list() embeds_pal_list = list() - shinyMatrices <- getAvailableMatrices(ArchRProj) + allMatrices <- getAvailableMatrices(ArchRProj) for(matrix in colorBy){ - if(matrix %ni% shinyMatrices){ - stop(matrix,"not in ArchRProj") - } - matrixName = paste0(matrix,"_names") + if(matrix %ni% allMatrices){ + stop(matrix,"not in ArchRProj") + } + matrixName = paste0(matrix,"_names") - if(file.exists(paste0(outputDirEmbeds, "/", matrixName, ".rds"))){ + if(file.exists(file.path(outputDirEmbeds, paste0(matrixName, ".rds")))){ - geneMatrixNames <- readRDS(file.path(outputDir, subOutputDir, matName, "_names.rds")) + geneMatrixNames <- readRDS(file.path(outputDirEmbeds, paste0(matrixName, ".rds"))) - if(!is.null(geneMatrixNames)){ + if(!is.null(geneMatrixNames)){ embeds_points <- .safelapply(1:length(geneMatrixNames), function(x){ - - print(paste0("Creating plots for ", matrix,": ",x,": ",round((x/length(geneMatrixNames))*100,3), "%")) + print(paste0("Creating plots for ", matrix,": ",x,": ",round((x/length(geneMatrixNames))*100,3), "%")) if(!is.na(matrices[[matrix]][x])){ - gene_plot <- plotEmbedding( - ArchRProj = ArchRProj, - colorBy = matrix, - name = geneMatrixNames[x], - embedding = embedding, - quantCut = c(0.01, 0.95), - imputeWeights = getImputeWeights(ArchRProj = ArchRProj), - plotAs = "points", - matrices = matrices, - embeddingDF = df, - imputeMatrices = imputeMatrices, - rastr = TRUE - ) + gene_plot <- plotEmbedding( + ArchRProj = ArchRProj, + colorBy = matrix, + name = geneMatrixNames[x], + embedding = embedding, + quantCut = c(0.01, 0.95), + imputeWeights = getImputeWeights(ArchRProj = ArchRProj), + plotAs = "points", + matrices = matrices, + embeddingDF = df, + imputeMatrices = imputeMatrices, + rastr = TRUE + ) }else{ - gene_plot = NULL } - if(!is.null(gene_plot)){ - - gene_plot_blank <- gene_plot + theme(axis.title.x = element_blank()) + - theme(axis.title.y = element_blank()) + - theme(axis.title = element_blank()) + - theme(legend.position = "none") + - theme( - panel.grid.major = element_blank(), - panel.grid.minor = element_blank(), - panel.border = element_blank(), - title=element_blank() - ) - - #save plot without axes etc as a jpg. - ggsave(filename = file.path(outputDirEmbeds, paste0(shinymatrices,"_embeds"), paste0(geneMatrixNames[x],"_blank72.jpg")), - plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) - - #read back in that jpg because we need vector in native format - blank_jpg72 <- readJPEG(source = file.path(outputDirEmbeds, paste0(shinymatrices,"_embeds"), - paste0(geneMatrixNames[x],"_blank72.jpg")), native = TRUE) - - g <- ggplot_build(gene_plot) - - res = list(list(plot=as.vector(blank_jpg72), min = round(min(gene_plot$data$color),1), - max = round(max(gene_plot$data$color),1), pal = unique(g$data[[1]][,"colour"]))) - - return(res) - } - - - }, threads = threads) + if(!is.null(gene_plot)){ + + gene_plot_blank <- gene_plot + theme(axis.title.x = element_blank()) + + theme(axis.title.y = element_blank()) + + theme(axis.title = element_blank()) + + theme(legend.position = "none") + + theme( + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.border = element_blank(), + title=element_blank() + ) - names(embeds_points) <- geneMatrixNames + #save plot without axes etc as a jpg. + ggsave(filename = file.path(outputDirEmbeds, paste0(matrix,"_embeds"), paste0(geneMatrixNames[x],"_blank72.jpg")), + plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) - embeds_points = embeds_points[!unlist(lapply(embeds_points, is.null))] + #read back in that jpg because we need vector in native format + blank_jpg72 <- readJPEG(source = file.path(outputDirEmbeds, paste0(matrix,"_embeds"), + paste0(geneMatrixNames[x],"_blank72.jpg")), native = TRUE) - embeds_min_max <- data.frame(matrix(NA, 2, length(embeds_points))) - colnames(embeds_min_max) <- names(embeds_points)[which(!unlist(lapply(embeds_points, is.null)))] - rownames(embeds_min_max) <- c("min","max") + g <- ggplot_build(gene_plot) - h5closeAll() - points = H5Fcreate(name = file.path(outputDirEmbeds, paste0(shinymatrices,"_plotBlank72.h5"))) - h5createGroup(file.path(outputDirEmbeds, paste0(shinymatrices,"_plotBlank72.h5")), shinymatrices) + res = list(list(plot=as.vector(blank_jpg72), min = round(min(gene_plot$data$color),1), + max = round(max(gene_plot$data$color),1), pal = unique(g$data[[1]][,"colour"]))) - for(i in 1:length(embeds_points)){ + return(res) + } - print(paste0("Getting H5 files for embeds_points: ",i,": ",round((i/length(embeds_points))*100,3), "%")) - h5createDataset(file = points, dataset = paste0(shinymatrices,"/",geneMatrixNames[i]), dims = c(46656,1), storage.mode = "integer") - h5writeDataset(obj = embeds_points[[i]][[1]]$plot, h5loc = points, name=paste0(shinymatrices,"/",geneMatrixNames[i])) - embeds_min_max[1,i] = embeds_points[[i]][[1]]$min - embeds_min_max[2,i] = embeds_points[[i]][[1]]$max - } + }, threads = threads) - embeds_min_max_list[[shinymatrices]] = embeds_min_max - embeds_pal_list[[shinymatrices]] = embeds_points[[length(embeds_points)]][[1]]$pal + names(embeds_points) <- geneMatrixNames + embeds_points = embeds_points[!unlist(lapply(embeds_points, is.null))] - }else{ + embeds_min_max <- data.frame(matrix(NA, 2, length(embeds_points))) + colnames(embeds_min_max) <- names(embeds_points)[which(!unlist(lapply(embeds_points, is.null)))] + rownames(embeds_min_max) <- c("min","max") - message(matrixName,".rds file is NULL") + h5closeAll() + points = H5Fcreate(name = file.path(outputDirEmbeds, paste0(matrix,"_plotBlank72.h5"))) + h5createGroup(file.path(outputDirEmbeds, paste0(matrix,"_plotBlank72.h5")), matrix) + for(i in 1:length(embeds_points)){ + print(paste0("Getting H5 files for embeds_points: ",i,": ",round((i/length(embeds_points))*100,3), "%")) + h5createDataset(file = points, dataset = paste0(matrix,"/",geneMatrixNames[i]), dims = c(46656,1), storage.mode = "integer") + h5writeDataset(obj = embeds_points[[i]][[1]]$plot, h5loc = points, name=paste0(matrix,"/",geneMatrixNames[i])) + embeds_min_max[1,i] = embeds_points[[i]][[1]]$min + embeds_min_max[2,i] = embeds_points[[i]][[1]]$max } - + embeds_min_max_list[[matrix]] = embeds_min_max + embeds_pal_list[[matrix]] = embeds_points[[length(embeds_points)]][[1]]$pal }else{ - - message(matrixName,".rds file does not exist") + stop(matrixName,".rds file is NULL") } + }else{ + stop(matrixName,".rds file does not exist. This file should have been created previously be exportShinyArchR.") + } - } + } scale <- embeds_min_max_list pal <- embeds_pal_list From eae011b1fd7bbf2b5bb4ab2048fd7168b8a8c2f9 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Tue, 17 Jan 2023 15:29:32 -0800 Subject: [PATCH 083/162] typos --- R/ShinyArchRExports.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index c2fb1539..d5709ae1 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -64,7 +64,7 @@ exportShinyArchR <- function( } #check that groupBy column exists and doesnt have NA values - if (groupBy %ni% colnames(ArchRProjShiny@cellColData)) { + if (groupBy %ni% colnames(ArchRProj@cellColData)) { stop("groupBy is not part of cellColData") } else if ((any(is.na(paste0("ArchRProj$", groupBy))))) { stop("Some entries in the column indicated by groupBy have NA values. Please subset your project using subsetArchRProject() to only contain cells with values for groupBy") @@ -226,7 +226,7 @@ exportShinyArchR <- function( if(!file.exists(file.path(outputDir, subOutputDir, "plotBlank72.h5"))){ .matrixEmbeds( - ArchRProj = ArchRProj, + ArchRProj = ArchRProjShiny, outputDirEmbed = file.path(mainDir, outputDir, subOutputDir), colorBy = intersect(supportedMatrices, allMatrices), embedding = embedding, From 25eeab33c19782ade637c35b410949b820c127a7 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Wed, 18 Jan 2023 08:33:39 -0800 Subject: [PATCH 084/162] revert all changes --- tests/testthat/test_1_arrow.R | 61 +++++++++++++++++------------------ 1 file changed, 30 insertions(+), 31 deletions(-) diff --git a/tests/testthat/test_1_arrow.R b/tests/testthat/test_1_arrow.R index 17449d5e..c42f4042 100644 --- a/tests/testthat/test_1_arrow.R +++ b/tests/testthat/test_1_arrow.R @@ -45,42 +45,42 @@ arrowFiles <- createArrowFiles( test_that("Checking Arrow Contents...", { expect_equal( - .validArrow(arrowFiles), + ArchR:::.validArrow(arrowFiles), arrowFiles ) expect_equal( - .availableArrays(arrowFiles), + ArchR:::.availableArrays(arrowFiles), c("GeneScoreMatrix", "TileMatrix") ) expect_equal( - nrow(.getFeatureDF(arrowFiles, "TileMatrix")), + nrow(ArchR:::.getFeatureDF(arrowFiles, "TileMatrix")), 31593 ) expect_equal( - nrow(.getFeatureDF(arrowFiles, "GeneScoreMatrix")), + nrow(ArchR:::.getFeatureDF(arrowFiles, "GeneScoreMatrix")), 2454 ) expect_equal( - .availableSeqnames(arrowFiles), + ArchR:::.availableSeqnames(arrowFiles), c("chr11", "chr5") ) expect_equal( - .availableChr(arrowFiles), + ArchR:::.availableChr(arrowFiles), c("chr11", "chr5") ) expect_equal( - as.vector(table(substr(.availableCells(arrowFiles), 9, 9))[c("B", "M", "T")]), + as.vector(table(substr(ArchR:::.availableCells(arrowFiles), 9, 9))[c("B", "M", "T")]), c(45, 33, 49) ) expect_equal( - paste0(.sampleName(arrowFiles)), + paste0(ArchR:::.sampleName(arrowFiles)), "PBSmall" ) @@ -90,7 +90,7 @@ test_that("Checking Arrow Contents...", { # Testing Dropping Matrices ################################################ -arrowFiles <- .dropGroupsFromArrow( +arrowFiles <- ArchR:::.dropGroupsFromArrow( ArrowFile = arrowFiles, dropGroups = c("GeneScoreMatrix", "TileMatrix") ) @@ -99,32 +99,32 @@ arrowFiles <- .dropGroupsFromArrow( test_that("Checking Arrow Contents After Drop...", { expect_equal( - .validArrow(arrowFiles), + ArchR:::.validArrow(arrowFiles), arrowFiles ) expect_equal( - paste0(.availableArrays(arrowFiles)), + paste0(ArchR:::.availableArrays(arrowFiles)), c("")[-1] ) expect_equal( - .availableSeqnames(arrowFiles), + ArchR:::.availableSeqnames(arrowFiles), c("chr11", "chr5") ) expect_equal( - .availableChr(arrowFiles), + ArchR:::.availableChr(arrowFiles), c("chr11", "chr5") ) expect_equal( - as.vector(table(substr(.availableCells(arrowFiles), 9, 9))[c("B", "M", "T")]), + as.vector(table(substr(ArchR:::.availableCells(arrowFiles), 9, 9))[c("B", "M", "T")]), c(45, 33, 49) ) expect_equal( - paste0(.sampleName(arrowFiles)), + paste0(ArchR:::.sampleName(arrowFiles)), "PBSmall" ) @@ -145,37 +145,37 @@ arrowFiles <- addTileMatrix( test_that("Checking Arrow Contents after addTileMatrix", { expect_equal( - .validArrow(arrowFiles), + ArchR:::.validArrow(arrowFiles), arrowFiles ) expect_equal( - paste0(.availableArrays(arrowFiles)), + paste0(ArchR:::.availableArrays(arrowFiles)), "TileMatrix" ) expect_equal( - nrow(.getFeatureDF(arrowFiles, "TileMatrix")), + nrow(ArchR:::.getFeatureDF(arrowFiles, "TileMatrix")), 12638 ) expect_equal( - .availableSeqnames(arrowFiles), + ArchR:::.availableSeqnames(arrowFiles), c("chr11", "chr5") ) expect_equal( - .availableChr(arrowFiles), + ArchR:::.availableChr(arrowFiles), c("chr11", "chr5") ) expect_equal( - as.vector(table(substr(.availableCells(arrowFiles), 9, 9))[c("B", "M", "T")]), + as.vector(table(substr(ArchR:::.availableCells(arrowFiles), 9, 9))[c("B", "M", "T")]), c(45, 33, 49) ) expect_equal( - paste0(.sampleName(arrowFiles)), + paste0(ArchR:::.sampleName(arrowFiles)), "PBSmall" ) @@ -195,42 +195,42 @@ arrowFiles <- addGeneScoreMatrix( test_that("Checking Arrow Contents after addGeneScoreMatrix...", { expect_equal( - .validArrow(arrowFiles), + ArchR:::.validArrow(arrowFiles), arrowFiles ) expect_equal( - .availableArrays(arrowFiles), + ArchR:::.availableArrays(arrowFiles), c("GeneScoreMatrix", "TileMatrix") ) expect_equal( - nrow(.getFeatureDF(arrowFiles, "TileMatrix")), + nrow(ArchR:::.getFeatureDF(arrowFiles, "TileMatrix")), 12638 ) expect_equal( - nrow(.getFeatureDF(arrowFiles, "GeneScoreMatrix")), + nrow(ArchR:::.getFeatureDF(arrowFiles, "GeneScoreMatrix")), 2454 ) expect_equal( - .availableSeqnames(arrowFiles), + ArchR:::.availableSeqnames(arrowFiles), c("chr11", "chr5") ) expect_equal( - .availableChr(arrowFiles), + ArchR:::.availableChr(arrowFiles), c("chr11", "chr5") ) expect_equal( - as.vector(table(substr(.availableCells(arrowFiles), 9, 9))[c("B", "M", "T")]), + as.vector(table(substr(ArchR:::.availableCells(arrowFiles), 9, 9))[c("B", "M", "T")]), c(45, 33, 49) ) expect_equal( - paste0(.sampleName(arrowFiles)), + paste0(ArchR:::.sampleName(arrowFiles)), "PBSmall" ) @@ -275,4 +275,3 @@ for(i in seq_along(files)){ - From f5b3d3a93028b8db70c780fc9d34f23b4008cebd Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Wed, 18 Jan 2023 08:34:32 -0800 Subject: [PATCH 085/162] revert all changes --- tests/testthat/test_3_cpp.R | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/tests/testthat/test_3_cpp.R b/tests/testthat/test_3_cpp.R index 61510e4b..78f87fbc 100644 --- a/tests/testthat/test_3_cpp.R +++ b/tests/testthat/test_3_cpp.R @@ -19,7 +19,7 @@ m2 <- m1[rev(1:10), rev(1:10)] ################################################ #Correlations -c1 <- rowCorCpp(1:10, 1:10, m1, m2) +c1 <- ArchR:::rowCorCpp(1:10, 1:10, m1, m2) c2 <- lapply(1:10, function(x){ cor(m1[x, ], m2[x, ]) }) %>% unlist @@ -34,10 +34,10 @@ test_that("Row-wise Correlation is working...", { ################################################ #KNN -knnObj <- .computeKNN(m1, m2, k = 5) +knnObj <- ArchR:::.computeKNN(m1, m2, k = 5) #Check Knn Overlap Cpp -overlapCpp <- determineOverlapCpp(knnObj, 3) +overlapCpp <- ArchR:::determineOverlapCpp(knnObj, 3) #Check Knn Overlap R overlapR <- lapply(seq_len(nrow(knnObj)), function(x){ @@ -61,7 +61,7 @@ test_that("KNN Utils is working...", { ################################################ #tabulate2dCpp -tab2d <- as.matrix(tabulate2dCpp( +tab2d <- as.matrix(ArchR:::tabulate2dCpp( x = c(0,0,2,2,3), xmin = 0, xmax = 3, @@ -85,7 +85,7 @@ test_that("Tabulate Utils is working...", { sm1 <- as(m1, "dgCMatrix") #Variances -var1 <- computeSparseRowVariances( +var1 <- ArchR:::computeSparseRowVariances( sm1@i + 1, sm1@x, Matrix::rowMeans(sm1), ncol(sm1)) var2 <- apply(m1, 1, var) @@ -96,4 +96,3 @@ test_that("Variance Utils is working...", { - From d4984a775ad82b793bc27edae4ce7bf384452e26 Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Fri, 20 Jan 2023 21:01:52 -0600 Subject: [PATCH 086/162] adding matrices list to mainembeds fun --- R/ShinyArchRExports.R | 195 +++++++------ R/VisualizeData.R | 657 ++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 763 insertions(+), 89 deletions(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index d5709ae1..2b9a2495 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -105,12 +105,12 @@ exportShinyArchR <- function( # Add metadata to ArchRProjShiny ArchRProjShiny@projectMetadata[["groupBy"]] <- groupBy ArchRProjShiny@projectMetadata[["tileSize"]] <- tileSize - #units <- tryCatch({ - # .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, "/Info/Units"))[1] - #},error=function(e){ - # "values" - #}) - #ArchRProjShiny@projectMetadata[["units"]] <- units + units <- tryCatch({ + .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, "/Info/Units"))[1] + },error=function(e){ + "values" + }) + ArchRProjShiny@projectMetadata[["units"]] <- units ArchRProjShiny <- saveArchRProject(ArchRProj = ArchRProjShiny, outputDirectory = file.path(mainDir, outputDir, "Save-ArchRProjShiny"), dropCells = TRUE, overwrite = TRUE, load = TRUE) @@ -118,7 +118,7 @@ exportShinyArchR <- function( # Create fragment files - should be saved within a dir called ShinyFragments within the ArchRProjShiny output directory fragDir <- file.path(projDir, "ShinyFragments", groupBy) - fragFiles <- list.files(path = file.path(fragDir, pattern = "\\_frags.rds$") + fragFiles <- list.files(path = file.path(fragDir, pattern = "\\_frags.rds$")) #this is still a slightly dangerous comparison, better would be to compare for explicitly the file names that are expected if(length(fragFiles) == length(unique(ArchRProjShiny@cellColData[,groupBy]))){ if(force){ @@ -126,7 +126,7 @@ exportShinyArchR <- function( } else{ message("Fragment files already exist. Skipping fragment file generation...") } - }else + }else{ .getGroupFragsFromProj(ArchRProj = ArchRProjShiny, groupBy = groupBy, outDir = fragDir) } @@ -147,14 +147,6 @@ exportShinyArchR <- function( # Create directory to save input data to Shinyapps.io (everything that will be preprocessed) dir.create(file.path(mainDir, outputDir, subOutputDir), showWarnings = TRUE) - # if(!file.exists(file.path(mainDir, outputDir, subOutputDir, "features.rds"))){ - # gene_names <- getFeatures(ArchRProj = ArchRProj) - # saveRDS(gene_names, file.path(mainDir, outputDir, subOutputDir, "features.rds")) - # }else{ - # message("gene_names already exists...") - # gene_names <- readRDS(file.path(mainDir, outputDir, subOutputDir, "features.rds")) - # } - allMatrices <- getAvailableMatrices(ArchRProjShiny) matrices <- list() imputeMatrices <- list() @@ -163,16 +155,15 @@ exportShinyArchR <- function( if(!file.exists(file.path(outputDir, subOutputDir, "matrices.rds")) && !file.exists(file.path(outputDir, subOutputDir, "imputeMatrices.rds"))){ for(matName in allMatrices){ - matFeaturesNames <- paste0(matName, "_names") - result = assign(matFeaturesNames, getFeatures(ArchRProj = ArchRProjShiny, useMatrix = matName)) - saveRDS(result, file.path(outputDir, subOutputDir, matName, "_names.rds")) + featuresNames <- getFeatures(ArchRProj = ArchRProj, useMatrix = matName) + saveRDS(featuresNames, file.path(outputDir, subOutputDir, matName, "_names.rds")) - if(!is.null(result)){ + if(!is.null(featuresNames)){ mat = Matrix(.getMatrixValues( ArchRProj = ArchRProjShiny, - name = result, - matrixName = mat, + name = featuresNames, + matrixName = matName, log2Norm = FALSE, threads = threads), sparse = TRUE) @@ -189,12 +180,11 @@ exportShinyArchR <- function( } imputeMatrices[[matName]] <- imputeMat - }else{ message(matName, " is NULL.") } } - matrices$allColorBy= .availableArrays(head(getArrowFiles(ArchRProjShiny), 2)) + matrices$allColorBy= .availableArrays(head(getArrowFiles(ArchRProj), 2)) saveRDS(matrices, file.path(outputDir, subOutputDir, "matrices.rds")) saveRDS(imputeMatrices, file.path(outputDir, subOutputDir, "imputeMatrices.rds")) }else{ @@ -214,20 +204,19 @@ exportShinyArchR <- function( embeddingDF = df, matrices = matrices, imputeMatrices = imputeMatrices, - Shiny = TRUE, logFile = createLogFile("mainEmbeds") ) } else{ message("H5 for main embeddings already exists...") } - # matrixEmbeds will create an HDF5 file containing + # matrixEmbeds will create an HDF5 file containing he nativeRaster vectors for data stored in matrices supportedMatrices <- c("GeneScoreMatrix", "GeneIntegrationMatrix", "MotifMatrix") #only these matrices are currently supported for ShinyArchR if(!file.exists(file.path(outputDir, subOutputDir, "plotBlank72.h5"))){ .matrixEmbeds( - ArchRProj = ArchRProjShiny, - outputDirEmbed = file.path(mainDir, outputDir, subOutputDir), + ArchRProj = ArchRProj, + outDirEmbed = file.path(mainDir, outputDir, subOutputDir), colorBy = intersect(supportedMatrices, allMatrices), embedding = embedding, matrices = matrices, @@ -238,13 +227,10 @@ exportShinyArchR <- function( ) }else{ - message("H5 file already exists...") - } ## delete unnecessary files ----------------------------------------------------------------- unlink(file.path(projDir, "ShinyFragments"), recursive = TRUE) - #unlink("./ArchRLogs", recursive = TRUE) #this seems like a bad idea. ArchRLogs arent specific to an individual project so this would wipe all logs ## ready to launch --------------------------------------------------------------- message("App created! To launch, @@ -263,6 +249,8 @@ exportShinyArchR <- function( #' @param cellColEmbeddings A character vector of columns in `cellColData` to plot as part of the Shiny app. No default is provided so this must be set. #' For ex. `c("Sample","Clusters","TSSEnrichment","nFrags")`. #' @param embedding The embedding to use. Default is "UMAP". +#' @param matrices List of stored matrices to use for plotEmbedding so that it runs faster. +#' @param imputeMatrices List of stored imputed matrices to use for plotEmbedding so that it runs faster. #' @param threads The number of threads to use for parallel execution. #' @param logFile The path to a file to be used for logging ArchR output. #' @@ -272,10 +260,11 @@ exportShinyArchR <- function( colorBy = "cellColData", cellColEmbeddings = NULL, embedding = "UMAP", + matrices = NULL, + imputeMatrices = NULL, threads = getArchRThreads(), logFile = createLogFile("mainEmbeds") ){ - .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) .validInput(input = outDirEmbed, name = "outDirEmbed", valid = c("character")) .validInput(input = colorBy, name = "colorBy", valid = c("character")) @@ -285,7 +274,7 @@ exportShinyArchR <- function( .validInput(input = logFile, name = "logFile", valid = c("character")) .startLogging(logFile=logFile) - .logThis(mget(names(formals()),sys.frame(sys.nframe())), "exportShinyArchR Input-Parameters", logFile = logFile) + .logThis(mget(names(formals()),sys.frame(sys.nframe())), "mainEmbeds Input-Parameters", logFile = logFile) if(!file.exists(file.path(outDirEmbed, "embeds.rds"))){ @@ -308,14 +297,14 @@ exportShinyArchR <- function( embeddingDF = df, rastr = FALSE, size = 0.5, - imputeWeights = NULL, + # imputeWeights = NULL, # unsure if inputWeights needed for cellColData Shiny = TRUE )+ggtitle(paste0("Colored by ", name))+theme(text = element_text(size=12), legend.title = element_text(size = 12),legend.text = element_text(size = 6)) }, error = function(x){ print(x) }) - return(named_embed) + return(named_embed) }) names(embeds) <- names @@ -332,6 +321,7 @@ exportShinyArchR <- function( embed_legend <- list() embed_color <- list() + for(i in 1:length(embeds)){ embed_plot <- embeds[i] @@ -355,9 +345,11 @@ exportShinyArchR <- function( #read back in that jpg because we need vector in native format blank_jpg72 <- readJPEG(source = file.path(outDirEmbed, paste0(names(embeds)[[i]],"_blank72.jpg")), native = TRUE) + # save the native raster vectors h5createDataset(file = points, dataset = names(embeds)[i], dims = c(46656,1), storage.mode = "integer") h5writeDataset(obj = as.vector(blank_jpg72), h5loc = points, name= names[i]) + # save legend and color scale embed_legend[[i]] <- levels(embed_plot[[1]]$data$color) names(embed_legend)[[i]] <- names(embed_plot) @@ -366,78 +358,90 @@ exportShinyArchR <- function( } - saveRDS(embed_color, file.path(outDirEmbed, "embeddings.rds")) + saveRDS(embed_color, file.path(outDirEmbed, "embed_color.rds")) saveRDS(embed_legend, file.path(outDirEmbed, "embed_legend_names.rds")) } #' Create an HDF5 containing the nativeRaster vectors for all features for all feature matrices. #' This function will be called by exportShinyArchR() #' -#' @param ArchRProj An `ArchRProject` object loaded in the environment. -#' @param colorBy A string indicating which matrices in the corresponding ArrowFiles should be used for plotting -#' features (i.e. "GeneScoreMatrix", "MotifMatrix", "PeakMatrix"). -#' @param outputDirEmbeds Where the HDF5 and the jpgs will be saved. +#' @param ArchRProj An `ArchRProject` object loaded in the environment. Can do this using: loadArchRProject("path to ArchRProject/") +#' @param outDirEmbed Where the HDF5 and the jpgs will be saved. +#' @param colorBy A string indicating whether points in the plot should be colored by a column in `cellColData` ("cellColData") or by +#' a data matrix in the corresponding ArrowFiles (i.e. "GeneScoreMatrix", "MotifMatrix", "PeakMatrix"). +#' @param embedding The embedding to use. Default is "UMAP". +#' @param matrices List of stored matrices to use for plotEmbedding so that it runs faster. +#' @param imputeMatrices List of stored imputed matrices to use for plotEmbedding so that it runs faster. #' @param threads The number of threads to use for parallel execution. #' @param verbose A boolean value that determines whether standard output should be printed. #' @param logFile The path to a file to be used for logging ArchR output. #' .matrixEmbeds <- function( ArchRProj = NULL, - outputDirEmbeds = NULL, + outDirEmbed = NULL, colorBy = c("GeneScoreMatrix", "GeneIntegrationMatrix", "MotifMatrix"), embedding = "UMAP", matrices = NULL, - imputeMatricesList = NULL, + imputeMatrices = NULL, threads = getArchRThreads(), verbose = TRUE, logFile = createLogFile("matrixEmbeds") ){ .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) - .validInput(input = outputDirEmbeds, name = "outputDirEmbeds", valid = c("character")) + .validInput(input = outDirEmbed, name = "outDirEmbed", valid = c("character")) + .validInput(input = colorBy, name = "colorBy", valid = c("character")) + .validInput(input = embedding, name = "embedding", valid = c("character")) + .validInput(input = matrices, name = "matrices", valid = c("list")) + .validInput(input = imputeMatrices, name = "imputeMatrices", valid = c("list")) .validInput(input = threads, name = "threads", valid = c("numeric")) .validInput(input = verbose, name = "verbose", valid = c("boolean")) .validInput(input = logFile, name = "logFile", valid = c("character")) + + .startLogging(logFile=logFile) + .logThis(mget(names(formals()),sys.frame(sys.nframe())), "matrixEmbeds Input-Parameters", logFile = logFile) - - if (file.exists(file.path(outputDirEmbeds, "plotBlank72.h5"))){ - file.remove(file.path(outputDirEmbeds, "plotBlank72.h5")) + if (file.exists(file.path(outDirEmbed, "plotBlank72.h5"))){ + file.remove(file.path(outDirEmbed, "plotBlank72.h5")) } + # save the scale embeds_min_max_list = list() + # save the palette embeds_pal_list = list() allMatrices <- getAvailableMatrices(ArchRProj) - for(matrix in colorBy){ - if(matrix %ni% allMatrices){ - stop(matrix,"not in ArchRProj") - } - matrixName = paste0(matrix,"_names") + for(mat in colorBy){ + if(mat %ni% shinyMatrices){ + stop(mat,"not in ArchRProj") + } - if(file.exists(file.path(outputDirEmbeds, paste0(matrixName, ".rds")))){ + if(file.exists(paste0(outDirEmbed, "/", mat, ".rds"))){ + featureNames <- readRDS(file.path(outputDir, subOutputDir, mat, "_names.rds")) + }else{ + - geneMatrixNames <- readRDS(file.path(outputDirEmbeds, paste0(matrixName, ".rds"))) + if(!is.null(featureNames)){ - if(!is.null(geneMatrixNames)){ + embeds_points <- .safelapply(1:length(featureNames), function(x){ - embeds_points <- .safelapply(1:length(geneMatrixNames), function(x){ - print(paste0("Creating plots for ", matrix,": ",x,": ",round((x/length(geneMatrixNames))*100,3), "%")) + print(paste0("Creating plots for ", mat,": ",x,": ",round((x/length(featureNames))*100,3), "%")) - if(!is.na(matrices[[matrix]][x])){ + if(!is.na(matrices[[mat]][x])){ - gene_plot <- plotEmbedding( - ArchRProj = ArchRProj, - colorBy = matrix, - name = geneMatrixNames[x], - embedding = embedding, - quantCut = c(0.01, 0.95), - imputeWeights = getImputeWeights(ArchRProj = ArchRProj), - plotAs = "points", - matrices = matrices, - embeddingDF = df, - imputeMatrices = imputeMatrices, - rastr = TRUE - ) + gene_plot <- plotEmbedding( + ArchRProj = ArchRProj, + colorBy = mat, + name = featureNames[x], + embedding = embedding, + quantCut = c(0.01, 0.95), + imputeWeights = getImputeWeights(ArchRProj = ArchRProj), + plotAs = "points", + matrices = mat, + embeddingDF = df, + imputeMatrices = imputeMatrices, + rastr = TRUE + ) }else{ gene_plot = NULL } @@ -455,13 +459,13 @@ exportShinyArchR <- function( title=element_blank() ) - #save plot without axes etc as a jpg. - ggsave(filename = file.path(outputDirEmbeds, paste0(matrix,"_embeds"), paste0(geneMatrixNames[x],"_blank72.jpg")), - plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) + #save plot without axes etc as a jpg. + ggsave(filename = file.path(outDirEmbed, paste0(shinymatrices,"_embeds"), paste0(featureNames[x],"_blank72.jpg")), + plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) - #read back in that jpg because we need vector in native format - blank_jpg72 <- readJPEG(source = file.path(outputDirEmbeds, paste0(matrix,"_embeds"), - paste0(geneMatrixNames[x],"_blank72.jpg")), native = TRUE) + #read back in that jpg because we need vector in native format + blank_jpg72 <- readJPEG(source = file.path(outDirEmbed, paste0(shinymatrices,"_embeds"), + paste0(featureNames[x],"_blank72.jpg")), native = TRUE) g <- ggplot_build(gene_plot) @@ -474,7 +478,7 @@ exportShinyArchR <- function( }, threads = threads) - names(embeds_points) <- geneMatrixNames + names(embeds_points) <- featureNames embeds_points = embeds_points[!unlist(lapply(embeds_points, is.null))] @@ -482,23 +486,36 @@ exportShinyArchR <- function( colnames(embeds_min_max) <- names(embeds_points)[which(!unlist(lapply(embeds_points, is.null)))] rownames(embeds_min_max) <- c("min","max") - h5closeAll() - points = H5Fcreate(name = file.path(outputDirEmbeds, paste0(matrix,"_plotBlank72.h5"))) - h5createGroup(file.path(outputDirEmbeds, paste0(matrix,"_plotBlank72.h5")), matrix) + h5closeAll() + points = H5Fcreate(name = file.path(outDirEmbed, paste0(shinymatrices,"_plotBlank72.h5"))) + h5createGroup(file.path(outDirEmbed, paste0(shinymatrices,"_plotBlank72.h5")), shinymatrices) + + for(i in 1:length(embeds_points)){ + + print(paste0("Getting H5 files for embeds_points: ",i,": ",round((i/length(embeds_points))*100,3), "%")) + h5createDataset(file = points, dataset = paste0(shinymatrices,"/",featureNames[i]), dims = c(46656,1), storage.mode = "integer") + h5writeDataset(obj = embeds_points[[i]][[1]]$plot, h5loc = points, name=paste0(shinymatrices,"/",featureNames[i])) + embeds_min_max[1,i] = embeds_points[[i]][[1]]$min + embeds_min_max[2,i] = embeds_points[[i]][[1]]$max + + } + + embeds_min_max_list[[shinymatrices]] = embeds_min_max + embeds_pal_list[[shinymatrices]] = embeds_points[[length(embeds_points)]][[1]]$pal + + + }else{ + + message(matName,".rds file is NULL") - for(i in 1:length(embeds_points)){ - print(paste0("Getting H5 files for embeds_points: ",i,": ",round((i/length(embeds_points))*100,3), "%")) - h5createDataset(file = points, dataset = paste0(matrix,"/",geneMatrixNames[i]), dims = c(46656,1), storage.mode = "integer") - h5writeDataset(obj = embeds_points[[i]][[1]]$plot, h5loc = points, name=paste0(matrix,"/",geneMatrixNames[i])) - embeds_min_max[1,i] = embeds_points[[i]][[1]]$min - embeds_min_max[2,i] = embeds_points[[i]][[1]]$max } embeds_min_max_list[[matrix]] = embeds_min_max embeds_pal_list[[matrix]] = embeds_points[[length(embeds_points)]][[1]]$pal }else{ - stop(matrixName,".rds file is NULL") + + message(matName,".rds file does not exist") } }else{ stop(matrixName,".rds file does not exist. This file should have been created previously be exportShinyArchR.") @@ -510,7 +527,7 @@ exportShinyArchR <- function( scale <- embeds_min_max_list pal <- embeds_pal_list - saveRDS(scale, file.path(outputDirEmbeds, "scale.rds")) - saveRDS(pal, file.path(outputDirEmbeds, "pal.rds")) + saveRDS(scale, file.path(outDirEmbed, "scale.rds")) + saveRDS(pal, file.path(outDirEmbed, "pal.rds")) } diff --git a/R/VisualizeData.R b/R/VisualizeData.R index 60add723..6b25f724 100644 --- a/R/VisualizeData.R +++ b/R/VisualizeData.R @@ -1,3 +1,172 @@ +#################################################################### +# Save Visualization Methods +#################################################################### + +#' Plot PDF in outputDirectory of an ArchRProject +#' +#' This function will save a plot or set of plots as a PDF file in the outputDirectory of a given ArchRProject. +#' +#' @param ... vector of plots to be plotted (if input is a list use plotList instead) +#' @param name The file name to be used for the output PDF file. +#' @param width The width in inches to be used for the output PDF file. +#' @param height The height in inches to be used for the output PDF. +#' @param ArchRProj An `ArchRProject` object to be used for retrieving the desired `outputDirectory` which will be used to store the output +#' plots in a subfolder called "plots". +#' @param addDOC A boolean variable that determines whether to add the date of creation to the end of the PDF file name. This is useful +#' for preventing overwritting of old plots. +#' @param useDingbats A boolean variable that determines wheter to use dingbats characters for plotting points. +#' @param plotList A `list` of plots to be printed to the output PDF file. Each element of `plotList` should be a printable plot formatted +#' object (ggplot2, plot, heatmap, etc). +#' +#' @examples +#' +#' #Get Test Project +#' proj <- getTestProject() +#' +#' #Plot UMAP +#' p <- plotEmbedding(proj, name = "Clusters") +#' +#' #PDF +#' plotPDF(p, name = "UMAP-Clusters", ArchRProj = proj) +#' +#' @export +plotPDF <- function( + ..., + name = "Plot", + width = 6, + height = 6, + ArchRProj = NULL, + addDOC = TRUE, + useDingbats = FALSE, + plotList = NULL + ){ + + #Validate + .validInput(input = name, name = "name", valid = "character") + .validInput(input = width, name = "width", valid = "numeric") + .validInput(input = height, name = "height", valid = "numeric") + .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProject", "null")) + .validInput(input = addDOC, name = "addDOC", valid = "boolean") + .validInput(input = useDingbats, name = "useDingbats", valid = "boolean") + .validInput(input = plotList, name = "plotList", valid = c("list","null")) + ######### + + if(is.null(plotList)){ + plotList <- list(...) + plotList2 <- list() + for(i in seq_along(plotList)){ + if(inherits(plotList[[i]], "list")){ + for(j in seq_along(plotList[[i]])){ + plotList2[[length(plotList2) + 1]] <- plotList[[i]][[j]] + } + }else{ + plotList2[[length(plotList2) + 1]] <- plotList[[i]] + } + } + plotList <- plotList2 + rm(plotList2) + gc() + }else{ + plotList2 <- list() + for(i in seq_along(plotList)){ + if(inherits(plotList[[i]], "list")){ + for(j in seq_along(plotList[[i]])){ + plotList2[[length(plotList2) + 1]] <- plotList[[i]][[j]] + } + }else{ + plotList2[[length(plotList2) + 1]] <- plotList[[i]] + } + } + plotList <- plotList2 + rm(plotList2) + gc() + } + + name <- gsub("\\.pdf", "", name) + if(is.null(ArchRProj)){ + outDir <- "Plots" + }else{ + .validInput(input = ArchRProj, name = "ArchRProj", valid = "ArchRProject") + outDir <- file.path(getOutputDirectory(ArchRProj), "Plots") + } + + dir.create(outDir, showWarnings = FALSE) + if(addDOC){ + doc <- gsub(":","-",stringr::str_split(Sys.time(), pattern=" ",simplify=TRUE)[1,2]) + filename <- file.path(outDir, paste0(name, "_Date-", Sys.Date(), "_Time-", doc, ".pdf")) + }else{ + filename <- file.path(outDir, paste0(name, ".pdf")) + } + + o <- suppressWarnings(tryCatch({ + + pdf(filename, width = width, height = height, useDingbats = useDingbats) + for(i in seq_along(plotList)){ + + if(inherits(plotList[[i]], "gg")){ + + if(inherits(plotList[[i]], "patchwork")){ + + if(getArchRVerbose()) message("Plotting Patchwork!") + print(plotList[[i]]) + + }else{ + + if(getArchRVerbose()) message("Plotting Ggplot!") + + if(!is.null(attr(plotList[[i]], "ratioYX"))){ + .fixPlotSize(plotList[[i]], plotWidth = width, plotHeight = height, height = attr(plotList[[i]], "ratioYX"), newPage = FALSE) + }else{ + .fixPlotSize(plotList[[i]], plotWidth = width, plotHeight = height, newPage = FALSE) + } + + } + + if(i != length(plotList)){ + grid::grid.newpage() + } + + }else if(inherits(plotList[[i]], "gtable")){ + + if(getArchRVerbose()) message("Plotting Gtable!") + + print(grid::grid.draw(plotList[[i]])) + if(i != length(plotList)){ + grid::grid.newpage() + } + }else if(inherits(plotList[[i]], "HeatmapList") | inherits(plotList[[i]], "Heatmap") ){ + + if(getArchRVerbose()) message("Plotting ComplexHeatmap!") + + padding <- 15 + draw(plotList[[i]], + padding = unit(c(padding, padding, padding, padding), "mm"), + heatmap_legend_side = "bot", + annotation_legend_side = "bot" + ) + + }else{ + + if(getArchRVerbose()) message("Plotting Other") + + print(plotList[[i]]) + + } + + } + dev.off() + + + }, error = function(x){ + + if(getArchRVerbose()) message(x) + + })) + + return(invisible(0)) + +} + #################################################################### # Visualization Methods #################################################################### @@ -392,4 +561,492 @@ plotEmbedding <- function( } +#' Visualize Groups from ArchR Project +#' +#' This function will group, summarize and then plot data from an ArchRProject for visual comparison. +#' +#' @param ArchRProj An `ArchRProject` object. +#' @param groupBy The name of the column in `cellColData` to use for grouping cells together for summarizing and plotting. +#' @param colorBy A string indicating whether the numeric values to be used in the violin plot should be from a column in +#' `cellColData` ("cellColData") or from a data matrix in the ArrowFiles (i.e. "GeneScoreMatrix", "MotifMatrix", "PeakMatrix"). +#' @param name The name of the column in `cellColData` or the featureName/rowname of the data matrix to be used for plotting. +#' For example if `colorBy` is "cellColData" then `name` refers to a column name in the cellcoldata (see `getCellcoldata()`). If `colorBy` +#' is "GeneScoreMatrix" then `name` refers to a gene name which can be listed by `getFeatures(ArchRProj, useMatrix = "GeneScoreMatrix")`. +#' @param imputeWeights The weights to be used for imputing numerical values for each cell as a linear combination of other cells values. See `addImputationWeights()` and `getImutationWeights()` for more information. +#' @param maxCells The maximum cells to consider when making the plot. +#' @param quantCut If this is not null, a quantile cut is performed to threshold the top and bottom of the distribution of values. +#' This prevents skewed color scales caused by strong outliers. The format of this should be c(a,b) where `a` is the upper threshold and +#' `b` is the lower threshold. For example, quantCut = c(0.025,0.975) will take the top and bottom 2.5 percent of values and set them +#' to the value of the 97.5th and 2.5th percentile values respectively. +#' @param log2Norm A boolean value indicating whether a log2 transformation should be performed on the values (if continuous) in plotting. +#' @param pal A custom palette (see `paletteDiscrete` or `ArchRPalettes`) used to override discreteSet/continuousSet for coloring vector. +#' @param discreteSet The name of a discrete palette from `ArchRPalettes` for visualizing `colorBy` if a discrete color set is desired. +#' @param ylim A vector of two numeric values indicating the lower and upper bounds of the y-axis on the plot. +#' @param size The numeric size of the points to be plotted. +#' @param baseSize The base font size to use in the plot. +#' @param ratioYX The aspect ratio of the x and y axes on the plot. +#' @param ridgeScale The scale factor for the relative heights of each ridge when making a ridgeplot with `ggridges`. +#' @param plotAs A string that indicates whether a rigdge plot ("ridges") should be plotted or a violin plot ("violin") should be plotted. +#' @param threads The number of threads to be used for parallel computing. +#' @param ... Additional parameters to pass to `ggGroup()`. +#' +#' @examples +#' +#' #Get Test Project +#' proj <- getTestProject() +#' +#' #Plot Groups +#' p <- plotGroups(proj, groupBy = "Clusters", colorBy = "colData", name = "TSSEnrichment", plotAs = "violin", alpha = 0.5) +#' +#' #PDF +#' plotPDF(p, name = "Clusters-TSS", ArchRProj = proj) +#' +#' @export +plotGroups <- function( + ArchRProj = NULL, + groupBy = "Sample", + colorBy = "colData", + name = "TSSEnrichment", + imputeWeights = if(!grepl("coldata",tolower(colorBy[1]))) getImputeWeights(ArchRProj), + maxCells = 1000, + quantCut = c(0.002, 0.998), + log2Norm = NULL, + pal = NULL, + discreteSet = "stallion", + ylim = NULL, + size = 0.5, + baseSize = 6, + ratioYX = NULL, + ridgeScale = 2, + plotAs = "ridges", + threads = getArchRThreads(), + ... + ){ + + .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) + .validInput(input = groupBy, name = "groupBy", valid = c("character")) + .validInput(input = colorBy, name = "colorBy", valid = c("character")) + .validInput(input = name, name = "name", valid = c("character")) + .validInput(input = imputeWeights, name = "imputeWeights", valid = c("list", "null")) + .validInput(input = maxCells, name = "maxCells", valid = c("integer")) + .validInput(input = quantCut, name = "quantCut", valid = c("numeric")) + .validInput(input = log2Norm, name = "log2Norm", valid = c("boolean", "null")) + .validInput(input = pal, name = "pal", valid = c("character", "null")) + .validInput(input = discreteSet, name = "discreteSet", valid = c("character")) + .validInput(input = ylim, name = "ylim", valid = c("numeric", "null")) + .validInput(input = size, name = "size", valid = c("numeric")) + .validInput(input = baseSize, name = "baseSize", valid = c("numeric")) + .validInput(input = ratioYX, name = "ratioYX", valid = c("numeric", "null")) + .validInput(input = ridgeScale, name = "ridgeScale", valid = c("numeric")) + .validInput(input = plotAs, name = "plotAs", valid = c("character")) + .validInput(input = threads, name = "threads", valid = c("integer")) + + .requirePackage("ggplot2", source = "cran") + + #Make Sure ColorBy is valid! + if(length(colorBy) > 1){ + stop("colorBy must be of length 1!") + } + allColorBy <- c("colData", "cellColData", .availableArrays(head(getArrowFiles(ArchRProj), 2))) + if(tolower(colorBy) %ni% tolower(allColorBy)){ + stop("colorBy must be one of the following :\n", paste0(allColorBy, sep=", ")) + } + colorBy <- allColorBy[match(tolower(colorBy), tolower(allColorBy))] + + groups <- getCellColData(ArchRProj, groupBy, drop = FALSE) + groupNames <- groups[,1] + names(groupNames) <- rownames(groups) + groupNames2 <- gtools::mixedsort(unique(groupNames)) + + + plotParams <- list(...) + + if(tolower(colorBy) == "coldata" | tolower(colorBy) == "cellcoldata"){ + + colorList <- lapply(seq_along(name), function(x){ + colorParams <- list() + colorParams$color <- as.vector(getCellColData(ArchRProj, select = name[x], drop = TRUE)) + if(!is.numeric(colorParams$color)){ + stop(paste0("colorBy = cellColData, name = ", name[x], " : name must correspond to a numeric column!")) + } + if(!is.null(discreteSet)){ + colorParams$pal <- paletteDiscrete(values = groupNames2, set = discreteSet) + } + if(!is.null(pal)){ + colorParams$pal <- pal + } + colorParams + }) + + }else{ + + units <- tryCatch({ + .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, "/Info/Units"))[1] + },error=function(e){ + "values" + }) + + if(is.null(log2Norm) & tolower(colorBy) == "genescorematrix"){ + log2Norm <- TRUE + } + + if(is.null(log2Norm)){ + log2Norm <- FALSE + } + + colorMat <- .getMatrixValues( + ArchRProj = ArchRProj, + name = name, + matrixName = colorBy, + log2Norm = FALSE, + threads = threads + ) + + if(!is.null(imputeWeights)){ + colorMat <- imputeMatrix(mat = as.matrix(colorMat), imputeWeights = imputeWeights) + if(!inherits(colorMat, "matrix")){ + colorMat <- matrix(colorMat, ncol = nCells(ArchRProj)) + colnames(colorMat) <- ArchRProj$cellNames + } + } + + colorList <- lapply(seq_len(nrow(colorMat)), function(x){ + colorParams <- list() + colorParams$color <- colorMat[x, ] + if(!is.null(discreteSet)){ + colorParams$pal <- suppressMessages(paletteDiscrete(values = groupNames2, set = discreteSet)) + } + if(!is.null(pal)){ + colorParams$pal <- pal + } + colorParams + }) + + } + + if(!is.null(maxCells)){ + splitGroup <- split(names(groupNames), groupNames) + useCells <- lapply(splitGroup, function(x){ + if(length(x) > maxCells){ + sample(x, maxCells) + }else{ + x + } + }) %>% unlist %>% as.vector + idx <- match(useCells, names(groupNames)) + }else{ + idx <- seq_along(groupNames) + } + + pl <- lapply(seq_along(colorList), function(x){ + + if(getArchRVerbose()) message(paste0(x, " "), appendLF = FALSE) + + if(is.null(ylim)){ + ylim <- range(colorList[[x]]$color,na.rm=TRUE) %>% extendrange(f = 0.05) + } + + plotParamsx <- plotParams + plotParamsx$x <- groupNames[idx] + if(!is.null(quantCut)){ + plotParamsx$y <- .quantileCut(colorList[[x]]$color[idx], min(quantCut), max(quantCut)) + }else{ + plotParamsx$y <- colorList[[x]]$color[idx] + } + plotParamsx$xlabel <- groupBy + plotParamsx$ylabel <- name[x] + plotParamsx$baseSize <- baseSize + plotParamsx$ridgeScale <- ridgeScale + plotParamsx$ratioYX <- ratioYX + plotParamsx$size <- size + plotParamsx$plotAs <- plotAs + plotParamsx$pal <- colorList[[x]]$pal + + p <- do.call(ggGroup, plotParamsx) + + p + + }) + + names(pl) <- name + if(getArchRVerbose()) message("") + + if(length(name)==1){ + pl[[1]] + }else{ + pl + } + +} + +.getMatrixValues <- function( + ArchRProj = NULL, + name = NULL, + matrixName = NULL, + log2Norm = FALSE, + threads = getArchRThreads(), + logFile = NULL + ){ + + o <- h5closeAll() + + .logMessage("Getting Matrix Values...", verbose = TRUE, logFile = logFile) + + featureDF <- .getFeatureDF(head(getArrowFiles(ArchRProj), 2), matrixName) + .logThis(featureDF, "FeatureDF", logFile = logFile) + + matrixClass <- h5read(getArrowFiles(ArchRProj)[1], paste0(matrixName, "/Info/Class")) + + if(matrixClass == "Sparse.Assays.Matrix"){ + if(!all(unlist(lapply(name, function(x) grepl(":",x))))){ + .logMessage("When accessing features from a matrix of class Sparse.Assays.Matrix it requires seqnames\n(denoted by seqnames:name) specifying to which assay to pull the feature from.\nIf confused, try getFeatures(ArchRProj, useMatrix) to list out available formats for input!", logFile = logFile) + stop("When accessing features from a matrix of class Sparse.Assays.Matrix it requires seqnames\n(denoted by seqnames:name) specifying to which assay to pull the feature from.\nIf confused, try getFeatures(ArchRProj, useMatrix) to list out available formats for input!") + } + } + + if(grepl(":",name[1])){ + + sname <- stringr::str_split(name,pattern=":",simplify=TRUE)[,1] + name <- stringr::str_split(name,pattern=":",simplify=TRUE)[,2] + + idx <- lapply(seq_along(name), function(x){ + ix <- intersect(which(tolower(name[x]) == tolower(featureDF$name)), BiocGenerics::which(tolower(sname[x]) == tolower(featureDF$seqnames))) + if(length(ix)==0){ + .logStop(sprintf("FeatureName (%s) does not exist! See getFeatures", name[x]), logFile = logFile) + } + ix + }) %>% unlist + + }else{ + + idx <- lapply(seq_along(name), function(x){ + ix <- which(tolower(name[x]) == tolower(featureDF$name))[1] + if(length(ix)==0){ + .logStop(sprintf("FeatureName (%s) does not exist! See getFeatures", name[x]), logFile = logFile) + } + ix + }) %>% unlist + + } + .logThis(idx, "idx", logFile = logFile) + + if(any(is.na(idx))){ + .logStop(sprintf("FeatureName (%s) does not exist! See getFeatures", paste0(name[which(is.na(idx))], collapse=",")), logFile = logFile) + } + + featureDF <- featureDF[idx, ,drop=FALSE] + .logThis(featureDF, "FeatureDF-Subset", logFile = logFile) + + #Get Values for FeatureName + cellNamesList <- split(rownames(getCellColData(ArchRProj)), getCellColData(ArchRProj)$Sample) + + values <- .safelapply(seq_along(cellNamesList), function(x){ + if(getArchRVerbose()) message(x, " ", appendLF = FALSE) + valuesx <- tryCatch({ + o <- h5closeAll() + ArrowFile <- getSampleColData(ArchRProj)[names(cellNamesList)[x],"ArrowFiles"] + valuesx <- .getMatFromArrow( + ArrowFile = ArrowFile, + featureDF = featureDF, + binarize = FALSE, + useMatrix = matrixName, + cellNames = cellNamesList[[x]], + threads = 1 + ) + colnames(valuesx) <- cellNamesList[[x]] + valuesx + }, error = function(e){ + errorList <- list( + x = x, + ArrowFile = ArrowFile, + ArchRProj = ArchRProj, + cellNames = ArchRProj$cellNames, + cellNamesList = cellNamesList, + featureDF = featureDF + ) + .logError(e, fn = ".getMatFromArrow", info = "", errorList = errorList, logFile = logFile) + }) + valuesx + }, threads = threads) %>% Reduce("cbind", .) + values <- values[, ArchRProj$cellNames, drop = FALSE] + if(getArchRVerbose()) message("") + gc() + .logThis(values, "Feature-Matrix", logFile = logFile) + + if(!inherits(values, "matrix")){ + values <- matrix(as.matrix(values), ncol = nCells(ArchRProj)) + colnames(values) <- ArchRProj$cellNames + } + + #Values Summary + if(!is.null(log2Norm)){ + if(log2Norm){ + if(getArchRVerbose()) message("Log2 Normalizing...") + values <- log2(values + 1) + } + } + + rownames(values) <- name + + return(values) + +} + +.fixPlotSize <- function( + p = NULL, + plotWidth = unit(6, "in"), + plotHeight = unit(6, "in"), + margin = 0.25, + height = 1, + it = 0.05, + newPage = FALSE + ){ + + .requirePackage("grid", source = "cran") + .requirePackage("gridExtra", source = "cran") + + if(!inherits(plotWidth, "unit")){ + plotWidth <- unit(plotWidth, "in") + } + + if(!inherits(plotHeight, "unit")){ + plotHeight <- unit(plotHeight, "in") + } + + #adapted from https://github.com/jwdink/egg/blob/master/R/set_panel_size.r + g <- ggplotGrob(p) + + legend <- grep("guide-box", g$layout$name) + if(length(legend)!=0){ + gl <- g$grobs[[legend]] + g <- ggplotGrob(p + theme(legend.position = "none")) + }else{ + gl <- NULL + g <- ggplotGrob(p) + } + + panels <- grep("panel", g$layout$name) + panel_index_w <- unique(g$layout$l[panels]) + panel_index_h <- unique(g$layout$t[panels]) + + nw <- length(panel_index_w) + nh <- length(panel_index_h) + + pw <- convertWidth(plotWidth, unitTo = "in", valueOnly = TRUE) + ph <- convertWidth(plotHeight, unitTo = "in", valueOnly = TRUE) + + pw <- pw * 0.95 + ph <- ph * 0.95 + + x <- 0 + width <- 1 + sm <- FALSE + + while(!sm){ + + x <- x + it + + w <- unit(x * width, "in") + h <- unit(x * height / width, "in") + m <- unit(x * margin / width, "in") + + g$widths[panel_index_w] <- rep(w, nw) + g$heights[panel_index_h] <- rep(h, nh) + + sw <- convertWidth( + x = sum(g$widths) + m, + unitTo = "in", + valueOnly = TRUE + ) + + sh <- convertHeight( + x = sum(g$heights) + m, + unitTo = "in", + valueOnly = TRUE + ) + + sm <- sw > pw | sh > ph + + } + + if(length(legend)!=0){ + + sgh <- convertHeight( + x = sum(g$heights), + unitTo = "in", + valueOnly = TRUE + ) + + sgw <- convertWidth( + x = sum(g$widths), + unitTo = "in", + valueOnly = TRUE + ) + + slh <- convertHeight( + x = sum(gl$heights), + unitTo = "in", + valueOnly = TRUE + ) + + slw <- convertWidth( + x = sum(gl$widths), + unitTo = "in", + valueOnly = TRUE + ) + + size <- 6 + wh <- 0.1 + it <- 0 + + while(slh > 0.2 * ph | slw > pw){ + + it <- it + 1 + + if(it > 3){ + break + } + + size <- size * 0.8 + wh <- wh * 0.8 + + gl <- ggplotGrob( + p + theme( + legend.key.width = unit(wh, "cm"), + legend.key.height = unit(wh, "cm"), + legend.spacing.x = unit(0, 'cm'), + legend.spacing.y = unit(0, 'cm'), + legend.text = element_text(size = max(size, 2)) + ) + .gg_guides(fill = guide_legend(ncol = 4), color = guide_legend(ncol = 4)) + )$grobs[[legend]] + + slh <- convertHeight( + x = sum(gl$heights), + unitTo = "in", + valueOnly = TRUE + ) + + slw <- convertWidth( + x = sum(gl$widths), + unitTo = "in", + valueOnly = TRUE + ) + + } + + p <- grid.arrange(g, gl, ncol=1, nrow=2, + heights = unit.c(unit(sgh,"in"), unit(min(slh, 0.2 * pw), "in")), + newpage = newPage + ) + + }else{ + + p <- grid.arrange(g, newpage = newPage) + + } + + + invisible(p) + +} From 4748e27bed95b9bafa9b1bd017d4861208ec3d2c Mon Sep 17 00:00:00 2001 From: pauline Paiz Date: Sat, 28 Jan 2023 18:03:57 -0800 Subject: [PATCH 087/162] correcting parentheses in getgroupfrag and cov funs --- R/GroupExport.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/GroupExport.R b/R/GroupExport.R index e71f5537..623c7684 100644 --- a/R/GroupExport.R +++ b/R/GroupExport.R @@ -600,7 +600,7 @@ getGroupFragments <- function( groupIDs <- names(cellGroups) - .safelapply(seq_along(groupIDs), function(x)){ + .safelapply(seq_along(groupIDs), function(x){ cat("Making fragment file for cluster:", groupIDs[x], "\n") # get GRanges with all fragments for that cluster cellNames <- cellGroups[[groupIDs[x]]] @@ -609,7 +609,7 @@ getGroupFragments <- function( # filter Fragments fragments <- GenomeInfoDb::keepStandardChromosomes(fragments, pruning.mode = "coarse") saveRDS(fragments, file.path(outDir, paste0(groupIDs[x], "_frags.rds"))) - } + }) } #' Export Cluster Coverage from an ArchRProject @@ -632,7 +632,7 @@ getGroupFragments <- function( tileSize = 100, scaleFactor = 1, groupBy = "Clusters", - fragDir = file.path(getOutputDirectory(ArchRProj), "fragments")) + fragDir = file.path(getOutputDirectory(ArchRProj), "fragments"), outDir = file.path(getOutputDirectory(ArchRProj), "coverage") ){ fragFiles = list.files(path = fragDir, pattern = "_frags.rds", full.names = TRUE) @@ -652,7 +652,7 @@ getGroupFragments <- function( chrRegions <- getChromSizes(ArchRProj) genome <- getGenome(ArchRProj) - for (file in fragFiles) { + for (file in fragFiles){ fragments <- readRDS(file) left <- GRanges(seqnames = seqnames(fragments), ranges = IRanges(start(fragments), width = 1)) From 7c73b00c80499e082a4e3e265c6fef7dc627aab9 Mon Sep 17 00:00:00 2001 From: pauline Paiz Date: Tue, 31 Jan 2023 12:44:13 -0800 Subject: [PATCH 088/162] ahora si --- R/ShinyArchRExports.R | 50 ++++++++++++++++++++++++------------------- 1 file changed, 28 insertions(+), 22 deletions(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 2b9a2495..18d74ab9 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -7,6 +7,7 @@ #' @param ArchRProj An `ArchRProject` object. #' @param outputDir The name (not the path!) of the directory for the Shiny App files. This will become a sub-directory of the ArchRProj output directory #' given by `getOutputDirectory(ArchRProj)`. +#' @param subOutputDir Where data to upload to Shinyapps.io will be stored. Defaults to `inputData`. #' @param groupBy The name of the column in `cellColData` to use for grouping cells together for generating BigWig-style sequencing tracks. #' Only one cell grouping is allowed. #' @param cellColEmbeddings A character vector of columns in `cellColData` to plot as part of the Shiny app. No default is provided so this must be set. @@ -19,7 +20,8 @@ #' @export exportShinyArchR <- function( ArchRProj = NULL, - outputDir = "Shiny", + mainDir = "Shiny", + subOutDir = "inputData", groupBy = "Clusters", cellColEmbeddings = NULL, embedding = "UMAP", @@ -31,7 +33,7 @@ exportShinyArchR <- function( .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) .validInput(input = outputDir, name = "outputDir", valid = c("character")) - .validInput(input = outputDir, name = "subOutputDir", valid = c("character")) + .validInput(input = subOutput, name = "subOutputDir", valid = c("character")) .validInput(input = groupBy, name = "groupBy", valid = c("character")) .validInput(input = cellColEmbeddings, name = "groupBy", valid = c("character", "null")) .validInput(input = embedding, name = "embedding", valid = c("character")) @@ -63,19 +65,22 @@ exportShinyArchR <- function( print(paste0("embedding:", embedding)) } - #check that groupBy column exists and doesnt have NA values + #check that groupBy column exists and doesn't have NA values if (groupBy %ni% colnames(ArchRProj@cellColData)) { stop("groupBy is not part of cellColData") } else if ((any(is.na(paste0("ArchRProj$", groupBy))))) { stop("Some entries in the column indicated by groupBy have NA values. Please subset your project using subsetArchRProject() to only contain cells with values for groupBy") } - subOutputDir <- "inputData" #hardcoded - mainDir <- getOutputDirectory(ArchRProj) + # get directories paths + projDir <- getOutputDirectory(ArchRProj) + mainDir <- file.path(projDir, mainDir) + subOutDir <- file.path(projDir, mainDir, subOutDir) + # Make directory for Shiny App - if(!dir.exists(outputDir)) { + if(!dir.exists(outDir)) { - dir.create(file.path(mainDir, outputDir), showWarnings = TRUE) + dir.create(mainDir, showWarnings = TRUE) ## Check the links for the files filesUrl <- data.frame( @@ -93,7 +98,7 @@ exportShinyArchR <- function( stringsAsFactors = FALSE ) - .downloadFiles(filesUrl = filesUrl, pathDownload = file.path(mainDir, outputDir), threads = threads) + .downloadFiles(filesUrl = filesUrl, pathDownload = mainDir, threads = threads) }else{ message("Using existing Shiny files...") @@ -101,7 +106,6 @@ exportShinyArchR <- function( # Create a copy of the ArchRProj ArchRProjShiny <- ArchRProj - # Add metadata to ArchRProjShiny ArchRProjShiny@projectMetadata[["groupBy"]] <- groupBy ArchRProjShiny@projectMetadata[["tileSize"]] <- tileSize @@ -112,22 +116,22 @@ exportShinyArchR <- function( }) ArchRProjShiny@projectMetadata[["units"]] <- units ArchRProjShiny <- saveArchRProject(ArchRProj = ArchRProjShiny, outputDirectory = - file.path(mainDir, outputDir, "Save-ArchRProjShiny"), dropCells = TRUE, overwrite = TRUE, load = TRUE) - - projDir <- getOutputDirectory(ArchRProj = ArchRProjShiny) + file.path(mainDir, "Save-ArchRProjShiny"), dropCells = TRUE, overwrite = TRUE, load = TRUE) # Create fragment files - should be saved within a dir called ShinyFragments within the ArchRProjShiny output directory fragDir <- file.path(projDir, "ShinyFragments", groupBy) fragFiles <- list.files(path = file.path(fragDir, pattern = "\\_frags.rds$")) #this is still a slightly dangerous comparison, better would be to compare for explicitly the file names that are expected - if(length(fragFiles) == length(unique(ArchRProjShiny@cellColData[,groupBy]))){ + if(length(fragFiles) == length(unique(ArchRProj@cellColData[,groupBy]))){ if(force){ - .getGroupFragsFromProj(ArchRProj = ArchRProjShiny, groupBy = groupBy, outDir = fragDir) + .getGroupFragsFromProj(ArchRProj = ArchRProj, groupBy = groupBy, outDir = fragDir) } else{ message("Fragment files already exist. Skipping fragment file generation...") } }else{ - .getGroupFragsFromProj(ArchRProj = ArchRProjShiny, groupBy = groupBy, outDir = fragDir) + dir.create(file.path(projDir, "ShinyFragments")) + dir.create(fragDir, showWarnings = TRUE) + .getGroupFragsFromProj(ArchRProj = ArchRProj, groupBy = groupBy, outDir = fragDir) } # Create coverage objects - should be saved within a dir called ShinyCoverage within the ArchRProjShiny output directory @@ -141,11 +145,13 @@ exportShinyArchR <- function( message("Coverage files already exist. Skipping fragment file generation...") } }else{ - .getClusterCoverage(ArchRProj = ArchRProjShiny, tileSize = tileSize, groupBy = groupBy, outDir = covDir) + dir.create(file.path(projDir, "ShinyCoverage")) + dir.create(covDir, showWarnings = TRUE) + .getClusterCoverage(ArchRProj = ArchRProj, tileSize = tileSize, groupBy = groupBy, outDir = covDir) } # Create directory to save input data to Shinyapps.io (everything that will be preprocessed) - dir.create(file.path(mainDir, outputDir, subOutputDir), showWarnings = TRUE) + dir.create(file.path(projDir, outputDir, subOutputDir), showWarnings = TRUE) allMatrices <- getAvailableMatrices(ArchRProjShiny) matrices <- list() @@ -191,14 +197,14 @@ exportShinyArchR <- function( message("matrices and imputeMatrices already exist. reading from local files...") - matrices <- readRDS(file.path(mainDir, outputDir, subOutputDir, "matrices.rds")) - imputeMatrices <- readRDS(file.path(mainDir, outputDir, subOutputDir, "imputeMatrices.rds")) + matrices <- readRDS(file.path(projDir, outputDir, subOutputDir, "matrices.rds")) + imputeMatrices <- readRDS(file.path(projDir, outputDir, subOutputDir, "imputeMatrices.rds")) } # mainEmbeds will create an HDF5 file containing the nativeRaster vectors for data stored in cellColData - if (!file.exists(file.path(mainDir, outputDir, subOutputDir, "mainEmbeds.h5"))) { + if (!file.exists(file.path(projDir, outputDir, subOutputDir, "mainEmbeds.h5"))) { .mainEmbeds(ArchRProj = ArchRProjShiny, - outDirEmbed = file.path(mainDir, outputDir, subOutputDir), + outDirEmbed = file.path(projDir, outputDir, subOutputDir), colorBy = "cellColData", cellColEmbeddings = cellColEmbeddings, embeddingDF = df, @@ -216,7 +222,7 @@ exportShinyArchR <- function( .matrixEmbeds( ArchRProj = ArchRProj, - outDirEmbed = file.path(mainDir, outputDir, subOutputDir), + outDirEmbed = file.path(projDir, outputDir, subOutputDir), colorBy = intersect(supportedMatrices, allMatrices), embedding = embedding, matrices = matrices, From 95cb6c54acbb9874bafd9c2d396bea27fe9110fe Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Fri, 3 Feb 2023 16:54:52 -0800 Subject: [PATCH 089/162] typo computeClosestCellsList --- R/MarkerFeatures.R | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/R/MarkerFeatures.R b/R/MarkerFeatures.R index b9d2c7f8..4a3e6bec 100644 --- a/R/MarkerFeatures.R +++ b/R/MarkerFeatures.R @@ -695,7 +695,7 @@ getMarkerFeatures <- function( if (closest){ .logMessage("Using the closest cells identified by KKN between the foreground and background", verbose = TRUE, logFile = logFile) - sortedCells <- .computeClostestCellsList(inputNormQ[idB, ,drop=FALSE], inputNormQ[idF, ,drop=FALSE], k = k2) + sortedCells <- .computeClosestCellsList(inputNormQ[idB, ,drop=FALSE], inputNormQ[idF, ,drop=FALSE], k = k2) idX <- c() inspected_cells <- c() idY <- c() @@ -867,8 +867,9 @@ getMarkerFeatures <- function( } -#from @anastasiya-pendragon -.computeClostestCellsList <- function( +# from @anastasiya-pendragon +# +.computeClosestCellsList <- function( data = NULL, query = NULL, k = 50, From e162c213bb4afa1f4ea511823da7d2583dc320d8 Mon Sep 17 00:00:00 2001 From: pauline Paiz Date: Sat, 18 Feb 2023 17:17:28 -0800 Subject: [PATCH 090/162] from pelayo --- R/ShinyArchRExports.R | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 18d74ab9..23a6fe3d 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -78,27 +78,27 @@ exportShinyArchR <- function( subOutDir <- file.path(projDir, mainDir, subOutDir) # Make directory for Shiny App - if(!dir.exists(outDir)) { + if(!dir.exists(mainDir)) { dir.create(mainDir, showWarnings = TRUE) ## Check the links for the files - filesUrl <- data.frame( - fileUrl = c( - "https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/app.R", - "https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/global.R", - "https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/server.R", - "https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/ui.R" - ), - md5sum = c( - "77502e1f195e21d2f7a4e8ac9c96e65e", - "618613b486e4f8c0101f4c05c69723b0", - "a8d5ae747841055ef230ba496bcfe937" - ), - stringsAsFactors = FALSE - ) + # filesUrl <- data.frame( + # fileUrl = c( + # "https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/app.R", + # "https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/global.R", + # "https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/server.R", + # "https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/ui.R" + # ), + # md5sum = c( + # "77502e1f195e21d2f7a4e8ac9c96e65e", + # "618613b486e4f8c0101f4c05c69723b0", + # "a8d5ae747841055ef230ba496bcfe937" + # ), + # stringsAsFactors = FALSE + # ) - .downloadFiles(filesUrl = filesUrl, pathDownload = mainDir, threads = threads) + # .downloadFiles(filesUrl = filesUrl, pathDownload = mainDir, threads = threads) }else{ message("Using existing Shiny files...") From 8f9d9f87b0b25c6d9be729ee974341ac09e2de1f Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Thu, 23 Feb 2023 11:36:05 -0800 Subject: [PATCH 091/162] changing matrixEmbeds variables to be consistent --- R/MarkerFeatures.R | 2 +- R/ShinyArchRExports.R | 79 ++++++++++++++++++------------------------- 2 files changed, 33 insertions(+), 48 deletions(-) diff --git a/R/MarkerFeatures.R b/R/MarkerFeatures.R index 4a3e6bec..3e066178 100644 --- a/R/MarkerFeatures.R +++ b/R/MarkerFeatures.R @@ -868,7 +868,7 @@ getMarkerFeatures <- function( } # from @anastasiya-pendragon -# +# create a sorted list of closest cells between foreground and background .computeClosestCellsList <- function( data = NULL, query = NULL, diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 23a6fe3d..fcb76740 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -255,7 +255,8 @@ exportShinyArchR <- function( #' @param cellColEmbeddings A character vector of columns in `cellColData` to plot as part of the Shiny app. No default is provided so this must be set. #' For ex. `c("Sample","Clusters","TSSEnrichment","nFrags")`. #' @param embedding The embedding to use. Default is "UMAP". -#' @param matrices List of stored matrices to use for plotEmbedding so that it runs faster. +#' @param embeddingDF The pre-processed/stored embedding data.frame to use so plotEmbedding() runs faster. +#' @param matrices List of stored matrices to use for plotEmbedding() so that it runs faster. #' @param imputeMatrices List of stored imputed matrices to use for plotEmbedding so that it runs faster. #' @param threads The number of threads to use for parallel execution. #' @param logFile The path to a file to be used for logging ArchR output. @@ -266,6 +267,7 @@ exportShinyArchR <- function( colorBy = "cellColData", cellColEmbeddings = NULL, embedding = "UMAP", + embeddingDF = NULL, matrices = NULL, imputeMatrices = NULL, threads = getArchRThreads(), @@ -300,7 +302,7 @@ exportShinyArchR <- function( name = name, allNames = names, embedding = embedding, - embeddingDF = df, + embeddingDF = embeddingDF, rastr = FALSE, size = 0.5, # imputeWeights = NULL, # unsure if inputWeights needed for cellColData @@ -372,12 +374,12 @@ exportShinyArchR <- function( #' This function will be called by exportShinyArchR() #' #' @param ArchRProj An `ArchRProject` object loaded in the environment. Can do this using: loadArchRProject("path to ArchRProject/") -#' @param outDirEmbed Where the HDF5 and the jpgs will be saved. #' @param colorBy A string indicating whether points in the plot should be colored by a column in `cellColData` ("cellColData") or by #' a data matrix in the corresponding ArrowFiles (i.e. "GeneScoreMatrix", "MotifMatrix", "PeakMatrix"). #' @param embedding The embedding to use. Default is "UMAP". -#' @param matrices List of stored matrices to use for plotEmbedding so that it runs faster. -#' @param imputeMatrices List of stored imputed matrices to use for plotEmbedding so that it runs faster. +#' @param matrices List of stored/pre-processed matrices to use for plotEmbedding() so that it runs faster. +#' @param imputeMatrices List of stored imputed matrices to use for plotEmbedding() so that it runs faster. +#' @param embeddingDF The pre-processed/stored embedding data.frame to use so plotEmbedding() runs faster. #' @param threads The number of threads to use for parallel execution. #' @param verbose A boolean value that determines whether standard output should be printed. #' @param logFile The path to a file to be used for logging ArchR output. @@ -389,6 +391,7 @@ exportShinyArchR <- function( embedding = "UMAP", matrices = NULL, imputeMatrices = NULL, + embeddingDF = NULL, threads = getArchRThreads(), verbose = TRUE, logFile = createLogFile("matrixEmbeds") @@ -415,23 +418,13 @@ exportShinyArchR <- function( # save the palette embeds_pal_list = list() - allMatrices <- getAvailableMatrices(ArchRProj) - for(mat in colorBy){ - if(mat %ni% shinyMatrices){ - stop(mat,"not in ArchRProj") - } + if(file.exists(paste0(outDirEmbed, "/", matrices, ".rds"))){ + featureNames <- readRDS(file.path(outputDir, subOutputDir, mat, "_names.rds")) + if(!is.null(featureNames)){ - if(file.exists(paste0(outDirEmbed, "/", mat, ".rds"))){ - featureNames <- readRDS(file.path(outputDir, subOutputDir, mat, "_names.rds")) - }else{ - - - if(!is.null(featureNames)){ - - embeds_points <- .safelapply(1:length(featureNames), function(x){ - - print(paste0("Creating plots for ", mat,": ",x,": ",round((x/length(featureNames))*100,3), "%")) + embeds_points <- .safelapply(1:length(featureNames), function(x){ + print(paste0("Creating plots for ", mat,": ",x,": ",round((x/length(featureNames))*100,3), "%")) if(!is.na(matrices[[mat]][x])){ @@ -443,9 +436,9 @@ exportShinyArchR <- function( quantCut = c(0.01, 0.95), imputeWeights = getImputeWeights(ArchRProj = ArchRProj), plotAs = "points", - matrices = mat, - embeddingDF = df, + matrices = matrices, imputeMatrices = imputeMatrices, + embeddingDF = embeddingDF, rastr = TRUE ) }else{ @@ -466,11 +459,11 @@ exportShinyArchR <- function( ) #save plot without axes etc as a jpg. - ggsave(filename = file.path(outDirEmbed, paste0(shinymatrices,"_embeds"), paste0(featureNames[x],"_blank72.jpg")), + ggsave(filename = file.path(outDirEmbed, paste0(mat,"_embeds"), paste0(featureNames[x],"_blank72.jpg")), plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) #read back in that jpg because we need vector in native format - blank_jpg72 <- readJPEG(source = file.path(outDirEmbed, paste0(shinymatrices,"_embeds"), + blank_jpg72 <- readJPEG(source = file.path(outDirEmbed, paste0(mat,"_embeds"), paste0(featureNames[x],"_blank72.jpg")), native = TRUE) g <- ggplot_build(gene_plot) @@ -484,27 +477,26 @@ exportShinyArchR <- function( }, threads = threads) - names(embeds_points) <- featureNames + names(embeds_points) <- featureNames embeds_points = embeds_points[!unlist(lapply(embeds_points, is.null))] - embeds_min_max <- data.frame(matrix(NA, 2, length(embeds_points))) colnames(embeds_min_max) <- names(embeds_points)[which(!unlist(lapply(embeds_points, is.null)))] rownames(embeds_min_max) <- c("min","max") - h5closeAll() - points = H5Fcreate(name = file.path(outDirEmbed, paste0(shinymatrices,"_plotBlank72.h5"))) - h5createGroup(file.path(outDirEmbed, paste0(shinymatrices,"_plotBlank72.h5")), shinymatrices) + h5closeAll() + points = H5Fcreate(name = file.path(outDirEmbed, paste0("shinymatrices_plotBlank72.h5"))) + h5createGroup(file.path(outDirEmbed, paste0("shinymatrices_plotBlank72.h5")), shinymatrices) - for(i in 1:length(embeds_points)){ + for(i in 1:length(embeds_points)){ - print(paste0("Getting H5 files for embeds_points: ",i,": ",round((i/length(embeds_points))*100,3), "%")) - h5createDataset(file = points, dataset = paste0(shinymatrices,"/",featureNames[i]), dims = c(46656,1), storage.mode = "integer") - h5writeDataset(obj = embeds_points[[i]][[1]]$plot, h5loc = points, name=paste0(shinymatrices,"/",featureNames[i])) - embeds_min_max[1,i] = embeds_points[[i]][[1]]$min - embeds_min_max[2,i] = embeds_points[[i]][[1]]$max + print(paste0("Getting H5 files for embeds_points: ",i,": ",round((i/length(embeds_points))*100,3), "%")) + h5createDataset(file = points, dataset = paste0(shinymatrices,"/",featureNames[i]), dims = c(46656,1), storage.mode = "integer") + h5writeDataset(obj = embeds_points[[i]][[1]]$plot, h5loc = points, name=paste0(shinymatrices,"/",featureNames[i])) + embeds_min_max[1,i] = embeds_points[[i]][[1]]$min + embeds_min_max[2,i] = embeds_points[[i]][[1]]$max - } + } embeds_min_max_list[[shinymatrices]] = embeds_min_max embeds_pal_list[[shinymatrices]] = embeds_points[[length(embeds_points)]][[1]]$pal @@ -512,22 +504,15 @@ exportShinyArchR <- function( }else{ - message(matName,".rds file is NULL") + message(mat,".rds file is NULL") } - embeds_min_max_list[[matrix]] = embeds_min_max - embeds_pal_list[[matrix]] = embeds_points[[length(embeds_points)]][[1]]$pal - - }else{ - - message(matName,".rds file does not exist") - } + embeds_min_max_list[[mat]] = embeds_min_max + embeds_pal_list[[mat]] = embeds_points[[length(embeds_points)]][[1]]$pal }else{ - stop(matrixName,".rds file does not exist. This file should have been created previously be exportShinyArchR.") + stop(matrices,".rds file does not exist. This file should have been created previously by exportShinyArchR().") } - - } scale <- embeds_min_max_list From 80777cf5d19c27e6046022cd0a3573affca1d973 Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Thu, 23 Feb 2023 14:34:51 -0800 Subject: [PATCH 092/162] matrixEmbeds updates --- R/ShinyArchRExports.R | 153 ++++++++++++++++++++++++------------------ 1 file changed, 86 insertions(+), 67 deletions(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index fcb76740..3a4d8cab 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -384,14 +384,16 @@ exportShinyArchR <- function( #' @param verbose A boolean value that determines whether standard output should be printed. #' @param logFile The path to a file to be used for logging ArchR output. #' + .matrixEmbeds <- function( ArchRProj = NULL, outDirEmbed = NULL, colorBy = c("GeneScoreMatrix", "GeneIntegrationMatrix", "MotifMatrix"), + supportedMatrices = c("GeneScoreMatrix", "GeneIntegrationMatrix", "MotifMatrix"), embedding = "UMAP", + embeddingDF = NULL, matrices = NULL, imputeMatrices = NULL, - embeddingDF = NULL, threads = getArchRThreads(), verbose = TRUE, logFile = createLogFile("matrixEmbeds") @@ -399,6 +401,7 @@ exportShinyArchR <- function( .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) .validInput(input = outDirEmbed, name = "outDirEmbed", valid = c("character")) .validInput(input = colorBy, name = "colorBy", valid = c("character")) + .validInput(input = supportedMatrices, name = "supportedMatrices", valid = c("character")) .validInput(input = embedding, name = "embedding", valid = c("character")) .validInput(input = matrices, name = "matrices", valid = c("list")) .validInput(input = imputeMatrices, name = "imputeMatrices", valid = c("list")) @@ -408,45 +411,56 @@ exportShinyArchR <- function( .startLogging(logFile=logFile) .logThis(mget(names(formals()),sys.frame(sys.nframe())), "matrixEmbeds Input-Parameters", logFile = logFile) - + if (file.exists(file.path(outDirEmbed, "plotBlank72.h5"))){ file.remove(file.path(outDirEmbed, "plotBlank72.h5")) } - + # save the scale embeds_min_max_list = list() # save the palette embeds_pal_list = list() - + + allMatrices <- getAvailableMatrices(ArchRProj) + for(mat in colorBy){ - if(file.exists(paste0(outDirEmbed, "/", matrices, ".rds"))){ - featureNames <- readRDS(file.path(outputDir, subOutputDir, mat, "_names.rds")) + if(mat %in% supportedMatrices){ + message(mat,"not in ArchRProj") ## NOTE: should we stop or just give a warning + } + + if(file.exists(paste0(outDirEmbed, "/",mat, "/", mat, "_names.rds"))){ + + dir.create(paste0(outDirEmbed, "/",mat, "/embeds"), showWarnings = FALSE) + + featureNames <- readRDS(file.path(outDirEmbed, mat, paste0(mat,"_names.rds"))) + if(!is.null(featureNames)){ - - embeds_points <- .safelapply(1:length(featureNames), function(x){ - print(paste0("Creating plots for ", mat,": ",x,": ",round((x/length(featureNames))*100,3), "%")) - - if(!is.na(matrices[[mat]][x])){ - - gene_plot <- plotEmbedding( - ArchRProj = ArchRProj, - colorBy = mat, - name = featureNames[x], - embedding = embedding, - quantCut = c(0.01, 0.95), - imputeWeights = getImputeWeights(ArchRProj = ArchRProj), - plotAs = "points", - matrices = matrices, - imputeMatrices = imputeMatrices, - embeddingDF = embeddingDF, - rastr = TRUE - ) + + embeds_points <- .safelapply(1:10, function(x){ # length(featureNames) + + print(paste0("Creating plots for ", mat,": ",x,": ",round((x/length(featureNames))*100,3), "%")) + + if(!is.na(featureNames[x])){ + + gene_plot <- plotEmbedding( + ArchRProj = ArchRProj, + colorBy = mat, + name = featureNames[x], + embedding = embedding, + quantCut = c(0.01, 0.95), + imputeWeights = getImputeWeights(ArchRProj = ArchRProj), + plotAs = "points", + matrices = mat, + embeddingDF = embeddingDF, + imputeMatrices = imputeMatrices, + rastr = TRUE + ) }else{ gene_plot = NULL } - + if(!is.null(gene_plot)){ - + gene_plot_blank <- gene_plot + theme(axis.title.x = element_blank()) + theme(axis.title.y = element_blank()) + theme(axis.title = element_blank()) + @@ -457,68 +471,73 @@ exportShinyArchR <- function( panel.border = element_blank(), title=element_blank() ) - - #save plot without axes etc as a jpg. - ggsave(filename = file.path(outDirEmbed, paste0(mat,"_embeds"), paste0(featureNames[x],"_blank72.jpg")), - plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) - - #read back in that jpg because we need vector in native format - blank_jpg72 <- readJPEG(source = file.path(outDirEmbed, paste0(mat,"_embeds"), - paste0(featureNames[x],"_blank72.jpg")), native = TRUE) - + + #save plot without axes etc as a jpg. + ggsave(filename = file.path(outDirEmbed, mat, "embeds", paste0(featureNames[x],"_blank72.jpg")), + plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) + + #read back in that jpg because we need vector in native format + blank_jpg72 <- readJPEG(source = file.path(outDirEmbed, mat, "embeds", paste0(featureNames[x],"_blank72.jpg")), + native = TRUE) + g <- ggplot_build(gene_plot) - + res = list(list(plot=as.vector(blank_jpg72), min = round(min(gene_plot$data$color),1), max = round(max(gene_plot$data$color),1), pal = unique(g$data[[1]][,"colour"]))) - + return(res) } - - + + }, threads = threads) - - names(embeds_points) <- featureNames - + + names(embeds_points) <- featureNames[1:10] embeds_points = embeds_points[!unlist(lapply(embeds_points, is.null))] + embeds_min_max <- data.frame(matrix(NA, 2, length(embeds_points))) colnames(embeds_min_max) <- names(embeds_points)[which(!unlist(lapply(embeds_points, is.null)))] rownames(embeds_min_max) <- c("min","max") - + h5closeAll() - points = H5Fcreate(name = file.path(outDirEmbed, paste0("shinymatrices_plotBlank72.h5"))) - h5createGroup(file.path(outDirEmbed, paste0("shinymatrices_plotBlank72.h5")), shinymatrices) - + points = H5Fcreate(name = file.path(outDirEmbed, paste0(mat,"_plotBlank72.h5"))) + h5createGroup(file.path(outDirEmbed, paste0(mat,"_plotBlank72.h5")), mat) + for(i in 1:length(embeds_points)){ - + print(paste0("Getting H5 files for embeds_points: ",i,": ",round((i/length(embeds_points))*100,3), "%")) - h5createDataset(file = points, dataset = paste0(shinymatrices,"/",featureNames[i]), dims = c(46656,1), storage.mode = "integer") - h5writeDataset(obj = embeds_points[[i]][[1]]$plot, h5loc = points, name=paste0(shinymatrices,"/",featureNames[i])) + h5createDataset(file = points, dataset = paste0(mat,"/",featureNames[i]), dims = c(46656,1), storage.mode = "integer") + h5writeDataset(obj = embeds_points[[i]][[1]]$plot, h5loc = points, name=paste0(mat,"/",featureNames[i])) embeds_min_max[1,i] = embeds_points[[i]][[1]]$min embeds_min_max[2,i] = embeds_points[[i]][[1]]$max - + } - - embeds_min_max_list[[shinymatrices]] = embeds_min_max - embeds_pal_list[[shinymatrices]] = embeds_points[[length(embeds_points)]][[1]]$pal - - - }else{ - - message(mat,".rds file is NULL") - - } - + embeds_min_max_list[[mat]] = embeds_min_max embeds_pal_list[[mat]] = embeds_points[[length(embeds_points)]][[1]]$pal + + + + + embeds_min_max_list[[mat]] = embeds_min_max + embeds_pal_list[[mat]] = embeds_points[[length(embeds_points)]][[1]]$pal + }else{ - stop(matrices,".rds file does not exist. This file should have been created previously by exportShinyArchR().") + + message(mat,".rds file does not exist") } + + }else{ + message(mat,".rds file does not exist. This file should have been created previously be exportShinyArchR. Skipping...") } + + +} - scale <- embeds_min_max_list - pal <- embeds_pal_list +scale <- embeds_min_max_list +pal <- embeds_pal_list - saveRDS(scale, file.path(outDirEmbed, "scale.rds")) - saveRDS(pal, file.path(outDirEmbed, "pal.rds")) +saveRDS(scale, file.path(outDirEmbed, "scale.rds")) +saveRDS(pal, file.path(outDirEmbed, "pal.rds")) } + From d5b78e0ea10b75afd8b205aef5024862ea9cbf9c Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Sun, 26 Feb 2023 08:52:52 -0800 Subject: [PATCH 093/162] "adding shinyarchr exports to collate field" --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index a8bb1585..469f3f0b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -91,6 +91,7 @@ Collate: 'RcppExports.R' 'ReproduciblePeakSet.R' 'SparseUtils.R' + 'ShinyArchRExports.R' 'Trajectory.R' 'ValidationUtils.R' 'VisualizeData.R' From ef7107fccdf3db0536bef3e0b053520d39bfb049 Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Sun, 26 Feb 2023 08:58:36 -0800 Subject: [PATCH 094/162] adding comma to loadArchRProject --- R/AllClasses.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/AllClasses.R b/R/AllClasses.R index 1f9752bc..66769880 100644 --- a/R/AllClasses.R +++ b/R/AllClasses.R @@ -403,7 +403,7 @@ recoverArchRProject <- function(ArchRProj){ loadArchRProject <- function( path = "./", force = FALSE, - showLogo = TRUE + showLogo = TRUE, shiny = FALSE ){ From 7fb03ff8c3bf207119a2de655b89a2055b0d1c29 Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Sun, 26 Feb 2023 09:08:06 -0800 Subject: [PATCH 095/162] "typo" --- R/ShinyArchRExports.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 3a4d8cab..7cb7c57c 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -49,7 +49,7 @@ exportShinyArchR <- function( .requirePackage("rhandsontable", installInfo = 'install.packages("rhandsontable")') if(length(groupBy) > 1){ - stop("Only one value is allowed for groupBy".) + stop("Only one value is allowed for groupBy.") } if(is.null(cellColEmbeddings)){ From 56c86ad1fcbaee72efff349eac92dcc271bb4471 Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Sun, 26 Feb 2023 09:11:15 -0800 Subject: [PATCH 096/162] ellColEmbeddings parameter --- R/ShinyArchRExports.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 7cb7c57c..f9c4099f 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -54,7 +54,7 @@ exportShinyArchR <- function( if(is.null(cellColEmbeddings)){ stop("The cellColEmbeddings parameter must be defined! Please see function input definitions.") - } else if(!all(cellColEmbeddings %in% colnames(ArchRProj@cellColData)){ + } else if(!all(cellColEmbeddings %in% colnames(ArchRProj@cellColData))){ stop("Not all entries in cellColEmbeddings exist in the cellColData of your ArchRProj. Please check provided inputs.") } From b3881e940e4da5232639890dca69a98afef15c03 Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Sun, 26 Feb 2023 09:47:14 -0800 Subject: [PATCH 097/162] end space visualize data --- R/VisualizeData.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/VisualizeData.R b/R/VisualizeData.R index 6b25f724..3c3788b5 100644 --- a/R/VisualizeData.R +++ b/R/VisualizeData.R @@ -1049,4 +1049,3 @@ plotGroups <- function( invisible(p) } - From def0afe9fbb22f4c0061e24dbfbd5ad51c61d998 Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Sun, 26 Feb 2023 10:38:52 -0800 Subject: [PATCH 098/162] latest global server ui files --- R/VisualizeData.R | 185 +++++++++++++++++++--------------------------- Shiny/global.R | 53 +++++++++---- Shiny/server.R | 24 +++--- 3 files changed, 126 insertions(+), 136 deletions(-) diff --git a/R/VisualizeData.R b/R/VisualizeData.R index 3c3788b5..d55ab4dc 100644 --- a/R/VisualizeData.R +++ b/R/VisualizeData.R @@ -210,7 +210,6 @@ plotPDF <- function( #' @param baseSize The base font size to use in the plot. #' @param plotAs A string that indicates whether points ("points") should be plotted or a hexplot ("hex") should be plotted. By default #' if `colorBy` is numeric, then `plotAs` is set to "hex". -#' @param Shiny A boolean value that tells the function is calling for Shiny or not. #' @param threads The number of threads to be used for parallel computing. #' @param logFile The path to a file to be used for logging ArchR output. #' @param ... Additional parameters to pass to `ggPoint()` or `ggHex()`. @@ -246,15 +245,11 @@ plotEmbedding <- function( keepAxis = FALSE, baseSize = 10, plotAs = NULL, - Shiny = FALSE, - matrices = NULL, - imputeMatrices = NULL, - embeddingDF = NULL, threads = getArchRThreads(), logFile = createLogFile("plotEmbedding"), ... -){ - + ){ + .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) .validInput(input = embedding, name = "reducedDims", valid = c("character")) .validInput(input = colorBy, name = "colorBy", valid = c("character")) @@ -273,41 +268,36 @@ plotEmbedding <- function( .validInput(input = keepAxis, name = "keepAxis", valid = c("boolean")) .validInput(input = baseSize, name = "baseSize", valid = c("numeric")) .validInput(input = plotAs, name = "plotAs", valid = c("character", "null")) - .validInput(input = Shiny, name = "Shiny", valid = c("boolean")) .validInput(input = threads, name = "threads", valid = c("integer")) .validInput(input = logFile, name = "logFile", valid = c("character")) - + .requirePackage("ggplot2", source = "cran") - + .startLogging(logFile = logFile) .logThis(mget(names(formals()),sys.frame(sys.nframe())), "Input-Parameters", logFile=logFile) - + ############################## # Get Embedding ############################## - .logMessage("Getting Embedding", logFile = logFile) - if(Shiny){ - df <- embeddingDF - } else{ - df <- getEmbedding(ArchRProj, embedding = embedding, returnDF = TRUE) - } + .logMessage("Getting UMAP Embedding", logFile = logFile) + df <- getEmbedding(ArchRProj, embedding = embedding, returnDF = TRUE) if(!all(rownames(df) %in% ArchRProj$cellNames)){ stop("Not all cells in embedding are present in ArchRProject!") } + .logThis(df, name = "Embedding data.frame", logFile = logFile) - if(!is.null(sampleCells)){ if(sampleCells < nrow(df)){ if(!is.null(imputeWeights)){ - stop("Cannot sampleCells with imputeWeights not equal to NULL at this time!") + stop("Cannot sampleCells with imputeWeights not equalt to NULL at this time!") } df <- df[sort(sample(seq_len(nrow(df)), sampleCells)), , drop = FALSE] } } - + #Parameters - plotParams <- list() + plotParams <- list(...) plotParams$x <- df[,1] plotParams$y <- df[,2] plotParams$title <- paste0(embedding, " of ", stringr::str_split(colnames(df)[1],pattern="#",simplify=TRUE)[,1]) @@ -319,32 +309,29 @@ plotEmbedding <- function( plotParams$rastr <- rastr plotParams$size <- size plotParams$randomize <- randomize - - #Check if Cells To Be Highlighted + + #Check if Cells To Be Highlighed if(!is.null(highlightCells)){ highlightPoints <- match(highlightCells, rownames(df), nomatch = 0) if(any(highlightPoints==0)){ stop("highlightCells contain cells not in Embedding cellNames! Please make sure that these match!") } } - + #Make Sure ColorBy is valid! if(length(colorBy) > 1){ stop("colorBy must be of length 1!") } - - if(!Shiny){ - allColorBy <- .availableArrays(head(getArrowFiles(ArchRProj), 2)) - } else { - allColorBy <- matrices$allColorBy - } + allColorBy <- c("colData", "cellColData", .availableArrays(head(getArrowFiles(ArchRProj), 2))) if(tolower(colorBy) %ni% tolower(allColorBy)){ stop("colorBy must be one of the following :\n", paste0(allColorBy, sep=", ")) } colorBy <- allColorBy[match(tolower(colorBy), tolower(allColorBy))] + .logMessage(paste0("ColorBy = ", colorBy), logFile = logFile) - + if(tolower(colorBy) == "coldata" | tolower(colorBy) == "cellcoldata"){ + colorList <- lapply(seq_along(name), function(x){ colorParams <- list() colorParams$color <- as.vector(getCellColData(ArchRProj, select = name[x], drop = FALSE)[rownames(df), 1]) @@ -361,7 +348,7 @@ plotEmbedding <- function( if(x == 1){ .logThis(colorParams, name = "ColorParams 1", logFile = logFile) } - + if(!is.null(imputeWeights)){ if(getArchRVerbose()) message("Imputing Matrix") colorMat <- matrix(colorParams$color, nrow=1) @@ -370,30 +357,28 @@ plotEmbedding <- function( colorParams$color <- as.vector(colorMat) } colorParams - }) - }else{# plotting embedding for matrix instead of col in cellcoldata + }) + + + }else{ + suppressMessages(message(logFile)) - - if(!Shiny){ - units <- tryCatch({ - .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, "/Info/Units"))[1] - },error=function(e){ - "values" + + units <- tryCatch({ + .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, "/Info/Units"))[1] + },error=function(e){ + "values" }) - }else{ - units <- ArchRProj@projectMetadata[["units"]] - } if(is.null(log2Norm) & tolower(colorBy) == "genescorematrix"){ log2Norm <- TRUE } - + if(is.null(log2Norm)){ log2Norm <- FALSE } - - if(!Shiny){ - colorMat <- .getMatrixValues( + + colorMat <- .getMatrixValues( ArchRProj = ArchRProj, name = name, matrixName = colorBy, @@ -401,47 +386,27 @@ plotEmbedding <- function( threads = threads, logFile = logFile ) - }else{ - #get values from pre-saved list - colorMat = tryCatch({ - t(as.matrix(matrices[[colorBy]][name,])) - }, warning = function(warning_condition) { - message(paste("name doesn't exist:", name)) - message(warning_condition) - return(NULL) - }, error = function(error_condition) { - message(paste("name doesn't exist:", name)) - message(error_condition) - return(NA) - }, finally={ - }) - rownames(colorMat)=name - } - + if(!all(rownames(df) %in% colnames(colorMat))){ .logMessage("Not all cells in embedding are present in feature matrix. This may be due to using a custom embedding.", logFile = logFile) stop("Not all cells in embedding are present in feature matrix. This may be due to using a custom embedding.") } - + colorMat <- colorMat[,rownames(df), drop=FALSE] - + .logThis(colorMat, "colorMat-Before-Impute", logFile = logFile) - + if(!is.null(imputeWeights)){ if(getArchRVerbose()) message("Imputing Matrix") - if(!Shiny){ - colorMat <- imputeMatrix(mat = as.matrix(colorMat), imputeWeights = imputeWeights, logFile = logFile) - }else{ - colorMat <- imputeMatrices[[colorBy]][name,] - } - if(!inherits(colorMat, "matrix")){ - colorMat <- matrix(colorMat, ncol = nrow(df)) - colnames(colorMat) <- rownames(df) - } + colorMat <- imputeMatrix(mat = as.matrix(colorMat), imputeWeights = imputeWeights, logFile = logFile) + if(!inherits(colorMat, "matrix")){ + colorMat <- matrix(colorMat, ncol = nrow(df)) + colnames(colorMat) <- rownames(df) + } } - + .logThis(colorMat, "colorMat-After-Impute", logFile = logFile) - + colorList <- lapply(seq_len(nrow(colorMat)), function(x){ colorParams <- list() colorParams$color <- colorMat[x, ] @@ -463,38 +428,39 @@ plotEmbedding <- function( } colorParams }) + } - + if(getArchRVerbose()) message("Plotting Embedding") - + ggList <- lapply(seq_along(colorList), function(x){ - + if(getArchRVerbose()) message(x, " ", appendLF = FALSE) - + plotParamsx <- .mergeParams(colorList[[x]], plotParams) - + if(plotParamsx$discrete){ plotParamsx$color <- paste0(plotParamsx$color) } - + if(!plotParamsx$discrete){ - + if(!is.null(quantCut)){ plotParamsx$color <- .quantileCut(plotParamsx$color, min(quantCut), max(quantCut)) } - + plotParamsx$pal <- paletteContinuous(set = plotParamsx$continuousSet) - + if(!is.null(pal)){ - + plotParamsx$pal <- pal } - + if(is.null(plotAs)){ plotAs <- "hexplot" } - + if(!is.null(log2Norm)){ if(log2Norm){ plotParamsx$color <- log2(plotParamsx$color + 1) @@ -503,64 +469,65 @@ plotEmbedding <- function( plotParamsx$colorTitle <- units } } - + if(tolower(plotAs) == "hex" | tolower(plotAs) == "hexplot"){ - + plotParamsx$discrete <- NULL plotParamsx$continuousSet <- NULL plotParamsx$rastr <- NULL plotParamsx$size <- NULL plotParamsx$randomize <- NULL - + .logThis(plotParamsx, name = paste0("PlotParams-", x), logFile = logFile) gg <- do.call(ggHex, plotParamsx) - + }else{ - + if(!is.null(highlightCells)){ plotParamsx$highlightPoints <- highlightPoints } - + .logThis(plotParamsx, name = paste0("PlotParams-", x), logFile = logFile) gg <- do.call(ggPoint, plotParamsx) - + } - + }else{ if(!is.null(pal)){ plotParamsx$pal <- pal } - + if(!is.null(highlightCells)){ plotParamsx$highlightPoints <- highlightPoints } - + .logThis(plotParamsx, name = paste0("PlotParams-", x), logFile = logFile) gg <- do.call(ggPoint, plotParamsx) - + } - + if(!keepAxis){ gg <- gg + theme(axis.text.x=element_blank(), axis.ticks.x=element_blank(), axis.text.y=element_blank(), axis.ticks.y=element_blank()) } - + gg - + }) names(ggList) <- name if(getArchRVerbose()) message("") - + if(length(ggList) == 1){ ggList <- ggList[[1]] } - + .endLogging(logFile = logFile) - + ggList - + } + #' Visualize Groups from ArchR Project #' #' This function will group, summarize and then plot data from an ArchRProject for visual comparison. @@ -1048,4 +1015,4 @@ plotGroups <- function( invisible(p) -} +} \ No newline at end of file diff --git a/Shiny/global.R b/Shiny/global.R index 9d275595..f41c4050 100644 --- a/Shiny/global.R +++ b/Shiny/global.R @@ -16,41 +16,64 @@ library(raster) library(jpeg) library(sparseMatrixStats) library(BiocManager) -library(AnnotationDbi) -library(BSgenome) -library(Biobase) -library(BiocGenerics) -library(BiocParallel) -library(Biostrings) -library(CNEr) library(ComplexHeatmap) library(ArchR) + +############# NEW ADDITIONS (start) ############################### + +# Adjusting ArchR functions +fn <- unclass(lsf.str(envir = asNamespace("ArchR"), all = TRUE)) +for (i in seq_along(fn)) { + tryCatch({ + eval(parse(text = paste0(fn[i], "<-ArchR:::", fn[i]))) + }, error = function(x) { + }) +} + +source("AllClasses.R") + + +# Calling ArchRProj +ArchRProj=loadArchRProject(path = ".", shiny = TRUE) +ArchRProj <- addImputeWeights(ArchRProj = ArchRProj) +mainDir = 'Shiny' +subOutDir = 'inputData' +groupBy = 'Clusters' +cellColEmbeddings = 'Clusters' +embedding = 'UMAP' +availableMatrices = c("GeneScoreMatrix", "MotifMatrix", "PeakMatrix", "TileMatrix") + + + + +############# NEW ADDITIONS (end) ############################### + # EMBED Visualization ------------------------------------------------------------ # create a list of dropdown options for EMBED tab EMBEDs_dropdown=colnames(ArchRProj@cellColData)[colnames(ArchRProj@cellColData) %in% groupBy] -matrices_dropdown = names(readRDS(paste0("./", subOutputDir, "/scale.rds"))) +matrices_dropdown = names(readRDS(file.path(subOutDir, "scale.rds"))) for(i in 1:length(matrices_dropdown)){ - if(file.exists(paste0(outputDir, "/", subOutputDir, "/", paste0(matrices_dropdown[i],"_names"), ".rds"))){ + if(file.exists(paste0(subOutDir, "/", paste0(matrices_dropdown[i], "/", matrices_dropdown[i],"_names"), ".rds"))){ - assign(paste0(matrices_dropdown[i], "_dropdown"), readRDS(paste0(outputDir, "/", subOutputDir, "/", paste0(matrices_dropdown[i],"_names"), ".rds"))) + assign(paste0(matrices_dropdown[i], "_dropdown"), readRDS(paste0(subOutDir, "/", paste0(matrices_dropdown[i], "/", matrices_dropdown[i],"_names"), ".rds"))) } } -embed_legend = readRDS(paste0(getOutputDirectory(ArchRProj),"/",outputDir, "/", subOutputDir, "/embed_legend_names.rds")) -color_embeddings = readRDS(paste0(getOutputDirectory(ArchRProj),"/",outputDir, "/", subOutputDir, "/embeddings.rds")) +embed_legend = readRDS(paste0(subOutDir, "/embed_legend_names.rds")) +color_embeddings = readRDS(paste0(subOutDir, "/embed_color.rds")) # define a function to get the EMBED for a feature/gene getEMBEDplotWithCol<-function(gene,EMBEDList,scaffoldName,matrixType) { gene_plot=EMBEDList[[gene]] - p_template1=readRDS(paste0(getOutputDirectory(ArchRProj),"/",outputDir, "/", subOutputDir, "/" ,scaffoldName,".rds")) + p_template1=readRDS(paste0(subOutDir, "/" ,scaffoldName,".rds")) p_template1$scales$scales <- gene_plot$scale @@ -70,7 +93,7 @@ getEMBED<-function(gene,fileIndexer,folderName,scaffoldName,matrixType) { if(gene %in% fileIndexer[[file]]) { - EMBEDs_data_subset=readRDS(paste(paste0(getOutputDirectory(ArchRProj),"/",outputDir, "/", subOutputDir, "/" ,folderName),file,sep="/")) + EMBEDs_data_subset=readRDS(paste(paste0(subOutDir, "/" ,folderName),file,sep="/")) return(getEMBEDplotWithCol(gene,EMBEDs_data_subset,scaffoldName,matrixType)) } @@ -80,6 +103,6 @@ getEMBED<-function(gene,fileIndexer,folderName,scaffoldName,matrixType) # PlotBrowser ------------------------------------------------------------------ # create a list of dropdown options for plotbroswer tab -gene_names=readRDS(paste0(getOutputDirectory(ArchRProj),"/",outputDir, "/", subOutputDir, "/features.rds")) +gene_names=readRDS(paste0(subOutDir, "/GeneScoreMatrix/GeneScoreMatrix_names.rds")) diff --git a/Shiny/server.R b/Shiny/server.R index ff5de96f..c1e1a3cf 100644 --- a/Shiny/server.R +++ b/Shiny/server.R @@ -6,7 +6,7 @@ shinyServer <- function(input,output, session){ plot1 <- reactive({ - availableMatrices <- getAvailableMatrices(ArchRProj) + # availableMatrices <- getAvailableMatrices(ArchRProj) if(input$matrix_EMBED1_forComparison %in% availableMatrices){ mat <- availableMatrices[ availableMatrices %in% input$matrix_EMBED1_forComparison] @@ -29,7 +29,7 @@ shinyServer <- function(input,output, session){ color = color()[[mat]], pos=.5, side=1) - p <- h5read(paste0("./",subOutputDir,"/",mat,"_plotBlank72.h5"), paste0(mat, "/", input$EMBED1_forComparison)) + p <- h5read(paste0(subOutDir,"/",mat,"_plotBlank72.h5"), paste0(mat, "/", input$EMBED1_forComparison)) temp_jpg <- t(matrix(decode_native(p), nrow = 216)) last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + @@ -58,7 +58,7 @@ shinyServer <- function(input,output, session){ horiz = FALSE, x.intersp = 1, text.width=0.35, cex = 0.7, bty="n", ncol = 4) - p <- h5read(paste0("./",subOutputDir,"/mainEmbeds.h5"), input$matrix_EMBED1_forComparison)# input$EMBED1_forComparison)) + p <- h5read(paste0(subOutDir,"/mainEmbeds.h5"), input$matrix_EMBED1_forComparison)# input$EMBED1_forComparison)) temp_jpg <- t(matrix(decode_native(p), nrow = 216)) last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.7) + @@ -72,7 +72,7 @@ shinyServer <- function(input,output, session){ plot2 <- reactive({ - availableMatrices <- getAvailableMatrices(ArchRProj) + # availableMatrices <- getAvailableMatrices(ArchRProj) if(input$matrix_EMBED2_forComparison %in% availableMatrices){ mat <- availableMatrices[ availableMatrices %in% input$matrix_EMBED2_forComparison] @@ -94,7 +94,7 @@ shinyServer <- function(input,output, session){ legend_plot <- gradientLegend(valRange=c(scale()[[mat]][,input$EMBED2_forComparison][1],scale()[[mat]][,input$EMBED2_forComparison][2]), color = color()[[mat]], pos=.5, side=1) - p <- h5read(paste0("./",subOutputDir,"/",mat,"_plotBlank72.h5"), paste0(mat, "/", input$EMBED2_forComparison)) + p <- h5read(paste0(subOutDir,"/",mat,"_plotBlank72.h5"), paste0(mat, "/", input$EMBED2_forComparison)) temp_jpg <- t(matrix(decode_native(p), nrow = 216)) last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + draw_plot(p_empty, scale = 0.8) + @@ -124,7 +124,7 @@ shinyServer <- function(input,output, session){ horiz = FALSE, x.intersp = 1, text.width=0.35, cex = 0.7, bty="n", ncol = 4) - p <- h5read(paste0("./",subOutputDir,"/mainEmbeds.h5"), input$matrix_EMBED2_forComparison)# input$EMBED2_forComparison)) + p <- h5read(paste0(subOutDir,"/mainEmbeds.h5"), input$matrix_EMBED2_forComparison)# input$EMBED2_forComparison)) temp_jpg <- t(matrix(decode_native(p), nrow = 216)) last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.7) + @@ -187,8 +187,8 @@ shinyServer <- function(input,output, session){ output$EMBED_plot_1 <- DT::renderDT(NULL) output$EMBED_plot_2 <- DT::renderDT(NULL) - color <- reactive({readRDS(paste0("./",subOutputDir,"/pal.rds"))}) - scale <- reactive({readRDS(paste0("./",subOutputDir,"/scale.rds"))}) + color <- reactive({readRDS(paste0(subOutDir,"/pal.rds"))}) + scale <- reactive({readRDS(paste0(subOutDir,"/scale.rds"))}) #plot EMBED1 output$EMBED_plot_1<- renderPlot({ @@ -210,9 +210,9 @@ shinyServer <- function(input,output, session){ featureNames1 <- reactive({ if(!(input$matrix_EMBED1_forComparison %in% groupBy)){ - availableMatrices <- getAvailableMatrices(ArchRProj) + # availableMatrices <- getAvailableMatrices(ArchRProj) matName <- availableMatrices[ availableMatrices %in% input$matrix_EMBED1_forComparison] - featureNames <- h5read(file = paste0(getOutputDirectory(ArchRProj), "/",outputDir, "/", subOutputDir, "/", matName, "_plotBlank72.h5"), + featureNames <- h5read(file = paste0(subOutDir, "/", matName, "_plotBlank72.h5"), name = matName) Feature_dropdown1 = names(featureNames) return(Feature_dropdown1) @@ -236,9 +236,9 @@ shinyServer <- function(input,output, session){ if(!(input$matrix_EMBED2_forComparison %in% groupBy)){ - availableMatrices <- getAvailableMatrices(ArchRProj) + # availableMatrices <- getAvailableMatrices(ArchRProj) matName <- availableMatrices[ availableMatrices %in% input$matrix_EMBED2_forComparison] - featureNames <- h5read(file = paste0(getOutputDirectory(ArchRProj), "/",outputDir, "/", subOutputDir, "/", matName, "_plotBlank72.h5"), + featureNames <- h5read(file = paste0(subOutDir, "/", matName, "_plotBlank72.h5"), name = matName) Feature_dropdown2 = names(featureNames) From 8b001d6a6aace7aa5b3fbd2ffafed838b3beb7b6 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Mon, 27 Feb 2023 16:10:49 -0800 Subject: [PATCH 099/162] newlines --- R/VisualizeData.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/VisualizeData.R b/R/VisualizeData.R index d55ab4dc..d84d63c6 100644 --- a/R/VisualizeData.R +++ b/R/VisualizeData.R @@ -1015,4 +1015,5 @@ plotGroups <- function( invisible(p) -} \ No newline at end of file +} + From 7a94faa981669599d260114e271d07ae3edaa5b2 Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Tue, 28 Feb 2023 18:21:15 -0800 Subject: [PATCH 100/162] getMatrixValues --- R/AllClasses.R | 479 ++++++++++++++++++++------------------- R/ArchRBrowser.R | 18 +- R/ShinyArchRExports.R | 303 +++++++++++++------------ R/VisualizeData.R | 505 ++++++++++++++++++++---------------------- Shiny/global.R | 7 +- Shiny/server.R | 7 +- Shiny/ui.R | 164 +++++++------- 7 files changed, 735 insertions(+), 748 deletions(-) diff --git a/R/AllClasses.R b/R/AllClasses.R index 66769880..1cf6efa5 100644 --- a/R/AllClasses.R +++ b/R/AllClasses.R @@ -3,27 +3,27 @@ #' @importClassesFrom GenomicRanges GRanges #' @importFrom GenomicRanges GRanges #' @import data.table -NULL + setClassUnion("characterOrNull", c("character", "NULL")) setClassUnion("GRangesOrNull", c("GRanges", "NULL")) setClass("ArchRProject", - representation( - projectMetadata = "SimpleList", - projectSummary = "SimpleList", - sampleColData = "DataFrame", - sampleMetadata = "SimpleList", - cellColData = "DataFrame", - cellMetadata = "SimpleList", - reducedDims = "SimpleList", - embeddings = "SimpleList", - peakSet = "GRangesOrNull", - peakAnnotation = "SimpleList", - geneAnnotation = "SimpleList", - genomeAnnotation = "SimpleList", - imputeWeights = "SimpleList" - ) + representation( + projectMetadata = "SimpleList", + projectSummary = "SimpleList", + sampleColData = "DataFrame", + sampleMetadata = "SimpleList", + cellColData = "DataFrame", + cellMetadata = "SimpleList", + reducedDims = "SimpleList", + embeddings = "SimpleList", + peakSet = "GRangesOrNull", + peakAnnotation = "SimpleList", + geneAnnotation = "SimpleList", + genomeAnnotation = "SimpleList", + imputeWeights = "SimpleList" + ) ) .validArrowFiles <- function(object){ @@ -39,40 +39,40 @@ setClass("ArchRProject", setValidity("ArchRProject", .validArrowFiles) setMethod("show", "ArchRProject", - - function(object) { - scat <- function(fmt, vals=character(), exdent=2, n = 5, ...){ - vals <- ifelse(nzchar(vals), vals, "''") - lbls <- paste(S4Vectors:::selectSome(vals, maxToShow = n), collapse=" ") - txt <- sprintf(fmt, length(vals), lbls) - cat(strwrap(txt, exdent=exdent, ...), sep="\n") - } - .ArchRLogo(ascii = "Package") - cat("class:", class(object), "\n") - cat("outputDirectory:", object@projectMetadata$outputDirectory, "\n") - - o <- tryCatch({ - object@cellColData$Sample - }, error = function(x){ - stop(paste0("\nError accessing sample info from ArchRProject.", - "\nThis is most likely the issue with saving the ArchRProject as an RDS", - "\nand not with save/loadArchRProject. This bug has mostly been attributed", - "\nto bioconductors DataFrame saving cross-compatability. We added a fix to this.", - "\nPlease Try:", - "\n\trecoverArchRProject(ArchRProj)", - "\n\nIf that does not work please report to Github: https://github.com/GreenleafLab/ArchR/issues" - )) - }) - - scat("samples(%d): %s\n", rownames(object@sampleColData)) - scat("sampleColData names(%d): %s\n", names(object@sampleColData)) - scat("cellColData names(%d): %s\n", names(object@cellColData)) - scat("numberOfCells(%d): %s\n", nrow(object@cellColData)) - scat("medianTSS(%d): %s\n", median(object@cellColData$TSSEnrichment)) - scat("medianFrags(%d): %s\n", median(object@cellColData$nFrags)) - - } - + + function(object) { + scat <- function(fmt, vals=character(), exdent=2, n = 5, ...){ + vals <- ifelse(nzchar(vals), vals, "''") + lbls <- paste(S4Vectors:::selectSome(vals, maxToShow = n), collapse=" ") + txt <- sprintf(fmt, length(vals), lbls) + cat(strwrap(txt, exdent=exdent, ...), sep="\n") + } + .ArchRLogo(ascii = "Package") + cat("class:", class(object), "\n") + cat("outputDirectory:", object@projectMetadata$outputDirectory, "\n") + + o <- tryCatch({ + object@cellColData$Sample + }, error = function(x){ + stop(paste0("\nError accessing sample info from ArchRProject.", + "\nThis is most likely the issue with saving the ArchRProject as an RDS", + "\nand not with save/loadArchRProject. This bug has mostly been attributed", + "\nto bioconductors DataFrame saving cross-compatability. We added a fix to this.", + "\nPlease Try:", + "\n\trecoverArchRProject(ArchRProj)", + "\n\nIf that does not work please report to Github: https://github.com/GreenleafLab/ArchR/issues" + )) + }) + + scat("samples(%d): %s\n", rownames(object@sampleColData)) + scat("sampleColData names(%d): %s\n", names(object@sampleColData)) + scat("cellColData names(%d): %s\n", names(object@cellColData)) + scat("numberOfCells(%d): %s\n", nrow(object@cellColData)) + scat("medianTSS(%d): %s\n", median(object@cellColData$TSSEnrichment)) + scat("medianFrags(%d): %s\n", median(object@cellColData$nFrags)) + + } + ) #' Create ArchRProject from ArrowFiles @@ -106,8 +106,8 @@ ArchRProject <- function( genomeAnnotation = getGenomeAnnotation(), showLogo = TRUE, threads = getArchRThreads() - ){ - +){ + .validInput(input = ArrowFiles, name = "ArrowFiles", valid = "character") .validInput(input = outputDirectory, name = "outputDirectory", valid = "character") .validInput(input = copyArrows, name = "copyArrows", valid = "boolean") @@ -116,7 +116,7 @@ ArchRProject <- function( geneAnnotation <- .validGeneAnnoByGenomeAnno(geneAnnotation = geneAnnotation, genomeAnnotation = genomeAnnotation) .validInput(input = showLogo, name = "showLogo", valid = "boolean") .validInput(input = threads, name = "threads", valid = c("integer")) - + if(grepl(" ", outputDirectory)){ stop("outputDirectory cannot have a space in the path! Path : ", outputDirectory) } @@ -126,33 +126,33 @@ ArchRProject <- function( } sampleDirectory <- file.path(normalizePath(outputDirectory), "ArrowFiles") dir.create(sampleDirectory,showWarnings=FALSE) - + if(is.null(ArrowFiles)){ stop("Need to Provide Arrow Files!") } - + threads <- min(threads, length(ArrowFiles)) - + #Validate message("Validating Arrows...") if(any(!file.exists(ArrowFiles))){ stop(paste0("Could not find ArrowFiles :\n", paste0(ArrowFiles[!file.exists(ArrowFiles)], collapse="\n"))) } ArrowFiles <- unlist(lapply(ArrowFiles, .validArrow)) - + message("Getting SampleNames...") sampleNames <- unlist(.safelapply(seq_along(ArrowFiles), function(x){ if(getArchRVerbose()) message(x, " ", appendLF = FALSE) .sampleName(ArrowFiles[x]) }, threads = threads)) message("") - + if(any(duplicated(sampleNames))){ stop("Error cannot have duplicate sampleNames, please add sampleNames that will overwrite the current sample name in Arrow file!") } - + if(length(sampleNames) != length(ArrowFiles)) stop("Samples is not equal to input ArrowFiles!") - + if(copyArrows){ message("Copying ArrowFiles to Ouptut Directory! If you want to save disk space set copyArrows = FALSE") for(i in seq_along(ArrowFiles)){ @@ -162,12 +162,12 @@ ArchRProject <- function( message("") ArrowFiles <- file.path(sampleDirectory, paste0(sampleNames, ".arrow")) } - + #Sample Information sampleColData <- DataFrame(row.names = sampleNames, ArrowFiles = ArrowFiles) sampleMetadata <- SimpleList(lapply(sampleNames, function(x) SimpleList())) names(sampleMetadata) <- sampleNames - + #Cell Information message("Getting Cell Metadata...") metadataList <- .safelapply(seq_along(ArrowFiles), function(x){ @@ -187,31 +187,31 @@ ArchRProject <- function( } mdx[, allCols, drop = FALSE] }) %>% Reduce("rbind", .) %>% DataFrame - + message("Initializing ArchRProject...") AProj <- new("ArchRProject", - projectMetadata = SimpleList(outputDirectory = normalizePath(outputDirectory)), - projectSummary = SimpleList(), - sampleColData = sampleColData, - sampleMetadata = sampleMetadata, - cellColData = cellColData, - cellMetadata = SimpleList(), - reducedDims = SimpleList(), - embeddings = SimpleList(), - peakSet = NULL, - peakAnnotation = SimpleList(), - geneAnnotation = .validGeneAnnotation(geneAnnotation), - genomeAnnotation = .validGenomeAnnotation(genomeAnnotation) + projectMetadata = SimpleList(outputDirectory = normalizePath(outputDirectory)), + projectSummary = SimpleList(), + sampleColData = sampleColData, + sampleMetadata = sampleMetadata, + cellColData = cellColData, + cellMetadata = SimpleList(), + reducedDims = SimpleList(), + embeddings = SimpleList(), + peakSet = NULL, + peakAnnotation = SimpleList(), + geneAnnotation = .validGeneAnnotation(geneAnnotation), + genomeAnnotation = .validGenomeAnnotation(genomeAnnotation) ) if(showLogo){ .ArchRLogo(ascii = "Logo") } - + AProj <- addProjectSummary(AProj, name = "DateOfCreation", summary = c("Date" = Sys.time())) - + AProj - + } #' Recover ArchRProject if broken sampleColData/cellColData @@ -230,9 +230,9 @@ ArchRProject <- function( #' #' @export recoverArchRProject <- function(ArchRProj){ - + .validInput(input = ArchRProj, name = "ArchRProj", valid = "ArchRProj") - + if(!inherits(ArchRProj@cellColData, "DataFrame")){ if(inherits(ArchRProj@cellColData, "DFrame")){ ArchRProj@cellColData <- .recoverDataFrame(ArchRProj@cellColData) @@ -240,7 +240,7 @@ recoverArchRProject <- function(ArchRProj){ stop("Unrecognized object for DataFrame in cellColData") } } - + if(!inherits(ArchRProj@sampleColData, "DataFrame")){ if(inherits(ArchRProj@sampleColData, "DFrame")){ ArchRProj@sampleColData <- .recoverDataFrame(ArchRProj@sampleColData) @@ -248,18 +248,18 @@ recoverArchRProject <- function(ArchRProj){ stop("Unrecognized object for DataFrame in sampleColData") } } - + #Try to make sure that DataFrame matches currently loaded #S4Vectors Package ArchRProj@cellColData <- DataFrame(ArchRProj@cellColData) ArchRProj@sampleColData <- DataFrame(ArchRProj@sampleColData) - + if(inherits(ArchRProj@peakSet, "GRanges")){ - + peakSet <- tryCatch({ - + ArchRProj@peakSet - + }, error = function(x){ pSet <- ArchRProj@peakSet @@ -275,21 +275,21 @@ recoverArchRProject <- function(ArchRProj){ names(mdata) <- names(pSet@metadata) pSet@metadata <- mdata pSet - + }) - + ArchRProj@peakSet <- peakSet - + } - + ArchRProj - + } .recoverDataFrame <- function(DF){ DFO <- DF - + rnNull <- (attr(DF, "rownames") == "\001NULL\001")[1] if(!rnNull){ @@ -302,7 +302,7 @@ recoverArchRProject <- function(ArchRProj){ if(length(attr(DFO, "metadata")) != 0){ mdata <- attr(DFO, "metadata") - + mdata <- lapply(seq_along(mdata), function(x){ mx <- mdata[[x]] @@ -316,34 +316,34 @@ recoverArchRProject <- function(ArchRProj){ mx <- DataFrame(attr(mx,"listData")) } } - + if(inherits(mx, "GRanges")){ mx <- .recoverGRanges(mx) } - + mx - + }) - + names(mdata) <- names(attr(DFO, "metadata")) S4Vectors::metadata(DF) <- mdata - + } - + DF - + } .recoverGRanges <- function(GR){ - - GRO <- tryCatch({ + GRO <- tryCatch({ + GR[1] - + GR - + }, error = function(x){ - + GR@elementMetadata <- .recoverDataFrame(GR@elementMetadata) mdata <- GR@metadata mdata <- lapply(seq_along(mdata), function(x){ @@ -355,11 +355,11 @@ recoverArchRProject <- function(ArchRProj){ }) names(mdata) <- names(GR@metadata) GR@metadata <- mdata - + GR - + }) - + GR <- GRanges(seqnames = GRO@seqnames, ranges = GRO@ranges, strand = GRO@strand) S4Vectors::metadata(GR) <- GRO@metadata if(nrow(GRO@elementMetadata) > 0){ @@ -367,7 +367,7 @@ recoverArchRProject <- function(ArchRProj){ } GR - + } #' Load Previous ArchRProject into R @@ -405,8 +405,8 @@ loadArchRProject <- function( force = FALSE, showLogo = TRUE, shiny = FALSE - ){ - +){ + .validInput(input = path, name = "path", valid = "character") .validInput(input = force, name = "force", valid = "boolean") .validInput(input = showLogo, name = "showLogo", valid = "boolean") @@ -416,120 +416,123 @@ loadArchRProject <- function( if(!file.exists(path2Proj)){ stop("Could not find previously saved ArchRProject in the path specified!") } - + ArchRProj <- recoverArchRProject(readRDS(path2Proj)) outputDir <- getOutputDirectory(ArchRProj) outputDirNew <- normalizePath(path) - -if (!shiny) { - #1. Arrows Paths - ArrowFilesNew <- file.path(outputDirNew, "ArrowFiles", basename(ArchRProj@sampleColData$ArrowFiles)) - if(!all(file.exists(ArrowFilesNew))){ - stop("ArrowFiles do not exist in saved ArchRProject!") - } - ArchRProj@sampleColData$ArrowFiles <- ArrowFilesNew - - #2. Annotations Paths - - if(length(ArchRProj@peakAnnotation) > 0){ + ArchRProj@projectMetadata$outputDirectory <- outputDirNew + + + if (!shiny) { + #1. Arrows Paths + ArrowFilesNew <- file.path(outputDirNew, "ArrowFiles", basename(ArchRProj@sampleColData$ArrowFiles)) + if(!all(file.exists(ArrowFilesNew))){ + stop("ArrowFiles do not exist in saved ArchRProject!") + } + ArchRProj@sampleColData$ArrowFiles <- ArrowFilesNew - keepAnno <- rep(TRUE, length(ArchRProj@peakAnnotation)) - - for(i in seq_along(ArchRProj@peakAnnotation)){ - #Postions - if(!is.null(ArchRProj@peakAnnotation[[i]]$Positions)){ - - if(tolower(ArchRProj@peakAnnotation[[i]]$Positions) != "none"){ - - PositionsNew <- gsub(outputDir, outputDirNew, ArchRProj@peakAnnotation[[i]]$Positions) - if(!all(file.exists(PositionsNew))){ + #2. Annotations Paths + + if(length(ArchRProj@peakAnnotation) > 0){ + + keepAnno <- rep(TRUE, length(ArchRProj@peakAnnotation)) + + for(i in seq_along(ArchRProj@peakAnnotation)){ + #Postions + if(!is.null(ArchRProj@peakAnnotation[[i]]$Positions)){ + + if(tolower(ArchRProj@peakAnnotation[[i]]$Positions) != "none"){ + + PositionsNew <- gsub(outputDir, outputDirNew, ArchRProj@peakAnnotation[[i]]$Positions) + if(!all(file.exists(PositionsNew))){ + if(force){ + keepAnno[i] <- FALSE + message("Positions for peakAnnotation do not exist in saved ArchRProject!") + }else{ + stop("Positions for peakAnnotation do not exist in saved ArchRProject!") + } + } + ArchRProj@peakAnnotation[[i]]$Positions <- PositionsNew + + } + + } + + #Matches + if(!is.null(ArchRProj@peakAnnotation[[i]]$Matches)){ + + MatchesNew <- gsub(outputDir, outputDirNew, ArchRProj@peakAnnotation[[i]]$Matches) + if(!all(file.exists(MatchesNew))){ if(force){ + message("Matches for peakAnnotation do not exist in saved ArchRProject!") keepAnno[i] <- FALSE - message("Positions for peakAnnotation do not exist in saved ArchRProject!") }else{ - stop("Positions for peakAnnotation do not exist in saved ArchRProject!") + stop("Matches for peakAnnotation do not exist in saved ArchRProject!") } } - ArchRProj@peakAnnotation[[i]]$Positions <- PositionsNew - + ArchRProj@peakAnnotation[[i]]$Matches <- MatchesNew + } - + } - - #Matches - if(!is.null(ArchRProj@peakAnnotation[[i]]$Matches)){ - - MatchesNew <- gsub(outputDir, outputDirNew, ArchRProj@peakAnnotation[[i]]$Matches) - if(!all(file.exists(MatchesNew))){ + + ArchRProj@peakAnnotation <- ArchRProj@peakAnnotation[keepAnno] + + } + + + #3. Background Peaks Paths + if(!is.null(getPeakSet(ArchRProj))){ + + if(!is.null(S4Vectors::metadata(getPeakSet(ArchRProj))$bgdPeaks)){ + + bgdPeaksNew <- gsub(outputDir, outputDirNew, S4Vectors::metadata(getPeakSet(ArchRProj))$bgdPeaks) + + if(!all(file.exists(bgdPeaksNew))){ + if(force){ - message("Matches for peakAnnotation do not exist in saved ArchRProject!") - keepAnno[i] <- FALSE + message("BackgroundPeaks do not exist in saved ArchRProject!") + S4Vectors::metadata(ArchRProj@peakSet)$bgdPeaks <- NULL }else{ - stop("Matches for peakAnnotation do not exist in saved ArchRProject!") + stop("BackgroundPeaks do not exist in saved ArchRProject!") } - } - ArchRProj@peakAnnotation[[i]]$Matches <- MatchesNew - - } - - } - - ArchRProj@peakAnnotation <- ArchRProj@peakAnnotation[keepAnno] - - } - - - #3. Background Peaks Paths - if(!is.null(getPeakSet(ArchRProj))){ - - if(!is.null(S4Vectors::metadata(getPeakSet(ArchRProj))$bgdPeaks)){ - - bgdPeaksNew <- gsub(outputDir, outputDirNew, S4Vectors::metadata(getPeakSet(ArchRProj))$bgdPeaks) - - if(!all(file.exists(bgdPeaksNew))){ - - if(force){ - message("BackgroundPeaks do not exist in saved ArchRProject!") - S4Vectors::metadata(ArchRProj@peakSet)$bgdPeaks <- NULL + }else{ - stop("BackgroundPeaks do not exist in saved ArchRProject!") - } - - }else{ - - S4Vectors::metadata(ArchRProj@peakSet)$bgdPeaks <- bgdPeaksNew - - } - + + S4Vectors::metadata(ArchRProj@peakSet)$bgdPeaks <- bgdPeaksNew + + } + + } + } - - } - - #4. Group Coverages - - #update paths for group coverage files in project metadata - if(length(ArchRProj@projectMetadata$GroupCoverages) > 0) { - groupC <- length(ArchRProj@projectMetadata$GroupCoverages) - for(z in seq_len(groupC)){ - zdata <- ArchRProj@projectMetadata$GroupCoverages[[z]]$coverageMetadata - zfiles <- gsub(outputDir, outputDirNew, zdata$File) - ArchRProj@projectMetadata$GroupCoverages[[z]]$coverageMetadata$File <- zfiles - stopifnot(all(file.exists(zfiles))) + + #4. Group Coverages + + #update paths for group coverage files in project metadata + if(length(ArchRProj@projectMetadata$GroupCoverages) > 0) { + groupC <- length(ArchRProj@projectMetadata$GroupCoverages) + for(z in seq_len(groupC)){ + zdata <- ArchRProj@projectMetadata$GroupCoverages[[z]]$coverageMetadata + zfiles <- gsub(outputDir, outputDirNew, zdata$File) + ArchRProj@projectMetadata$GroupCoverages[[z]]$coverageMetadata$File <- zfiles + stopifnot(all(file.exists(zfiles))) + } } + } #5. Set Output Directory ArchRProj@projectMetadata$outputDirectory <- outputDirNew - + message("Successfully loaded ArchRProject!") if(showLogo){ - .ArchRLogo(ascii = "Logo") + .ArchRLogo(ascii = "Logo") } - ArchRProj - } + #' Save ArchRProject for Later Usage #' #' This function will organize arrows and project output into a directory and save the ArchRProject for later usage. @@ -557,17 +560,17 @@ saveArchRProject <- function( dropCells = FALSE, logFile = createLogFile("saveArchRProject"), threads = getArchRThreads() - ){ - +){ + .validInput(input = ArchRProj, name = "ArchRProj", valid = "ArchRProj") .validInput(input = outputDirectory, name = "outputDirectory", valid = "character") .validInput(input = overwrite, name = "overwrite", valid = "boolean") .validInput(input = load, name = "load", valid = "boolean") - + if(grepl(" ", outputDirectory)){ stop("outputDirectory cannot have a space in the path! Path : ", outputDirectory) } - + dir.create(outputDirectory, showWarnings=FALSE) outputDirectory <- normalizePath(outputDirectory) outDirOld <- normalizePath(getOutputDirectory(ArchRProj)) @@ -575,20 +578,20 @@ saveArchRProject <- function( newProj <- ArchRProj ArrowFiles <- getArrowFiles(ArchRProj) ArrowFiles <- ArrowFiles[names(ArrowFiles) %in% unique(newProj$Sample)] - + oldFiles <- list.files(outDirOld) oldFiles <- oldFiles[oldFiles %ni% c("ArrowFiles", "ImputeWeights", "Save-ArchR-Project.rds")] - + dir.create(file.path(outputDirectory, "ArrowFiles"), showWarnings=FALSE) ArrowFilesNew <- file.path(outputDirectory, "ArrowFiles", basename(ArrowFiles)) names(ArrowFilesNew) <- names(ArrowFiles) - + if(outputDirectory != outDirOld){ message("Copying ArchRProject to new outputDirectory : ", normalizePath(outputDirectory)) } - + if(!identical(paste0(ArrowFiles), paste0(ArrowFilesNew))){ - + #Copy Arrow Files message("Copying Arrow Files...") if(dropCells){ @@ -605,9 +608,9 @@ saveArchRProject <- function( cf <- file.copy(ArrowFiles[i], ArrowFilesNew[i], overwrite = overwrite) } } - + }else{ - + if(dropCells){ for(i in seq_along(ArrowFiles)){ message(sprintf("Moving Arrow Files (%s of %s)", i, length(ArrowFiles))) @@ -626,17 +629,17 @@ saveArchRProject <- function( rmf <- file.remove(paste0(ArrowFiles, "-old")) } } - + } - + if(outputDirectory != outDirOld){ - + #Empty Impute Weights If Changing Directory Because This Could Be A Different Set of Cells if(!is.null(getImputeWeights(newProj))){ message("Dropping ImputeWeights...") newProj@imputeWeights <- SimpleList() } - + #Copy Recursively message("Copying Other Files...") for(i in seq_along(oldFiles)){ @@ -644,11 +647,11 @@ saveArchRProject <- function( oldPath <- file.path(outDirOld, oldFiles[i]) file.copy(oldPath, outputDirectory, recursive=TRUE, overwrite=overwrite) } - + #Set New Info newProj@sampleColData <- newProj@sampleColData[names(ArrowFilesNew), , drop = FALSE] newProj@sampleColData$ArrowFiles <- ArrowFilesNew[rownames(newProj@sampleColData)] - + #Check for Group Coverages Copied groupC <- length(newProj@projectMetadata$GroupCoverages) if(length(groupC) > 0){ @@ -659,9 +662,9 @@ saveArchRProject <- function( stopifnot(all(file.exists(zfiles))) } } - + } - + message("Saving ArchRProject...") .safeSaveRDS(newProj, file.path(outputDirectory, "Save-ArchR-Project.rds")) @@ -669,7 +672,7 @@ saveArchRProject <- function( message("Loading ArchRProject...") loadArchRProject(path = outputDirectory) } - + } #' Subset an ArchRProject for downstream analysis @@ -701,24 +704,24 @@ subsetArchRProject <- function( logFile = NULL, threads = getArchRThreads(), force = FALSE - ){ - +){ + .validInput(input = ArchRProj, name = "ArchRProj", valid = "ArchRProj") .validInput(input = cells, name = "cells", valid = "character") .validInput(input = outputDirectory, name = "outputDirectory", valid = "character") - + outDirOld <- getOutputDirectory(ArchRProj) - + if(dir.exists(outputDirectory)){ if(!force){ stop("outputDirectory exists! Please set force = TRUE to overwrite existing directory!") } } - + if(outputDirectory == outDirOld){ stop("outputDirectory must be different than ArchRProj outputDirectory to properly subset!") } - + saveArchRProject( ArchRProj = ArchRProj[cells, ], outputDirectory = outputDirectory, @@ -727,7 +730,7 @@ subsetArchRProject <- function( logFile = logFile, threads = threads ) - + } #Accessor methods adapted from Seurat @@ -801,7 +804,7 @@ subsetArchRProject <- function( if(missing(i)){ return(x) } - + if(!missing(j)){ message("Subsetting columns not supported this way to remove columns set them to NULL.\nEx. ArchRProj$Clusters <- NULL\nContinuing just with cell subsetting.") } @@ -816,25 +819,25 @@ subsetArchRProject <- function( if (is.numeric(i)) { i <- rownames(cD)[i] } - + if(length(i) == 1){ stop("Length of subsetting cells must be greater than 1!") } - + i <- unique(i) - + #First Subset CellColData x@cellColData <- cD[i, , drop=FALSE] cellsKeep <- rownames(x@cellColData) - + #Second Remove Impute Weights if(length(i) != nrow(cD)){ if(length(x@imputeWeights) != 0){ - message("Dropping ImputeWeights Since You Are Subsetting Cells! ImputeWeights is a cell-x-cell Matrix!") + message("Dropping ImputeWeights Since You Are Subsetting Cells! ImputeWeights is a cell-x-cell Matrix!") } x@imputeWeights <- SimpleList() } - + #Third Subset ReducedDims rD <- x@reducedDims rD2 <- lapply(seq_along(rD), function(x){ @@ -844,7 +847,7 @@ subsetArchRProject <- function( names(rD2) <- names(rD) rD <- x@reducedDims rm(rD, rD2) - + #Fourth Subset Embeddings eD <- x@embeddings eD2 <- lapply(seq_along(eD), function(x){ @@ -854,9 +857,9 @@ subsetArchRProject <- function( names(eD2) <- names(eD) x@embeddings <- eD2 rm(eD, eD2) - + return(x) - + } setMethod( @@ -874,9 +877,3 @@ setMethod( rownames(x@cellColData) } ) - - - - - - diff --git a/R/ArchRBrowser.R b/R/ArchRBrowser.R index 871f1557..6de5fbac 100644 --- a/R/ArchRBrowser.R +++ b/R/ArchRBrowser.R @@ -38,6 +38,7 @@ #' @export ArchRBrowser <- function( ArchRProj = NULL, + ShinyArchR = FALSE, features = getPeakSet(ArchRProj), loops = getCoAccessibility(ArchRProj), minCells = 25, @@ -382,6 +383,7 @@ ArchRBrowser <- function( p <- .bulkTracks( ArchRProj = ArchRProj, + ShinyArchR = ShinyArchR, region = region, tileSize = tileSize, useGroups = useGroups, @@ -524,6 +526,7 @@ ArchRBrowser <- function( p <- .bulkTracks( ArchRProj = ArchRProj, + ShinyArchR = ShinyArchR, region = tmpArchRRegion, tileSize = tileSize, useGroups = useGroups, @@ -837,7 +840,8 @@ plotBrowserTrack <- function( if("bulktrack" %in% tolower(plotSummary)){ .logDiffTime(sprintf("Adding Bulk Tracks (%s of %s)",x,length(region)), t1=tstart, verbose=verbose, logFile=logFile) plotList$bulktrack <- .bulkTracks( - ArchRProj = ArchRProj, + ArchRProj = ArchRProj, + ShinyArchR = ShinyArchR, region = region[x], tileSize = tileSize, groupBy = groupBy, @@ -1014,6 +1018,7 @@ plotBrowserTrack <- function( ####################################################### .bulkTracks <- function( ArchRProj = NULL, + ShinyArchR = FALSE, region = NULL, tileSize = 100, maxCells = 500, @@ -1039,6 +1044,7 @@ plotBrowserTrack <- function( .requirePackage("ggplot2", source = "cran") + if(is.null(tstart)){ tstart <- Sys.time() } @@ -1384,7 +1390,8 @@ plotBrowserTrack <- function( ) cvgObjs = list.files(path = file.path(getOutputDirectory(ArchRProj),"ShinyCoverage",groupBy), pattern = "*_cvg.rds", full.names = TRUE) - if(length(cvgObjs == 0)) { + + if(length(cvgObjs) == 0) { stop(paste0("No coverage files detected. You may not have created them via exportShinyArchR(). Please ensure that *_cvg.rds files exist within ", file.path(getOutputDirectory(ArchRProj),"ShinyCoverage",groupBy))) } allCvgGR = c() @@ -2275,10 +2282,3 @@ plotBrowserTrack <- function( p } - - - - - - - diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index f9c4099f..1443c188 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -22,8 +22,9 @@ exportShinyArchR <- function( ArchRProj = NULL, mainDir = "Shiny", subOutDir = "inputData", + savedArchRProjFile = "Save-ArchR-Project.rds", groupBy = "Clusters", - cellColEmbeddings = NULL, + cellColEmbeddings = "Clusters", embedding = "UMAP", tileSize = 100, force = FALSE, @@ -31,17 +32,20 @@ exportShinyArchR <- function( logFile = createLogFile("exportShinyArchR") ){ + options(warn=-1) + .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) - .validInput(input = outputDir, name = "outputDir", valid = c("character")) - .validInput(input = subOutput, name = "subOutputDir", valid = c("character")) + .validInput(input = mainDir, name = "mainDir", valid = c("character")) + .validInput(input = subOutDir, name = "subOutDir", valid = c("character")) + .validInput(input = savedArchRProjFile, name = "savedArchRProjFile", valid = c("character")) .validInput(input = groupBy, name = "groupBy", valid = c("character")) - .validInput(input = cellColEmbeddings, name = "groupBy", valid = c("character", "null")) + .validInput(input = cellColEmbeddings, name = "cellColEmbeddings", valid = c("character", "null")) .validInput(input = embedding, name = "embedding", valid = c("character")) .validInput(input = tileSize, name = "tileSize", valid = c("integer")) .validInput(input = force, name = "force", valid = c("boolean")) .validInput(input = threads, name = "threads", valid = c("integer")) .validInput(input = logFile, name = "logFile", valid = c("character")) - + .startLogging(logFile=logFile) .logThis(mget(names(formals()),sys.frame(sys.nframe())), "exportShinyArchR Input-Parameters", logFile = logFile) @@ -54,7 +58,8 @@ exportShinyArchR <- function( if(is.null(cellColEmbeddings)){ stop("The cellColEmbeddings parameter must be defined! Please see function input definitions.") - } else if(!all(cellColEmbeddings %in% colnames(ArchRProj@cellColData))){ + } + if(!all(cellColEmbeddings %in% colnames(ArchRProj@cellColData))){ stop("Not all entries in cellColEmbeddings exist in the cellColData of your ArchRProj. Please check provided inputs.") } @@ -74,13 +79,14 @@ exportShinyArchR <- function( # get directories paths projDir <- getOutputDirectory(ArchRProj) - mainDir <- file.path(projDir, mainDir) - subOutDir <- file.path(projDir, mainDir, subOutDir) + mainOutputDir <- file.path(projDir, mainDir) + subOutputDir <- file.path(projDir, mainDir, subOutDir) + # Make directory for Shiny App - if(!dir.exists(mainDir)) { + if(!dir.exists(mainOutputDir)) { - dir.create(mainDir, showWarnings = TRUE) + dir.create(mainOutputDir, showWarnings = TRUE) ## Check the links for the files # filesUrl <- data.frame( @@ -98,44 +104,48 @@ exportShinyArchR <- function( # stringsAsFactors = FALSE # ) - # .downloadFiles(filesUrl = filesUrl, pathDownload = mainDir, threads = threads) + # .downloadFiles(filesUrl = filesUrl, pathDownload = mainOutputDir, threads = threads) }else{ message("Using existing Shiny files...") } - # Create a copy of the ArchRProj + dir.create(subOutputDir, showWarnings = FALSE) + + # Create a copy of the ArchRProj + # ArchRProjShiny will be only a .rds ArchRProjShiny <- ArchRProj # Add metadata to ArchRProjShiny ArchRProjShiny@projectMetadata[["groupBy"]] <- groupBy ArchRProjShiny@projectMetadata[["tileSize"]] <- tileSize units <- tryCatch({ - .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, "/Info/Units"))[1] + .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, "/Info/Units"))[1] },error=function(e){ - "values" + "values" }) ArchRProjShiny@projectMetadata[["units"]] <- units - ArchRProjShiny <- saveArchRProject(ArchRProj = ArchRProjShiny, outputDirectory = - file.path(mainDir, "Save-ArchRProjShiny"), dropCells = TRUE, overwrite = TRUE, load = TRUE) + + file.copy(file.path(getOutputDirectory(ArchRProjShiny), savedArchRProjFile), file.path(mainOutputDir), recursive=FALSE) # Create fragment files - should be saved within a dir called ShinyFragments within the ArchRProjShiny output directory - fragDir <- file.path(projDir, "ShinyFragments", groupBy) + fragDir <- file.path(projDir, mainDir, "ShinyFragments", groupBy) fragFiles <- list.files(path = file.path(fragDir, pattern = "\\_frags.rds$")) + #this is still a slightly dangerous comparison, better would be to compare for explicitly the file names that are expected if(length(fragFiles) == length(unique(ArchRProj@cellColData[,groupBy]))){ if(force){ - .getGroupFragsFromProj(ArchRProj = ArchRProj, groupBy = groupBy, outDir = fragDir) + .getGroupFragsFromProj(ArchRProj = ArchRProjShiny, groupBy = groupBy, outDir = fragDir) } else{ message("Fragment files already exist. Skipping fragment file generation...") } }else{ - dir.create(file.path(projDir, "ShinyFragments")) - dir.create(fragDir, showWarnings = TRUE) + dir.create(file.path(mainOutputDir, "ShinyFragments"), showWarnings = FALSE) + dir.create(fragDir, showWarnings = FALSE) .getGroupFragsFromProj(ArchRProj = ArchRProj, groupBy = groupBy, outDir = fragDir) } # Create coverage objects - should be saved within a dir called ShinyCoverage within the ArchRProjShiny output directory - covDir <- file.path(projDir, "ShinyCoverage", groupBy) + covDir <- file.path(projDir, mainDir, "ShinyCoverage", groupBy) covFiles <- list.files(path = covDir, pattern = "\\_cvg.rds$") #this is still a slightly dangerous comparison, better would be to compare for explicitly the file names that are expected if(length(covFiles) == length(unique(ArchRProjShiny@cellColData[,groupBy]))){ @@ -145,41 +155,43 @@ exportShinyArchR <- function( message("Coverage files already exist. Skipping fragment file generation...") } }else{ - dir.create(file.path(projDir, "ShinyCoverage")) + dir.create(file.path(mainOutputDir, "ShinyCoverage")) dir.create(covDir, showWarnings = TRUE) - .getClusterCoverage(ArchRProj = ArchRProj, tileSize = tileSize, groupBy = groupBy, outDir = covDir) + .getClusterCoverage(ArchRProj = ArchRProj, tileSize = tileSize, groupBy = groupBy, fragDir = fragDir, outDir = covDir) } - + # Create directory to save input data to Shinyapps.io (everything that will be preprocessed) - dir.create(file.path(projDir, outputDir, subOutputDir), showWarnings = TRUE) - + # dir.create(file.path(projDir, mainDir, subOutDir), showWarnings = TRUE) + supportedMatrices <- c("GeneScoreMatrix", "GeneIntegrationMatrix", "MotifMatrix") #only these matrices are currently supported for ShinyArchR allMatrices <- getAvailableMatrices(ArchRProjShiny) + supportedMatrices <- intersect(supportedMatrices, allMatrices) matrices <- list() imputeMatrices <- list() imputeWeights <- getImputeWeights(ArchRProj = ArchRProjShiny) df <- getEmbedding(ArchRProjShiny, embedding = embedding, returnDF = TRUE) - if(!file.exists(file.path(outputDir, subOutputDir, "matrices.rds")) && !file.exists(file.path(outputDir, subOutputDir, "imputeMatrices.rds"))){ - for(matName in allMatrices){ + if(!file.exists(file.path(mainDir, subOutDir, "matrices.rds")) && !file.exists(file.path(mainDir, subOutDir, "imputeMatrices.rds"))){ + for(matName in supportedMatrices){ featuresNames <- getFeatures(ArchRProj = ArchRProj, useMatrix = matName) - saveRDS(featuresNames, file.path(outputDir, subOutputDir, matName, "_names.rds")) - + dir.create(file.path(mainOutputDir, subOutDir, matName), showWarnings = FALSE) + saveRDS(featuresNames, file.path(mainOutputDir, subOutDir, matName, paste0(matName, "_names.rds"))) + if(!is.null(featuresNames)){ - mat = Matrix(.getMatrixValues( + mat <- .getMatrixValues( ArchRProj = ArchRProjShiny, name = featuresNames, matrixName = matName, log2Norm = FALSE, - threads = threads), sparse = TRUE) + threads = threads) matrices[[matName]] = mat matList = mat[,rownames(df), drop=FALSE] .logThis(matList, paste0(matName,"-Before-Impute"), logFile = logFile) - + if(getArchRVerbose()) message("Imputing Matrix") imputeMat <- imputeMatrix(mat = as.matrix(matList), imputeWeights = imputeWeights, logFile = logFile) - + if(!inherits(imputeMat, "matrix")){ imputeMat <- mat(imputeMat, ncol = nrow(df)) colnames(imputeMat) <- rownames(df) @@ -190,40 +202,39 @@ exportShinyArchR <- function( message(matName, " is NULL.") } } - matrices$allColorBy= .availableArrays(head(getArrowFiles(ArchRProj), 2)) - saveRDS(matrices, file.path(outputDir, subOutputDir, "matrices.rds")) - saveRDS(imputeMatrices, file.path(outputDir, subOutputDir, "imputeMatrices.rds")) + matrices$allColorBy <- supportedMatrices + saveRDS(matrices, file.path(mainOutputDir, subOutDir, "matrices.rds")) + saveRDS(imputeMatrices, file.path(mainOutputDir, subOutDir, "imputeMatrices.rds")) }else{ message("matrices and imputeMatrices already exist. reading from local files...") - matrices <- readRDS(file.path(projDir, outputDir, subOutputDir, "matrices.rds")) - imputeMatrices <- readRDS(file.path(projDir, outputDir, subOutputDir, "imputeMatrices.rds")) + matrices <- readRDS(file.path(projDir, mainDir, subOutDir, "matrices.rds")) + imputeMatrices <- readRDS(file.path(projDir, mainDir, subOutDir, "imputeMatrices.rds")) } - - # mainEmbeds will create an HDF5 file containing the nativeRaster vectors for data stored in cellColData - if (!file.exists(file.path(projDir, outputDir, subOutputDir, "mainEmbeds.h5"))) { + + + if (!file.exists(file.path(projDir, mainDir, subOutDir, "mainEmbeds.h5"))) { + # mainEmbeds will create an HDF5 file containing the nativeRaster vectors for data stored in cellColData .mainEmbeds(ArchRProj = ArchRProjShiny, - outDirEmbed = file.path(projDir, outputDir, subOutputDir), - colorBy = "cellColData", - cellColEmbeddings = cellColEmbeddings, - embeddingDF = df, - matrices = matrices, - imputeMatrices = imputeMatrices, - logFile = createLogFile("mainEmbeds") - ) + outDirEmbed = file.path(projDir, mainDir, subOutDir), + colorBy = "cellColData", + cellColEmbeddings = cellColEmbeddings, + # embeddingDF = df, + matrices = matrices, + imputeMatrices = imputeMatrices, + logFile = createLogFile("mainEmbeds") + ) } else{ message("H5 for main embeddings already exists...") } - - # matrixEmbeds will create an HDF5 file containing he nativeRaster vectors for data stored in matrices - supportedMatrices <- c("GeneScoreMatrix", "GeneIntegrationMatrix", "MotifMatrix") #only these matrices are currently supported for ShinyArchR - if(!file.exists(file.path(outputDir, subOutputDir, "plotBlank72.h5"))){ - + + if(!file.exists(file.path(mainDir, subOutDir, "plotBlank72.h5"))){ + # matrixEmbeds will create an HDF5 file containing the nativeRaster vectors for data stored in matrices .matrixEmbeds( ArchRProj = ArchRProj, - outDirEmbed = file.path(projDir, outputDir, subOutputDir), - colorBy = intersect(supportedMatrices, allMatrices), + outDirEmbed = file.path(projDir, mainDir, subOutDir), + colorBy = supportedMatrices, embedding = embedding, matrices = matrices, imputeMatrices = imputeMatrices, @@ -231,19 +242,30 @@ exportShinyArchR <- function( verbose = TRUE, logFile = createLogFile("matrixEmbeds") ) - + }else{ message("H5 file already exists...") } + + ## delete unnecessary files ----------------------------------------------------------------- unlink(file.path(projDir, "ShinyFragments"), recursive = TRUE) - + ## ready to launch --------------------------------------------------------------- - message("App created! To launch, - ArchRProj <- loadArchRProject('", projDir,"') and - run shiny::runApp('", outputDir, "') from parent directory") - # runApp("myappdir") - + message("App is created!", '\n', + "Please run the following code chunk to launch the app:",'\n\n', + + "ArchRProj <- loadArchRProject('", projDir,"')\n", + "mainDir = ", "'", mainDir, "'" ,'\n', + "subOutDir = ", "'",subOutDir,"'",'\n', + "savedArchRProjFile = ", "'",savedArchRProjFile,"'",'\n', + "groupBy = ", "'",groupBy,"'",'\n', + "cellColEmbeddings = ", "'",cellColEmbeddings,"'",'\n', + "embedding = ", "'",embedding,"'",'\n', + "availableMatrices = ", "c(",paste(shQuote(allMatrices, type = "cmd"), collapse=", "),")",'\n', + "shiny::runApp('", mainDir, "')" + + ) } #' Create an HDF5 file, mainEmbeds.h5, containing the nativeRaster vectors for the 5 main embeddings. @@ -255,8 +277,7 @@ exportShinyArchR <- function( #' @param cellColEmbeddings A character vector of columns in `cellColData` to plot as part of the Shiny app. No default is provided so this must be set. #' For ex. `c("Sample","Clusters","TSSEnrichment","nFrags")`. #' @param embedding The embedding to use. Default is "UMAP". -#' @param embeddingDF The pre-processed/stored embedding data.frame to use so plotEmbedding() runs faster. -#' @param matrices List of stored matrices to use for plotEmbedding() so that it runs faster. +#' @param matrices List of stored matrices to use for plotEmbedding so that it runs faster. #' @param imputeMatrices List of stored imputed matrices to use for plotEmbedding so that it runs faster. #' @param threads The number of threads to use for parallel execution. #' @param logFile The path to a file to be used for logging ArchR output. @@ -267,7 +288,6 @@ exportShinyArchR <- function( colorBy = "cellColData", cellColEmbeddings = NULL, embedding = "UMAP", - embeddingDF = NULL, matrices = NULL, imputeMatrices = NULL, threads = getArchRThreads(), @@ -280,60 +300,59 @@ exportShinyArchR <- function( .validInput(input = embedding, name = "embedding", valid = c("character")) .validInput(input = threads, name = "threads", valid = c("numeric")) .validInput(input = logFile, name = "logFile", valid = c("character")) - + .startLogging(logFile=logFile) .logThis(mget(names(formals()),sys.frame(sys.nframe())), "mainEmbeds Input-Parameters", logFile = logFile) - + if(!file.exists(file.path(outDirEmbed, "embeds.rds"))){ - - # check all names exist in ArchRProj - if(cellColEmbeddings %ni% colnames(ArchRProj@cellColData)){ - stop("All columns should be present in cellColData") - } - - embeds <- .safelapply(1:length(cellColEmbeddings), function(x){ - name <- cellColEmbeddings[[x]] - - tryCatch({ - named_embed <- plotEmbedding( - ArchRProj = ArchRProj, - baseSize = 12, - colorBy = colorBy, - name = name, - allNames = names, - embedding = embedding, - embeddingDF = embeddingDF, - rastr = FALSE, - size = 0.5, - # imputeWeights = NULL, # unsure if inputWeights needed for cellColData - Shiny = TRUE - )+ggtitle(paste0("Colored by ", name))+theme(text = element_text(size=12), - legend.title = element_text(size = 12),legend.text = element_text(size = 6)) - }, error = function(x){ - print(x) - }) - return(named_embed) + + # check all names exist in ArchRProj + if(cellColEmbeddings %ni% colnames(ArchRProj@cellColData)){ + stop("All columns should be present in cellColData") + } + + embeds <- .safelapply(length(cellColEmbeddings), function(x){ + name <- cellColEmbeddings[x] + + tryCatch({ + named_embed <- plotEmbedding( + ArchRProj = ArchRProj, + baseSize = 12, + colorBy = colorBy, + name = name, + embedding = embedding, + embeddingDF = df, + rastr = FALSE, + size = 0.5, + imputeWeights = NULL, + Shiny = TRUE + )+ggtitle(paste0("Colored by ", name))+theme(text = element_text(size=12), + legend.title = element_text(size = 12),legend.text = element_text(size = 6)) + }, error = function(x){ + print(x) + }) + return(named_embed) }) - - names(embeds) <- names + + names(embeds) <- cellColEmbeddings[1:length(cellColEmbeddings)] saveRDS(embeds, file.path(outDirEmbed, "embeds.rds")) - + } else { message("Main embeddings already exist. Skipping generation and reading in embeds.rds file...") embeds <- readRDS(file.path(outDirEmbed, "embeds.rds")) } - + h5closeAll() points <- H5Fcreate(name = file.path(outDirEmbed, "mainEmbeds.h5")) - + embed_legend <- list() embed_color <- list() - - + + for(i in 1:length(embeds)){ - + embed_plot <- embeds[i] - + embed_plot[[1]]$labels$title <- NULL embed_plot_blank <- embed_plot[[1]] + theme(axis.title.x = element_blank()) + theme(axis.title.y = element_blank()) + @@ -345,27 +364,27 @@ exportShinyArchR <- function( panel.border = element_blank(), title=element_blank() ) - + #save plot without axes etc as a jpg ggsave(filename = file.path(outDirEmbed, paste0(names(embeds)[i],"_blank72.jpg")), - plot = embed_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) - + plot = embed_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 300) + #read back in that jpg because we need vector in native format blank_jpg72 <- readJPEG(source = file.path(outDirEmbed, paste0(names(embeds)[[i]],"_blank72.jpg")), native = TRUE) - + # save the native raster vectors h5createDataset(file = points, dataset = names(embeds)[i], dims = c(46656,1), storage.mode = "integer") - h5writeDataset(obj = as.vector(blank_jpg72), h5loc = points, name= names[i]) - + h5writeDataset(obj = as.vector(blank_jpg72), h5loc = points, name= names(embeds)[i]) + # save legend and color scale embed_legend[[i]] <- levels(embed_plot[[1]]$data$color) names(embed_legend)[[i]] <- names(embed_plot) - + embed_color[[i]] <- unique(ggplot_build(embed_plot[[1]])$data[[1]][,"colour"]) names(embed_color)[[i]] <- names(embed_plot) - + } - + saveRDS(embed_color, file.path(outDirEmbed, "embed_color.rds")) saveRDS(embed_legend, file.path(outDirEmbed, "embed_legend_names.rds")) } @@ -374,24 +393,22 @@ exportShinyArchR <- function( #' This function will be called by exportShinyArchR() #' #' @param ArchRProj An `ArchRProject` object loaded in the environment. Can do this using: loadArchRProject("path to ArchRProject/") +#' @param outDirEmbed Where the HDF5 and the jpgs will be saved. #' @param colorBy A string indicating whether points in the plot should be colored by a column in `cellColData` ("cellColData") or by #' a data matrix in the corresponding ArrowFiles (i.e. "GeneScoreMatrix", "MotifMatrix", "PeakMatrix"). #' @param embedding The embedding to use. Default is "UMAP". -#' @param matrices List of stored/pre-processed matrices to use for plotEmbedding() so that it runs faster. -#' @param imputeMatrices List of stored imputed matrices to use for plotEmbedding() so that it runs faster. -#' @param embeddingDF The pre-processed/stored embedding data.frame to use so plotEmbedding() runs faster. +#' @param matrices List of stored matrices to use for plotEmbedding so that it runs faster. +#' @param imputeMatrices List of stored imputed matrices to use for plotEmbedding so that it runs faster. #' @param threads The number of threads to use for parallel execution. #' @param verbose A boolean value that determines whether standard output should be printed. #' @param logFile The path to a file to be used for logging ArchR output. #' - .matrixEmbeds <- function( ArchRProj = NULL, outDirEmbed = NULL, colorBy = c("GeneScoreMatrix", "GeneIntegrationMatrix", "MotifMatrix"), supportedMatrices = c("GeneScoreMatrix", "GeneIntegrationMatrix", "MotifMatrix"), embedding = "UMAP", - embeddingDF = NULL, matrices = NULL, imputeMatrices = NULL, threads = getArchRThreads(), @@ -424,7 +441,7 @@ exportShinyArchR <- function( allMatrices <- getAvailableMatrices(ArchRProj) for(mat in colorBy){ - if(mat %in% supportedMatrices){ + if(mat %ni% intersect(supportedMatrices, allMatrices)){ message(mat,"not in ArchRProj") ## NOTE: should we stop or just give a warning } @@ -433,13 +450,13 @@ exportShinyArchR <- function( dir.create(paste0(outDirEmbed, "/",mat, "/embeds"), showWarnings = FALSE) featureNames <- readRDS(file.path(outDirEmbed, mat, paste0(mat,"_names.rds"))) - + if(!is.null(featureNames)){ - embeds_points <- .safelapply(1:10, function(x){ # length(featureNames) + embeds_points <- .safelapply(1:length(featureNames), function(x){ print(paste0("Creating plots for ", mat,": ",x,": ",round((x/length(featureNames))*100,3), "%")) - + if(!is.na(featureNames[x])){ gene_plot <- plotEmbedding( @@ -451,7 +468,7 @@ exportShinyArchR <- function( imputeWeights = getImputeWeights(ArchRProj = ArchRProj), plotAs = "points", matrices = mat, - embeddingDF = embeddingDF, + embeddingDF = df, imputeMatrices = imputeMatrices, rastr = TRUE ) @@ -478,7 +495,7 @@ exportShinyArchR <- function( #read back in that jpg because we need vector in native format blank_jpg72 <- readJPEG(source = file.path(outDirEmbed, mat, "embeds", paste0(featureNames[x],"_blank72.jpg")), - native = TRUE) + native = TRUE) g <- ggplot_build(gene_plot) @@ -491,7 +508,7 @@ exportShinyArchR <- function( }, threads = threads) - names(embeds_points) <- featureNames[1:10] + names(embeds_points) <- featureNames[1:length(featureNames)] embeds_points = embeds_points[!unlist(lapply(embeds_points, is.null))] embeds_min_max <- data.frame(matrix(NA, 2, length(embeds_points))) @@ -515,29 +532,25 @@ exportShinyArchR <- function( embeds_min_max_list[[mat]] = embeds_min_max embeds_pal_list[[mat]] = embeds_points[[length(embeds_points)]][[1]]$pal + # embeds_min_max_list[[mat]] = embeds_min_max + # embeds_pal_list[[mat]] = embeds_points[[length(embeds_points)]][[1]]$pal - - - embeds_min_max_list[[mat]] = embeds_min_max - embeds_pal_list[[mat]] = embeds_points[[length(embeds_points)]][[1]]$pal + }else{ + + message(mat,".rds file does not exist") + } }else{ - - message(mat,".rds file does not exist") + message(mat,".rds file does not exist. This file should have been created previously be exportShinyArchR. Skipping...") } - - }else{ - message(mat,".rds file does not exist. This file should have been created previously be exportShinyArchR. Skipping...") + + } + scale <- embeds_min_max_list + pal <- embeds_pal_list + + saveRDS(scale, file.path(outDirEmbed, "scale.rds")) + saveRDS(pal, file.path(outDirEmbed, "pal.rds")) } - -scale <- embeds_min_max_list -pal <- embeds_pal_list - -saveRDS(scale, file.path(outDirEmbed, "scale.rds")) -saveRDS(pal, file.path(outDirEmbed, "pal.rds")) - -} - diff --git a/R/VisualizeData.R b/R/VisualizeData.R index d84d63c6..454bf87b 100644 --- a/R/VisualizeData.R +++ b/R/VisualizeData.R @@ -249,282 +249,255 @@ plotEmbedding <- function( logFile = createLogFile("plotEmbedding"), ... ){ - - .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) - .validInput(input = embedding, name = "reducedDims", valid = c("character")) - .validInput(input = colorBy, name = "colorBy", valid = c("character")) - .validInput(input = name, name = "name", valid = c("character")) - .validInput(input = log2Norm, name = "log2Norm", valid = c("boolean", "null")) - .validInput(input = imputeWeights, name = "imputeWeights", valid = c("list", "null")) - .validInput(input = pal, name = "pal", valid = c("palette", "null")) - .validInput(input = size, name = "size", valid = c("numeric")) - .validInput(input = sampleCells, name = "sampleCells", valid = c("numeric", "null")) - .validInput(input = highlightCells, name = "highlightCells", valid = c("character", "null")) - .validInput(input = rastr, name = "rastr", valid = c("boolean")) - .validInput(input = quantCut, name = "quantCut", valid = c("numeric", "null")) - .validInput(input = discreteSet, name = "discreteSet", valid = c("character", "null")) - .validInput(input = continuousSet, name = "continuousSet", valid = c("character", "null")) - .validInput(input = randomize, name = "randomize", valid = c("boolean")) - .validInput(input = keepAxis, name = "keepAxis", valid = c("boolean")) - .validInput(input = baseSize, name = "baseSize", valid = c("numeric")) - .validInput(input = plotAs, name = "plotAs", valid = c("character", "null")) - .validInput(input = threads, name = "threads", valid = c("integer")) - .validInput(input = logFile, name = "logFile", valid = c("character")) - - .requirePackage("ggplot2", source = "cran") - - .startLogging(logFile = logFile) - .logThis(mget(names(formals()),sys.frame(sys.nframe())), "Input-Parameters", logFile=logFile) - - ############################## - # Get Embedding - ############################## - .logMessage("Getting UMAP Embedding", logFile = logFile) - df <- getEmbedding(ArchRProj, embedding = embedding, returnDF = TRUE) - - if(!all(rownames(df) %in% ArchRProj$cellNames)){ - stop("Not all cells in embedding are present in ArchRProject!") - } - - .logThis(df, name = "Embedding data.frame", logFile = logFile) - if(!is.null(sampleCells)){ - if(sampleCells < nrow(df)){ - if(!is.null(imputeWeights)){ - stop("Cannot sampleCells with imputeWeights not equalt to NULL at this time!") - } - df <- df[sort(sample(seq_len(nrow(df)), sampleCells)), , drop = FALSE] + .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) + .validInput(input = embedding, name = "reducedDims", valid = c("character")) + .validInput(input = colorBy, name = "colorBy", valid = c("character")) + .validInput(input = name, name = "name", valid = c("character")) + .validInput(input = log2Norm, name = "log2Norm", valid = c("boolean", + "null")) + .validInput(input = imputeWeights, name = "imputeWeights", + valid = c("list", "null")) + .validInput(input = pal, name = "pal", valid = c("palette", + "null")) + .validInput(input = size, name = "size", valid = c("numeric")) + .validInput(input = sampleCells, name = "sampleCells", valid = c("numeric", + "null")) + .validInput(input = highlightCells, name = "highlightCells", + valid = c("character", "null")) + .validInput(input = rastr, name = "rastr", valid = c("boolean")) + .validInput(input = quantCut, name = "quantCut", valid = c("numeric", + "null")) + .validInput(input = discreteSet, name = "discreteSet", valid = c("character", + "null")) + .validInput(input = continuousSet, name = "continuousSet", + valid = c("character", "null")) + .validInput(input = randomize, name = "randomize", valid = c("boolean")) + .validInput(input = keepAxis, name = "keepAxis", valid = c("boolean")) + .validInput(input = baseSize, name = "baseSize", valid = c("numeric")) + .validInput(input = plotAs, name = "plotAs", valid = c("character", + "null")) + .validInput(input = threads, name = "threads", valid = c("integer")) + .validInput(input = logFile, name = "logFile", valid = c("character")) + .requirePackage("ggplot2", source = "cran") + .startLogging(logFile = logFile) + .logThis(mget(names(formals()), sys.frame(sys.nframe())), + "Input-Parameters", logFile = logFile) + .logMessage("Getting UMAP Embedding", logFile = logFile) + df <- getEmbedding(ArchRProj, embedding = embedding, returnDF = TRUE) + if (!all(rownames(df) %in% ArchRProj$cellNames)) { + stop("Not all cells in embedding are present in ArchRProject!") } - } - - #Parameters - plotParams <- list(...) - plotParams$x <- df[,1] - plotParams$y <- df[,2] - plotParams$title <- paste0(embedding, " of ", stringr::str_split(colnames(df)[1],pattern="#",simplify=TRUE)[,1]) - plotParams$baseSize <- baseSize - - #Additional Params! - plotParams$xlabel <- gsub("_", " ",stringr::str_split(colnames(df)[1],pattern="#",simplify=TRUE)[,2]) - plotParams$ylabel <- gsub("_", " ",stringr::str_split(colnames(df)[2],pattern="#",simplify=TRUE)[,2]) - plotParams$rastr <- rastr - plotParams$size <- size - plotParams$randomize <- randomize - - #Check if Cells To Be Highlighed - if(!is.null(highlightCells)){ - highlightPoints <- match(highlightCells, rownames(df), nomatch = 0) - if(any(highlightPoints==0)){ - stop("highlightCells contain cells not in Embedding cellNames! Please make sure that these match!") + .logThis(df, name = "Embedding data.frame", logFile = logFile) + if (!is.null(sampleCells)) { + if (sampleCells < nrow(df)) { + if (!is.null(imputeWeights)) { + stop("Cannot sampleCells with imputeWeights not equalt to NULL at this time!") + } + df <- df[sort(sample(seq_len(nrow(df)), sampleCells)), + , drop = FALSE] + } } - } - - #Make Sure ColorBy is valid! - if(length(colorBy) > 1){ - stop("colorBy must be of length 1!") - } - allColorBy <- c("colData", "cellColData", .availableArrays(head(getArrowFiles(ArchRProj), 2))) - if(tolower(colorBy) %ni% tolower(allColorBy)){ - stop("colorBy must be one of the following :\n", paste0(allColorBy, sep=", ")) - } - colorBy <- allColorBy[match(tolower(colorBy), tolower(allColorBy))] - - .logMessage(paste0("ColorBy = ", colorBy), logFile = logFile) - - if(tolower(colorBy) == "coldata" | tolower(colorBy) == "cellcoldata"){ - - colorList <- lapply(seq_along(name), function(x){ - colorParams <- list() - colorParams$color <- as.vector(getCellColData(ArchRProj, select = name[x], drop = FALSE)[rownames(df), 1]) - colorParams$discrete <- .isDiscrete(colorParams$color) - colorParams$continuousSet <- "solarExtra" - colorParams$discreteSet <- "stallion" - colorParams$title <- paste(plotParams$title, " colored by\ncolData : ", name[x]) - if(!is.null(continuousSet)){ - colorParams$continuousSet <- continuousSet - } - if(!is.null(discreteSet)){ - colorParams$discreteSet <- discreteSet - } - if(x == 1){ - .logThis(colorParams, name = "ColorParams 1", logFile = logFile) - } - - if(!is.null(imputeWeights)){ - if(getArchRVerbose()) message("Imputing Matrix") - colorMat <- matrix(colorParams$color, nrow=1) - colnames(colorMat) <- rownames(df) - colorMat <- imputeMatrix(mat = colorMat, imputeWeights = imputeWeights, logFile = logFile) - colorParams$color <- as.vector(colorMat) - } - colorParams - }) - - - }else{ - - suppressMessages(message(logFile)) - - units <- tryCatch({ - .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, "/Info/Units"))[1] - },error=function(e){ - "values" - }) - - if(is.null(log2Norm) & tolower(colorBy) == "genescorematrix"){ - log2Norm <- TRUE + plotParams <- list(...) + plotParams$x <- df[, 1] + plotParams$y <- df[, 2] + plotParams$title <- paste0(embedding, " of ", stringr::str_split(colnames(df)[1], + pattern = "#", simplify = TRUE)[, 1]) + plotParams$baseSize <- baseSize + plotParams$xlabel <- gsub("_", " ", stringr::str_split(colnames(df)[1], + pattern = "#", simplify = TRUE)[, 2]) + plotParams$ylabel <- gsub("_", " ", stringr::str_split(colnames(df)[2], + pattern = "#", simplify = TRUE)[, 2]) + plotParams$rastr <- rastr + plotParams$size <- size + plotParams$randomize <- randomize + if (!is.null(highlightCells)) { + highlightPoints <- match(highlightCells, rownames(df), + nomatch = 0) + if (any(highlightPoints == 0)) { + stop("highlightCells contain cells not in Embedding cellNames! Please make sure that these match!") + } } - - if(is.null(log2Norm)){ - log2Norm <- FALSE + if (length(colorBy) > 1) { + stop("colorBy must be of length 1!") } - - colorMat <- .getMatrixValues( - ArchRProj = ArchRProj, - name = name, - matrixName = colorBy, - log2Norm = FALSE, - threads = threads, - logFile = logFile - ) - - if(!all(rownames(df) %in% colnames(colorMat))){ - .logMessage("Not all cells in embedding are present in feature matrix. This may be due to using a custom embedding.", logFile = logFile) - stop("Not all cells in embedding are present in feature matrix. This may be due to using a custom embedding.") + allColorBy <- c("colData", "cellColData", .availableArrays(head(getArrowFiles(ArchRProj), + 2))) + if (tolower(colorBy) %ni% tolower(allColorBy)) { + stop("colorBy must be one of the following :\n", paste0(allColorBy, + sep = ", ")) } - - colorMat <- colorMat[,rownames(df), drop=FALSE] - - .logThis(colorMat, "colorMat-Before-Impute", logFile = logFile) - - if(!is.null(imputeWeights)){ - if(getArchRVerbose()) message("Imputing Matrix") - colorMat <- imputeMatrix(mat = as.matrix(colorMat), imputeWeights = imputeWeights, logFile = logFile) - if(!inherits(colorMat, "matrix")){ - colorMat <- matrix(colorMat, ncol = nrow(df)) - colnames(colorMat) <- rownames(df) - } + colorBy <- allColorBy[match(tolower(colorBy), tolower(allColorBy))] + .logMessage(paste0("ColorBy = ", colorBy), logFile = logFile) + if (tolower(colorBy) == "coldata" | tolower(colorBy) == "cellcoldata") { + colorList <- lapply(seq_along(name), function(x) { + colorParams <- list() + colorParams$color <- as.vector(getCellColData(ArchRProj, + select = name[x], drop = FALSE)[rownames(df), + 1]) + colorParams$discrete <- .isDiscrete(colorParams$color) + colorParams$continuousSet <- "solarExtra" + colorParams$discreteSet <- "stallion" + colorParams$title <- paste(plotParams$title, " colored by\ncolData : ", + name[x]) + if (!is.null(continuousSet)) { + colorParams$continuousSet <- continuousSet + } + if (!is.null(discreteSet)) { + colorParams$discreteSet <- discreteSet + } + if (x == 1) { + .logThis(colorParams, name = "ColorParams 1", + logFile = logFile) + } + if (!is.null(imputeWeights)) { + if (getArchRVerbose()) + message("Imputing Matrix") + colorMat <- matrix(colorParams$color, nrow = 1) + colnames(colorMat) <- rownames(df) + colorMat <- imputeMatrix(mat = colorMat, imputeWeights = imputeWeights, + logFile = logFile) + colorParams$color <- as.vector(colorMat) + } + colorParams + }) } - - .logThis(colorMat, "colorMat-After-Impute", logFile = logFile) - - colorList <- lapply(seq_len(nrow(colorMat)), function(x){ - colorParams <- list() - colorParams$color <- colorMat[x, ] - colorParams$discrete <- FALSE - colorParams$title <- sprintf("%s colored by\n%s : %s", plotParams$title, colorBy, name[x]) - if(tolower(colorBy) == "genescorematrix"){ - colorParams$continuousSet <- "horizonExtra" - }else{ - colorParams$continuousSet <- "solarExtra" - } - if(!is.null(continuousSet)){ - colorParams$continuousSet <- continuousSet - } - if(!is.null(discreteSet)){ - colorParams$discreteSet <- discreteSet - } - if(x == 1){ - .logThis(colorParams, name = "ColorParams 1", logFile = logFile) - } - colorParams - }) - - } - - if(getArchRVerbose()) message("Plotting Embedding") - - ggList <- lapply(seq_along(colorList), function(x){ - - if(getArchRVerbose()) message(x, " ", appendLF = FALSE) - - plotParamsx <- .mergeParams(colorList[[x]], plotParams) - - if(plotParamsx$discrete){ - plotParamsx$color <- paste0(plotParamsx$color) - } - - if(!plotParamsx$discrete){ - - if(!is.null(quantCut)){ - plotParamsx$color <- .quantileCut(plotParamsx$color, min(quantCut), max(quantCut)) - } - - plotParamsx$pal <- paletteContinuous(set = plotParamsx$continuousSet) - - if(!is.null(pal)){ - - plotParamsx$pal <- pal - - } - - if(is.null(plotAs)){ - plotAs <- "hexplot" - } - - if(!is.null(log2Norm)){ - if(log2Norm){ - plotParamsx$color <- log2(plotParamsx$color + 1) - plotParamsx$colorTitle <- paste0("Log2(",units," + 1)") - }else{ - plotParamsx$colorTitle <- units + else { + suppressMessages(message(logFile)) + units <- tryCatch({ + .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, + "/Info/Units"))[1] + }, error = function(e) { + "values" + }) + if (is.null(log2Norm) & tolower(colorBy) == "genescorematrix") { + log2Norm <- TRUE } - } - - if(tolower(plotAs) == "hex" | tolower(plotAs) == "hexplot"){ - - plotParamsx$discrete <- NULL - plotParamsx$continuousSet <- NULL - plotParamsx$rastr <- NULL - plotParamsx$size <- NULL - plotParamsx$randomize <- NULL - - .logThis(plotParamsx, name = paste0("PlotParams-", x), logFile = logFile) - gg <- do.call(ggHex, plotParamsx) - - }else{ - - if(!is.null(highlightCells)){ - plotParamsx$highlightPoints <- highlightPoints + if (is.null(log2Norm)) { + log2Norm <- FALSE } - - .logThis(plotParamsx, name = paste0("PlotParams-", x), logFile = logFile) - gg <- do.call(ggPoint, plotParamsx) - - } - - }else{ - - if(!is.null(pal)){ - plotParamsx$pal <- pal - } - - if(!is.null(highlightCells)){ - plotParamsx$highlightPoints <- highlightPoints - } - - .logThis(plotParamsx, name = paste0("PlotParams-", x), logFile = logFile) - gg <- do.call(ggPoint, plotParamsx) - + colorMat <- .getMatrixValues(ArchRProj = ArchRProj, name = name, + matrixName = colorBy, log2Norm = FALSE, threads = threads, + logFile = logFile) + if (!all(rownames(df) %in% colnames(colorMat))) { + .logMessage("Not all cells in embedding are present in feature matrix. This may be due to using a custom embedding.", + logFile = logFile) + stop("Not all cells in embedding are present in feature matrix. This may be due to using a custom embedding.") + } + colorMat <- colorMat[, rownames(df), drop = FALSE] + .logThis(colorMat, "colorMat-Before-Impute", logFile = logFile) + if (!is.null(imputeWeights)) { + if (getArchRVerbose()) + message("Imputing Matrix") + colorMat <- imputeMatrix(mat = as.matrix(colorMat), + imputeWeights = imputeWeights, logFile = logFile) + if (!inherits(colorMat, "matrix")) { + colorMat <- matrix(colorMat, ncol = nrow(df)) + colnames(colorMat) <- rownames(df) + } + } + .logThis(colorMat, "colorMat-After-Impute", logFile = logFile) + colorList <- lapply(seq_len(nrow(colorMat)), function(x) { + colorParams <- list() + colorParams$color <- colorMat[x, ] + colorParams$discrete <- FALSE + colorParams$title <- sprintf("%s colored by\n%s : %s", + plotParams$title, colorBy, name[x]) + if (tolower(colorBy) == "genescorematrix") { + colorParams$continuousSet <- "horizonExtra" + } + else { + colorParams$continuousSet <- "solarExtra" + } + if (!is.null(continuousSet)) { + colorParams$continuousSet <- continuousSet + } + if (!is.null(discreteSet)) { + colorParams$discreteSet <- discreteSet + } + if (x == 1) { + .logThis(colorParams, name = "ColorParams 1", + logFile = logFile) + } + colorParams + }) } - - if(!keepAxis){ - gg <- gg + theme(axis.text.x=element_blank(), axis.ticks.x=element_blank(), axis.text.y=element_blank(), axis.ticks.y=element_blank()) + if (getArchRVerbose()) + message("Plotting Embedding") + ggList <- lapply(seq_along(colorList), function(x) { + if (getArchRVerbose()) + message(x, " ", appendLF = FALSE) + plotParamsx <- .mergeParams(colorList[[x]], plotParams) + if (plotParamsx$discrete) { + plotParamsx$color <- paste0(plotParamsx$color) + } + if (!plotParamsx$discrete) { + if (!is.null(quantCut)) { + plotParamsx$color <- .quantileCut(plotParamsx$color, + min(quantCut), max(quantCut)) + } + plotParamsx$pal <- paletteContinuous(set = plotParamsx$continuousSet) + if (!is.null(pal)) { + plotParamsx$pal <- pal + } + if (is.null(plotAs)) { + plotAs <- "hexplot" + } + if (!is.null(log2Norm)) { + if (log2Norm) { + plotParamsx$color <- log2(plotParamsx$color + + 1) + plotParamsx$colorTitle <- paste0("Log2(", units, + " + 1)") + } + else { + plotParamsx$colorTitle <- units + } + } + if (tolower(plotAs) == "hex" | tolower(plotAs) == + "hexplot") { + plotParamsx$discrete <- NULL + plotParamsx$continuousSet <- NULL + plotParamsx$rastr <- NULL + plotParamsx$size <- NULL + plotParamsx$randomize <- NULL + .logThis(plotParamsx, name = paste0("PlotParams-", + x), logFile = logFile) + gg <- do.call(ggHex, plotParamsx) + } + else { + if (!is.null(highlightCells)) { + plotParamsx$highlightPoints <- highlightPoints + } + .logThis(plotParamsx, name = paste0("PlotParams-", + x), logFile = logFile) + gg <- do.call(ggPoint, plotParamsx) + } + } + else { + if (!is.null(pal)) { + plotParamsx$pal <- pal + } + if (!is.null(highlightCells)) { + plotParamsx$highlightPoints <- highlightPoints + } + .logThis(plotParamsx, name = paste0("PlotParams-", + x), logFile = logFile) + gg <- do.call(ggPoint, plotParamsx) + } + if (!keepAxis) { + gg <- gg + theme(axis.text.x = element_blank(), axis.ticks.x = element_blank(), + axis.text.y = element_blank(), axis.ticks.y = element_blank()) + } + gg + }) + names(ggList) <- name + if (getArchRVerbose()) + message("") + if (length(ggList) == 1) { + ggList <- ggList[[1]] } - - gg - - }) - names(ggList) <- name - if(getArchRVerbose()) message("") - - if(length(ggList) == 1){ - ggList <- ggList[[1]] - } - - .endLogging(logFile = logFile) - - ggList - + .endLogging(logFile = logFile) + ggList } diff --git a/Shiny/global.R b/Shiny/global.R index f41c4050..0567d834 100644 --- a/Shiny/global.R +++ b/Shiny/global.R @@ -32,6 +32,8 @@ for (i in seq_along(fn)) { } source("AllClasses.R") +source("ArchRBrowser.R") +source("GgplotUtils.R") # Calling ArchRProj @@ -43,7 +45,8 @@ groupBy = 'Clusters' cellColEmbeddings = 'Clusters' embedding = 'UMAP' availableMatrices = c("GeneScoreMatrix", "MotifMatrix", "PeakMatrix", "TileMatrix") - +ShinyArchR = TRUE +sampleLabels = 'Clusters' @@ -72,7 +75,7 @@ color_embeddings = readRDS(paste0(subOutDir, "/embed_color.rds")) getEMBEDplotWithCol<-function(gene,EMBEDList,scaffoldName,matrixType) { gene_plot=EMBEDList[[gene]] - + p_template1=readRDS(paste0(subOutDir, "/" ,scaffoldName,".rds")) p_template1$scales$scales <- gene_plot$scale diff --git a/Shiny/server.R b/Shiny/server.R index c1e1a3cf..018ee7a3 100644 --- a/Shiny/server.R +++ b/Shiny/server.R @@ -318,10 +318,10 @@ shinyServer <- function(input,output, session){ else {tiff(file = file, width = input$plot_width, height = input$plot_height,units="in",res=1000)} - + p_browser_atacClusters<- plotBrowserTrack( ArchRProj = ArchRProj, - # ShinyArchR = ShinyArchR, + ShinyArchR = TRUE, plotSummary = c("bulkTrack", input$selectPlotSummary), baseSize = 11, facetbaseSize = 11, @@ -361,7 +361,7 @@ shinyServer <- function(input,output, session){ p_browser_atacClusters<- plotBrowserTrack( ArchRProj = ArchRProj, - # ShinyArchR = ShinyArchR, + ShinyArchR = TRUE, plotSummary = c("bulkTrack", input$selectPlotSummary), baseSize = 11, facetbaseSize = 11, @@ -383,3 +383,4 @@ shinyServer <- function(input,output, session){ } }) } +z \ No newline at end of file diff --git a/Shiny/ui.R b/Shiny/ui.R index 973f2eb6..f8826be0 100644 --- a/Shiny/ui.R +++ b/Shiny/ui.R @@ -4,92 +4,92 @@ library(shinybusy) # EMBEDING plotting ---------------------------------------------------------------------- EMBED_panel <- tabPanel(id="EMBED_panel", - - titlePanel(h5("scClusters")), - sidebarPanel( - titlePanel(h3('EMBEDDING 1', align = 'center')), - width = 3, - h4(''), - hr(style = "border-color: grey"), - - selectizeInput( - 'matrix_EMBED1_forComparison', - label = 'EMBEDDING type', - choices = c(EMBEDs_dropdown, matrices_dropdown), - selected = NULL - ), - - conditionalPanel( - condition = '!(input.matrix_EMBED1_forComparison %in% EMBEDs_dropdown)', - selectizeInput( - 'EMBED1_forComparison', - label = 'EMBEDDING 1', - choices = "", - selected = NULL - )), - - splitLayout(cellWidths = c("30%","30%","40%"), - numericInput("EMBED1_plot_width", "Width", min = 0, max = 250, value = 8), - numericInput("EMBED1_plot_height", "Height", min = 0, max = 250, value = 12), - selectizeInput( - 'plot_choice_download_EMBED1', - label = "Format", - choices = c(".pdf",".png",".tiff"), - selected = ".pdf"), - tags$head(tags$style(HTML(" + + titlePanel(h5("scClusters")), + sidebarPanel( + titlePanel(h3('EMBEDDING 1', align = 'center')), + width = 3, + h4(''), + hr(style = "border-color: grey"), + + selectizeInput( + 'matrix_EMBED1_forComparison', + label = 'EMBEDDING type', + choices = c(EMBEDs_dropdown, matrices_dropdown), + selected = NULL + ), + + conditionalPanel( + condition = '!(input.matrix_EMBED1_forComparison %in% EMBEDs_dropdown)', + selectizeInput( + 'EMBED1_forComparison', + label = 'EMBEDDING 1', + choices = "", + selected = NULL + )), + + splitLayout(cellWidths = c("30%","30%","40%"), + numericInput("EMBED1_plot_width", "Width", min = 0, max = 250, value = 8), + numericInput("EMBED1_plot_height", "Height", min = 0, max = 250, value = 12), + selectizeInput( + 'plot_choice_download_EMBED1', + label = "Format", + choices = c(".pdf",".png",".tiff"), + selected = ".pdf"), + tags$head(tags$style(HTML(" .shiny-split-layout > div { overflow: visible;}"))) - ), - - downloadButton(outputId = "download_EMBED1", label = "Download EMBEDDING 1"), - - titlePanel(h3('EMBEDDING 2', align = 'center')), - hr(style = "border-color: grey"), - selectizeInput( - 'matrix_EMBED2_forComparison', - label = 'EMBEDDING type', - choices = c(EMBEDs_dropdown, matrices_dropdown), - selected =NULL - ), - - conditionalPanel(condition = '!(input.matrix_EMBED2_forComparison %in% EMBEDs_dropdown)', - selectizeInput( - 'EMBED2_forComparison', - label = 'EMBEDDING 2', - choices ="", - selected = NULL - )), - - - splitLayout(cellWidths = c("30%","30%","40%"), - numericInput("EMBED2_plot_width", "Width", min = 0, max = 250, value = 8), - numericInput("EMBED2_plot_height", "Height", min = 0, max = 250, value = 12), - selectizeInput( - 'plot_choice_download_EMBED2', - label = "Format", - choices = c(".pdf",".png",".tiff"), - selected = ".pdf"), - tags$head(tags$style(HTML(" + ), + + downloadButton(outputId = "download_EMBED1", label = "Download EMBEDDING 1"), + + titlePanel(h3('EMBEDDING 2', align = 'center')), + hr(style = "border-color: grey"), + selectizeInput( + 'matrix_EMBED2_forComparison', + label = 'EMBEDDING type', + choices = c(EMBEDs_dropdown, matrices_dropdown), + selected =NULL + ), + + conditionalPanel(condition = '!(input.matrix_EMBED2_forComparison %in% EMBEDs_dropdown)', + selectizeInput( + 'EMBED2_forComparison', + label = 'EMBEDDING 2', + choices ="", + selected = NULL + )), + + + splitLayout(cellWidths = c("30%","30%","40%"), + numericInput("EMBED2_plot_width", "Width", min = 0, max = 250, value = 8), + numericInput("EMBED2_plot_height", "Height", min = 0, max = 250, value = 12), + selectizeInput( + 'plot_choice_download_EMBED2', + label = "Format", + choices = c(".pdf",".png",".tiff"), + selected = ".pdf"), + tags$head(tags$style(HTML(" .shiny-split-layout > div { overflow: visible;}"))) - ), - downloadButton(outputId = "download_EMBED2", label = "Download EMBEDDING 2"), - - ), - - mainPanel( - verbatimTextOutput("feat"), - verbatimTextOutput("text"), - fluidRow(h5("Dimension Reduction scClusters EMBEDs" - )), - fluidRow(helpText("Users can view and compare side-by-side EMBEDs' representing identified scATAC-seq clusters, + ), + downloadButton(outputId = "download_EMBED2", label = "Download EMBEDDING 2"), + + ), + + mainPanel( + verbatimTextOutput("feat"), + verbatimTextOutput("text"), + fluidRow(h5("Dimension Reduction scClusters EMBEDs" + )), + fluidRow(helpText("Users can view and compare side-by-side EMBEDs' 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("EMBED_plot_1")), ##%>% withSpinner(color="#0dc5c1") - column(6,plotOutput("EMBED_plot_2")) - ) - ) + ), + fluidRow( + column(6,plotOutput("EMBED_plot_1")), ##%>% withSpinner(color="#0dc5c1") + column(6,plotOutput("EMBED_plot_2")) + ) + ) ) # Plot Browser:scATAC Clusters -------------------------------------------------------- @@ -125,7 +125,7 @@ scATACbrowser_panel <- tabPanel( choices = sort(gene_names), selected = sort(sort(gene_names))[1] ), - + 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), From 013672eb97f58acb52cf6e3e793bc17f42974a11 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Tue, 28 Feb 2023 21:38:36 -0800 Subject: [PATCH 101/162] Update AllClasses.R --- R/AllClasses.R | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/R/AllClasses.R b/R/AllClasses.R index 314c4182..47b7ec1c 100644 --- a/R/AllClasses.R +++ b/R/AllClasses.R @@ -800,9 +800,4 @@ setMethod( rownames(x@cellColData) } ) - - - - - - + From b2627c9c2c9ef9ad2035d764aadded4cf09eaa3a Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Tue, 28 Feb 2023 21:46:49 -0800 Subject: [PATCH 102/162] add NULL --- R/AllClasses.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/AllClasses.R b/R/AllClasses.R index 1cf6efa5..7cbd6abd 100644 --- a/R/AllClasses.R +++ b/R/AllClasses.R @@ -3,7 +3,7 @@ #' @importClassesFrom GenomicRanges GRanges #' @importFrom GenomicRanges GRanges #' @import data.table - +NULL setClassUnion("characterOrNull", c("character", "NULL")) setClassUnion("GRangesOrNull", c("GRanges", "NULL")) From 6ae5a83f95dca804e916e79712e46228928640cc Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Wed, 1 Mar 2023 16:52:06 +0300 Subject: [PATCH 103/162] Update GroupExport.R change groups to cellGroups --- R/GroupExport.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/GroupExport.R b/R/GroupExport.R index 623c7684..60125b9d 100644 --- a/R/GroupExport.R +++ b/R/GroupExport.R @@ -644,7 +644,7 @@ getGroupFragments <- function( # find barcodes of cells in that groupBy. cellGroups <- getCellColData(ArchRProj, select = groupBy, drop = TRUE) cells <- ArchRProj$cellNames - cellGroups <- split(cells, groups) + cellGroups <- split(cells, cellGroups) # outputs unique cell groups/clusters. groupIDs <- names(cellGroups) From 5d41b80d5467f92a13e4aee2ab644a0fb3aab81f Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Wed, 1 Mar 2023 21:20:00 +0300 Subject: [PATCH 104/162] update function --- R/ShinyArchRExports.R | 181 +++++++++++++++++++++++------------------- 1 file changed, 101 insertions(+), 80 deletions(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 1443c188..832ac55c 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -22,6 +22,7 @@ exportShinyArchR <- function( ArchRProj = NULL, mainDir = "Shiny", subOutDir = "inputData", + # ArchRProjFile = "Save-ArchRProjShiny", savedArchRProjFile = "Save-ArchR-Project.rds", groupBy = "Clusters", cellColEmbeddings = "Clusters", @@ -45,7 +46,7 @@ exportShinyArchR <- function( .validInput(input = force, name = "force", valid = c("boolean")) .validInput(input = threads, name = "threads", valid = c("integer")) .validInput(input = logFile, name = "logFile", valid = c("character")) - + .startLogging(logFile=logFile) .logThis(mget(names(formals()),sys.frame(sys.nframe())), "exportShinyArchR Input-Parameters", logFile = logFile) @@ -81,6 +82,7 @@ exportShinyArchR <- function( projDir <- getOutputDirectory(ArchRProj) mainOutputDir <- file.path(projDir, mainDir) subOutputDir <- file.path(projDir, mainDir, subOutDir) + supportedMatrices <- c("GeneScoreMatrix", "GeneIntegrationMatrix", "MotifMatrix") #only these matrices are currently supported for ShinyArchR # Make directory for Shiny App @@ -111,22 +113,28 @@ exportShinyArchR <- function( } dir.create(subOutputDir, showWarnings = FALSE) + # dir.create(ArchRProjOutputDir, showWarnings = FALSE) + - # Create a copy of the ArchRProj - # ArchRProjShiny will be only a .rds + # Create a copy of the ArchRProj ArchRProjShiny <- ArchRProj # Add metadata to ArchRProjShiny ArchRProjShiny@projectMetadata[["groupBy"]] <- groupBy ArchRProjShiny@projectMetadata[["tileSize"]] <- tileSize units <- tryCatch({ - .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, "/Info/Units"))[1] + .h5read(getArrowFiles(ArchRProjShiny)[1], paste0(colorBy, "/Info/Units"))[1] },error=function(e){ "values" }) ArchRProjShiny@projectMetadata[["units"]] <- units - - file.copy(file.path(getOutputDirectory(ArchRProjShiny), savedArchRProjFile), file.path(mainOutputDir), recursive=FALSE) - + # ArchRProjShiny <- saveArchRProject(ArchRProj = ArchRProjShiny, outputDirectory = + # file.path(ArchRProjOutputDir), dropCells = TRUE, overwrite = F, load = TRUE) + + # file.copy(file.path(getOutputDirectory(ArchRProjShiny), ArchRProjFile), mainOutputDir, recursive=TRUE) + # file.copy(file.path(getOutputDirectory(ArchRProjShiny), savedArchRProjFile), file.path(mainOutputDir), recursive=FALSE) + + # saveArchRProject(ArchRProj = ArchRProjShiny, outputDirectory = file.path(mainOutputDir), load = FALSE) + # Create fragment files - should be saved within a dir called ShinyFragments within the ArchRProjShiny output directory fragDir <- file.path(projDir, mainDir, "ShinyFragments", groupBy) fragFiles <- list.files(path = file.path(fragDir, pattern = "\\_frags.rds$")) @@ -147,7 +155,8 @@ exportShinyArchR <- function( # Create coverage objects - should be saved within a dir called ShinyCoverage within the ArchRProjShiny output directory covDir <- file.path(projDir, mainDir, "ShinyCoverage", groupBy) covFiles <- list.files(path = covDir, pattern = "\\_cvg.rds$") - #this is still a slightly dangerous comparison, better would be to compare for explicitly the file names that are expected + + # this is still a slightly dangerous comparison, better would be to compare for explicitly the file names that are expected if(length(covFiles) == length(unique(ArchRProjShiny@cellColData[,groupBy]))){ if(force){ .getClusterCoverage(ArchRProj = ArchRProjShiny, tileSize = tileSize, groupBy = groupBy, outDir = covDir) @@ -162,49 +171,52 @@ exportShinyArchR <- function( # Create directory to save input data to Shinyapps.io (everything that will be preprocessed) # dir.create(file.path(projDir, mainDir, subOutDir), showWarnings = TRUE) - supportedMatrices <- c("GeneScoreMatrix", "GeneIntegrationMatrix", "MotifMatrix") #only these matrices are currently supported for ShinyArchR + allMatrices <- getAvailableMatrices(ArchRProjShiny) - supportedMatrices <- intersect(supportedMatrices, allMatrices) matrices <- list() imputeMatrices <- list() imputeWeights <- getImputeWeights(ArchRProj = ArchRProjShiny) df <- getEmbedding(ArchRProjShiny, embedding = embedding, returnDF = TRUE) if(!file.exists(file.path(mainDir, subOutDir, "matrices.rds")) && !file.exists(file.path(mainDir, subOutDir, "imputeMatrices.rds"))){ - for(matName in supportedMatrices){ - featuresNames <- getFeatures(ArchRProj = ArchRProj, useMatrix = matName) - dir.create(file.path(mainOutputDir, subOutDir, matName), showWarnings = FALSE) - saveRDS(featuresNames, file.path(mainOutputDir, subOutDir, matName, paste0(matName, "_names.rds"))) - - if(!is.null(featuresNames)){ - - mat <- .getMatrixValues( - ArchRProj = ArchRProjShiny, - name = featuresNames, - matrixName = matName, - log2Norm = FALSE, - threads = threads) - - matrices[[matName]] = mat - matList = mat[,rownames(df), drop=FALSE] - .logThis(matList, paste0(matName,"-Before-Impute"), logFile = logFile) - - if(getArchRVerbose()) message("Imputing Matrix") - imputeMat <- imputeMatrix(mat = as.matrix(matList), imputeWeights = imputeWeights, logFile = logFile) - - if(!inherits(imputeMat, "matrix")){ - imputeMat <- mat(imputeMat, ncol = nrow(df)) - colnames(imputeMat) <- rownames(df) - } - imputeMatrices[[matName]] <- imputeMat + for(matName in allMatrices){ + if(matName %in% supportedMatrices){ + featuresNames <- getFeatures(ArchRProj = ArchRProj, useMatrix = matName) + dir.create(file.path(mainDir, subOutDir, matName), showWarnings = FALSE) + saveRDS(featuresNames, file.path(mainDir, subOutDir, matName, paste0(matName, "_names.rds"))) + + if(!is.null(featuresNames)){ + + mat = Matrix(.getMatrixValues( + ArchRProj = ArchRProjShiny, + name = featuresNames, + matrixName = matName, + log2Norm = FALSE, + threads = threads), sparse = TRUE) + + matrices[[matName]] = mat + matList = mat[,rownames(df), drop=FALSE] + .logThis(matList, paste0(matName,"-Before-Impute"), logFile = logFile) + + if(getArchRVerbose()) message("Imputing Matrix") + imputeMat <- imputeMatrix(mat = as.matrix(matList), imputeWeights = imputeWeights, logFile = logFile) + + if(!inherits(imputeMat, "matrix")){ + imputeMat <- mat(imputeMat, ncol = nrow(df)) + colnames(imputeMat) <- rownames(df) + } + imputeMatrices[[matName]] <- imputeMat + }else{ - message(matName, " is NULL.") + message(matName, " is NULL.") + } } } - matrices$allColorBy <- supportedMatrices - saveRDS(matrices, file.path(mainOutputDir, subOutDir, "matrices.rds")) - saveRDS(imputeMatrices, file.path(mainOutputDir, subOutDir, "imputeMatrices.rds")) + + matrices$allColorBy= .availableArrays(head(getArrowFiles(ArchRProj), 2)) + saveRDS(matrices, file.path(mainDir, subOutDir, "matrices.rds")) + saveRDS(imputeMatrices, file.path(mainDir, subOutDir, "imputeMatrices.rds")) }else{ message("matrices and imputeMatrices already exist. reading from local files...") @@ -213,9 +225,8 @@ exportShinyArchR <- function( imputeMatrices <- readRDS(file.path(projDir, mainDir, subOutDir, "imputeMatrices.rds")) } - + # mainEmbeds will create an HDF5 file containing the nativeRaster vectors for data stored in cellColData if (!file.exists(file.path(projDir, mainDir, subOutDir, "mainEmbeds.h5"))) { - # mainEmbeds will create an HDF5 file containing the nativeRaster vectors for data stored in cellColData .mainEmbeds(ArchRProj = ArchRProjShiny, outDirEmbed = file.path(projDir, mainDir, subOutDir), colorBy = "cellColData", @@ -229,12 +240,13 @@ exportShinyArchR <- function( message("H5 for main embeddings already exists...") } + # matrixEmbeds will create an HDF5 file containing he nativeRaster vectors for data stored in matrices if(!file.exists(file.path(mainDir, subOutDir, "plotBlank72.h5"))){ - # matrixEmbeds will create an HDF5 file containing the nativeRaster vectors for data stored in matrices + .matrixEmbeds( ArchRProj = ArchRProj, outDirEmbed = file.path(projDir, mainDir, subOutDir), - colorBy = supportedMatrices, + colorBy = intersect(supportedMatrices, allMatrices), embedding = embedding, matrices = matrices, imputeMatrices = imputeMatrices, @@ -247,7 +259,7 @@ exportShinyArchR <- function( message("H5 file already exists...") } - + ## delete unnecessary files ----------------------------------------------------------------- unlink(file.path(projDir, "ShinyFragments"), recursive = TRUE) @@ -255,17 +267,18 @@ exportShinyArchR <- function( message("App is created!", '\n', "Please run the following code chunk to launch the app:",'\n\n', - "ArchRProj <- loadArchRProject('", projDir,"')\n", - "mainDir = ", "'", mainDir, "'" ,'\n', - "subOutDir = ", "'",subOutDir,"'",'\n', - "savedArchRProjFile = ", "'",savedArchRProjFile,"'",'\n', - "groupBy = ", "'",groupBy,"'",'\n', - "cellColEmbeddings = ", "'",cellColEmbeddings,"'",'\n', - "embedding = ", "'",embedding,"'",'\n', - "availableMatrices = ", "c(",paste(shQuote(allMatrices, type = "cmd"), collapse=", "),")",'\n', - "shiny::runApp('", mainDir, "')" + "ArchRProj <- loadArchRProject('", projDir,"')\n", + "mainDir = ", "'", mainDir, "'" ,'\n', + "subOutDir = ", "'",subOutDir,"'",'\n', + "savedArchRProjFile = ", "'",savedArchRProjFile,"'",'\n', + "groupBy = ", "'",groupBy,"'",'\n', + "cellColEmbeddings = ", "c(",paste(shQuote(cellColEmbeddings, type = "cmd"), collapse=", "),")",'\n', + "embedding = ", "'",embedding,"'",'\n', + "availableMatrices = ", "c(",paste(shQuote(allMatrices, type = "cmd"), collapse=", "),")",'\n', + "shiny::runApp('", mainDir, "')" - ) + ) + } #' Create an HDF5 file, mainEmbeds.h5, containing the nativeRaster vectors for the 5 main embeddings. @@ -311,20 +324,20 @@ exportShinyArchR <- function( stop("All columns should be present in cellColData") } - embeds <- .safelapply(length(cellColEmbeddings), function(x){ + embeds <- .safelapply(1:length(cellColEmbeddings), function(x){ # name <- cellColEmbeddings[x] - tryCatch({ named_embed <- plotEmbedding( ArchRProj = ArchRProj, baseSize = 12, colorBy = colorBy, name = name, + # allNames = names, embedding = embedding, embeddingDF = df, rastr = FALSE, size = 0.5, - imputeWeights = NULL, + # imputeWeights = NULL, # unsure if inputWeights needed for cellColData Shiny = TRUE )+ggtitle(paste0("Colored by ", name))+theme(text = element_text(size=12), legend.title = element_text(size = 12),legend.text = element_text(size = 6)) @@ -334,7 +347,7 @@ exportShinyArchR <- function( return(named_embed) }) - names(embeds) <- cellColEmbeddings[1:length(cellColEmbeddings)] + names(embeds) <- cellColEmbeddings saveRDS(embeds, file.path(outDirEmbed, "embeds.rds")) } else { @@ -367,7 +380,7 @@ exportShinyArchR <- function( #save plot without axes etc as a jpg ggsave(filename = file.path(outDirEmbed, paste0(names(embeds)[i],"_blank72.jpg")), - plot = embed_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 300) + plot = embed_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) #read back in that jpg because we need vector in native format blank_jpg72 <- readJPEG(source = file.path(outDirEmbed, paste0(names(embeds)[[i]],"_blank72.jpg")), native = TRUE) @@ -450,13 +463,13 @@ exportShinyArchR <- function( dir.create(paste0(outDirEmbed, "/",mat, "/embeds"), showWarnings = FALSE) featureNames <- readRDS(file.path(outDirEmbed, mat, paste0(mat,"_names.rds"))) - + if(!is.null(featureNames)){ - embeds_points <- .safelapply(1:length(featureNames), function(x){ + embeds_points <- .safelapply(1:10, function(x){ #length(featureNames) print(paste0("Creating plots for ", mat,": ",x,": ",round((x/length(featureNames))*100,3), "%")) - + if(!is.na(featureNames[x])){ gene_plot <- plotEmbedding( @@ -495,7 +508,7 @@ exportShinyArchR <- function( #read back in that jpg because we need vector in native format blank_jpg72 <- readJPEG(source = file.path(outDirEmbed, mat, "embeds", paste0(featureNames[x],"_blank72.jpg")), - native = TRUE) + native = TRUE) g <- ggplot_build(gene_plot) @@ -508,7 +521,7 @@ exportShinyArchR <- function( }, threads = threads) - names(embeds_points) <- featureNames[1:length(featureNames)] + names(embeds_points) <- featureNames[1:10] embeds_points = embeds_points[!unlist(lapply(embeds_points, is.null))] embeds_min_max <- data.frame(matrix(NA, 2, length(embeds_points))) @@ -531,26 +544,34 @@ exportShinyArchR <- function( embeds_min_max_list[[mat]] = embeds_min_max embeds_pal_list[[mat]] = embeds_points[[length(embeds_points)]][[1]]$pal - - # embeds_min_max_list[[mat]] = embeds_min_max - # embeds_pal_list[[mat]] = embeds_points[[length(embeds_points)]][[1]]$pal - - }else{ - - message(mat,".rds file does not exist") - } }else{ - message(mat,".rds file does not exist. This file should have been created previously be exportShinyArchR. Skipping...") + + message(mat,".rds file does not exist") } - - + + }else{ + message(mat,".rds file does not exist. This file should have been created previously be exportShinyArchR. Skipping...") } - scale <- embeds_min_max_list - pal <- embeds_pal_list - saveRDS(scale, file.path(outDirEmbed, "scale.rds")) - saveRDS(pal, file.path(outDirEmbed, "pal.rds")) +} + +for(i in 1:length(embeds_pal_list)){ + + cols = embeds_pal_list[[i]] + rgb <- col2rgb(cols) + lab <- convertColor(t(rgb), 'sRGB', 'Lab') + embeds_pal_list[[i]] <- cols[order(lab[, 'L'])] } + + +scale <- embeds_min_max_list +pal <- embeds_pal_list + +saveRDS(scale, file.path(outDirEmbed, "scale.rds")) +saveRDS(pal, file.path(outDirEmbed, "pal.rds")) + +} + From bb5484edc8e6754c50f5147b1c720394fec37b0d Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Wed, 1 Mar 2023 21:36:28 +0300 Subject: [PATCH 105/162] Update VisualizeData.R --- R/VisualizeData.R | 538 ++++++++++++++++++++++++++-------------------- 1 file changed, 299 insertions(+), 239 deletions(-) diff --git a/R/VisualizeData.R b/R/VisualizeData.R index 454bf87b..6b25f724 100644 --- a/R/VisualizeData.R +++ b/R/VisualizeData.R @@ -210,6 +210,7 @@ plotPDF <- function( #' @param baseSize The base font size to use in the plot. #' @param plotAs A string that indicates whether points ("points") should be plotted or a hexplot ("hex") should be plotted. By default #' if `colorBy` is numeric, then `plotAs` is set to "hex". +#' @param Shiny A boolean value that tells the function is calling for Shiny or not. #' @param threads The number of threads to be used for parallel computing. #' @param logFile The path to a file to be used for logging ArchR output. #' @param ... Additional parameters to pass to `ggPoint()` or `ggHex()`. @@ -245,262 +246,321 @@ plotEmbedding <- function( keepAxis = FALSE, baseSize = 10, plotAs = NULL, + Shiny = FALSE, + matrices = NULL, + imputeMatrices = NULL, + embeddingDF = NULL, threads = getArchRThreads(), logFile = createLogFile("plotEmbedding"), ... - ){ - .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) - .validInput(input = embedding, name = "reducedDims", valid = c("character")) - .validInput(input = colorBy, name = "colorBy", valid = c("character")) - .validInput(input = name, name = "name", valid = c("character")) - .validInput(input = log2Norm, name = "log2Norm", valid = c("boolean", - "null")) - .validInput(input = imputeWeights, name = "imputeWeights", - valid = c("list", "null")) - .validInput(input = pal, name = "pal", valid = c("palette", - "null")) - .validInput(input = size, name = "size", valid = c("numeric")) - .validInput(input = sampleCells, name = "sampleCells", valid = c("numeric", - "null")) - .validInput(input = highlightCells, name = "highlightCells", - valid = c("character", "null")) - .validInput(input = rastr, name = "rastr", valid = c("boolean")) - .validInput(input = quantCut, name = "quantCut", valid = c("numeric", - "null")) - .validInput(input = discreteSet, name = "discreteSet", valid = c("character", - "null")) - .validInput(input = continuousSet, name = "continuousSet", - valid = c("character", "null")) - .validInput(input = randomize, name = "randomize", valid = c("boolean")) - .validInput(input = keepAxis, name = "keepAxis", valid = c("boolean")) - .validInput(input = baseSize, name = "baseSize", valid = c("numeric")) - .validInput(input = plotAs, name = "plotAs", valid = c("character", - "null")) - .validInput(input = threads, name = "threads", valid = c("integer")) - .validInput(input = logFile, name = "logFile", valid = c("character")) - .requirePackage("ggplot2", source = "cran") - .startLogging(logFile = logFile) - .logThis(mget(names(formals()), sys.frame(sys.nframe())), - "Input-Parameters", logFile = logFile) - .logMessage("Getting UMAP Embedding", logFile = logFile) +){ + + .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) + .validInput(input = embedding, name = "reducedDims", valid = c("character")) + .validInput(input = colorBy, name = "colorBy", valid = c("character")) + .validInput(input = name, name = "name", valid = c("character")) + .validInput(input = log2Norm, name = "log2Norm", valid = c("boolean", "null")) + .validInput(input = imputeWeights, name = "imputeWeights", valid = c("list", "null")) + .validInput(input = pal, name = "pal", valid = c("palette", "null")) + .validInput(input = size, name = "size", valid = c("numeric")) + .validInput(input = sampleCells, name = "sampleCells", valid = c("numeric", "null")) + .validInput(input = highlightCells, name = "highlightCells", valid = c("character", "null")) + .validInput(input = rastr, name = "rastr", valid = c("boolean")) + .validInput(input = quantCut, name = "quantCut", valid = c("numeric", "null")) + .validInput(input = discreteSet, name = "discreteSet", valid = c("character", "null")) + .validInput(input = continuousSet, name = "continuousSet", valid = c("character", "null")) + .validInput(input = randomize, name = "randomize", valid = c("boolean")) + .validInput(input = keepAxis, name = "keepAxis", valid = c("boolean")) + .validInput(input = baseSize, name = "baseSize", valid = c("numeric")) + .validInput(input = plotAs, name = "plotAs", valid = c("character", "null")) + .validInput(input = Shiny, name = "Shiny", valid = c("boolean")) + .validInput(input = threads, name = "threads", valid = c("integer")) + .validInput(input = logFile, name = "logFile", valid = c("character")) + + .requirePackage("ggplot2", source = "cran") + + .startLogging(logFile = logFile) + .logThis(mget(names(formals()),sys.frame(sys.nframe())), "Input-Parameters", logFile=logFile) + + ############################## + # Get Embedding + ############################## + .logMessage("Getting Embedding", logFile = logFile) + if(Shiny){ + df <- embeddingDF + } else{ df <- getEmbedding(ArchRProj, embedding = embedding, returnDF = TRUE) - if (!all(rownames(df) %in% ArchRProj$cellNames)) { - stop("Not all cells in embedding are present in ArchRProject!") + } + + if(!all(rownames(df) %in% ArchRProj$cellNames)){ + stop("Not all cells in embedding are present in ArchRProject!") + } + .logThis(df, name = "Embedding data.frame", logFile = logFile) + + if(!is.null(sampleCells)){ + if(sampleCells < nrow(df)){ + if(!is.null(imputeWeights)){ + stop("Cannot sampleCells with imputeWeights not equal to NULL at this time!") + } + df <- df[sort(sample(seq_len(nrow(df)), sampleCells)), , drop = FALSE] } - .logThis(df, name = "Embedding data.frame", logFile = logFile) - if (!is.null(sampleCells)) { - if (sampleCells < nrow(df)) { - if (!is.null(imputeWeights)) { - stop("Cannot sampleCells with imputeWeights not equalt to NULL at this time!") - } - df <- df[sort(sample(seq_len(nrow(df)), sampleCells)), - , drop = FALSE] - } + } + + #Parameters + plotParams <- list() + plotParams$x <- df[,1] + plotParams$y <- df[,2] + plotParams$title <- paste0(embedding, " of ", stringr::str_split(colnames(df)[1],pattern="#",simplify=TRUE)[,1]) + plotParams$baseSize <- baseSize + + #Additional Params! + plotParams$xlabel <- gsub("_", " ",stringr::str_split(colnames(df)[1],pattern="#",simplify=TRUE)[,2]) + plotParams$ylabel <- gsub("_", " ",stringr::str_split(colnames(df)[2],pattern="#",simplify=TRUE)[,2]) + plotParams$rastr <- rastr + plotParams$size <- size + plotParams$randomize <- randomize + + #Check if Cells To Be Highlighted + if(!is.null(highlightCells)){ + highlightPoints <- match(highlightCells, rownames(df), nomatch = 0) + if(any(highlightPoints==0)){ + stop("highlightCells contain cells not in Embedding cellNames! Please make sure that these match!") } - plotParams <- list(...) - plotParams$x <- df[, 1] - plotParams$y <- df[, 2] - plotParams$title <- paste0(embedding, " of ", stringr::str_split(colnames(df)[1], - pattern = "#", simplify = TRUE)[, 1]) - plotParams$baseSize <- baseSize - plotParams$xlabel <- gsub("_", " ", stringr::str_split(colnames(df)[1], - pattern = "#", simplify = TRUE)[, 2]) - plotParams$ylabel <- gsub("_", " ", stringr::str_split(colnames(df)[2], - pattern = "#", simplify = TRUE)[, 2]) - plotParams$rastr <- rastr - plotParams$size <- size - plotParams$randomize <- randomize - if (!is.null(highlightCells)) { - highlightPoints <- match(highlightCells, rownames(df), - nomatch = 0) - if (any(highlightPoints == 0)) { - stop("highlightCells contain cells not in Embedding cellNames! Please make sure that these match!") - } + } + + #Make Sure ColorBy is valid! + if(length(colorBy) > 1){ + stop("colorBy must be of length 1!") + } + + if(!Shiny){ + allColorBy <- .availableArrays(head(getArrowFiles(ArchRProj), 2)) + } else { + allColorBy <- matrices$allColorBy + } + if(tolower(colorBy) %ni% tolower(allColorBy)){ + stop("colorBy must be one of the following :\n", paste0(allColorBy, sep=", ")) + } + colorBy <- allColorBy[match(tolower(colorBy), tolower(allColorBy))] + .logMessage(paste0("ColorBy = ", colorBy), logFile = logFile) + + if(tolower(colorBy) == "coldata" | tolower(colorBy) == "cellcoldata"){ + colorList <- lapply(seq_along(name), function(x){ + colorParams <- list() + colorParams$color <- as.vector(getCellColData(ArchRProj, select = name[x], drop = FALSE)[rownames(df), 1]) + colorParams$discrete <- .isDiscrete(colorParams$color) + colorParams$continuousSet <- "solarExtra" + colorParams$discreteSet <- "stallion" + colorParams$title <- paste(plotParams$title, " colored by\ncolData : ", name[x]) + if(!is.null(continuousSet)){ + colorParams$continuousSet <- continuousSet + } + if(!is.null(discreteSet)){ + colorParams$discreteSet <- discreteSet + } + if(x == 1){ + .logThis(colorParams, name = "ColorParams 1", logFile = logFile) + } + + if(!is.null(imputeWeights)){ + if(getArchRVerbose()) message("Imputing Matrix") + colorMat <- matrix(colorParams$color, nrow=1) + colnames(colorMat) <- rownames(df) + colorMat <- imputeMatrix(mat = colorMat, imputeWeights = imputeWeights, logFile = logFile) + colorParams$color <- as.vector(colorMat) + } + colorParams + }) + }else{# plotting embedding for matrix instead of col in cellcoldata + suppressMessages(message(logFile)) + + if(!Shiny){ + units <- tryCatch({ + .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, "/Info/Units"))[1] + },error=function(e){ + "values" + }) + }else{ + units <- ArchRProj@projectMetadata[["units"]] } - if (length(colorBy) > 1) { - stop("colorBy must be of length 1!") + + if(is.null(log2Norm) & tolower(colorBy) == "genescorematrix"){ + log2Norm <- TRUE } - allColorBy <- c("colData", "cellColData", .availableArrays(head(getArrowFiles(ArchRProj), - 2))) - if (tolower(colorBy) %ni% tolower(allColorBy)) { - stop("colorBy must be one of the following :\n", paste0(allColorBy, - sep = ", ")) + + if(is.null(log2Norm)){ + log2Norm <- FALSE } - colorBy <- allColorBy[match(tolower(colorBy), tolower(allColorBy))] - .logMessage(paste0("ColorBy = ", colorBy), logFile = logFile) - if (tolower(colorBy) == "coldata" | tolower(colorBy) == "cellcoldata") { - colorList <- lapply(seq_along(name), function(x) { - colorParams <- list() - colorParams$color <- as.vector(getCellColData(ArchRProj, - select = name[x], drop = FALSE)[rownames(df), - 1]) - colorParams$discrete <- .isDiscrete(colorParams$color) - colorParams$continuousSet <- "solarExtra" - colorParams$discreteSet <- "stallion" - colorParams$title <- paste(plotParams$title, " colored by\ncolData : ", - name[x]) - if (!is.null(continuousSet)) { - colorParams$continuousSet <- continuousSet - } - if (!is.null(discreteSet)) { - colorParams$discreteSet <- discreteSet - } - if (x == 1) { - .logThis(colorParams, name = "ColorParams 1", - logFile = logFile) - } - if (!is.null(imputeWeights)) { - if (getArchRVerbose()) - message("Imputing Matrix") - colorMat <- matrix(colorParams$color, nrow = 1) - colnames(colorMat) <- rownames(df) - colorMat <- imputeMatrix(mat = colorMat, imputeWeights = imputeWeights, - logFile = logFile) - colorParams$color <- as.vector(colorMat) - } - colorParams - }) + + if(!Shiny){ + colorMat <- .getMatrixValues( + ArchRProj = ArchRProj, + name = name, + matrixName = colorBy, + log2Norm = FALSE, + threads = threads, + logFile = logFile + ) + }else{ + #get values from pre-saved list + colorMat = tryCatch({ + t(as.matrix(matrices[[colorBy]][name,])) + }, warning = function(warning_condition) { + message(paste("name doesn't exist:", name)) + message(warning_condition) + return(NULL) + }, error = function(error_condition) { + message(paste("name doesn't exist:", name)) + message(error_condition) + return(NA) + }, finally={ + }) + rownames(colorMat)=name } - else { - suppressMessages(message(logFile)) - units <- tryCatch({ - .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, - "/Info/Units"))[1] - }, error = function(e) { - "values" - }) - if (is.null(log2Norm) & tolower(colorBy) == "genescorematrix") { - log2Norm <- TRUE - } - if (is.null(log2Norm)) { - log2Norm <- FALSE - } - colorMat <- .getMatrixValues(ArchRProj = ArchRProj, name = name, - matrixName = colorBy, log2Norm = FALSE, threads = threads, - logFile = logFile) - if (!all(rownames(df) %in% colnames(colorMat))) { - .logMessage("Not all cells in embedding are present in feature matrix. This may be due to using a custom embedding.", - logFile = logFile) - stop("Not all cells in embedding are present in feature matrix. This may be due to using a custom embedding.") - } - colorMat <- colorMat[, rownames(df), drop = FALSE] - .logThis(colorMat, "colorMat-Before-Impute", logFile = logFile) - if (!is.null(imputeWeights)) { - if (getArchRVerbose()) - message("Imputing Matrix") - colorMat <- imputeMatrix(mat = as.matrix(colorMat), - imputeWeights = imputeWeights, logFile = logFile) - if (!inherits(colorMat, "matrix")) { - colorMat <- matrix(colorMat, ncol = nrow(df)) - colnames(colorMat) <- rownames(df) - } - } - .logThis(colorMat, "colorMat-After-Impute", logFile = logFile) - colorList <- lapply(seq_len(nrow(colorMat)), function(x) { - colorParams <- list() - colorParams$color <- colorMat[x, ] - colorParams$discrete <- FALSE - colorParams$title <- sprintf("%s colored by\n%s : %s", - plotParams$title, colorBy, name[x]) - if (tolower(colorBy) == "genescorematrix") { - colorParams$continuousSet <- "horizonExtra" - } - else { - colorParams$continuousSet <- "solarExtra" - } - if (!is.null(continuousSet)) { - colorParams$continuousSet <- continuousSet - } - if (!is.null(discreteSet)) { - colorParams$discreteSet <- discreteSet - } - if (x == 1) { - .logThis(colorParams, name = "ColorParams 1", - logFile = logFile) - } - colorParams - }) + + if(!all(rownames(df) %in% colnames(colorMat))){ + .logMessage("Not all cells in embedding are present in feature matrix. This may be due to using a custom embedding.", logFile = logFile) + stop("Not all cells in embedding are present in feature matrix. This may be due to using a custom embedding.") } - if (getArchRVerbose()) - message("Plotting Embedding") - ggList <- lapply(seq_along(colorList), function(x) { - if (getArchRVerbose()) - message(x, " ", appendLF = FALSE) - plotParamsx <- .mergeParams(colorList[[x]], plotParams) - if (plotParamsx$discrete) { - plotParamsx$color <- paste0(plotParamsx$color) - } - if (!plotParamsx$discrete) { - if (!is.null(quantCut)) { - plotParamsx$color <- .quantileCut(plotParamsx$color, - min(quantCut), max(quantCut)) - } - plotParamsx$pal <- paletteContinuous(set = plotParamsx$continuousSet) - if (!is.null(pal)) { - plotParamsx$pal <- pal - } - if (is.null(plotAs)) { - plotAs <- "hexplot" - } - if (!is.null(log2Norm)) { - if (log2Norm) { - plotParamsx$color <- log2(plotParamsx$color + - 1) - plotParamsx$colorTitle <- paste0("Log2(", units, - " + 1)") - } - else { - plotParamsx$colorTitle <- units - } - } - if (tolower(plotAs) == "hex" | tolower(plotAs) == - "hexplot") { - plotParamsx$discrete <- NULL - plotParamsx$continuousSet <- NULL - plotParamsx$rastr <- NULL - plotParamsx$size <- NULL - plotParamsx$randomize <- NULL - .logThis(plotParamsx, name = paste0("PlotParams-", - x), logFile = logFile) - gg <- do.call(ggHex, plotParamsx) - } - else { - if (!is.null(highlightCells)) { - plotParamsx$highlightPoints <- highlightPoints - } - .logThis(plotParamsx, name = paste0("PlotParams-", - x), logFile = logFile) - gg <- do.call(ggPoint, plotParamsx) - } + + colorMat <- colorMat[,rownames(df), drop=FALSE] + + .logThis(colorMat, "colorMat-Before-Impute", logFile = logFile) + + if(!is.null(imputeWeights)){ + if(getArchRVerbose()) message("Imputing Matrix") + if(!Shiny){ + colorMat <- imputeMatrix(mat = as.matrix(colorMat), imputeWeights = imputeWeights, logFile = logFile) + }else{ + colorMat <- imputeMatrices[[colorBy]][name,] } - else { - if (!is.null(pal)) { - plotParamsx$pal <- pal - } - if (!is.null(highlightCells)) { - plotParamsx$highlightPoints <- highlightPoints - } - .logThis(plotParamsx, name = paste0("PlotParams-", - x), logFile = logFile) - gg <- do.call(ggPoint, plotParamsx) + if(!inherits(colorMat, "matrix")){ + colorMat <- matrix(colorMat, ncol = nrow(df)) + colnames(colorMat) <- rownames(df) + } + } + + .logThis(colorMat, "colorMat-After-Impute", logFile = logFile) + + colorList <- lapply(seq_len(nrow(colorMat)), function(x){ + colorParams <- list() + colorParams$color <- colorMat[x, ] + colorParams$discrete <- FALSE + colorParams$title <- sprintf("%s colored by\n%s : %s", plotParams$title, colorBy, name[x]) + if(tolower(colorBy) == "genescorematrix"){ + colorParams$continuousSet <- "horizonExtra" + }else{ + colorParams$continuousSet <- "solarExtra" + } + if(!is.null(continuousSet)){ + colorParams$continuousSet <- continuousSet + } + if(!is.null(discreteSet)){ + colorParams$discreteSet <- discreteSet + } + if(x == 1){ + .logThis(colorParams, name = "ColorParams 1", logFile = logFile) + } + colorParams + }) + } + + if(getArchRVerbose()) message("Plotting Embedding") + + ggList <- lapply(seq_along(colorList), function(x){ + + if(getArchRVerbose()) message(x, " ", appendLF = FALSE) + + plotParamsx <- .mergeParams(colorList[[x]], plotParams) + + if(plotParamsx$discrete){ + plotParamsx$color <- paste0(plotParamsx$color) + } + + if(!plotParamsx$discrete){ + + if(!is.null(quantCut)){ + plotParamsx$color <- .quantileCut(plotParamsx$color, min(quantCut), max(quantCut)) + } + + plotParamsx$pal <- paletteContinuous(set = plotParamsx$continuousSet) + + if(!is.null(pal)){ + + plotParamsx$pal <- pal + + } + + if(is.null(plotAs)){ + plotAs <- "hexplot" + } + + if(!is.null(log2Norm)){ + if(log2Norm){ + plotParamsx$color <- log2(plotParamsx$color + 1) + plotParamsx$colorTitle <- paste0("Log2(",units," + 1)") + }else{ + plotParamsx$colorTitle <- units } - if (!keepAxis) { - gg <- gg + theme(axis.text.x = element_blank(), axis.ticks.x = element_blank(), - axis.text.y = element_blank(), axis.ticks.y = element_blank()) + } + + if(tolower(plotAs) == "hex" | tolower(plotAs) == "hexplot"){ + + plotParamsx$discrete <- NULL + plotParamsx$continuousSet <- NULL + plotParamsx$rastr <- NULL + plotParamsx$size <- NULL + plotParamsx$randomize <- NULL + + .logThis(plotParamsx, name = paste0("PlotParams-", x), logFile = logFile) + gg <- do.call(ggHex, plotParamsx) + + }else{ + + if(!is.null(highlightCells)){ + plotParamsx$highlightPoints <- highlightPoints } - gg - }) - names(ggList) <- name - if (getArchRVerbose()) - message("") - if (length(ggList) == 1) { - ggList <- ggList[[1]] + + .logThis(plotParamsx, name = paste0("PlotParams-", x), logFile = logFile) + gg <- do.call(ggPoint, plotParamsx) + + } + + }else{ + + if(!is.null(pal)){ + plotParamsx$pal <- pal + } + + if(!is.null(highlightCells)){ + plotParamsx$highlightPoints <- highlightPoints + } + + .logThis(plotParamsx, name = paste0("PlotParams-", x), logFile = logFile) + gg <- do.call(ggPoint, plotParamsx) + } - .endLogging(logFile = logFile) - ggList + + if(!keepAxis){ + gg <- gg + theme(axis.text.x=element_blank(), axis.ticks.x=element_blank(), axis.text.y=element_blank(), axis.ticks.y=element_blank()) + } + + gg + + }) + names(ggList) <- name + if(getArchRVerbose()) message("") + + if(length(ggList) == 1){ + ggList <- ggList[[1]] + } + + .endLogging(logFile = logFile) + + ggList + } - #' Visualize Groups from ArchR Project #' #' This function will group, summarize and then plot data from an ArchRProject for visual comparison. From f9d6bd44db7fee6149a2ee4a23d0fc6e01cc79d1 Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Wed, 1 Mar 2023 21:41:56 +0300 Subject: [PATCH 106/162] Update ShinyArchRExports.R --- R/ShinyArchRExports.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 832ac55c..9b36e001 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -131,7 +131,7 @@ exportShinyArchR <- function( # file.path(ArchRProjOutputDir), dropCells = TRUE, overwrite = F, load = TRUE) # file.copy(file.path(getOutputDirectory(ArchRProjShiny), ArchRProjFile), mainOutputDir, recursive=TRUE) - # file.copy(file.path(getOutputDirectory(ArchRProjShiny), savedArchRProjFile), file.path(mainOutputDir), recursive=FALSE) + file.copy(file.path(getOutputDirectory(ArchRProjShiny), savedArchRProjFile), file.path(mainOutputDir), recursive=FALSE) # saveArchRProject(ArchRProj = ArchRProjShiny, outputDirectory = file.path(mainOutputDir), load = FALSE) From 8049bfa3648c680d3c5bfae088472c4505228733 Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Wed, 1 Mar 2023 23:05:46 +0300 Subject: [PATCH 107/162] Update VisualizeData.R --- R/VisualizeData.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/R/VisualizeData.R b/R/VisualizeData.R index 6b25f724..6185ccdb 100644 --- a/R/VisualizeData.R +++ b/R/VisualizeData.R @@ -334,10 +334,11 @@ plotEmbedding <- function( } if(!Shiny){ - allColorBy <- .availableArrays(head(getArrowFiles(ArchRProj), 2)) + allColorBy <- c("colData", "cellColData", .availableArrays(head(getArrowFiles(ArchRProj), 2))) } else { - allColorBy <- matrices$allColorBy + allColorBy <- c("colData", "cellColData", matrices$allColorBy) } + if(tolower(colorBy) %ni% tolower(allColorBy)){ stop("colorBy must be one of the following :\n", paste0(allColorBy, sep=", ")) } From 3f10ff5837cfcfd9a74e996d04dfb97be5735e3c Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Wed, 1 Mar 2023 23:31:46 +0300 Subject: [PATCH 108/162] Update ShinyArchRExports.R --- R/ShinyArchRExports.R | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 9b36e001..3b6ce2ea 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -337,6 +337,8 @@ exportShinyArchR <- function( embeddingDF = df, rastr = FALSE, size = 0.5, + matrices = matrices, + imputeMatrices = imputeMatrices, # imputeWeights = NULL, # unsure if inputWeights needed for cellColData Shiny = TRUE )+ggtitle(paste0("Colored by ", name))+theme(text = element_text(size=12), @@ -419,7 +421,7 @@ exportShinyArchR <- function( .matrixEmbeds <- function( ArchRProj = NULL, outDirEmbed = NULL, - colorBy = c("GeneScoreMatrix", "GeneIntegrationMatrix", "MotifMatrix"), + colorBy = "cellColData", supportedMatrices = c("GeneScoreMatrix", "GeneIntegrationMatrix", "MotifMatrix"), embedding = "UMAP", matrices = NULL, @@ -480,8 +482,8 @@ exportShinyArchR <- function( quantCut = c(0.01, 0.95), imputeWeights = getImputeWeights(ArchRProj = ArchRProj), plotAs = "points", - matrices = mat, embeddingDF = df, + matrices = matrices, imputeMatrices = imputeMatrices, rastr = TRUE ) @@ -544,6 +546,12 @@ exportShinyArchR <- function( embeds_min_max_list[[mat]] = embeds_min_max embeds_pal_list[[mat]] = embeds_points[[length(embeds_points)]][[1]]$pal + + +# +# +# embeds_min_max_list[[mat]] = embeds_min_max +# embeds_pal_list[[mat]] = embeds_points[[length(embeds_points)]][[1]]$pal }else{ @@ -556,6 +564,8 @@ exportShinyArchR <- function( } + +# nms = names(embeds_pal_list) for(i in 1:length(embeds_pal_list)){ From e478e037326574e577cb7a2e1ace143c22c10564 Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Wed, 1 Mar 2023 23:50:58 +0300 Subject: [PATCH 109/162] Update ShinyArchRExports.R --- R/ShinyArchRExports.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 3b6ce2ea..927a8917 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -485,6 +485,7 @@ exportShinyArchR <- function( embeddingDF = df, matrices = matrices, imputeMatrices = imputeMatrices, + Shiny = TRUE, rastr = TRUE ) }else{ From 4c82e96387a91a455c1e6c20f1205c102c0dafbd Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Wed, 1 Mar 2023 23:59:22 +0300 Subject: [PATCH 110/162] Update ShinyArchRExports.R --- R/ShinyArchRExports.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 927a8917..a044f902 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -485,7 +485,7 @@ exportShinyArchR <- function( embeddingDF = df, matrices = matrices, imputeMatrices = imputeMatrices, - Shiny = TRUE, + Shiny = FALSE, rastr = TRUE ) }else{ From 1c3393241d2a932f31cad059efca6a11614fdcec Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Thu, 2 Mar 2023 00:23:27 +0300 Subject: [PATCH 111/162] Update ShinyArchRExports.R --- R/ShinyArchRExports.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index a044f902..3b20f533 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -1,6 +1,6 @@ # Functions for exporting an ArchR-based Shiny app ----------------------------------------------------------- #' -#' Export a Shiny App based on an ArchRProj +#' Export a Shiny App based on an ArchRProj #' #' Generate all files required for an autonomous Shiny app to display browser tracks and embeddings. #' From c7dc70850096edd4262f10f0a2d37c9c8b4b2ea5 Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Thu, 2 Mar 2023 00:23:47 +0300 Subject: [PATCH 112/162] Update ShinyArchRExports.R --- R/ShinyArchRExports.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 3b20f533..a044f902 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -1,6 +1,6 @@ # Functions for exporting an ArchR-based Shiny app ----------------------------------------------------------- #' -#' Export a Shiny App based on an ArchRProj +#' Export a Shiny App based on an ArchRProj #' #' Generate all files required for an autonomous Shiny app to display browser tracks and embeddings. #' From a5de6246014f4983c398bc1ccf8c1df7b75ceac9 Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Thu, 2 Mar 2023 00:44:29 +0300 Subject: [PATCH 113/162] Update ShinyArchRExports.R --- R/ShinyArchRExports.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index a044f902..984ad284 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -248,6 +248,7 @@ exportShinyArchR <- function( outDirEmbed = file.path(projDir, mainDir, subOutDir), colorBy = intersect(supportedMatrices, allMatrices), embedding = embedding, + embeddingDF = df, matrices = matrices, imputeMatrices = imputeMatrices, threads = getArchRThreads(), From 8ab4baba172f8b7f29f1c240d1e4386b7301beb5 Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Thu, 2 Mar 2023 00:53:33 +0300 Subject: [PATCH 114/162] Update ShinyArchRExports.R --- R/ShinyArchRExports.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 984ad284..f6e7d0aa 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -486,7 +486,7 @@ exportShinyArchR <- function( embeddingDF = df, matrices = matrices, imputeMatrices = imputeMatrices, - Shiny = FALSE, + Shiny = TRUE, rastr = TRUE ) }else{ From 18207fb892289644596f89c6567153e28575ecc2 Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Thu, 2 Mar 2023 14:10:42 +0300 Subject: [PATCH 115/162] Update ShinyArchRExports.R --- R/ShinyArchRExports.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index f6e7d0aa..fd5652ba 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -242,6 +242,7 @@ exportShinyArchR <- function( # matrixEmbeds will create an HDF5 file containing he nativeRaster vectors for data stored in matrices if(!file.exists(file.path(mainDir, subOutDir, "plotBlank72.h5"))){ + df <- getEmbedding(ArchRProjShiny, embedding = embedding, returnDF = TRUE) .matrixEmbeds( ArchRProj = ArchRProj, @@ -425,6 +426,7 @@ exportShinyArchR <- function( colorBy = "cellColData", supportedMatrices = c("GeneScoreMatrix", "GeneIntegrationMatrix", "MotifMatrix"), embedding = "UMAP", + embeddingDF = NULL, matrices = NULL, imputeMatrices = NULL, threads = getArchRThreads(), @@ -466,6 +468,7 @@ exportShinyArchR <- function( dir.create(paste0(outDirEmbed, "/",mat, "/embeds"), showWarnings = FALSE) featureNames <- readRDS(file.path(outDirEmbed, mat, paste0(mat,"_names.rds"))) + featureNames = gsub(".*:","",featureNames) if(!is.null(featureNames)){ @@ -489,6 +492,8 @@ exportShinyArchR <- function( Shiny = TRUE, rastr = TRUE ) + + }else{ gene_plot = NULL } From 76b9b73d9768be51549f187709c87830170385d2 Mon Sep 17 00:00:00 2001 From: Pau Paiz <59720098+paupaiz@users.noreply.github.com> Date: Thu, 2 Mar 2023 15:16:31 +0300 Subject: [PATCH 116/162] Update ShinyArchRExports.R --- R/ShinyArchRExports.R | 24 +++++++++++++++--------- 1 file changed, 15 insertions(+), 9 deletions(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index fd5652ba..cc96e553 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -225,13 +225,15 @@ exportShinyArchR <- function( imputeMatrices <- readRDS(file.path(projDir, mainDir, subOutDir, "imputeMatrices.rds")) } + print("Mainembeds started...") + # mainEmbeds will create an HDF5 file containing the nativeRaster vectors for data stored in cellColData if (!file.exists(file.path(projDir, mainDir, subOutDir, "mainEmbeds.h5"))) { .mainEmbeds(ArchRProj = ArchRProjShiny, outDirEmbed = file.path(projDir, mainDir, subOutDir), colorBy = "cellColData", cellColEmbeddings = cellColEmbeddings, - # embeddingDF = df, + embeddingDF = df, matrices = matrices, imputeMatrices = imputeMatrices, logFile = createLogFile("mainEmbeds") @@ -240,9 +242,11 @@ exportShinyArchR <- function( message("H5 for main embeddings already exists...") } + print("MatrixEmbeds started...") + # matrixEmbeds will create an HDF5 file containing he nativeRaster vectors for data stored in matrices if(!file.exists(file.path(mainDir, subOutDir, "plotBlank72.h5"))){ - df <- getEmbedding(ArchRProjShiny, embedding = embedding, returnDF = TRUE) + embeddingDF = df .matrixEmbeds( ArchRProj = ArchRProj, @@ -261,6 +265,7 @@ exportShinyArchR <- function( message("H5 file already exists...") } + print("MatrixEmbeds finished...") ## delete unnecessary files ----------------------------------------------------------------- unlink(file.path(projDir, "ShinyFragments"), recursive = TRUE) @@ -303,6 +308,7 @@ exportShinyArchR <- function( colorBy = "cellColData", cellColEmbeddings = NULL, embedding = "UMAP", + embeddingDF = NULL, matrices = NULL, imputeMatrices = NULL, threads = getArchRThreads(), @@ -313,6 +319,7 @@ exportShinyArchR <- function( .validInput(input = colorBy, name = "colorBy", valid = c("character")) .validInput(input = cellColEmbeddings, name = "cellColEmbeddings", valid = c("character")) .validInput(input = embedding, name = "embedding", valid = c("character")) + .validInput(input = embeddingDF, name = "embeddingDF", valid = c("data.frame")) .validInput(input = threads, name = "threads", valid = c("numeric")) .validInput(input = logFile, name = "logFile", valid = c("character")) @@ -336,7 +343,7 @@ exportShinyArchR <- function( name = name, # allNames = names, embedding = embedding, - embeddingDF = df, + embeddingDF = embeddingDF, rastr = FALSE, size = 0.5, matrices = matrices, @@ -438,6 +445,7 @@ exportShinyArchR <- function( .validInput(input = colorBy, name = "colorBy", valid = c("character")) .validInput(input = supportedMatrices, name = "supportedMatrices", valid = c("character")) .validInput(input = embedding, name = "embedding", valid = c("character")) + .validInput(input = embeddingDF, name = "embeddingDF", valid = c("data.frame")) .validInput(input = matrices, name = "matrices", valid = c("list")) .validInput(input = imputeMatrices, name = "imputeMatrices", valid = c("list")) .validInput(input = threads, name = "threads", valid = c("numeric")) @@ -468,11 +476,10 @@ exportShinyArchR <- function( dir.create(paste0(outDirEmbed, "/",mat, "/embeds"), showWarnings = FALSE) featureNames <- readRDS(file.path(outDirEmbed, mat, paste0(mat,"_names.rds"))) - featureNames = gsub(".*:","",featureNames) - + if(!is.null(featureNames)){ - embeds_points <- .safelapply(1:10, function(x){ #length(featureNames) + embeds_points <- .safelapply(1:length(featureNames), function(x){ #length(featureNames) print(paste0("Creating plots for ", mat,": ",x,": ",round((x/length(featureNames))*100,3), "%")) @@ -486,10 +493,9 @@ exportShinyArchR <- function( quantCut = c(0.01, 0.95), imputeWeights = getImputeWeights(ArchRProj = ArchRProj), plotAs = "points", - embeddingDF = df, + embeddingDF = embeddingDF, matrices = matrices, imputeMatrices = imputeMatrices, - Shiny = TRUE, rastr = TRUE ) @@ -530,7 +536,7 @@ exportShinyArchR <- function( }, threads = threads) - names(embeds_points) <- featureNames[1:10] + names(embeds_points) <- featureNames embeds_points = embeds_points[!unlist(lapply(embeds_points, is.null))] embeds_min_max <- data.frame(matrix(NA, 2, length(embeds_points))) From 8a0a16770e8b17ce922347dc7d382dd3663d9a92 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Thu, 16 Mar 2023 14:53:37 -0700 Subject: [PATCH 117/162] Add validInput for ShinyArchR --- R/ArchRBrowser.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/ArchRBrowser.R b/R/ArchRBrowser.R index 6de5fbac..a725c724 100644 --- a/R/ArchRBrowser.R +++ b/R/ArchRBrowser.R @@ -38,7 +38,6 @@ #' @export ArchRBrowser <- function( ArchRProj = NULL, - ShinyArchR = FALSE, features = getPeakSet(ArchRProj), loops = getCoAccessibility(ArchRProj), minCells = 25, @@ -50,6 +49,7 @@ ArchRBrowser <- function( browserTheme = "cosmo", threads = getArchRThreads(), verbose = TRUE, + ShinyArchR = FALSE, logFile = createLogFile("ArchRBrowser") ){ @@ -65,6 +65,7 @@ ArchRBrowser <- function( .validInput(input = browserTheme, name = "browserTheme", valid = c("character")) .validInput(input = threads, name = "threads", valid = c("integer")) .validInput(input = verbose, name = "verbose", valid = c("boolean")) + .validInput(input = ShinyArchR, name = "ShinyArchR", valid = c("boolean")) .validInput(input = logFile, name = "logFile", valid = c("character")) .startLogging(logFile=logFile) From 1e8a8765cd6fe7949a867c2b8e67b2264c5a2728 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Thu, 16 Mar 2023 15:20:45 -0700 Subject: [PATCH 118/162] add threads option to getGroupFragsFromProj safelapply didnt have a threads argument so was only going to default to 1 thread --- R/GroupExport.R | 3 ++- R/ShinyArchRExports.R | 4 ++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/R/GroupExport.R b/R/GroupExport.R index 60125b9d..bb373b48 100644 --- a/R/GroupExport.R +++ b/R/GroupExport.R @@ -587,6 +587,7 @@ getGroupFragments <- function( .getGroupFragsFromProj <- function( ArchRProj = NULL, groupBy = NULL, + threads = getArchRThreads(), outDir = file.path(getOutputDirectory(ArchRProj), "fragments") ){ dir.create(outDir, showWarnings = FALSE) @@ -609,7 +610,7 @@ getGroupFragments <- function( # filter Fragments fragments <- GenomeInfoDb::keepStandardChromosomes(fragments, pruning.mode = "coarse") saveRDS(fragments, file.path(outDir, paste0(groupIDs[x], "_frags.rds"))) - }) + }, threads = threads) } #' Export Cluster Coverage from an ArchRProject diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index cc96e553..119d7c2e 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -142,14 +142,14 @@ exportShinyArchR <- function( #this is still a slightly dangerous comparison, better would be to compare for explicitly the file names that are expected if(length(fragFiles) == length(unique(ArchRProj@cellColData[,groupBy]))){ if(force){ - .getGroupFragsFromProj(ArchRProj = ArchRProjShiny, groupBy = groupBy, outDir = fragDir) + .getGroupFragsFromProj(ArchRProj = ArchRProjShiny, groupBy = groupBy, outDir = fragDir, threads = threads) } else{ message("Fragment files already exist. Skipping fragment file generation...") } }else{ dir.create(file.path(mainOutputDir, "ShinyFragments"), showWarnings = FALSE) dir.create(fragDir, showWarnings = FALSE) - .getGroupFragsFromProj(ArchRProj = ArchRProj, groupBy = groupBy, outDir = fragDir) + .getGroupFragsFromProj(ArchRProj = ArchRProj, groupBy = groupBy, outDir = fragDir, threads = threads) } # Create coverage objects - should be saved within a dir called ShinyCoverage within the ArchRProjShiny output directory From e9e269835b15675c57a64696406a7c95e9dd5c3a Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Thu, 16 Mar 2023 15:25:49 -0700 Subject: [PATCH 119/162] change function name to avoid confusion between getGroupFragments and this function, I've changed its name to exportGroupFragmentsRDS --- R/GroupExport.R | 9 +++++---- R/ShinyArchRExports.R | 4 ++-- 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/R/GroupExport.R b/R/GroupExport.R index bb373b48..9938975b 100644 --- a/R/GroupExport.R +++ b/R/GroupExport.R @@ -565,10 +565,11 @@ getGroupFragments <- function( } -#' Export Group Fragment Files from a Project +#' Export Group Fragment Files from a Project in .RDS format #' #' This function will group export fragment files for each user-specified -#' group in an ArchRProject and output them under a directory. +#' group in an ArchRProject and output them as .RDS files containing a GRanges +#' object into a specified directory. #' #' @param ArchRProj An `ArchRProject` object. #' @param groupBy A string that indicates how cells should be grouped. This string corresponds to one of the standard or @@ -582,9 +583,9 @@ getGroupFragments <- function( #' proj <- getTestProject() #' #' # Create directory for fragments -#' ArchR:::.getGroupFragmentsFromProj(proj, groupBy = "Clusters", outDir = "./Shiny/Fragments") +#' ArchR:::.exportGroupFragmentsRDS(proj, groupBy = "Clusters", outDir = "./Shiny/Fragments") #' -.getGroupFragsFromProj <- function( +.exportGroupFragmentsRDS <- function( ArchRProj = NULL, groupBy = NULL, threads = getArchRThreads(), diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 119d7c2e..a6283ea4 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -142,14 +142,14 @@ exportShinyArchR <- function( #this is still a slightly dangerous comparison, better would be to compare for explicitly the file names that are expected if(length(fragFiles) == length(unique(ArchRProj@cellColData[,groupBy]))){ if(force){ - .getGroupFragsFromProj(ArchRProj = ArchRProjShiny, groupBy = groupBy, outDir = fragDir, threads = threads) + .exportGroupFragmentsRDS(ArchRProj = ArchRProjShiny, groupBy = groupBy, outDir = fragDir, threads = threads) } else{ message("Fragment files already exist. Skipping fragment file generation...") } }else{ dir.create(file.path(mainOutputDir, "ShinyFragments"), showWarnings = FALSE) dir.create(fragDir, showWarnings = FALSE) - .getGroupFragsFromProj(ArchRProj = ArchRProj, groupBy = groupBy, outDir = fragDir, threads = threads) + .exportGroupFragmentsRDS(ArchRProj = ArchRProj, groupBy = groupBy, outDir = fragDir, threads = threads) } # Create coverage objects - should be saved within a dir called ShinyCoverage within the ArchRProjShiny output directory From 3c1abf17524e2ab674da649ddf18ec58e33855db Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Thu, 16 Mar 2023 15:31:43 -0700 Subject: [PATCH 120/162] change function name making a distinction between "get" and "export" where "export" means something is created and get means something is returned. --- R/GroupExport.R | 7 ++++--- R/ShinyArchRExports.R | 4 ++-- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/R/GroupExport.R b/R/GroupExport.R index 9938975b..286d5d1b 100644 --- a/R/GroupExport.R +++ b/R/GroupExport.R @@ -616,8 +616,9 @@ getGroupFragments <- function( #' Export Cluster Coverage from an ArchRProject #' -#' This function will group export fragment files for each user-specified -#' group in an ArchRProject and output them under a directory. +#' This function will create "coverage" files in the form of RLE objects +#' for each user-specified group in an ArchRProject and output them to a +#' specified directory. #' #' @param ArchRProj An `ArchRProject` object. #' @param tileSize The numeric width of the tile/bin in basepairs for plotting ATAC-seq signal tracks. @@ -629,7 +630,7 @@ getGroupFragments <- function( #' @param fragDir The path to the directory containing fragment files. #' @param outDir The path to the desired output directory for storage of coverage files. #' -.getClusterCoverage <- function( +.exportClusterCoverageRDS <- function( ArchRProj = NULL, tileSize = 100, scaleFactor = 1, diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index a6283ea4..8c2ffd92 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -159,14 +159,14 @@ exportShinyArchR <- function( # this is still a slightly dangerous comparison, better would be to compare for explicitly the file names that are expected if(length(covFiles) == length(unique(ArchRProjShiny@cellColData[,groupBy]))){ if(force){ - .getClusterCoverage(ArchRProj = ArchRProjShiny, tileSize = tileSize, groupBy = groupBy, outDir = covDir) + .exportClusterCoverageRDS(ArchRProj = ArchRProjShiny, tileSize = tileSize, groupBy = groupBy, outDir = covDir) } else{ message("Coverage files already exist. Skipping fragment file generation...") } }else{ dir.create(file.path(mainOutputDir, "ShinyCoverage")) dir.create(covDir, showWarnings = TRUE) - .getClusterCoverage(ArchRProj = ArchRProj, tileSize = tileSize, groupBy = groupBy, fragDir = fragDir, outDir = covDir) + .exportClusterCoverageRDS(ArchRProj = ArchRProj, tileSize = tileSize, groupBy = groupBy, fragDir = fragDir, outDir = covDir) } # Create directory to save input data to Shinyapps.io (everything that will be preprocessed) From e47e4b1a9770248924a49c4dc6963010eaa91a37 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Thu, 16 Mar 2023 16:24:16 -0700 Subject: [PATCH 121/162] fix mainDir path issues should be `projDir,mainDir` in all instances unless I'm mistaken --- R/HiddenUtils.R | 2 +- R/ShinyArchRExports.R | 16 +++++++--------- R/VisualizeData.R | 5 +++-- 3 files changed, 11 insertions(+), 12 deletions(-) diff --git a/R/HiddenUtils.R b/R/HiddenUtils.R index 57dd6bda..d5ed2080 100644 --- a/R/HiddenUtils.R +++ b/R/HiddenUtils.R @@ -531,7 +531,7 @@ fn <- unclass(lsf.str(envir = asNamespace("ArchR"), all = TRUE)) for(i in seq_along(fn)){ tryCatch({ - eval(parse(text=paste0(fn[i], '<- ArchR:::', fn[i]))) + eval(parse(text=paste0(fn[i], '<-ArchR:::', fn[i]))) }, error = function(x){ }) } diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 8c2ffd92..169e9b1e 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -37,7 +37,7 @@ exportShinyArchR <- function( .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) .validInput(input = mainDir, name = "mainDir", valid = c("character")) - .validInput(input = subOutDir, name = "subOutDir", valid = c("character")) + .validInput(input = subOutDir, name = "subOutDir", valid = c("character")) .validInput(input = savedArchRProjFile, name = "savedArchRProjFile", valid = c("character")) .validInput(input = groupBy, name = "groupBy", valid = c("character")) .validInput(input = cellColEmbeddings, name = "cellColEmbeddings", valid = c("character", "null")) @@ -67,8 +67,6 @@ exportShinyArchR <- function( # Check that the embedding exists in ArchRProj@embeddings if(embedding %ni% names(ArchRProj@embeddings)){ stop("embedding doesn't exist in ArchRProj@embeddings") - }else{ - print(paste0("embedding:", embedding)) } #check that groupBy column exists and doesn't have NA values @@ -178,13 +176,13 @@ exportShinyArchR <- function( imputeWeights <- getImputeWeights(ArchRProj = ArchRProjShiny) df <- getEmbedding(ArchRProjShiny, embedding = embedding, returnDF = TRUE) - if(!file.exists(file.path(mainDir, subOutDir, "matrices.rds")) && !file.exists(file.path(mainDir, subOutDir, "imputeMatrices.rds"))){ + if(!file.exists(file.path(projDir,mainDir, subOutDir, "matrices.rds")) && !file.exists(file.path(projDir,mainDir, subOutDir, "imputeMatrices.rds"))){ for(matName in allMatrices){ if(matName %in% supportedMatrices){ featuresNames <- getFeatures(ArchRProj = ArchRProj, useMatrix = matName) - dir.create(file.path(mainDir, subOutDir, matName), showWarnings = FALSE) - saveRDS(featuresNames, file.path(mainDir, subOutDir, matName, paste0(matName, "_names.rds"))) + dir.create(file.path(projDir,mainDir, subOutDir, matName), showWarnings = FALSE) + saveRDS(featuresNames, file.path(projDir,mainDir, subOutDir, matName, paste0(matName, "_names.rds"))) if(!is.null(featuresNames)){ @@ -215,8 +213,8 @@ exportShinyArchR <- function( } matrices$allColorBy= .availableArrays(head(getArrowFiles(ArchRProj), 2)) - saveRDS(matrices, file.path(mainDir, subOutDir, "matrices.rds")) - saveRDS(imputeMatrices, file.path(mainDir, subOutDir, "imputeMatrices.rds")) + saveRDS(matrices, file.path(projDir,mainDir, subOutDir, "matrices.rds")) + saveRDS(imputeMatrices, file.path(projDir,mainDir, subOutDir, "imputeMatrices.rds")) }else{ message("matrices and imputeMatrices already exist. reading from local files...") @@ -245,7 +243,7 @@ exportShinyArchR <- function( print("MatrixEmbeds started...") # matrixEmbeds will create an HDF5 file containing he nativeRaster vectors for data stored in matrices - if(!file.exists(file.path(mainDir, subOutDir, "plotBlank72.h5"))){ + if(!file.exists(file.path(projDir,mainDir, subOutDir, "plotBlank72.h5"))){ embeddingDF = df .matrixEmbeds( diff --git a/R/VisualizeData.R b/R/VisualizeData.R index 6185ccdb..f586ab33 100644 --- a/R/VisualizeData.R +++ b/R/VisualizeData.R @@ -210,7 +210,8 @@ plotPDF <- function( #' @param baseSize The base font size to use in the plot. #' @param plotAs A string that indicates whether points ("points") should be plotted or a hexplot ("hex") should be plotted. By default #' if `colorBy` is numeric, then `plotAs` is set to "hex". -#' @param Shiny A boolean value that tells the function is calling for Shiny or not. +#' @param Shiny A boolean value that tells whether the function is being called from exportShinyArchR() or not. +#' This parameter is not meant to be used by the end user. #' @param threads The number of threads to be used for parallel computing. #' @param logFile The path to a file to be used for logging ArchR output. #' @param ... Additional parameters to pass to `ggPoint()` or `ggHex()`. @@ -307,7 +308,7 @@ plotEmbedding <- function( } #Parameters - plotParams <- list() + plotParams <- list(...) plotParams$x <- df[,1] plotParams$y <- df[,2] plotParams$title <- paste0(embedding, " of ", stringr::str_split(colnames(df)[1],pattern="#",simplify=TRUE)[,1]) From 8383fe3ff3b3207950fa918fcc69245324e88daa Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Thu, 16 Mar 2023 16:31:23 -0700 Subject: [PATCH 122/162] update DESCRIPTION to reflect ArchR/dev --- DESCRIPTION | 75 ++++++++++++++++++++++++++++++++++++----------------- 1 file changed, 51 insertions(+), 24 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 469f3f0b..af5f6dd6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -16,37 +16,64 @@ URL: https://www.ArchRProject.com RoxygenNote: 7.2.1 Encoding: UTF-8 Imports: + BiocGenerics, + Biostrings, + chromVAR, + chromVARmotifs, + ComplexHeatmap, + data.table, devtools, + GenomicRanges, ggplot2, - SummarizedExperiment, - data.table, - Matrix, - rhdf5, + ggrepel, + gridExtra, + gtable, + gtools, + harmony, magrittr, - S4Vectors (>= 0.9.25), - BiocGenerics, - Rcpp (>= 0.12.16), - RcppArmadillo, + Matrix, matrixStats, - sparseMatrixStats, - plyr, - nabor, motifmatchr, - chromVAR, - uwot, - ggrepel, + nabor, + plyr, + presto, + Rcpp (>= 0.12.16), + RcppArmadillo, + rhdf5, Rsamtools, - gtable, - gtools, + S4Vectors (>= 0.9.25), + Seurat, + SeuratObject, + sparseMatrixStats, stringr, - grid, - gridExtra, - Biostrings, - ComplexHeatmap, - GenomicRanges, - presto, - harmony + SummarizedExperiment, + uwot Depends: +Suggests: + Cairo, + DESeq2, + edgeR, + GenomicFeatures, + ggridges, + ggseqlogo, + hexbin, + jpeg, + leiden, + limma, + monocle3, + pdftools, + pheatmap, + rhandsontable, + scran, + shiny, + shinythemes, + slingshot, + testthat +Remotes: + GreenleafLab/chromVARmotifs, + cole-trapnell-lab/monocle3, + immunogenomics/presto +biocViews: Collate: 'AllClasses.R' 'AnnotationGenome.R' @@ -94,4 +121,4 @@ Collate: 'ShinyArchRExports.R' 'Trajectory.R' 'ValidationUtils.R' - 'VisualizeData.R' + 'VisualizeData.R' \ No newline at end of file From 2cfc1f80de858eae01e0e304844b5bfcc44647f8 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Fri, 17 Mar 2023 09:39:15 -0700 Subject: [PATCH 123/162] add explicit package mentions making sure packages are explicitly called --- R/ShinyArchRExports.R | 4 +- Shiny/app.R | 6 +- Shiny/global.R | 81 +++++----- Shiny/server.R | 338 +++++++++++++++++++++--------------------- Shiny/ui.R | 138 ++++++++--------- 5 files changed, 285 insertions(+), 282 deletions(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 169e9b1e..1fb38880 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -392,7 +392,7 @@ exportShinyArchR <- function( plot = embed_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) #read back in that jpg because we need vector in native format - blank_jpg72 <- readJPEG(source = file.path(outDirEmbed, paste0(names(embeds)[[i]],"_blank72.jpg")), native = TRUE) + blank_jpg72 <- jpeg::readJPEG(source = file.path(outDirEmbed, paste0(names(embeds)[[i]],"_blank72.jpg")), native = TRUE) # save the native raster vectors h5createDataset(file = points, dataset = names(embeds)[i], dims = c(46656,1), storage.mode = "integer") @@ -520,7 +520,7 @@ exportShinyArchR <- function( plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) #read back in that jpg because we need vector in native format - blank_jpg72 <- readJPEG(source = file.path(outDirEmbed, mat, "embeds", paste0(featureNames[x],"_blank72.jpg")), + blank_jpg72 <- jpeg::readJPEG(source = file.path(outDirEmbed, mat, "embeds", paste0(featureNames[x],"_blank72.jpg")), native = TRUE) g <- ggplot_build(gene_plot) diff --git a/Shiny/app.R b/Shiny/app.R index 8f60aec8..c91421f5 100644 --- a/Shiny/app.R +++ b/Shiny/app.R @@ -1,6 +1,6 @@ # Load libraries so they are available # Run the app through this file. -source("ui.R") -source("server.R") -shinyApp(ui:ui, server:shinyServer) +base::source("ui.R") +base::source("server.R") +shiny::shinyApp(ui:ui, server:shinyServer) # http://127.0.0.1:6747 \ No newline at end of file diff --git a/Shiny/global.R b/Shiny/global.R index 0567d834..4070f8fa 100644 --- a/Shiny/global.R +++ b/Shiny/global.R @@ -1,52 +1,55 @@ # Setting up ---------------------------------------------------------------------- -library(shinycssloaders) -library(hexbin) -library(magick) +library(ggplot2) library(gridExtra) library(grid) -library(patchwork) -library(shinybusy) library(cowplot) -library(ggpubr) library(farver) library(rhdf5) library(plotfunctions) library(raster) library(jpeg) -library(sparseMatrixStats) -library(BiocManager) -library(ComplexHeatmap) library(ArchR) +#As best I can tell, these are not used explicitly. +#Some are dependencies of ArchR already. Others not. +# library(sparseMatrixStats) +# library(BiocManager) +# library(ComplexHeatmap) +# library(shinybusy) +# library(patchwork) +# library(hexbin) +# library(magick) +# library(shinycssloaders) +# library(ggpubr) ############# NEW ADDITIONS (start) ############################### # Adjusting ArchR functions -fn <- unclass(lsf.str(envir = asNamespace("ArchR"), all = TRUE)) -for (i in seq_along(fn)) { - tryCatch({ - eval(parse(text = paste0(fn[i], "<-ArchR:::", fn[i]))) +fn <- base::unclass(utils::lsf.str(envir = base::asNamespace("ArchR"), all = TRUE)) +for (i in base::seq_along(fn)) { + base::tryCatch({ + base::eval(base::parse(text = base::paste0(fn[i], "<-ArchR:::", fn[i]))) }, error = function(x) { }) } -source("AllClasses.R") -source("ArchRBrowser.R") -source("GgplotUtils.R") +base::source("AllClasses.R") +base::source("ArchRBrowser.R") +base::source("GgplotUtils.R") # Calling ArchRProj -ArchRProj=loadArchRProject(path = ".", shiny = TRUE) -ArchRProj <- addImputeWeights(ArchRProj = ArchRProj) -mainDir = 'Shiny' -subOutDir = 'inputData' -groupBy = 'Clusters' -cellColEmbeddings = 'Clusters' -embedding = 'UMAP' -availableMatrices = c("GeneScoreMatrix", "MotifMatrix", "PeakMatrix", "TileMatrix") -ShinyArchR = TRUE -sampleLabels = 'Clusters' +ArchRProj <- ArchR::loadArchRProject(path = ".", shiny = TRUE) +ArchRProj <- ArchR::addImputeWeights(ArchRProj = ArchRProj) +mainDir <- 'Shiny' +subOutDir <- 'inputData' +groupBy <- 'Clusters' +cellColEmbeddings <- 'Clusters' +embedding <- 'UMAP' +availableMatrices <- c("GeneScoreMatrix", "MotifMatrix", "PeakMatrix", "TileMatrix") +ShinyArchR <- TRUE +sampleLabels <- 'Clusters' @@ -55,34 +58,34 @@ sampleLabels = 'Clusters' # EMBED Visualization ------------------------------------------------------------ # create a list of dropdown options for EMBED tab -EMBEDs_dropdown=colnames(ArchRProj@cellColData)[colnames(ArchRProj@cellColData) %in% groupBy] -matrices_dropdown = names(readRDS(file.path(subOutDir, "scale.rds"))) +EMBEDs_dropdown = base::colnames(ArchRProj@cellColData)[base::colnames(ArchRProj@cellColData) %in% groupBy] +matrices_dropdown = base::names(base::readRDS(base::file.path(subOutDir, "scale.rds"))) -for(i in 1:length(matrices_dropdown)){ +for(i in 1:base::length(matrices_dropdown)){ - if(file.exists(paste0(subOutDir, "/", paste0(matrices_dropdown[i], "/", matrices_dropdown[i],"_names"), ".rds"))){ + if(base::file.exists(base::paste0(subOutDir, "/", base::paste0(matrices_dropdown[i], "/", matrices_dropdown[i],"_names"), ".rds"))){ - assign(paste0(matrices_dropdown[i], "_dropdown"), readRDS(paste0(subOutDir, "/", paste0(matrices_dropdown[i], "/", matrices_dropdown[i],"_names"), ".rds"))) + base::assign(base::paste0(matrices_dropdown[i], "_dropdown"), base::readRDS(base::paste0(subOutDir, "/", base::paste0(matrices_dropdown[i], "/", matrices_dropdown[i],"_names"), ".rds"))) } } -embed_legend = readRDS(paste0(subOutDir, "/embed_legend_names.rds")) -color_embeddings = readRDS(paste0(subOutDir, "/embed_color.rds")) +embed_legend = base::readRDS(base::paste0(subOutDir, "/embed_legend_names.rds")) +color_embeddings = base::readRDS(base::paste0(subOutDir, "/embed_color.rds")) # define a function to get the EMBED for a feature/gene getEMBEDplotWithCol<-function(gene,EMBEDList,scaffoldName,matrixType) { gene_plot=EMBEDList[[gene]] - p_template1=readRDS(paste0(subOutDir, "/" ,scaffoldName,".rds")) + p_template1=base::readRDS(base::paste0(subOutDir, "/" ,scaffoldName,".rds")) p_template1$scales$scales <- gene_plot$scale - title=paste("EMBED of IterativeLSI colored by\n",matrixType," : ",sep="") + title=base::paste("EMBED of IterativeLSI colored by\n",matrixType," : ",sep="") - p_template1$labels$title <- paste0(title, gene) + p_template1$labels$title <- base::paste0(title, gene) return(p_template1) } @@ -92,11 +95,11 @@ getEMBEDplotWithCol<-function(gene,EMBEDList,scaffoldName,matrixType) getEMBED<-function(gene,fileIndexer,folderName,scaffoldName,matrixType) { # getFilename - for(file in names(fileIndexer)) + for(file in base::names(fileIndexer)) { if(gene %in% fileIndexer[[file]]) { - EMBEDs_data_subset=readRDS(paste(paste0(subOutDir, "/" ,folderName),file,sep="/")) + EMBEDs_data_subset=base::readRDS(base::paste(base::paste0(subOutDir, "/" ,folderName),file,sep="/")) return(getEMBEDplotWithCol(gene,EMBEDs_data_subset,scaffoldName,matrixType)) } @@ -106,6 +109,6 @@ getEMBED<-function(gene,fileIndexer,folderName,scaffoldName,matrixType) # PlotBrowser ------------------------------------------------------------------ # create a list of dropdown options for plotbroswer tab -gene_names=readRDS(paste0(subOutDir, "/GeneScoreMatrix/GeneScoreMatrix_names.rds")) +gene_names=base::readRDS(base::paste0(subOutDir, "/GeneScoreMatrix/GeneScoreMatrix_names.rds")) diff --git a/Shiny/server.R b/Shiny/server.R index 018ee7a3..6fff4da7 100644 --- a/Shiny/server.R +++ b/Shiny/server.R @@ -4,134 +4,134 @@ shinyServer <- function(input,output, session){ # EMBEDS ------------------------------------------------------------------------------------ - plot1 <- reactive({ + plot1 <- shiny::reactive({ # availableMatrices <- getAvailableMatrices(ArchRProj) if(input$matrix_EMBED1_forComparison %in% availableMatrices){ mat <- availableMatrices[ availableMatrices %in% input$matrix_EMBED1_forComparison] - p_empty <- ggplot() + - xlab("Dimension 1") + ylab("Dimension 2") + theme_bw(base_size=10)+ - ggtitle(paste0("EMBED of IterativeLSI colored by \n", mat,": ",input$EMBED1_forComparison)) + - theme( - panel.background = element_rect(fill='transparent'), #transparent panel bg - plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg - panel.grid.major = element_blank(), #remove major gridlines - panel.grid.minor = element_blank(), #remove minor gridlines - legend.background = element_rect(fill='transparent'), #transparent legend bg - legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), - plot.title = element_text(size=16) + p_empty <- ggplot2::ggplot() + + ggplot2::xlab("Dimension 1") + ggplot2::ylab("Dimension 2") + ggplot2::theme_bw(base_size=10)+ + ggplot2::ggtitle(base::paste0("EMBED of IterativeLSI colored by \n", mat,": ",input$EMBED1_forComparison)) + + ggplot2::theme( + panel.background = ggplot2::element_rect(fill='transparent'), #transparent panel bg + plot.background = ggplot2::element_rect(fill='transparent', color=NA), #transparent plot bg + panel.grid.major = ggplot2::element_blank(), #remove major gridlines + panel.grid.minor = ggplot2::element_blank(), #remove minor gridlines + legend.background = ggplot2::element_rect(fill='transparent'), #transparent legend bg + legend.box.background = ggplot2::element_rect(fill='transparent'), axis.title=ggplot2::element_text(size=14), + plot.title = ggplot2::element_text(size=16) ) - emptyPlot(0,0, axes=FALSE) - legend_plot <- gradientLegend(valRange=c(scale()[[mat]][,input$EMBED1_forComparison][1],scale()[[mat]][,input$EMBED1_forComparison][2]), - color = color()[[mat]], pos=.5, side=1) + plotfunctions::emptyPlot(0,0, axes=FALSE) + legend_plot <- plotfunctions::gradientLegend(valRange=base::c(base::scale()[[mat]][,input$EMBED1_forComparison][1],base::scale()[[mat]][,input$EMBED1_forComparison][2]), + color = raster::color()[[mat]], pos=.5, side=1) - p <- h5read(paste0(subOutDir,"/",mat,"_plotBlank72.h5"), paste0(mat, "/", input$EMBED1_forComparison)) - temp_jpg <- t(matrix(decode_native(p), nrow = 216)) + p <- rhdf5::h5read(paste0(subOutDir,"/",mat,"_plotBlank72.h5"), base::paste0(mat, "/", input$EMBED1_forComparison)) + temp_jpg <- t(base::matrix(farver::decode_native(p), nrow = 216)) - last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + - draw_plot(p_empty, scale = 0.8) + - draw_text("Log2(+1)", x = 0.35, y = 0.05, size = 12) + last_plot <- cowplot::ggdraw() + cowplot::draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + + cowplot::draw_plot(p_empty, scale = 0.8) + + cowplot::draw_text("Log2(+1)", x = 0.35, y = 0.05, size = 12) - print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) + base::print(last_plot, vp=grid::viewport(0.5, 0.6, 1, 1)) }else{ - p_empty <- ggplot() + - xlab("Dimension 1") + ylab("Dimension 2") + theme_bw(base_size=10)+ - ggtitle(input$matrix_EMBED1_forComparison) + - theme( - panel.background = element_rect(fill='transparent'), #transparent panel bg - plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg - panel.grid.major = element_blank(), #remove major gridlines - panel.grid.minor = element_blank(), #remove minor gridlines - legend.background = element_rect(fill='transparent'), #transparent legend bg - legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), - plot.title = element_text(size=16) + p_empty <- ggplot2::ggplot() + + ggplot2::xlab("Dimension 1") + ggplot2::ylab("Dimension 2") + ggplot2::theme_bw(base_size=10)+ + ggplot2::ggtitle(input$matrix_EMBED1_forComparison) + + ggplot2::theme( + panel.background = ggplot2::element_rect(fill='transparent'), #transparent panel bg + plot.background = ggplot2::element_rect(fill='transparent', color=NA), #transparent plot bg + panel.grid.major = ggplot2::element_blank(), #remove major gridlines + panel.grid.minor = ggplot2::element_blank(), #remove minor gridlines + legend.background = ggplot2::element_rect(fill='transparent'), #transparent legend bg + legend.box.background = ggplot2::element_rect(fill='transparent'), axis.title=ggplot2::element_text(size=14), + plot.title = ggplot2::element_text(size=16) ) - emptyPlot(0,0, axes=FALSE) + plotfunctions::emptyPlot(0,0, axes=FALSE) - legend('bottom', legend=embed_legend[[1]], + graphics::legend('bottom', legend=embed_legend[[1]], pch=15, col = color_embeddings[[1]], horiz = FALSE, x.intersp = 1, text.width=0.35, cex = 0.7, bty="n", ncol = 4) - p <- h5read(paste0(subOutDir,"/mainEmbeds.h5"), input$matrix_EMBED1_forComparison)# input$EMBED1_forComparison)) - temp_jpg <- t(matrix(decode_native(p), nrow = 216)) + p <- rhdf5::h5read(base::paste0(subOutDir,"/mainEmbeds.h5"), input$matrix_EMBED1_forComparison)# input$EMBED1_forComparison)) + temp_jpg <- t(base::matrix(farver::decode_native(p), nrow = 216)) - last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.7) + - draw_plot(p_empty, scale = 0.7) + - draw_text("color", x = 0.1, y = 0.135, size = 12) + last_plot <- cowplot::ggdraw() + cowplot::draw_image(temp_jpg, x = 0, y = 0, scale = 0.7) + + cowplot::draw_plot(p_empty, scale = 0.7) + + cowplot::draw_text("color", x = 0.1, y = 0.135, size = 12) - print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) + base::print(last_plot, vp=grid::viewport(0.5, 0.6, 1, 1)) } }) - plot2 <- reactive({ + plot2 <- shiny::reactive({ # availableMatrices <- getAvailableMatrices(ArchRProj) if(input$matrix_EMBED2_forComparison %in% availableMatrices){ mat <- availableMatrices[ availableMatrices %in% input$matrix_EMBED2_forComparison] - p_empty <- ggplot() + - xlab("Dimension 1") + ylab("Dimension 2") + theme_bw(base_size=10)+ - ggtitle(paste0("EMBED of IterativeLSI colored by \n", mat,": ",input$EMBED2_forComparison)) + - theme( - panel.background = element_rect(fill='transparent'), #transparent panel bg - plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg - panel.grid.major = element_blank(), #remove major gridlines - panel.grid.minor = element_blank(), #remove minor gridlines - legend.background = element_rect(fill='transparent'), #transparent legend bg - legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), - plot.title = element_text(size=16) + p_empty <- ggplot2::ggplot() + + ggplot2::xlab("Dimension 1") + ggplot2::ylab("Dimension 2") + ggplot2::theme_bw(base_size=10)+ + ggplot2::ggtitle(base::paste0("EMBED of IterativeLSI colored by \n", mat,": ",input$EMBED2_forComparison)) + + ggplot2::theme( + panel.background = ggplot2::element_rect(fill='transparent'), #transparent panel bg + plot.background = ggplot2::element_rect(fill='transparent', color=NA), #transparent plot bg + panel.grid.major = ggplot2::element_blank(), #remove major gridlines + panel.grid.minor = ggplot2::element_blank(), #remove minor gridlines + legend.background = ggplot2::element_rect(fill='transparent'), #transparent legend bg + legend.box.background = ggplot2::element_rect(fill='transparent'), axis.title=ggplot2::element_text(size=14), + plot.title = ggplot2::element_text(size=16) ) - emptyPlot(0,0, axes=FALSE) - legend_plot <- gradientLegend(valRange=c(scale()[[mat]][,input$EMBED2_forComparison][1],scale()[[mat]][,input$EMBED2_forComparison][2]), - color = color()[[mat]], pos=.5, side=1) + plotfunctions::emptyPlot(0,0, axes=FALSE) + legend_plot <- plotfunctions::gradientLegend(valRange=base::c(base::scale()[[mat]][,input$EMBED2_forComparison][1],base::scale()[[mat]][,input$EMBED2_forComparison][2]), + color = raster::color()[[mat]], pos=.5, side=1) - p <- h5read(paste0(subOutDir,"/",mat,"_plotBlank72.h5"), paste0(mat, "/", input$EMBED2_forComparison)) - temp_jpg <- t(matrix(decode_native(p), nrow = 216)) - last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + - draw_plot(p_empty, scale = 0.8) + - draw_text("Log2(+1)", x = 0.35, y = 0.05, size = 12) + p <- h5read(base::paste0(subOutDir,"/",mat,"_plotBlank72.h5"), base::paste0(mat, "/", input$EMBED2_forComparison)) + temp_jpg <- t(base::matrix(farver::decode_native(p), nrow = 216)) + last_plot <- cowplot::ggdraw() + cowplot::draw_image(temp_jpg, x = 0, y = 0, scale = 0.85) + + cowplot::draw_plot(p_empty, scale = 0.8) + + cowplot::draw_text("Log2(+1)", x = 0.35, y = 0.05, size = 12) - print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) + base::print(last_plot, vp=grid::viewport(0.5, 0.6, 1, 1)) }else{ - p_empty <- ggplot() + - xlab("Dimension 1") + ylab("Dimension 2") + theme_bw(base_size=10)+ - ggtitle(input$matrix_EMBED2_forComparison) + - theme( - panel.background = element_rect(fill='transparent'), #transparent panel bg - plot.background = element_rect(fill='transparent', color=NA), #transparent plot bg - panel.grid.major = element_blank(), #remove major gridlines - panel.grid.minor = element_blank(), #remove minor gridlines - legend.background = element_rect(fill='transparent'), #transparent legend bg - legend.box.background = element_rect(fill='transparent'), axis.title=element_text(size=14), - plot.title = element_text(size=16) + p_empty <- ggplot2::ggplot() + + ggplot2::xlab("Dimension 1") + ggplot2::ylab("Dimension 2") + ggplot2::theme_bw(base_size=10)+ + ggplot2::ggtitle(input$matrix_EMBED2_forComparison) + + ggplot2::theme( + panel.background = ggplot2::element_rect(fill='transparent'), #transparent panel bg + plot.background = ggplot2::element_rect(fill='transparent', color=NA), #transparent plot bg + panel.grid.major = ggplot2::element_blank(), #remove major gridlines + panel.grid.minor = ggplot2::element_blank(), #remove minor gridlines + legend.background = ggplot2::element_rect(fill='transparent'), #transparent legend bg + legend.box.background = ggplot2::element_rect(fill='transparent'), axis.title=ggplot2::element_text(size=14), + plot.title = ggplot2::element_text(size=16) ) - emptyPlot(0,0, axes=FALSE) + plotfunctions::emptyPlot(0,0, axes=FALSE) legend('bottom', legend=embed_legend[[1]], pch=15, col = color_embeddings[[1]], horiz = FALSE, x.intersp = 1, text.width=0.35, cex = 0.7, bty="n", ncol = 4) - p <- h5read(paste0(subOutDir,"/mainEmbeds.h5"), input$matrix_EMBED2_forComparison)# input$EMBED2_forComparison)) - temp_jpg <- t(matrix(decode_native(p), nrow = 216)) + p <- h5read(base::paste0(subOutDir,"/mainEmbeds.h5"), input$matrix_EMBED2_forComparison)# input$EMBED2_forComparison)) + temp_jpg <- t(base::matrix(farver::decode_native(p), nrow = 216)) - last_plot <- ggdraw() + draw_image(temp_jpg, x = 0, y = 0, scale = 0.7) + - draw_plot(p_empty, scale = 0.7) + - draw_text("color", x = 0.1, y = 0.135, size = 12) + last_plot <- cowplot::ggdraw() + cowplot::draw_image(temp_jpg, x = 0, y = 0, scale = 0.7) + + cowplot::draw_plot(p_empty, scale = 0.7) + + cowplot::draw_text("color", x = 0.1, y = 0.135, size = 12) - print(last_plot, vp=viewport(0.5, 0.6, 1, 1)) + base::print(last_plot, vp=grid::viewport(0.5, 0.6, 1, 1)) } @@ -139,66 +139,66 @@ shinyServer <- function(input,output, session){ #Output Handler: Downloads EMBEDS - output$download_EMBED1<-downloadHandler( + output$download_EMBED1 <- shiny::downloadHandler( filename <- function(){ - paste0("EMBED-",paste(input$matrix_EMBED1_forComparison,input$EMBED1_forComparison,sep="-"),input$plot_choice_download_EMBED1) + base::paste0("EMBED-",base::paste(input$matrix_EMBED1_forComparison,input$EMBED1_forComparison,sep="-"),input$plot_choice_download_EMBED1) }, content = function(file){ if(input$plot_choice_download_EMBED1==".pdf") - {pdf(file = file,onefile=FALSE, width = input$EMBED1_plot_width, height = input$EMBED1_plot_height)} + {grDevices::pdf(file = file,onefile=FALSE, width = input$EMBED1_plot_width, height = input$EMBED1_plot_height)} else if(input$plot_choice_download_EMBED1==".png") - {png(file = file, width = input$EMBED1_plot_width, height = input$EMBED1_plot_height,units="in",res=1000)} + {grDevices::png(file = file, width = input$EMBED1_plot_width, height = input$EMBED1_plot_height,units="in",res=1000)} else - {tiff(file = file, width = input$EMBED1_plot_width, height = input$EMBED1_plot_height,units="in",res=1000)} + {grDevices::tiff(file = file, width = input$EMBED1_plot_width, height = input$EMBED1_plot_height,units="in",res=1000)} plot1 = plot1() - grid.arrange(plot1) - dev.off() + gridExtra::grid.arrange(plot1) + grDevices::dev.off() } ) - output$download_EMBED2<-downloadHandler( + output$download_EMBED2 <- shiny::downloadHandler( filename <- function(){ - paste0("EMBED-",paste(input$matrix_EMBED2_forComparison,input$EMBED2_forComparison,sep="-"),input$plot_choice_download_EMBED2) + base::paste0("EMBED-",base::paste(input$matrix_EMBED2_forComparison,input$EMBED2_forComparison,sep="-"),input$plot_choice_download_EMBED2) }, content = function(file){ if(input$plot_choice_download_EMBED2==".pdf") - {pdf(file = file,onefile=FALSE, width = input$EMBED2_plot_width, height = input$EMBED2_plot_height)} + {grDevices::pdf(file = file,onefile=FALSE, width = input$EMBED2_plot_width, height = input$EMBED2_plot_height)} else if(input$plot_choice_download_EMBED2==".png") - {png(file = file, width = input$EMBED2_plot_width, height = input$EMBED2_plot_height,units="in",res=1000)} + {grDevices::png(file = file, width = input$EMBED2_plot_width, height = input$EMBED2_plot_height,units="in",res=1000)} else - {tiff(file = file, width = input$EMBED2_plot_width, height = input$EMBED2_plot_height,units="in",res=1000)} + {grDevices::tiff(file = file, width = input$EMBED2_plot_width, height = input$EMBED2_plot_height,units="in",res=1000)} plot2 <- plot2() - grid.arrange(plot2) - dev.off() + gridExtra::grid.arrange(plot2) + grDevices::dev.off() } ) output$EMBED_plot_1 <- DT::renderDT(NULL) output$EMBED_plot_2 <- DT::renderDT(NULL) - color <- reactive({readRDS(paste0(subOutDir,"/pal.rds"))}) - scale <- reactive({readRDS(paste0(subOutDir,"/scale.rds"))}) + color <- shiny::reactive({base::readRDS(base::paste0(subOutDir,"/pal.rds"))}) + scale <- shiny::reactive({base::readRDS(base::paste0(subOutDir,"/scale.rds"))}) #plot EMBED1 - output$EMBED_plot_1<- renderPlot({ + output$EMBED_plot_1<- shiny::renderPlot({ plot1() }, height = 450,width=450) # #plot EMBED2 - output$EMBED_plot_2<- renderPlot({ + output$EMBED_plot_2<- shiny::renderPlot({ plot2() @@ -207,171 +207,171 @@ shinyServer <- function(input,output, session){ #update EMBED dropdown based on selected Matrix-------------------------------- #Update dropdown for EMBED1 - featureNames1 <- reactive({ + featureNames1 <- shiny::reactive({ if(!(input$matrix_EMBED1_forComparison %in% groupBy)){ # availableMatrices <- getAvailableMatrices(ArchRProj) matName <- availableMatrices[ availableMatrices %in% input$matrix_EMBED1_forComparison] - featureNames <- h5read(file = paste0(subOutDir, "/", matName, "_plotBlank72.h5"), + featureNames <- rhdf5::h5read(file = base::paste0(subOutDir, "/", matName, "_plotBlank72.h5"), name = matName) - Feature_dropdown1 = names(featureNames) + Feature_dropdown1 = base::names(featureNames) return(Feature_dropdown1) } }) - observeEvent(input$matrix_EMBED1_forComparison,{ + shiny::observeEvent(input$matrix_EMBED1_forComparison,{ if(!(input$matrix_EMBED1_forComparison %in% groupBy)){ - updateSelectizeInput(session, 'EMBED1_forComparison', label = 'Feature Name', - choices = sort(featureNames1()), - server = TRUE,selected =sort(featureNames1())[1]) + shiny::updateSelectizeInput(session, 'EMBED1_forComparison', label = 'Feature Name', + choices = base::sort(featureNames1()), + server = TRUE, selected = base::sort(featureNames1())[1]) } }) # }) - featureNames2 <- reactive({ + featureNames2 <- shiny::reactive({ if(!(input$matrix_EMBED2_forComparison %in% groupBy)){ # availableMatrices <- getAvailableMatrices(ArchRProj) matName <- availableMatrices[ availableMatrices %in% input$matrix_EMBED2_forComparison] - featureNames <- h5read(file = paste0(subOutDir, "/", matName, "_plotBlank72.h5"), + featureNames <- rdhf5::h5read(file = base::paste0(subOutDir, "/", matName, "_plotBlank72.h5"), name = matName) - Feature_dropdown2 = names(featureNames) + Feature_dropdown2 = base::names(featureNames) return(Feature_dropdown2) } }) - observeEvent(input$matrix_EMBED2_forComparison,{ + shiny::observeEvent(input$matrix_EMBED2_forComparison,{ if(!(input$matrix_EMBED2_forComparison %in% groupBy)){ - updateSelectizeInput(session, 'EMBED2_forComparison', label = 'Feature Name', - choices = sort(featureNames2()), - server = TRUE,selected =sort(featureNames2())[1]) + shiny::updateSelectizeInput(session, 'EMBED2_forComparison', label = 'Feature Name', + choices = base::sort(featureNames2()), + server = TRUE, selected = base::sort(featureNames2())[1]) } }) #Update dropdown for EMBED2 - # observeEvent(input$matrix_EMBED2_forComparison,{ - # if(isolate(input$matrix_EMBED2_forComparison)=="Motif Matrix") + # shiny::observeEvent(input$matrix_EMBED2_forComparison,{ + # if(shiny::isolate(input$matrix_EMBED2_forComparison)=="Motif Matrix") # { - # - # updateSelectizeInput(session, 'EMBED2_forComparison', label = 'Feature Name', - # choices = sort(MM_dropdown), - # server = TRUE,selected =sort(MM_dropdown)[2]) + + # shiny::updateSelectizeInput(session, 'EMBED2_forComparison', label = 'Feature Name', + # choices = base::sort(MM_dropdown), + # server = TRUE, selected = base::sort(MM_dropdown)[2]) # } - # - # else if(isolate(input$matrix_EMBED2_forComparison)=="Gene Score Matrix") + + # else if(shiny::isolate(input$matrix_EMBED2_forComparison)=="Gene Score Matrix") # { - # updateSelectizeInput(session, 'EMBED2_forComparison', label = 'Feature Name', - # choices = sort(GSM_dropdown), - # server = TRUE,selected =sort(GSM_dropdown)[2]) + # shiny::updateSelectizeInput(session, 'EMBED2_forComparison', label = 'Feature Name', + # choices = base::sort(GSM_dropdown), + # server = TRUE, selected = base::sort(GSM_dropdown)[2]) # } - # else if(isolate(input$matrix_EMBED2_forComparison)=="Gene Integration Matrix") + # else if(shiny::isolate(input$matrix_EMBED2_forComparison)=="Gene Integration Matrix") # { - # - # updateSelectizeInput(session, 'EMBED2_forComparison', label = 'Feature Name', - # choices = sort(GIM_dropdown), - # server = TRUE,selected =sort(GIM_dropdown)[2]) + + # shiny::updateSelectizeInput(session, 'EMBED2_forComparison', label = 'Feature Name', + # choices = base::sort(GIM_dropdown), + # server = TRUE,selected = base::sort(GIM_dropdown)[2]) # } - # + # }) # Plot Browser ---------------------------------------------------------------- # Observe the inputs for ATAC-Seq Explorer - observeEvent(input$range_min, { - updateSliderInput(session, "range", - value = c(input$range_min,max(input$range))) + shiny::observeEvent(input$range_min, { + shiny::updateSliderInput(session, "range", + value = base::c(input$range_min, base::max(input$range))) }) - observeEvent(input$range_max, { - updateSliderInput(session, "range", - value = c(input$range_min,input$range_max)) + shiny::observeEvent(input$range_max, { + shiny::updateSliderInput(session, "range", + value = base::c(input$range_min,input$range_max)) }) - observeEvent(input$range , { + shiny::observeEvent(input$range , { - updateNumericInput(session, "range_min", value = min(input$range)) - updateNumericInput(session, "range_max", value = max(input$range)) + shiny::updateNumericInput(session, "range_min", value = base::min(input$range)) + shiny::updateNumericInput(session, "range_max", value = base::max(input$range)) }, priority = 200) # Output Handler:downloads file - output$down<-downloadHandler( + output$down <- shiny::downloadHandler( filename <- function(){ - paste0("ArchRBrowser-",input$gene_name,input$plot_choice_download_peakBrowser) + base::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)} + {grDevices::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)} + {grDevices::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)} + {grDevices::tiff(file = file, width = input$plot_width, height = input$plot_height,units="in",res=1000)} - p_browser_atacClusters<- plotBrowserTrack( + p_browser_atacClusters<- ArchR::plotBrowserTrack( ArchRProj = ArchRProj, ShinyArchR = TRUE, - plotSummary = c("bulkTrack", input$selectPlotSummary), + plotSummary = base::c("bulkTrack", input$selectPlotSummary), baseSize = 11, facetbaseSize = 11, groupBy = input$browserContent, - geneSymbol = isolate(input$gene_name), - 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(ArchRProj) + geneSymbol = shiny::isolate(input$gene_name), + upstream = -base::min(shiny::isolate(input$range))*1000, + downstream = base::max(shiny::isolate(input$range))*1000, + tileSize = shiny::isolate(input$tile_size), + ylim = base::c(0, shiny::isolate(input$ymax)), + loops = ArchR::getCoAccessibility(ArchRProj) )[[input$gene_name]] - grid.arrange(p_browser_atacClusters) + gridExtra::grid.arrange(p_browser_atacClusters) - dev.off() + grDevices::dev.off() } ) output$browser_atacClusters <- DT::renderDT(NULL) #handles error - restartFN <- observeEvent(input$restartButton, { - 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() - print(p) + restartFN <- shiny::observeEvent(input$restartButton, { + if (shiny::isolate(input$gene_name) == ""){ + + output$browser_atacClusters <- shiny::renderPlot({ + p <- ggplot2::ggplot() + + ggplot2::xlim(base::c(-5,5)) + ggplot2::ylim(base::c(-5,5)) + + ggplot2::geom_text(size=20, ggplot2::aes(x = 0, y = 0, label = "Please supply\na valid gene name!")) + ggplot2::theme_void() + base::print(p) }) }else{ # Plots scATACSeq clusters - output$browser_atacClusters<- renderPlot({ + output$browser_atacClusters<- shiny::renderPlot({ grid::grid.newpage() - p_browser_atacClusters<- plotBrowserTrack( + p_browser_atacClusters<- ArchR::plotBrowserTrack( ArchRProj = ArchRProj, ShinyArchR = TRUE, - plotSummary = c("bulkTrack", input$selectPlotSummary), + plotSummary = base::c("bulkTrack", input$selectPlotSummary), baseSize = 11, facetbaseSize = 11, groupBy = input$browserContent, - geneSymbol = isolate(input$gene_name), - 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(ArchRProj) + geneSymbol = shiny::isolate(input$gene_name), + upstream = -base::min(shiny::isolate(input$range))*1000, + downstream = base::max(shiny::isolate(input$range))*1000, + tileSize = shiny::isolate(input$tile_size), + ylim = base::c(0, shiny::isolate(input$ymax)), + loops = ArchR::getCoAccessibility(ArchRProj) )[[input$gene_name]] diff --git a/Shiny/ui.R b/Shiny/ui.R index f8826be0..1df142a4 100644 --- a/Shiny/ui.R +++ b/Shiny/ui.R @@ -3,57 +3,57 @@ library(shinybusy) # This file contains UI widgets. # EMBEDING plotting ---------------------------------------------------------------------- -EMBED_panel <- tabPanel(id="EMBED_panel", +EMBED_panel <- shiny::tabPanel(id="EMBED_panel", - titlePanel(h5("scClusters")), - sidebarPanel( - titlePanel(h3('EMBEDDING 1', align = 'center')), + shiny::titlePanel(htmltools::h5("scClusters")), + shiny::sidebarPanel( + shiny::titlePanel(htmltools::h3('EMBEDDING 1', align = 'center')), width = 3, - h4(''), - hr(style = "border-color: grey"), + htmltools::h4(''), + htmltools::hr(style = "border-color: grey"), - selectizeInput( + shiny::selectizeInput( 'matrix_EMBED1_forComparison', label = 'EMBEDDING type', - choices = c(EMBEDs_dropdown, matrices_dropdown), + choices = base::c(EMBEDs_dropdown, matrices_dropdown), selected = NULL ), - conditionalPanel( + shiny::conditionalPanel( condition = '!(input.matrix_EMBED1_forComparison %in% EMBEDs_dropdown)', - selectizeInput( + shiny::selectizeInput( 'EMBED1_forComparison', label = 'EMBEDDING 1', choices = "", selected = NULL )), - splitLayout(cellWidths = c("30%","30%","40%"), - numericInput("EMBED1_plot_width", "Width", min = 0, max = 250, value = 8), - numericInput("EMBED1_plot_height", "Height", min = 0, max = 250, value = 12), - selectizeInput( + shiny::splitLayout(cellWidths = c("30%","30%","40%"), + shiny::numericInput("EMBED1_plot_width", "Width", min = 0, max = 250, value = 8), + shiny::numericInput("EMBED1_plot_height", "Height", min = 0, max = 250, value = 12), + shiny::selectizeInput( 'plot_choice_download_EMBED1', label = "Format", choices = c(".pdf",".png",".tiff"), selected = ".pdf"), - tags$head(tags$style(HTML(" + tags$head(tags$style(htmltools::HTML(" .shiny-split-layout > div { overflow: visible;}"))) ), - downloadButton(outputId = "download_EMBED1", label = "Download EMBEDDING 1"), + shiny::downloadButton(outputId = "download_EMBED1", label = "Download EMBEDDING 1"), - titlePanel(h3('EMBEDDING 2', align = 'center')), - hr(style = "border-color: grey"), - selectizeInput( + shiny::titlePanel(htmltools::h3('EMBEDDING 2', align = 'center')), + htmltools::hr(style = "border-color: grey"), + shiny::selectizeInput( 'matrix_EMBED2_forComparison', label = 'EMBEDDING type', - choices = c(EMBEDs_dropdown, matrices_dropdown), + choices = base::c(EMBEDs_dropdown, matrices_dropdown), selected =NULL ), - conditionalPanel(condition = '!(input.matrix_EMBED2_forComparison %in% EMBEDs_dropdown)', - selectizeInput( + shiny::conditionalPanel(condition = '!(input.matrix_EMBED2_forComparison %in% EMBEDs_dropdown)', + shiny::selectizeInput( 'EMBED2_forComparison', label = 'EMBEDDING 2', choices ="", @@ -61,116 +61,116 @@ EMBED_panel <- tabPanel(id="EMBED_panel", )), - splitLayout(cellWidths = c("30%","30%","40%"), - numericInput("EMBED2_plot_width", "Width", min = 0, max = 250, value = 8), - numericInput("EMBED2_plot_height", "Height", min = 0, max = 250, value = 12), - selectizeInput( + shiny::splitLayout(cellWidths = c("30%","30%","40%"), + shiny::numericInput("EMBED2_plot_width", "Width", min = 0, max = 250, value = 8), + shiny::numericInput("EMBED2_plot_height", "Height", min = 0, max = 250, value = 12), + shiny::selectizeInput( 'plot_choice_download_EMBED2', label = "Format", - choices = c(".pdf",".png",".tiff"), + choices = base::c(".pdf",".png",".tiff"), selected = ".pdf"), - tags$head(tags$style(HTML(" + tags$head(tags$style(htmltools::HTML(" .shiny-split-layout > div { overflow: visible;}"))) ), - downloadButton(outputId = "download_EMBED2", label = "Download EMBEDDING 2"), + shiny::downloadButton(outputId = "download_EMBED2", label = "Download EMBEDDING 2"), ), - mainPanel( - verbatimTextOutput("feat"), - verbatimTextOutput("text"), - fluidRow(h5("Dimension Reduction scClusters EMBEDs" + shiny::mainPanel( + shiny::verbatimTextOutput("feat"), + shiny::verbatimTextOutput("text"), + shiny::fluidRow(htmltools::h5("Dimension Reduction scClusters EMBEDs" )), - fluidRow(helpText("Users can view and compare side-by-side EMBEDs' representing identified scATAC-seq clusters, + shiny::fluidRow(shiny::helpText("Users can view and compare side-by-side EMBEDs' 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("EMBED_plot_1")), ##%>% withSpinner(color="#0dc5c1") - column(6,plotOutput("EMBED_plot_2")) + shiny::fluidRow( + shiny::column(6,shiny::plotOutput("EMBED_plot_1")), ##%>% withSpinner(color="#0dc5c1") + shiny::column(6,shiny::plotOutput("EMBED_plot_2")) ) ) ) # Plot Browser:scATAC Clusters -------------------------------------------------------- -scATACbrowser_panel <- tabPanel( +scATACbrowser_panel <- shiny::tabPanel( - titlePanel(h5("scATAC-seq peak browser")), + shiny::titlePanel(htmltools::h5("scATAC-seq peak browser")), - sidebarPanel( - titlePanel(h5('Gene Name', align = 'center')), + shiny::sidebarPanel( + shiny::titlePanel(htmltools::h5('Gene Name', align = 'center')), width = 3, - h4(''), - hr(style = "border-color: grey"), + htmltools::h4(''), + htmltools::hr(style = "border-color: grey"), - actionButton(inputId = "restartButton", label = "Plot Track", icon = icon("play-circle")), + shiny::actionButton(inputId = "restartButton", label = "Plot Track", icon = shiny::icon("play-circle")), - checkboxGroupInput(inputId = "selectPlotSummary", label = "Select track plots", + shiny::checkboxGroupInput(inputId = "selectPlotSummary", label = "Select track plots", choices = c("Feature" = "featureTrack", "Loop" = "loopTrack", "Gene" = "geneTrack"), selected = c("featureTrack", "loopTrack", "geneTrack"), inline = TRUE), - selectizeInput( + shiny::selectizeInput( 'browserContent', label = 'Type', choices = EMBEDs_dropdown, selected = EMBEDs_dropdown[1] ), - selectizeInput( + shiny::selectizeInput( 'gene_name', label = 'Gene Name', - choices = sort(gene_names), - selected = sort(sort(gene_names))[1] + choices = base::sort(gene_names), + selected = base::sort(base::sort(gene_names))[1] ), - 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) + shiny::sliderInput("range", "Distance From Center (kb):", min = -250, max = 250, value = c(-50,50)), + shiny::splitLayout(cellWidths = c("50%","50%"), + shiny::numericInput("range_min", "Distance (-kb):", min = -250, max = 250, value = -50), + shiny::numericInput("range_max", "Distance (+kb):", min = -250, max = 250, value = 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) + shiny::splitLayout(cellWidths = c("50%","50%"), + shiny::numericInput("tile_size", "TileSize:", min = 10, max = 5000, value = 250), + shiny::numericInput("ymax", "Y-Max (0,1):", min = 0, max = 1, value = 0.99) ), - hr(style = "border-color: grey"), + htmltools::hr(style = "border-color: grey"), - 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( + shiny::splitLayout(cellWidths = c("30%","30%","40%"), + shiny::numericInput("plot_width", "Width", min = 0, max = 250, value = 8), + shiny::numericInput("plot_height", "Height", min = 0, max = 250, value = 12), + shiny::selectizeInput( 'plot_choice_download_peakBrowser', label = "Format", choices = c(".pdf",".png",".tiff"), selected = ".pdf"), - tags$head(tags$style(HTML(" + tags$head(tags$style(htmltools::HTML(" .shiny-split-layout > div { overflow: visible;}"))) ), - downloadButton(outputId = "down", label = "Download"), + shiny::downloadButton(outputId = "down", label = "Download"), ), - mainPanel(fluidRow(h5("Peak browser of scATAC-seq clusters" + shiny::mainPanel(shiny::fluidRow(htmltools::h5("Peak browser of scATAC-seq clusters" )), - plotOutput("browser_atacClusters") + shiny::plotOutput("browser_atacClusters") ) ) -ui <- shinyUI(fluidPage( - add_busy_spinner(spin = "radar", color = "#CCCCCC", onstart = TRUE, height = "55px", width = "55px"), +ui <- shiny::shinyUI(shiny::fluidPage( + shinybusy::add_busy_spinner(spin = "radar", color = "#CCCCCC", onstart = TRUE, height = "55px", width = "55px"), - navbarPage( + shiny::navbarPage( EMBED_panel, scATACbrowser_panel, title ="ShinyArchR Export", tags$head(tags$style(".shiny-output-error{color: grey;}")) ), - tags$footer(HTML("

This webpage was made using ArchR Browser.

"), + tags$footer(htmltools::HTML("

This webpage was made using ArchR Browser.

"), align = "left", style = " position:relative; bottom:0; From 18fb6c616f13d80276e916f0e9c1fe1f78331d7f Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Fri, 17 Mar 2023 09:50:35 -0700 Subject: [PATCH 124/162] update file download links --- R/ShinyArchRExports.R | 47 ++++++++++++++++++++++--------------------- 1 file changed, 24 insertions(+), 23 deletions(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 1fb38880..2c43656a 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -89,22 +89,23 @@ exportShinyArchR <- function( dir.create(mainOutputDir, showWarnings = TRUE) ## Check the links for the files - # filesUrl <- data.frame( - # fileUrl = c( - # "https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/app.R", - # "https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/global.R", - # "https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/server.R", - # "https://jeffgranja.s3.amazonaws.com/ArchR/Shiny/ui.R" - # ), - # md5sum = c( - # "77502e1f195e21d2f7a4e8ac9c96e65e", - # "618613b486e4f8c0101f4c05c69723b0", - # "a8d5ae747841055ef230ba496bcfe937" - # ), - # stringsAsFactors = FALSE - # ) + filesUrl <- data.frame( + fileUrl = c( + "https://files.corces.gladstone.org/Users/rcorces/ArchR/Shiny/1.0.3/app.R", + "https://files.corces.gladstone.org/Users/rcorces/ArchR/Shiny/1.0.3/global.R", + "https://files.corces.gladstone.org/Users/rcorces/ArchR/Shiny/1.0.3/server.R", + "https://files.corces.gladstone.org/Users/rcorces/ArchR/Shiny/1.0.3/ui.R" + ), + md5sum = c( + "6453814565316d26a9c83bddebaf41d8", + "a07b98a777d374df3639f3c961585a47", + "faaf6665647e32e44f62320822868872", + "b34874b7d130dc88b579853e297c7e88" + ), + stringsAsFactors = FALSE + ) - # .downloadFiles(filesUrl = filesUrl, pathDownload = mainOutputDir, threads = threads) + .downloadFiles(filesUrl = filesUrl, pathDownload = mainOutputDir, threads = threads) }else{ message("Using existing Shiny files...") @@ -564,17 +565,17 @@ exportShinyArchR <- function( # embeds_min_max_list[[mat]] = embeds_min_max # embeds_pal_list[[mat]] = embeds_points[[length(embeds_points)]][[1]]$pal + }else{ + + message(mat,".rds file does not exist") + } + }else{ - - message(mat,".rds file does not exist") + message(mat,".rds file does not exist. This file should have been created previously be exportShinyArchR. Skipping...") } - - }else{ - message(mat,".rds file does not exist. This file should have been created previously be exportShinyArchR. Skipping...") + + } - - -} # nms = names(embeds_pal_list) From 8443d6d4a7f53a1abb0c736a921000d12bfdb9e0 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Fri, 17 Mar 2023 09:56:00 -0700 Subject: [PATCH 125/162] shouldnt need to source if ArchR is loaded Minimally, these file locations do not point to any files. but I also dont think these source statements should be necessary --- Shiny/global.R | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/Shiny/global.R b/Shiny/global.R index 4070f8fa..4775f7a8 100644 --- a/Shiny/global.R +++ b/Shiny/global.R @@ -10,6 +10,7 @@ library(plotfunctions) library(raster) library(jpeg) library(ArchR) +library(htmltools) #As best I can tell, these are not used explicitly. #Some are dependencies of ArchR already. Others not. @@ -34,9 +35,9 @@ for (i in base::seq_along(fn)) { }) } -base::source("AllClasses.R") -base::source("ArchRBrowser.R") -base::source("GgplotUtils.R") +# base::source("AllClasses.R") +# base::source("ArchRBrowser.R") +# base::source("GgplotUtils.R") # Calling ArchRProj From 2441acf6812dcc09d3edf5169bb6d35b9f9be1b2 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Fri, 17 Mar 2023 16:38:40 -0700 Subject: [PATCH 126/162] bugfixes --- R/ShinyArchRExports.R | 21 +++++++++++++++++++++ Shiny/global.R | 8 ++------ Shiny/server.R | 13 ++++++------- 3 files changed, 29 insertions(+), 13 deletions(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 2c43656a..1bdbae16 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -17,6 +17,27 @@ #' @param force A boolean value that indicates whether to overwrite any relevant files during the `exportShinyArchR()` process. #' @param threads The number of threads to use for parallel execution. #' @param logFile The path to a file to be used for logging ArchR output. +#' +#' @examples +#' +#' proj <- getTestProject(version = 2) +#' proj@geneAnnotation$genes <- proj@geneAnnotation$genes[which(proj@geneAnnotation$genes$symbol %in% c("CD14","CD3D","MS4A1","CD74"))] +#' proj <- addGeneScoreMatrix(input = proj, force = TRUE) +#' ArchR:::.dropGroupsFromArrow(ArrowFile = getArrowFiles(proj)[1], dropGroups = c("GeneIntegrationMatrix","MotifMatrix")) +#' proj <- addImputeWeights(proj) +#' +#' ArchR:::exportShinyArchR(ArchRProj = proj, +#' mainDir = "Shiny", +#' subOutDir = "inputData", +#' savedArchRProjFile = "Save-ArchR-Project.rds", +#' groupBy = "Clusters", +#' cellColEmbeddings = "Clusters", +#' embedding = "UMAP", +#' tileSize = 100, +#' force = FALSE, +#' threads = getArchRThreads(), +#' logFile = createLogFile("exportShinyArchR")) +#' #' @export exportShinyArchR <- function( ArchRProj = NULL, diff --git a/Shiny/global.R b/Shiny/global.R index 4775f7a8..2b850fae 100644 --- a/Shiny/global.R +++ b/Shiny/global.R @@ -1,5 +1,6 @@ # Setting up ---------------------------------------------------------------------- +library(shiny) library(ggplot2) library(gridExtra) library(grid) @@ -7,7 +8,6 @@ library(cowplot) library(farver) library(rhdf5) library(plotfunctions) -library(raster) library(jpeg) library(ArchR) library(htmltools) @@ -23,6 +23,7 @@ library(htmltools) # library(magick) # library(shinycssloaders) # library(ggpubr) +# library(raster) ############# NEW ADDITIONS (start) ############################### @@ -35,11 +36,6 @@ for (i in base::seq_along(fn)) { }) } -# base::source("AllClasses.R") -# base::source("ArchRBrowser.R") -# base::source("GgplotUtils.R") - - # Calling ArchRProj ArchRProj <- ArchR::loadArchRProject(path = ".", shiny = TRUE) ArchRProj <- ArchR::addImputeWeights(ArchRProj = ArchRProj) diff --git a/Shiny/server.R b/Shiny/server.R index 6fff4da7..583acfe6 100644 --- a/Shiny/server.R +++ b/Shiny/server.R @@ -25,8 +25,8 @@ shinyServer <- function(input,output, session){ ) plotfunctions::emptyPlot(0,0, axes=FALSE) - legend_plot <- plotfunctions::gradientLegend(valRange=base::c(base::scale()[[mat]][,input$EMBED1_forComparison][1],base::scale()[[mat]][,input$EMBED1_forComparison][2]), - color = raster::color()[[mat]], pos=.5, side=1) + legend_plot <- plotfunctions::gradientLegend(valRange=base::c(scale()[[mat]][,input$EMBED1_forComparison][1],scale()[[mat]][,input$EMBED1_forComparison][2]), + color = color()[[mat]], pos=.5, side=1) p <- rhdf5::h5read(paste0(subOutDir,"/",mat,"_plotBlank72.h5"), base::paste0(mat, "/", input$EMBED1_forComparison)) @@ -91,8 +91,8 @@ shinyServer <- function(input,output, session){ ) plotfunctions::emptyPlot(0,0, axes=FALSE) - legend_plot <- plotfunctions::gradientLegend(valRange=base::c(base::scale()[[mat]][,input$EMBED2_forComparison][1],base::scale()[[mat]][,input$EMBED2_forComparison][2]), - color = raster::color()[[mat]], pos=.5, side=1) + legend_plot <- plotfunctions::gradientLegend(valRange=base::c(scale()[[mat]][,input$EMBED2_forComparison][1],scale()[[mat]][,input$EMBED2_forComparison][2]), + color = color()[[mat]], pos=.5, side=1) p <- h5read(base::paste0(subOutDir,"/",mat,"_plotBlank72.h5"), base::paste0(mat, "/", input$EMBED2_forComparison)) temp_jpg <- t(base::matrix(farver::decode_native(p), nrow = 216)) @@ -238,7 +238,7 @@ shinyServer <- function(input,output, session){ # availableMatrices <- getAvailableMatrices(ArchRProj) matName <- availableMatrices[ availableMatrices %in% input$matrix_EMBED2_forComparison] - featureNames <- rdhf5::h5read(file = base::paste0(subOutDir, "/", matName, "_plotBlank72.h5"), + featureNames <- rhdf5::h5read(file = base::paste0(subOutDir, "/", matName, "_plotBlank72.h5"), name = matName) Feature_dropdown2 = base::names(featureNames) @@ -382,5 +382,4 @@ shinyServer <- function(input,output, session){ } }) -} -z \ No newline at end of file +} \ No newline at end of file From 9b83c0a194314081fa9eeb7b09994b66cd2c8412 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Fri, 24 Mar 2023 11:48:00 -0700 Subject: [PATCH 127/162] code review replace for statements with safelapply improve file checking and messaging add matsToUse param consistent referencing of directories --- R/GroupExport.R | 4 +- R/ShinyArchRExports.R | 237 +++++++++++++++++++----------------------- 2 files changed, 111 insertions(+), 130 deletions(-) diff --git a/R/GroupExport.R b/R/GroupExport.R index 286d5d1b..65ac6f92 100644 --- a/R/GroupExport.R +++ b/R/GroupExport.R @@ -588,8 +588,8 @@ getGroupFragments <- function( .exportGroupFragmentsRDS <- function( ArchRProj = NULL, groupBy = NULL, - threads = getArchRThreads(), - outDir = file.path(getOutputDirectory(ArchRProj), "fragments") + outDir = file.path(getOutputDirectory(ArchRProj), "fragments"), + threads = getArchRThreads() ){ dir.create(outDir, showWarnings = FALSE) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 1bdbae16..3527c123 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -13,6 +13,8 @@ #' @param cellColEmbeddings A character vector of columns in `cellColData` to plot as part of the Shiny app. No default is provided so this must be set. #' For ex. `c("Sample","Clusters","TSSEnrichment","nFrags")`. #' @param embedding The name of the embedding from `ArchRProj` to be used for plotting embeddings in the Shiny app. +#' @param matsToUse A character vector containing the matrices that you want to include in the Shiny app. This should be used to limit +#' which matrices are included in the app. Matrices listed here must exist in your project (see `getAvailableMatrices()`). #' @param tileSize The numeric width of the tile/bin in basepairs for plotting ATAC-seq signal tracks. All insertions in a single bin will be summed. #' @param force A boolean value that indicates whether to overwrite any relevant files during the `exportShinyArchR()` process. #' @param threads The number of threads to use for parallel execution. @@ -26,7 +28,7 @@ #' ArchR:::.dropGroupsFromArrow(ArrowFile = getArrowFiles(proj)[1], dropGroups = c("GeneIntegrationMatrix","MotifMatrix")) #' proj <- addImputeWeights(proj) #' -#' ArchR:::exportShinyArchR(ArchRProj = proj, +#' exportShinyArchR(ArchRProj = proj, #' mainDir = "Shiny", #' subOutDir = "inputData", #' savedArchRProjFile = "Save-ArchR-Project.rds", @@ -43,26 +45,25 @@ exportShinyArchR <- function( ArchRProj = NULL, mainDir = "Shiny", subOutDir = "inputData", - # ArchRProjFile = "Save-ArchRProjShiny", savedArchRProjFile = "Save-ArchR-Project.rds", groupBy = "Clusters", cellColEmbeddings = "Clusters", embedding = "UMAP", + matsToUse = NULL, tileSize = 100, force = FALSE, threads = getArchRThreads(), logFile = createLogFile("exportShinyArchR") ){ - options(warn=-1) - .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) .validInput(input = mainDir, name = "mainDir", valid = c("character")) .validInput(input = subOutDir, name = "subOutDir", valid = c("character")) .validInput(input = savedArchRProjFile, name = "savedArchRProjFile", valid = c("character")) .validInput(input = groupBy, name = "groupBy", valid = c("character")) - .validInput(input = cellColEmbeddings, name = "cellColEmbeddings", valid = c("character", "null")) + .validInput(input = cellColEmbeddings, name = "cellColEmbeddings", valid = c("character")) .validInput(input = embedding, name = "embedding", valid = c("character")) + .validInput(input = matsToUse, name = "matsToUse", valid = c("character","null")) .validInput(input = tileSize, name = "tileSize", valid = c("integer")) .validInput(input = force, name = "force", valid = c("boolean")) .validInput(input = threads, name = "threads", valid = c("integer")) @@ -78,9 +79,6 @@ exportShinyArchR <- function( stop("Only one value is allowed for groupBy.") } - if(is.null(cellColEmbeddings)){ - stop("The cellColEmbeddings parameter must be defined! Please see function input definitions.") - } if(!all(cellColEmbeddings %in% colnames(ArchRProj@cellColData))){ stop("Not all entries in cellColEmbeddings exist in the cellColData of your ArchRProj. Please check provided inputs.") } @@ -92,49 +90,51 @@ exportShinyArchR <- function( #check that groupBy column exists and doesn't have NA values if (groupBy %ni% colnames(ArchRProj@cellColData)) { - stop("groupBy is not part of cellColData") + stop("groupBy is not an entry in cellColData") } else if ((any(is.na(paste0("ArchRProj$", groupBy))))) { - stop("Some entries in the column indicated by groupBy have NA values. Please subset your project using subsetArchRProject() to only contain cells with values for groupBy") + stop("Some entries in the column indicated by groupBy have NA values. Please subset your project using subsetArchRProject() to only contain cells with values for groupBy.") } + supportedMatrices <- c("GeneScoreMatrix", "GeneIntegrationMatrix", "MotifMatrix") #only these matrices are currently supported for ShinyArchR + #subset matrices for use in Shiny app + allMatrices <- getAvailableMatrices(ArchRProjShiny) + if(!is.null(matsToUse)){ + if(!all(matsToUse %in% allMatrices)){ + stop("Not all matrices defined in matsToUse exist in your ArchRProject. See getAvailableMatrices().") + } else { + allMatrices <- allMatrices[which(allMatrices %in% matsToUse)] + } + } + # get directories paths projDir <- getOutputDirectory(ArchRProj) mainOutputDir <- file.path(projDir, mainDir) subOutputDir <- file.path(projDir, mainDir, subOutDir) - supportedMatrices <- c("GeneScoreMatrix", "GeneIntegrationMatrix", "MotifMatrix") #only these matrices are currently supported for ShinyArchR - # Make directory for Shiny App - if(!dir.exists(mainOutputDir)) { - - dir.create(mainOutputDir, showWarnings = TRUE) - - ## Check the links for the files - filesUrl <- data.frame( - fileUrl = c( - "https://files.corces.gladstone.org/Users/rcorces/ArchR/Shiny/1.0.3/app.R", - "https://files.corces.gladstone.org/Users/rcorces/ArchR/Shiny/1.0.3/global.R", - "https://files.corces.gladstone.org/Users/rcorces/ArchR/Shiny/1.0.3/server.R", - "https://files.corces.gladstone.org/Users/rcorces/ArchR/Shiny/1.0.3/ui.R" - ), - md5sum = c( - "6453814565316d26a9c83bddebaf41d8", - "a07b98a777d374df3639f3c961585a47", - "faaf6665647e32e44f62320822868872", - "b34874b7d130dc88b579853e297c7e88" - ), - stringsAsFactors = FALSE - ) - - .downloadFiles(filesUrl = filesUrl, pathDownload = mainOutputDir, threads = threads) - - }else{ - message("Using existing Shiny files...") - } + # Make directory for Shiny App and download the app, global, server, and ui files if they dont already exist + dir.create(mainOutputDir, showWarnings = TRUE) + + ## Check the links for the files + filesUrl <- data.frame( + fileUrl = c( + "https://files.corces.gladstone.org/Users/rcorces/ArchR/Shiny/1.0.3/app.R", + "https://files.corces.gladstone.org/Users/rcorces/ArchR/Shiny/1.0.3/global.R", + "https://files.corces.gladstone.org/Users/rcorces/ArchR/Shiny/1.0.3/server.R", + "https://files.corces.gladstone.org/Users/rcorces/ArchR/Shiny/1.0.3/ui.R" + ), + md5sum = c( + "6453814565316d26a9c83bddebaf41d8", + "a07b98a777d374df3639f3c961585a47", + "faaf6665647e32e44f62320822868872", + "b34874b7d130dc88b579853e297c7e88" + ), + stringsAsFactors = FALSE + ) + + dl <- .downloadFiles(filesUrl = filesUrl, pathDownload = mainOutputDir, threads = threads) dir.create(subOutputDir, showWarnings = FALSE) - # dir.create(ArchRProjOutputDir, showWarnings = FALSE) - # Create a copy of the ArchRProj ArchRProjShiny <- ArchRProj @@ -147,110 +147,101 @@ exportShinyArchR <- function( "values" }) ArchRProjShiny@projectMetadata[["units"]] <- units - # ArchRProjShiny <- saveArchRProject(ArchRProj = ArchRProjShiny, outputDirectory = - # file.path(ArchRProjOutputDir), dropCells = TRUE, overwrite = F, load = TRUE) - # file.copy(file.path(getOutputDirectory(ArchRProjShiny), ArchRProjFile), mainOutputDir, recursive=TRUE) + #copy the RDS corresponding to the ArchRProject to a new directory for use in the Shiny app file.copy(file.path(getOutputDirectory(ArchRProjShiny), savedArchRProjFile), file.path(mainOutputDir), recursive=FALSE) - # saveArchRProject(ArchRProj = ArchRProjShiny, outputDirectory = file.path(mainOutputDir), load = FALSE) - # Create fragment files - should be saved within a dir called ShinyFragments within the ArchRProjShiny output directory - fragDir <- file.path(projDir, mainDir, "ShinyFragments", groupBy) + fragDir <- file.path(mainOutputDir, "ShinyFragments", groupBy) fragFiles <- list.files(path = file.path(fragDir, pattern = "\\_frags.rds$")) - - #this is still a slightly dangerous comparison, better would be to compare for explicitly the file names that are expected - if(length(fragFiles) == length(unique(ArchRProj@cellColData[,groupBy]))){ - if(force){ + dir.create(file.path(mainOutputDir, "ShinyFragments"), showWarnings = FALSE) + + #check for the existence of each expected fragment file and create if not found + fragGroups <- unique(ArchRProj@cellColData[,groupBy]) + fragOut <- .safelapply(seq_along(fragGroups), function(x){ + fragGroupsx <- fragGroups[x] + if(!file.exists(file.path(fragDir,paste0(fragGroupsx,"_frags.rds"))) | force){ .exportGroupFragmentsRDS(ArchRProj = ArchRProjShiny, groupBy = groupBy, outDir = fragDir, threads = threads) - } else{ - message("Fragment files already exist. Skipping fragment file generation...") - } - }else{ - dir.create(file.path(mainOutputDir, "ShinyFragments"), showWarnings = FALSE) - dir.create(fragDir, showWarnings = FALSE) - .exportGroupFragmentsRDS(ArchRProj = ArchRProj, groupBy = groupBy, outDir = fragDir, threads = threads) - } + } else { + message(paste0("Fragment file for ", fragGroupsx," already exist. Skipping fragment file generation...")) + } + return(NULL) + }, threads = threads) - # Create coverage objects - should be saved within a dir called ShinyCoverage within the ArchRProjShiny output directory - covDir <- file.path(projDir, mainDir, "ShinyCoverage", groupBy) + # Create coverage objects - should be saved within a dir called ShinyCoverage within the mainOutputDir + covDir <- file.path(mainOutputDir, "ShinyCoverage", groupBy) covFiles <- list.files(path = covDir, pattern = "\\_cvg.rds$") - - # this is still a slightly dangerous comparison, better would be to compare for explicitly the file names that are expected - if(length(covFiles) == length(unique(ArchRProjShiny@cellColData[,groupBy]))){ - if(force){ - .exportClusterCoverageRDS(ArchRProj = ArchRProjShiny, tileSize = tileSize, groupBy = groupBy, outDir = covDir) - } else{ - message("Coverage files already exist. Skipping fragment file generation...") + dir.create(file.path(mainOutputDir, "ShinyCoverage"), showWarnings = FALSE) + + covOut <- .safelapply(seq_along(groups), function(x){ + groupsx <- groups[x] + if(!file.exists(file.path(covDir,paste0(groupsx,"_cvg.rds"))) | force){ + .exportClusterCoverageRDS(ArchRProj = ArchRProjShiny, tileSize = tileSize, groupBy = groupBy, outDir = covDir, fragDir = fragDir) + } else { + message(paste0("Coverage file for ", groupsx," already exist. Skipping coverage file generation...")) } - }else{ - dir.create(file.path(mainOutputDir, "ShinyCoverage")) - dir.create(covDir, showWarnings = TRUE) - .exportClusterCoverageRDS(ArchRProj = ArchRProj, tileSize = tileSize, groupBy = groupBy, fragDir = fragDir, outDir = covDir) - } - - # Create directory to save input data to Shinyapps.io (everything that will be preprocessed) - # dir.create(file.path(projDir, mainDir, subOutDir), showWarnings = TRUE) + return(NULL) + }, threads = threads) - allMatrices <- getAvailableMatrices(ArchRProjShiny) matrices <- list() imputeMatrices <- list() imputeWeights <- getImputeWeights(ArchRProj = ArchRProjShiny) df <- getEmbedding(ArchRProjShiny, embedding = embedding, returnDF = TRUE) - if(!file.exists(file.path(projDir,mainDir, subOutDir, "matrices.rds")) && !file.exists(file.path(projDir,mainDir, subOutDir, "imputeMatrices.rds"))){ + if(!file.exists(file.path(subOutputDir, "matrices.rds")) && !file.exists(file.path(subOutputDir, "imputeMatrices.rds"))){ for(matName in allMatrices){ if(matName %in% supportedMatrices){ - featuresNames <- getFeatures(ArchRProj = ArchRProj, useMatrix = matName) - dir.create(file.path(projDir,mainDir, subOutDir, matName), showWarnings = FALSE) - saveRDS(featuresNames, file.path(projDir,mainDir, subOutDir, matName, paste0(matName, "_names.rds"))) + featuresNames <- getFeatures(ArchRProj = ArchRProj, useMatrix = matName) + dir.create(file.path(subOutputDir, matName), showWarnings = FALSE) + saveRDS(featuresNames, file.path(subOutputDir, matName, paste0(matName, "_names.rds"))) + + if(!is.null(featuresNames)){ - if(!is.null(featuresNames)){ - - mat = Matrix(.getMatrixValues( - ArchRProj = ArchRProjShiny, - name = featuresNames, - matrixName = matName, - log2Norm = FALSE, - threads = threads), sparse = TRUE) - - matrices[[matName]] = mat - matList = mat[,rownames(df), drop=FALSE] - .logThis(matList, paste0(matName,"-Before-Impute"), logFile = logFile) - - if(getArchRVerbose()) message("Imputing Matrix") - imputeMat <- imputeMatrix(mat = as.matrix(matList), imputeWeights = imputeWeights, logFile = logFile) - - if(!inherits(imputeMat, "matrix")){ - imputeMat <- mat(imputeMat, ncol = nrow(df)) - colnames(imputeMat) <- rownames(df) - } - imputeMatrices[[matName]] <- imputeMat - - }else{ - message(matName, " is NULL.") + mat = Matrix(.getMatrixValues( + ArchRProj = ArchRProjShiny, + name = featuresNames, + matrixName = matName, + log2Norm = FALSE, + threads = threads), sparse = TRUE) + + matrices[[matName]] = mat + matList = mat[,rownames(df), drop=FALSE] + .logThis(matList, paste0(matName,"-Before-Impute"), logFile = logFile) + + if(getArchRVerbose()) message("Imputing Matrix") + + imputeMat <- imputeMatrix(mat = as.matrix(matList), imputeWeights = imputeWeights, logFile = logFile) + + if(!inherits(imputeMat, "matrix")){ + imputeMat <- matrix(imputeMat, ncol = nrow(df)) + colnames(imputeMat) <- rownames(df) } + imputeMatrices[[matName]] <- imputeMat + + }else{ + message(matName, " is NULL.") + } } } matrices$allColorBy= .availableArrays(head(getArrowFiles(ArchRProj), 2)) - saveRDS(matrices, file.path(projDir,mainDir, subOutDir, "matrices.rds")) - saveRDS(imputeMatrices, file.path(projDir,mainDir, subOutDir, "imputeMatrices.rds")) + saveRDS(matrices, file.path(subOutputDir, "matrices.rds")) + saveRDS(imputeMatrices, file.path(subOutputDir, "imputeMatrices.rds")) }else{ - message("matrices and imputeMatrices already exist. reading from local files...") + message("Matrices and imputed matrices already exist. Reading from local files...") - matrices <- readRDS(file.path(projDir, mainDir, subOutDir, "matrices.rds")) - imputeMatrices <- readRDS(file.path(projDir, mainDir, subOutDir, "imputeMatrices.rds")) + matrices <- readRDS(file.path(subOutputDir, "matrices.rds")) + imputeMatrices <- readRDS(file.path(subOutputDir, "imputeMatrices.rds")) } - print("Mainembeds started...") + message("Generating raster embedding images for cellColData entries...") # mainEmbeds will create an HDF5 file containing the nativeRaster vectors for data stored in cellColData - if (!file.exists(file.path(projDir, mainDir, subOutDir, "mainEmbeds.h5"))) { + if (!file.exists(file.path(subOutputDir, "mainEmbeds.h5"))) { .mainEmbeds(ArchRProj = ArchRProjShiny, - outDirEmbed = file.path(projDir, mainDir, subOutDir), + outDirEmbed = file.path(subOutputDir), colorBy = "cellColData", cellColEmbeddings = cellColEmbeddings, embeddingDF = df, @@ -262,15 +253,15 @@ exportShinyArchR <- function( message("H5 for main embeddings already exists...") } - print("MatrixEmbeds started...") + message("Generating raster embedding images for matrix data...") # matrixEmbeds will create an HDF5 file containing he nativeRaster vectors for data stored in matrices - if(!file.exists(file.path(projDir,mainDir, subOutDir, "plotBlank72.h5"))){ + if(!file.exists(file.path(subOutputDir, "plotBlank72.h5"))){ embeddingDF = df .matrixEmbeds( ArchRProj = ArchRProj, - outDirEmbed = file.path(projDir, mainDir, subOutDir), + outDirEmbed = file.path(subOutputDir), colorBy = intersect(supportedMatrices, allMatrices), embedding = embedding, embeddingDF = df, @@ -285,8 +276,6 @@ exportShinyArchR <- function( message("H5 file already exists...") } - print("MatrixEmbeds finished...") - ## delete unnecessary files ----------------------------------------------------------------- unlink(file.path(projDir, "ShinyFragments"), recursive = TRUE) @@ -317,6 +306,7 @@ exportShinyArchR <- function( #' @param cellColEmbeddings A character vector of columns in `cellColData` to plot as part of the Shiny app. No default is provided so this must be set. #' For ex. `c("Sample","Clusters","TSSEnrichment","nFrags")`. #' @param embedding The embedding to use. Default is "UMAP". +#' @param embeddingDF #' @param matrices List of stored matrices to use for plotEmbedding so that it runs faster. #' @param imputeMatrices List of stored imputed matrices to use for plotEmbedding so that it runs faster. #' @param threads The number of threads to use for parallel execution. @@ -348,11 +338,6 @@ exportShinyArchR <- function( if(!file.exists(file.path(outDirEmbed, "embeds.rds"))){ - # check all names exist in ArchRProj - if(cellColEmbeddings %ni% colnames(ArchRProj@cellColData)){ - stop("All columns should be present in cellColData") - } - embeds <- .safelapply(1:length(cellColEmbeddings), function(x){ # name <- cellColEmbeddings[x] tryCatch({ @@ -361,14 +346,12 @@ exportShinyArchR <- function( baseSize = 12, colorBy = colorBy, name = name, - # allNames = names, embedding = embedding, embeddingDF = embeddingDF, rastr = FALSE, size = 0.5, matrices = matrices, imputeMatrices = imputeMatrices, - # imputeWeights = NULL, # unsure if inputWeights needed for cellColData Shiny = TRUE )+ggtitle(paste0("Colored by ", name))+theme(text = element_text(size=12), legend.title = element_text(size = 12),legend.text = element_text(size = 6)) @@ -376,7 +359,7 @@ exportShinyArchR <- function( print(x) }) return(named_embed) - }) + }, threads = threads) names(embeds) <- cellColEmbeddings saveRDS(embeds, file.path(outDirEmbed, "embeds.rds")) @@ -440,6 +423,7 @@ exportShinyArchR <- function( #' @param outDirEmbed Where the HDF5 and the jpgs will be saved. #' @param colorBy A string indicating whether points in the plot should be colored by a column in `cellColData` ("cellColData") or by #' a data matrix in the corresponding ArrowFiles (i.e. "GeneScoreMatrix", "MotifMatrix", "PeakMatrix"). +#' @param supportedMatrices #' @param embedding The embedding to use. Default is "UMAP". #' @param matrices List of stored matrices to use for plotEmbedding so that it runs faster. #' @param imputeMatrices List of stored imputed matrices to use for plotEmbedding so that it runs faster. @@ -487,9 +471,6 @@ exportShinyArchR <- function( allMatrices <- getAvailableMatrices(ArchRProj) for(mat in colorBy){ - if(mat %ni% intersect(supportedMatrices, allMatrices)){ - message(mat,"not in ArchRProj") ## NOTE: should we stop or just give a warning - } if(file.exists(paste0(outDirEmbed, "/",mat, "/", mat, "_names.rds"))){ From f646a05bbe867daeb359a8457d2c4fd014b55511 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Fri, 24 Mar 2023 11:56:04 -0700 Subject: [PATCH 128/162] ensure closure of H5s --- R/ShinyArchRExports.R | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 3527c123..a5f5600b 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -113,7 +113,7 @@ exportShinyArchR <- function( # Make directory for Shiny App and download the app, global, server, and ui files if they dont already exist - dir.create(mainOutputDir, showWarnings = TRUE) + dir.create(mainOutputDir, showWarnings = FALSE) ## Check the links for the files filesUrl <- data.frame( @@ -412,6 +412,7 @@ exportShinyArchR <- function( } + h5closeAll() saveRDS(embed_color, file.path(outDirEmbed, "embed_color.rds")) saveRDS(embed_legend, file.path(outDirEmbed, "embed_legend_names.rds")) } @@ -462,6 +463,7 @@ exportShinyArchR <- function( if (file.exists(file.path(outDirEmbed, "plotBlank72.h5"))){ file.remove(file.path(outDirEmbed, "plotBlank72.h5")) } + h5closeAll() # save the scale embeds_min_max_list = list() @@ -594,6 +596,7 @@ for(i in 1:length(embeds_pal_list)){ scale <- embeds_min_max_list pal <- embeds_pal_list +h5closeAll() saveRDS(scale, file.path(outDirEmbed, "scale.rds")) saveRDS(pal, file.path(outDirEmbed, "pal.rds")) From eac195f5e0f44918aee2e0dcfc15fd85f8967092 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Fri, 24 Mar 2023 12:20:44 -0700 Subject: [PATCH 129/162] update file md5s. fix h5group creation H5Gcreate will prevent the warning about open h5 file handles --- R/ShinyArchRExports.R | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index a5f5600b..3249538e 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -124,10 +124,10 @@ exportShinyArchR <- function( "https://files.corces.gladstone.org/Users/rcorces/ArchR/Shiny/1.0.3/ui.R" ), md5sum = c( - "6453814565316d26a9c83bddebaf41d8", - "a07b98a777d374df3639f3c961585a47", - "faaf6665647e32e44f62320822868872", - "b34874b7d130dc88b579853e297c7e88" + "fe63ffcd28d04001997fe1efb900ac42", + "df9a4773d7dd4b3954446618e29aa197", + "8aa79954bfc191c0189d7ac657cb2b61", + "95a811550e8b8577ead13c3a010c9939" ), stringsAsFactors = FALSE ) @@ -412,7 +412,6 @@ exportShinyArchR <- function( } - h5closeAll() saveRDS(embed_color, file.path(outDirEmbed, "embed_color.rds")) saveRDS(embed_legend, file.path(outDirEmbed, "embed_legend_names.rds")) } @@ -463,8 +462,7 @@ exportShinyArchR <- function( if (file.exists(file.path(outDirEmbed, "plotBlank72.h5"))){ file.remove(file.path(outDirEmbed, "plotBlank72.h5")) } - h5closeAll() - + # save the scale embeds_min_max_list = list() # save the palette @@ -548,7 +546,7 @@ exportShinyArchR <- function( h5closeAll() points = H5Fcreate(name = file.path(outDirEmbed, paste0(mat,"_plotBlank72.h5"))) - h5createGroup(file.path(outDirEmbed, paste0(mat,"_plotBlank72.h5")), mat) + H5Gcreate(points, mat) for(i in 1:length(embeds_points)){ @@ -596,7 +594,6 @@ for(i in 1:length(embeds_pal_list)){ scale <- embeds_min_max_list pal <- embeds_pal_list -h5closeAll() saveRDS(scale, file.path(outDirEmbed, "scale.rds")) saveRDS(pal, file.path(outDirEmbed, "pal.rds")) From a24a4dc45ad6b85d0df289b0f0f12570f277f9a4 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Fri, 24 Mar 2023 12:57:31 -0700 Subject: [PATCH 130/162] bugfix --- R/ShinyArchRExports.R | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 3249538e..c3779521 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -291,7 +291,7 @@ exportShinyArchR <- function( "cellColEmbeddings = ", "c(",paste(shQuote(cellColEmbeddings, type = "cmd"), collapse=", "),")",'\n', "embedding = ", "'",embedding,"'",'\n', "availableMatrices = ", "c(",paste(shQuote(allMatrices, type = "cmd"), collapse=", "),")",'\n', - "shiny::runApp('", mainDir, "')" + "shiny::runApp('", mainOutputDir, "')" ) @@ -549,8 +549,6 @@ exportShinyArchR <- function( H5Gcreate(points, mat) for(i in 1:length(embeds_points)){ - - print(paste0("Getting H5 files for embeds_points: ",i,": ",round((i/length(embeds_points))*100,3), "%")) h5createDataset(file = points, dataset = paste0(mat,"/",featureNames[i]), dims = c(46656,1), storage.mode = "integer") h5writeDataset(obj = embeds_points[[i]][[1]]$plot, h5loc = points, name=paste0(mat,"/",featureNames[i])) embeds_min_max[1,i] = embeds_points[[i]][[1]]$min From 1f8b1f14aeaffc02787c34453c64adfe6d3d1315 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Fri, 24 Mar 2023 13:00:17 -0700 Subject: [PATCH 131/162] update example --- R/ShinyArchRExports.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index c3779521..a1bd6e25 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -25,7 +25,6 @@ #' proj <- getTestProject(version = 2) #' proj@geneAnnotation$genes <- proj@geneAnnotation$genes[which(proj@geneAnnotation$genes$symbol %in% c("CD14","CD3D","MS4A1","CD74"))] #' proj <- addGeneScoreMatrix(input = proj, force = TRUE) -#' ArchR:::.dropGroupsFromArrow(ArrowFile = getArrowFiles(proj)[1], dropGroups = c("GeneIntegrationMatrix","MotifMatrix")) #' proj <- addImputeWeights(proj) #' #' exportShinyArchR(ArchRProj = proj, @@ -35,6 +34,7 @@ #' groupBy = "Clusters", #' cellColEmbeddings = "Clusters", #' embedding = "UMAP", +#' matsToUse = "GeneScoreMatrix", #' tileSize = 100, #' force = FALSE, #' threads = getArchRThreads(), From de261e8d8e78b9bcb3165790dc962e205ac00cbc Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Sat, 25 Mar 2023 15:33:38 -0700 Subject: [PATCH 132/162] hiding addSeqLengths --- R/AnnotationGenome.R | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/R/AnnotationGenome.R b/R/AnnotationGenome.R index efd3ef80..00b46099 100644 --- a/R/AnnotationGenome.R +++ b/R/AnnotationGenome.R @@ -2,7 +2,7 @@ #' #' This function will create a genome annotation object that can be used for creating ArrowFiles or an ArchRProject, etc. #' -#' @param genome Either (i) a string that is a valid `BSgenome` or (ii) a `BSgenome` object (ie "hg38" or "BSgenome.Hsapiens.UCSC.hg38"). +#' @param genome Either (i) a string that is a valid `BSgenome` or (ii) a `BSgenome` object (ie "hg38" or "BSgenome.Hsapiens.UCSC.hg38"). # nolint #' @param chromSizes A `GRanges` object containing chromosome start and end coordinates. #' @param blacklist A `GRanges` object containing regions that should be excluded from analyses due to unwanted biases. #' @param filter A boolean value indicating whether non-standard chromosome scaffolds should be excluded. @@ -392,9 +392,7 @@ createGeneAnnotation <- function( #' @param gr A GRanges object. #' @param genome See the genome parameter for validBSgenome(). This option must be one of the following: (i) the name of a valid ArchR-supported genome ("hg38", "hg19", or "mm10"), #' (ii) the name of a BSgenome package (for ex. "BSgenome.Hsapiens.UCSC.hg19"), or (iii) a BSgenome object. -#' -#' @export -addSeqLengths <- function (gr, genome) { +.addSeqLengths <- function (gr, genome) { gr <- .validGRanges(gr) genome <- validBSgenome(genome) stopifnot(all(as.character(seqnames(gr)) %in% as.character(seqnames(genome)))) From 2987355c6505adeec2a75203650b1e1aee064866 Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Sat, 25 Mar 2023 16:44:12 -0700 Subject: [PATCH 133/162] safelapply for explorClusterCvgs --- R/GroupExport.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/R/GroupExport.R b/R/GroupExport.R index 65ac6f92..35d77da2 100644 --- a/R/GroupExport.R +++ b/R/GroupExport.R @@ -655,7 +655,8 @@ getGroupFragments <- function( chrRegions <- getChromSizes(ArchRProj) genome <- getGenome(ArchRProj) - for (file in fragFiles){ + .safelapply(seq_along(fragFiles), function(x){ + fragments <- readRDS(file) left <- GRanges(seqnames = seqnames(fragments), ranges = IRanges(start(fragments), width = 1)) @@ -686,5 +687,5 @@ getGroupFragments <- function( binnedCoverage <- coverage(bins, weight = bins$reads * scaleFactor ) saveRDS(binnedCoverage, file.path(outDir, paste0(groupID, "_cvg.rds"))) - } + }, threads = threads) } From 84af7ad367960fbe138beca241c3b934dcb073da Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Sun, 26 Mar 2023 22:31:58 -0400 Subject: [PATCH 134/162] getting units from the ArchRProj (not ArchRProjShiny) --- R/ShinyArchRExports.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index a1bd6e25..b50967e6 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -142,7 +142,7 @@ exportShinyArchR <- function( ArchRProjShiny@projectMetadata[["groupBy"]] <- groupBy ArchRProjShiny@projectMetadata[["tileSize"]] <- tileSize units <- tryCatch({ - .h5read(getArrowFiles(ArchRProjShiny)[1], paste0(colorBy, "/Info/Units"))[1] + .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, "/Info/Units"))[1] },error=function(e){ "values" }) From 39622f963602dfa59e38c0a213715c771e0dd480 Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Sun, 26 Mar 2023 22:54:39 -0400 Subject: [PATCH 135/162] adding stop condition --- R/ShinyArchRExports.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index b50967e6..d805b945 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -220,7 +220,7 @@ exportShinyArchR <- function( imputeMatrices[[matName]] <- imputeMat }else{ - message(matName, " is NULL.") + stop(matName, " is NULL.") } } } From 5c273609d94fade6140298acf46eaa6cc8a92960 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Mon, 27 Mar 2023 09:56:49 -0700 Subject: [PATCH 136/162] bugfix (file does not exist) change to safelapply removed variable named "file" also adding return NULL and storing the output of safelapply into a variable to avoid default printing it to std out. --- R/GroupExport.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/GroupExport.R b/R/GroupExport.R index 35d77da2..30ded3d3 100644 --- a/R/GroupExport.R +++ b/R/GroupExport.R @@ -655,9 +655,9 @@ getGroupFragments <- function( chrRegions <- getChromSizes(ArchRProj) genome <- getGenome(ArchRProj) - .safelapply(seq_along(fragFiles), function(x){ + fragOut <- .safelapply(seq_along(fragFiles), function(x){ - fragments <- readRDS(file) + fragments <- readRDS(fragFiles[x]) left <- GRanges(seqnames = seqnames(fragments), ranges = IRanges(start(fragments), width = 1)) right <- GRanges(seqnames = seqnames(fragments), @@ -665,7 +665,7 @@ getGroupFragments <- function( # call sort() after sortSeqlevels() to sort also the ranges in addition to the chromosomes. insertions <- c(left, right) %>% sortSeqlevels() %>% sort() - groupID <- file %>% basename() %>% gsub(".{4}$", "", .) + groupID <- fragFiles[x] %>% basename() %>% gsub(".{4}$", "", .) # binnedCoverage message("Creating bins for group ", groupID, "...") bins <- From 9351c905590ff0892c1ed6227119f86cf8aaebbb Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Mon, 27 Mar 2023 15:50:27 -0700 Subject: [PATCH 137/162] return null instead of last result --- R/GroupExport.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/GroupExport.R b/R/GroupExport.R index 30ded3d3..5e8a50de 100644 --- a/R/GroupExport.R +++ b/R/GroupExport.R @@ -687,5 +687,6 @@ getGroupFragments <- function( binnedCoverage <- coverage(bins, weight = bins$reads * scaleFactor ) saveRDS(binnedCoverage, file.path(outDir, paste0(groupID, "_cvg.rds"))) + return(NULL) }, threads = threads) } From 13251725228a2508637d6b8a4177da7d9582c72d Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Tue, 28 Mar 2023 09:45:42 -0700 Subject: [PATCH 138/162] remove Shiny version of plotEmbedding fix mainEmbeds and matrixEmbeds to use the original version of plotEmbedding. Remove all shiny-centric updates to plotEmbedding --- R/ShinyArchRExports.R | 207 +++++++++++------------------------------- R/VisualizeData.R | 180 +++++++++++++++--------------------- 2 files changed, 126 insertions(+), 261 deletions(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index d805b945..446bd501 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -141,12 +141,6 @@ exportShinyArchR <- function( # Add metadata to ArchRProjShiny ArchRProjShiny@projectMetadata[["groupBy"]] <- groupBy ArchRProjShiny@projectMetadata[["tileSize"]] <- tileSize - units <- tryCatch({ - .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, "/Info/Units"))[1] - },error=function(e){ - "values" - }) - ArchRProjShiny@projectMetadata[["units"]] <- units #copy the RDS corresponding to the ArchRProject to a new directory for use in the Shiny app file.copy(file.path(getOutputDirectory(ArchRProjShiny), savedArchRProjFile), file.path(mainOutputDir), recursive=FALSE) @@ -183,93 +177,36 @@ exportShinyArchR <- function( return(NULL) }, threads = threads) - matrices <- list() - imputeMatrices <- list() - imputeWeights <- getImputeWeights(ArchRProj = ArchRProjShiny) - df <- getEmbedding(ArchRProjShiny, embedding = embedding, returnDF = TRUE) - - if(!file.exists(file.path(subOutputDir, "matrices.rds")) && !file.exists(file.path(subOutputDir, "imputeMatrices.rds"))){ - for(matName in allMatrices){ - if(matName %in% supportedMatrices){ - - featuresNames <- getFeatures(ArchRProj = ArchRProj, useMatrix = matName) - dir.create(file.path(subOutputDir, matName), showWarnings = FALSE) - saveRDS(featuresNames, file.path(subOutputDir, matName, paste0(matName, "_names.rds"))) - - if(!is.null(featuresNames)){ - - mat = Matrix(.getMatrixValues( - ArchRProj = ArchRProjShiny, - name = featuresNames, - matrixName = matName, - log2Norm = FALSE, - threads = threads), sparse = TRUE) - - matrices[[matName]] = mat - matList = mat[,rownames(df), drop=FALSE] - .logThis(matList, paste0(matName,"-Before-Impute"), logFile = logFile) - - if(getArchRVerbose()) message("Imputing Matrix") - - imputeMat <- imputeMatrix(mat = as.matrix(matList), imputeWeights = imputeWeights, logFile = logFile) - - if(!inherits(imputeMat, "matrix")){ - imputeMat <- matrix(imputeMat, ncol = nrow(df)) - colnames(imputeMat) <- rownames(df) - } - imputeMatrices[[matName]] <- imputeMat - - }else{ - stop(matName, " is NULL.") - } - } - } - - matrices$allColorBy= .availableArrays(head(getArrowFiles(ArchRProj), 2)) - saveRDS(matrices, file.path(subOutputDir, "matrices.rds")) - saveRDS(imputeMatrices, file.path(subOutputDir, "imputeMatrices.rds")) - }else{ - - message("Matrices and imputed matrices already exist. Reading from local files...") - - matrices <- readRDS(file.path(subOutputDir, "matrices.rds")) - imputeMatrices <- readRDS(file.path(subOutputDir, "imputeMatrices.rds")) - } - + #Create embedding plots for columns in cellColData message("Generating raster embedding images for cellColData entries...") # mainEmbeds will create an HDF5 file containing the nativeRaster vectors for data stored in cellColData if (!file.exists(file.path(subOutputDir, "mainEmbeds.h5"))) { - .mainEmbeds(ArchRProj = ArchRProjShiny, - outDirEmbed = file.path(subOutputDir), - colorBy = "cellColData", - cellColEmbeddings = cellColEmbeddings, - embeddingDF = df, - matrices = matrices, - imputeMatrices = imputeMatrices, - logFile = createLogFile("mainEmbeds") - ) + .mainEmbeds( + ArchRProj = ArchRProjShiny, + outDirEmbed = file.path(subOutputDir), + colorBy = "cellColData", + cellColEmbeddings = cellColEmbeddings, + embedding = embedding, + logFile = logFile + ) } else{ message("H5 for main embeddings already exists...") } + #Create embedding plots for matrices message("Generating raster embedding images for matrix data...") # matrixEmbeds will create an HDF5 file containing he nativeRaster vectors for data stored in matrices if(!file.exists(file.path(subOutputDir, "plotBlank72.h5"))){ - embeddingDF = df - .matrixEmbeds( ArchRProj = ArchRProj, outDirEmbed = file.path(subOutputDir), colorBy = intersect(supportedMatrices, allMatrices), embedding = embedding, - embeddingDF = df, - matrices = matrices, - imputeMatrices = imputeMatrices, - threads = getArchRThreads(), + threads = threads, verbose = TRUE, - logFile = createLogFile("matrixEmbeds") + logFile = logFile ) }else{ @@ -306,9 +243,6 @@ exportShinyArchR <- function( #' @param cellColEmbeddings A character vector of columns in `cellColData` to plot as part of the Shiny app. No default is provided so this must be set. #' For ex. `c("Sample","Clusters","TSSEnrichment","nFrags")`. #' @param embedding The embedding to use. Default is "UMAP". -#' @param embeddingDF -#' @param matrices List of stored matrices to use for plotEmbedding so that it runs faster. -#' @param imputeMatrices List of stored imputed matrices to use for plotEmbedding so that it runs faster. #' @param threads The number of threads to use for parallel execution. #' @param logFile The path to a file to be used for logging ArchR output. #' @@ -318,9 +252,6 @@ exportShinyArchR <- function( colorBy = "cellColData", cellColEmbeddings = NULL, embedding = "UMAP", - embeddingDF = NULL, - matrices = NULL, - imputeMatrices = NULL, threads = getArchRThreads(), logFile = createLogFile("mainEmbeds") ){ @@ -329,7 +260,6 @@ exportShinyArchR <- function( .validInput(input = colorBy, name = "colorBy", valid = c("character")) .validInput(input = cellColEmbeddings, name = "cellColEmbeddings", valid = c("character")) .validInput(input = embedding, name = "embedding", valid = c("character")) - .validInput(input = embeddingDF, name = "embeddingDF", valid = c("data.frame")) .validInput(input = threads, name = "threads", valid = c("numeric")) .validInput(input = logFile, name = "logFile", valid = c("character")) @@ -339,26 +269,26 @@ exportShinyArchR <- function( if(!file.exists(file.path(outDirEmbed, "embeds.rds"))){ embeds <- .safelapply(1:length(cellColEmbeddings), function(x){ # - name <- cellColEmbeddings[x] + tryCatch({ named_embed <- plotEmbedding( ArchRProj = ArchRProj, baseSize = 12, colorBy = colorBy, - name = name, + name = cellColEmbeddings[x], embedding = embedding, - embeddingDF = embeddingDF, rastr = FALSE, size = 0.5, - matrices = matrices, - imputeMatrices = imputeMatrices, - Shiny = TRUE - )+ggtitle(paste0("Colored by ", name))+theme(text = element_text(size=12), - legend.title = element_text(size = 12),legend.text = element_text(size = 6)) + ) + ggtitle(paste0("Colored by ", cellColEmbeddings[x])) + + theme( + text = element_text(size=12), + legend.title = element_text(size = 12), + legend.text = element_text(size = 6) + ) }, error = function(x){ print(x) }) - return(named_embed) + return(named_embed) }, threads = threads) names(embeds) <- cellColEmbeddings @@ -425,8 +355,6 @@ exportShinyArchR <- function( #' a data matrix in the corresponding ArrowFiles (i.e. "GeneScoreMatrix", "MotifMatrix", "PeakMatrix"). #' @param supportedMatrices #' @param embedding The embedding to use. Default is "UMAP". -#' @param matrices List of stored matrices to use for plotEmbedding so that it runs faster. -#' @param imputeMatrices List of stored imputed matrices to use for plotEmbedding so that it runs faster. #' @param threads The number of threads to use for parallel execution. #' @param verbose A boolean value that determines whether standard output should be printed. #' @param logFile The path to a file to be used for logging ArchR output. @@ -468,46 +396,33 @@ exportShinyArchR <- function( # save the palette embeds_pal_list = list() - allMatrices <- getAvailableMatrices(ArchRProj) - for(mat in colorBy){ - - if(file.exists(paste0(outDirEmbed, "/",mat, "/", mat, "_names.rds"))){ - dir.create(paste0(outDirEmbed, "/",mat, "/embeds"), showWarnings = FALSE) - - featureNames <- readRDS(file.path(outDirEmbed, mat, paste0(mat,"_names.rds"))) + dir.create(paste0(outDirEmbed, "/",mat, "/embeds"), showWarnings = FALSE) + + featureNames <- getFeatures(ArchRProj = ArchRProj, useMatrix = mat) + featureNames <- featureNames[which(!is.na(featureNames))] - if(!is.null(featureNames)){ - - embeds_points <- .safelapply(1:length(featureNames), function(x){ #length(featureNames) - - print(paste0("Creating plots for ", mat,": ",x,": ",round((x/length(featureNames))*100,3), "%")) + message(paste0("Creating plots for ", mat,"...")) - if(!is.na(featureNames[x])){ - - gene_plot <- plotEmbedding( - ArchRProj = ArchRProj, - colorBy = mat, - name = featureNames[x], - embedding = embedding, - quantCut = c(0.01, 0.95), - imputeWeights = getImputeWeights(ArchRProj = ArchRProj), - plotAs = "points", - embeddingDF = embeddingDF, - matrices = matrices, - imputeMatrices = imputeMatrices, - rastr = TRUE - ) - - - }else{ - gene_plot = NULL - } - - if(!is.null(gene_plot)){ + if(!is.null(featureNames)){ + + featurePlots <- plotEmbedding( + ArchRProj = ArchRProj, + colorBy = mat, + name = featureNames, + quantCut = c(0.01, 0.95), + imputeWeights = getImputeWeights(ArchRProj = ArchRProj), + plotAs = "points", + rastr = TRUE, + threads = threads + ) + + embeds_points <- .safelapply(seq_along(featurePlots), function(x){ + featurePlotx <- featurePlots[x][[1]] + if(!is.null(featurePlotx)){ - gene_plot_blank <- gene_plot + theme(axis.title.x = element_blank()) + + featurePlotx_blank <- featurePlotx + theme(axis.title.x = element_blank()) + theme(axis.title.y = element_blank()) + theme(axis.title = element_blank()) + theme(legend.position = "none") + @@ -520,22 +435,20 @@ exportShinyArchR <- function( #save plot without axes etc as a jpg. ggsave(filename = file.path(outDirEmbed, mat, "embeds", paste0(featureNames[x],"_blank72.jpg")), - plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) + plot = featurePlotx_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) #read back in that jpg because we need vector in native format blank_jpg72 <- jpeg::readJPEG(source = file.path(outDirEmbed, mat, "embeds", paste0(featureNames[x],"_blank72.jpg")), - native = TRUE) + native = TRUE) - g <- ggplot_build(gene_plot) + g <- ggplot_build(featurePlotx) - res = list(list(plot=as.vector(blank_jpg72), min = round(min(gene_plot$data$color),1), - max = round(max(gene_plot$data$color),1), pal = unique(g$data[[1]][,"colour"]))) + res = list(list(plot=as.vector(blank_jpg72), min = round(min(featurePlotx$data$color),1), + max = round(max(featurePlotx$data$color),1), pal = unique(g$data[[1]][,"colour"]))) return(res) } - - - }, threads = threads) + }, threads = threads) names(embeds_points) <- featureNames embeds_points = embeds_points[!unlist(lapply(embeds_points, is.null))] @@ -558,27 +471,14 @@ exportShinyArchR <- function( embeds_min_max_list[[mat]] = embeds_min_max embeds_pal_list[[mat]] = embeds_points[[length(embeds_points)]][[1]]$pal - - -# -# -# embeds_min_max_list[[mat]] = embeds_min_max -# embeds_pal_list[[mat]] = embeds_points[[length(embeds_points)]][[1]]$pal - + }else{ - - message(mat,".rds file does not exist") - } - - }else{ - message(mat,".rds file does not exist. This file should have been created previously be exportShinyArchR. Skipping...") - } - + + stop("Matrix ", mat,"has no features!") + } } -# nms = names(embeds_pal_list) - for(i in 1:length(embeds_pal_list)){ cols = embeds_pal_list[[i]] @@ -588,7 +488,6 @@ for(i in 1:length(embeds_pal_list)){ } - scale <- embeds_min_max_list pal <- embeds_pal_list diff --git a/R/VisualizeData.R b/R/VisualizeData.R index f586ab33..3a370f60 100644 --- a/R/VisualizeData.R +++ b/R/VisualizeData.R @@ -247,15 +247,11 @@ plotEmbedding <- function( keepAxis = FALSE, baseSize = 10, plotAs = NULL, - Shiny = FALSE, - matrices = NULL, - imputeMatrices = NULL, - embeddingDF = NULL, threads = getArchRThreads(), logFile = createLogFile("plotEmbedding"), ... -){ - + ){ + .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) .validInput(input = embedding, name = "reducedDims", valid = c("character")) .validInput(input = colorBy, name = "colorBy", valid = c("character")) @@ -274,39 +270,34 @@ plotEmbedding <- function( .validInput(input = keepAxis, name = "keepAxis", valid = c("boolean")) .validInput(input = baseSize, name = "baseSize", valid = c("numeric")) .validInput(input = plotAs, name = "plotAs", valid = c("character", "null")) - .validInput(input = Shiny, name = "Shiny", valid = c("boolean")) .validInput(input = threads, name = "threads", valid = c("integer")) .validInput(input = logFile, name = "logFile", valid = c("character")) - + .requirePackage("ggplot2", source = "cran") - + .startLogging(logFile = logFile) .logThis(mget(names(formals()),sys.frame(sys.nframe())), "Input-Parameters", logFile=logFile) - + ############################## # Get Embedding ############################## - .logMessage("Getting Embedding", logFile = logFile) - if(Shiny){ - df <- embeddingDF - } else{ - df <- getEmbedding(ArchRProj, embedding = embedding, returnDF = TRUE) - } + .logMessage("Getting UMAP Embedding", logFile = logFile) + df <- getEmbedding(ArchRProj, embedding = embedding, returnDF = TRUE) if(!all(rownames(df) %in% ArchRProj$cellNames)){ stop("Not all cells in embedding are present in ArchRProject!") } + .logThis(df, name = "Embedding data.frame", logFile = logFile) - if(!is.null(sampleCells)){ if(sampleCells < nrow(df)){ if(!is.null(imputeWeights)){ - stop("Cannot sampleCells with imputeWeights not equal to NULL at this time!") + stop("Cannot sampleCells with imputeWeights not equalt to NULL at this time!") } df <- df[sort(sample(seq_len(nrow(df)), sampleCells)), , drop = FALSE] } } - + #Parameters plotParams <- list(...) plotParams$x <- df[,1] @@ -320,33 +311,29 @@ plotEmbedding <- function( plotParams$rastr <- rastr plotParams$size <- size plotParams$randomize <- randomize - - #Check if Cells To Be Highlighted + + #Check if Cells To Be Highlighed if(!is.null(highlightCells)){ highlightPoints <- match(highlightCells, rownames(df), nomatch = 0) if(any(highlightPoints==0)){ stop("highlightCells contain cells not in Embedding cellNames! Please make sure that these match!") } } - + #Make Sure ColorBy is valid! if(length(colorBy) > 1){ stop("colorBy must be of length 1!") } - - if(!Shiny){ - allColorBy <- c("colData", "cellColData", .availableArrays(head(getArrowFiles(ArchRProj), 2))) - } else { - allColorBy <- c("colData", "cellColData", matrices$allColorBy) - } - + allColorBy <- c("colData", "cellColData", .availableArrays(head(getArrowFiles(ArchRProj), 2))) if(tolower(colorBy) %ni% tolower(allColorBy)){ stop("colorBy must be one of the following :\n", paste0(allColorBy, sep=", ")) } colorBy <- allColorBy[match(tolower(colorBy), tolower(allColorBy))] + .logMessage(paste0("ColorBy = ", colorBy), logFile = logFile) - + if(tolower(colorBy) == "coldata" | tolower(colorBy) == "cellcoldata"){ + colorList <- lapply(seq_along(name), function(x){ colorParams <- list() colorParams$color <- as.vector(getCellColData(ArchRProj, select = name[x], drop = FALSE)[rownames(df), 1]) @@ -363,7 +350,7 @@ plotEmbedding <- function( if(x == 1){ .logThis(colorParams, name = "ColorParams 1", logFile = logFile) } - + if(!is.null(imputeWeights)){ if(getArchRVerbose()) message("Imputing Matrix") colorMat <- matrix(colorParams$color, nrow=1) @@ -372,30 +359,28 @@ plotEmbedding <- function( colorParams$color <- as.vector(colorMat) } colorParams - }) - }else{# plotting embedding for matrix instead of col in cellcoldata + }) + + + }else{ + suppressMessages(message(logFile)) - - if(!Shiny){ - units <- tryCatch({ - .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, "/Info/Units"))[1] - },error=function(e){ - "values" + + units <- tryCatch({ + .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, "/Info/Units"))[1] + },error=function(e){ + "values" }) - }else{ - units <- ArchRProj@projectMetadata[["units"]] - } if(is.null(log2Norm) & tolower(colorBy) == "genescorematrix"){ log2Norm <- TRUE } - + if(is.null(log2Norm)){ log2Norm <- FALSE } - - if(!Shiny){ - colorMat <- .getMatrixValues( + + colorMat <- .getMatrixValues( ArchRProj = ArchRProj, name = name, matrixName = colorBy, @@ -403,47 +388,27 @@ plotEmbedding <- function( threads = threads, logFile = logFile ) - }else{ - #get values from pre-saved list - colorMat = tryCatch({ - t(as.matrix(matrices[[colorBy]][name,])) - }, warning = function(warning_condition) { - message(paste("name doesn't exist:", name)) - message(warning_condition) - return(NULL) - }, error = function(error_condition) { - message(paste("name doesn't exist:", name)) - message(error_condition) - return(NA) - }, finally={ - }) - rownames(colorMat)=name - } - + if(!all(rownames(df) %in% colnames(colorMat))){ .logMessage("Not all cells in embedding are present in feature matrix. This may be due to using a custom embedding.", logFile = logFile) stop("Not all cells in embedding are present in feature matrix. This may be due to using a custom embedding.") } - + colorMat <- colorMat[,rownames(df), drop=FALSE] - + .logThis(colorMat, "colorMat-Before-Impute", logFile = logFile) - + if(!is.null(imputeWeights)){ if(getArchRVerbose()) message("Imputing Matrix") - if(!Shiny){ - colorMat <- imputeMatrix(mat = as.matrix(colorMat), imputeWeights = imputeWeights, logFile = logFile) - }else{ - colorMat <- imputeMatrices[[colorBy]][name,] - } - if(!inherits(colorMat, "matrix")){ - colorMat <- matrix(colorMat, ncol = nrow(df)) - colnames(colorMat) <- rownames(df) - } + colorMat <- imputeMatrix(mat = as.matrix(colorMat), imputeWeights = imputeWeights, logFile = logFile) + if(!inherits(colorMat, "matrix")){ + colorMat <- matrix(colorMat, ncol = nrow(df)) + colnames(colorMat) <- rownames(df) + } } - + .logThis(colorMat, "colorMat-After-Impute", logFile = logFile) - + colorList <- lapply(seq_len(nrow(colorMat)), function(x){ colorParams <- list() colorParams$color <- colorMat[x, ] @@ -465,38 +430,39 @@ plotEmbedding <- function( } colorParams }) + } - + if(getArchRVerbose()) message("Plotting Embedding") - + ggList <- lapply(seq_along(colorList), function(x){ - + if(getArchRVerbose()) message(x, " ", appendLF = FALSE) - + plotParamsx <- .mergeParams(colorList[[x]], plotParams) - + if(plotParamsx$discrete){ plotParamsx$color <- paste0(plotParamsx$color) } - + if(!plotParamsx$discrete){ - + if(!is.null(quantCut)){ plotParamsx$color <- .quantileCut(plotParamsx$color, min(quantCut), max(quantCut)) } - + plotParamsx$pal <- paletteContinuous(set = plotParamsx$continuousSet) - + if(!is.null(pal)){ - + plotParamsx$pal <- pal } - + if(is.null(plotAs)){ plotAs <- "hexplot" } - + if(!is.null(log2Norm)){ if(log2Norm){ plotParamsx$color <- log2(plotParamsx$color + 1) @@ -505,62 +471,62 @@ plotEmbedding <- function( plotParamsx$colorTitle <- units } } - + if(tolower(plotAs) == "hex" | tolower(plotAs) == "hexplot"){ - + plotParamsx$discrete <- NULL plotParamsx$continuousSet <- NULL plotParamsx$rastr <- NULL plotParamsx$size <- NULL plotParamsx$randomize <- NULL - + .logThis(plotParamsx, name = paste0("PlotParams-", x), logFile = logFile) gg <- do.call(ggHex, plotParamsx) - + }else{ - + if(!is.null(highlightCells)){ plotParamsx$highlightPoints <- highlightPoints } - + .logThis(plotParamsx, name = paste0("PlotParams-", x), logFile = logFile) gg <- do.call(ggPoint, plotParamsx) - + } - + }else{ if(!is.null(pal)){ plotParamsx$pal <- pal } - + if(!is.null(highlightCells)){ plotParamsx$highlightPoints <- highlightPoints } - + .logThis(plotParamsx, name = paste0("PlotParams-", x), logFile = logFile) gg <- do.call(ggPoint, plotParamsx) - + } - + if(!keepAxis){ gg <- gg + theme(axis.text.x=element_blank(), axis.ticks.x=element_blank(), axis.text.y=element_blank(), axis.ticks.y=element_blank()) } - + gg - + }) names(ggList) <- name if(getArchRVerbose()) message("") - + if(length(ggList) == 1){ ggList <- ggList[[1]] } - + .endLogging(logFile = logFile) - + ggList - + } #' Visualize Groups from ArchR Project From e484d360dc048e280e91586c84ceefbefa5c382c Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Tue, 28 Mar 2023 09:54:23 -0700 Subject: [PATCH 139/162] bugfix --- R/ShinyArchRExports.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 446bd501..fcd82c3b 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -97,7 +97,7 @@ exportShinyArchR <- function( supportedMatrices <- c("GeneScoreMatrix", "GeneIntegrationMatrix", "MotifMatrix") #only these matrices are currently supported for ShinyArchR #subset matrices for use in Shiny app - allMatrices <- getAvailableMatrices(ArchRProjShiny) + allMatrices <- getAvailableMatrices(ArchRProj) if(!is.null(matsToUse)){ if(!all(matsToUse %in% allMatrices)){ stop("Not all matrices defined in matsToUse exist in your ArchRProject. See getAvailableMatrices().") From 89fd4af6cd520a02750c9e98ff624badad1d5680 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Tue, 28 Mar 2023 10:00:32 -0700 Subject: [PATCH 140/162] bugfix make groups apply to both frags and cov --- R/ShinyArchRExports.R | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index fcd82c3b..6ec72892 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -150,14 +150,15 @@ exportShinyArchR <- function( fragFiles <- list.files(path = file.path(fragDir, pattern = "\\_frags.rds$")) dir.create(file.path(mainOutputDir, "ShinyFragments"), showWarnings = FALSE) + groups <- unique(ArchRProj@cellColData[,groupBy]) + #check for the existence of each expected fragment file and create if not found - fragGroups <- unique(ArchRProj@cellColData[,groupBy]) - fragOut <- .safelapply(seq_along(fragGroups), function(x){ - fragGroupsx <- fragGroups[x] - if(!file.exists(file.path(fragDir,paste0(fragGroupsx,"_frags.rds"))) | force){ + fragOut <- .safelapply(seq_along(groups), function(x){ + groupsx <- groups[x] + if(!file.exists(file.path(fragDir,paste0(groupsx,"_frags.rds"))) | force){ .exportGroupFragmentsRDS(ArchRProj = ArchRProjShiny, groupBy = groupBy, outDir = fragDir, threads = threads) } else { - message(paste0("Fragment file for ", fragGroupsx," already exist. Skipping fragment file generation...")) + message(paste0("Fragment file for ", groupsx," already exist. Skipping fragment file generation...")) } return(NULL) }, threads = threads) From d5353804df9ebe703bf914ec6c4c1ed8bf4f46cf Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Tue, 28 Mar 2023 10:06:56 -0700 Subject: [PATCH 141/162] add threads argument to exportClusterCoverage --- R/GroupExport.R | 8 ++++++-- R/ShinyArchRExports.R | 2 +- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/R/GroupExport.R b/R/GroupExport.R index 30ded3d3..652177ae 100644 --- a/R/GroupExport.R +++ b/R/GroupExport.R @@ -576,6 +576,7 @@ getGroupFragments <- function( #' user-supplied `cellColData` metadata columns (for example, "Clusters"). Cells with the same value annotated in this metadata #' column will be grouped together and their fragments exported to `outputDirectory`/GroupFragments. #' @param outDir the directory to output the group fragment files. +#' @param threads An integer specifying the number of threads for parallel. #' #' @examples #' @@ -629,6 +630,7 @@ getGroupFragments <- function( #' column will be grouped together and the average signal will be plotted. #' @param fragDir The path to the directory containing fragment files. #' @param outDir The path to the desired output directory for storage of coverage files. +#' @param threads An integer specifying the number of threads for parallel. #' .exportClusterCoverageRDS <- function( ArchRProj = NULL, @@ -636,7 +638,8 @@ getGroupFragments <- function( scaleFactor = 1, groupBy = "Clusters", fragDir = file.path(getOutputDirectory(ArchRProj), "fragments"), - outDir = file.path(getOutputDirectory(ArchRProj), "coverage") + outDir = file.path(getOutputDirectory(ArchRProj), "coverage"), + threads = getArchRThreads() ){ fragFiles = list.files(path = fragDir, pattern = "_frags.rds", full.names = TRUE) if(length(fragFiles) < 1){ @@ -687,5 +690,6 @@ getGroupFragments <- function( binnedCoverage <- coverage(bins, weight = bins$reads * scaleFactor ) saveRDS(binnedCoverage, file.path(outDir, paste0(groupID, "_cvg.rds"))) - }, threads = threads) + }, threads = threads) + return(NULL) } diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 6ec72892..d9e8a6ef 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -171,7 +171,7 @@ exportShinyArchR <- function( covOut <- .safelapply(seq_along(groups), function(x){ groupsx <- groups[x] if(!file.exists(file.path(covDir,paste0(groupsx,"_cvg.rds"))) | force){ - .exportClusterCoverageRDS(ArchRProj = ArchRProjShiny, tileSize = tileSize, groupBy = groupBy, outDir = covDir, fragDir = fragDir) + .exportClusterCoverageRDS(ArchRProj = ArchRProjShiny, tileSize = tileSize, groupBy = groupBy, outDir = covDir, fragDir = fragDir, threads = threads) } else { message(paste0("Coverage file for ", groupsx," already exist. Skipping coverage file generation...")) } From bbb2c9fe3ed7d0680f55cb7b043e8bb5837618c9 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Tue, 28 Mar 2023 10:12:20 -0700 Subject: [PATCH 142/162] bugfix addSeqLengths is hidden correct function name --- R/GroupExport.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/GroupExport.R b/R/GroupExport.R index 652177ae..f7714ec7 100644 --- a/R/GroupExport.R +++ b/R/GroupExport.R @@ -683,7 +683,7 @@ getGroupFragments <- function( minoverlap = 0L, type = "any" ) - addSeqLengths(bins, genome) + .addSeqLengths(bins, genome) groupReadsInTSS <- ArchRProj@cellColData$ReadsInTSS[cells %in% cellGroups$groupID] From 415a8a4c24297c39e892fac1464eb1a489feeda8 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Tue, 28 Mar 2023 10:17:24 -0700 Subject: [PATCH 143/162] bugfix old arguments --- R/ShinyArchRExports.R | 11 +---------- 1 file changed, 1 insertion(+), 10 deletions(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index d9e8a6ef..4bc9a023 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -354,7 +354,6 @@ exportShinyArchR <- function( #' @param outDirEmbed Where the HDF5 and the jpgs will be saved. #' @param colorBy A string indicating whether points in the plot should be colored by a column in `cellColData` ("cellColData") or by #' a data matrix in the corresponding ArrowFiles (i.e. "GeneScoreMatrix", "MotifMatrix", "PeakMatrix"). -#' @param supportedMatrices #' @param embedding The embedding to use. Default is "UMAP". #' @param threads The number of threads to use for parallel execution. #' @param verbose A boolean value that determines whether standard output should be printed. @@ -363,12 +362,8 @@ exportShinyArchR <- function( .matrixEmbeds <- function( ArchRProj = NULL, outDirEmbed = NULL, - colorBy = "cellColData", - supportedMatrices = c("GeneScoreMatrix", "GeneIntegrationMatrix", "MotifMatrix"), + colorBy = NULL, embedding = "UMAP", - embeddingDF = NULL, - matrices = NULL, - imputeMatrices = NULL, threads = getArchRThreads(), verbose = TRUE, logFile = createLogFile("matrixEmbeds") @@ -376,11 +371,7 @@ exportShinyArchR <- function( .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) .validInput(input = outDirEmbed, name = "outDirEmbed", valid = c("character")) .validInput(input = colorBy, name = "colorBy", valid = c("character")) - .validInput(input = supportedMatrices, name = "supportedMatrices", valid = c("character")) .validInput(input = embedding, name = "embedding", valid = c("character")) - .validInput(input = embeddingDF, name = "embeddingDF", valid = c("data.frame")) - .validInput(input = matrices, name = "matrices", valid = c("list")) - .validInput(input = imputeMatrices, name = "imputeMatrices", valid = c("list")) .validInput(input = threads, name = "threads", valid = c("numeric")) .validInput(input = verbose, name = "verbose", valid = c("boolean")) .validInput(input = logFile, name = "logFile", valid = c("character")) From 0cc745734da634ebb6ee481c9d18c5314e69425b Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Tue, 28 Mar 2023 10:34:45 -0700 Subject: [PATCH 144/162] add back feature name storage --- R/ShinyArchRExports.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 4bc9a023..61ce649e 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -394,6 +394,8 @@ exportShinyArchR <- function( featureNames <- getFeatures(ArchRProj = ArchRProj, useMatrix = mat) featureNames <- featureNames[which(!is.na(featureNames))] + dir.create(file.path(subOutputDir, mat), showWarnings = FALSE) + saveRDS(featuresNames, file.path(subOutputDir, mat, paste0(mat, "_names.rds"))) message(paste0("Creating plots for ", mat,"...")) From 2b1d8fcd0ecdbfba1dea7b6748132da6e5a791d9 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Tue, 28 Mar 2023 10:39:39 -0700 Subject: [PATCH 145/162] remove explicit namespace loading from global is this needed? seems like it should not be needed --- Shiny/global.R | 9 --------- 1 file changed, 9 deletions(-) diff --git a/Shiny/global.R b/Shiny/global.R index 2b850fae..f6e8bc5e 100644 --- a/Shiny/global.R +++ b/Shiny/global.R @@ -27,15 +27,6 @@ library(htmltools) ############# NEW ADDITIONS (start) ############################### -# Adjusting ArchR functions -fn <- base::unclass(utils::lsf.str(envir = base::asNamespace("ArchR"), all = TRUE)) -for (i in base::seq_along(fn)) { - base::tryCatch({ - base::eval(base::parse(text = base::paste0(fn[i], "<-ArchR:::", fn[i]))) - }, error = function(x) { - }) -} - # Calling ArchRProj ArchRProj <- ArchR::loadArchRProject(path = ".", shiny = TRUE) ArchRProj <- ArchR::addImputeWeights(ArchRProj = ArchRProj) From fc3f673902af324104c1820a9bef0d5162b69ef1 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Tue, 28 Mar 2023 10:43:23 -0700 Subject: [PATCH 146/162] bugfix dir name --- R/ShinyArchRExports.R | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 61ce649e..7a81abe1 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -389,13 +389,12 @@ exportShinyArchR <- function( embeds_pal_list = list() for(mat in colorBy){ - - dir.create(paste0(outDirEmbed, "/",mat, "/embeds"), showWarnings = FALSE) + dir.create(file.path(outDirEmbed, mat), showWarnings = FALSE) + dir.create(file.path(outDirEmbed, mat, "/embeds"), showWarnings = FALSE) featureNames <- getFeatures(ArchRProj = ArchRProj, useMatrix = mat) featureNames <- featureNames[which(!is.na(featureNames))] - dir.create(file.path(subOutputDir, mat), showWarnings = FALSE) - saveRDS(featuresNames, file.path(subOutputDir, mat, paste0(mat, "_names.rds"))) + saveRDS(featuresNames, file.path(outDirEmbed, mat, paste0(mat, "_names.rds"))) message(paste0("Creating plots for ", mat,"...")) From 11039ee02eb796f9ed8b6ddbc33fb7b579143e70 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Tue, 28 Mar 2023 10:48:50 -0700 Subject: [PATCH 147/162] typo --- R/ShinyArchRExports.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 7a81abe1..07e668c6 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -394,7 +394,7 @@ exportShinyArchR <- function( featureNames <- getFeatures(ArchRProj = ArchRProj, useMatrix = mat) featureNames <- featureNames[which(!is.na(featureNames))] - saveRDS(featuresNames, file.path(outDirEmbed, mat, paste0(mat, "_names.rds"))) + saveRDS(featureNames, file.path(outDirEmbed, mat, paste0(mat, "_names.rds"))) message(paste0("Creating plots for ", mat,"...")) From e742abb32738eb6b79266c62612055a2838db8fc Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Tue, 28 Mar 2023 11:39:42 -0700 Subject: [PATCH 148/162] add status reporting for feature plots --- R/ShinyArchRExports.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 07e668c6..253064a2 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -412,6 +412,9 @@ exportShinyArchR <- function( ) embeds_points <- .safelapply(seq_along(featurePlots), function(x){ + if((x %% 100) == 0) { + message("Processing feature #",x," of ",length(featurePlots)," for ", mat,".") + } featurePlotx <- featurePlots[x][[1]] if(!is.null(featurePlotx)){ From 4b374760b1333d4fbf327ed11ac822d04f0becd7 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Tue, 28 Mar 2023 11:42:51 -0700 Subject: [PATCH 149/162] pass logFile to plotEmbedding --- R/ShinyArchRExports.R | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 253064a2..a7062dae 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -280,6 +280,8 @@ exportShinyArchR <- function( embedding = embedding, rastr = FALSE, size = 0.5, + threads = threads, + logFile = logFile ) + ggtitle(paste0("Colored by ", cellColEmbeddings[x])) + theme( text = element_text(size=12), @@ -408,7 +410,8 @@ exportShinyArchR <- function( imputeWeights = getImputeWeights(ArchRProj = ArchRProj), plotAs = "points", rastr = TRUE, - threads = threads + threads = threads, + logFile = logFile ) embeds_points <- .safelapply(seq_along(featurePlots), function(x){ From ee7e5530340a1e22c2c20bef3e7fcf5f5ce58172 Mon Sep 17 00:00:00 2001 From: Paulina Paiz Date: Tue, 28 Mar 2023 17:24:49 -0400 Subject: [PATCH 150/162] typo --- R/ShinyArchRExports.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index d805b945..bd0ae498 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -255,7 +255,7 @@ exportShinyArchR <- function( message("Generating raster embedding images for matrix data...") - # matrixEmbeds will create an HDF5 file containing he nativeRaster vectors for data stored in matrices + # matrixEmbeds will create an HDF5 file containing the nativeRaster vectors for data stored in matrices if(!file.exists(file.path(subOutputDir, "plotBlank72.h5"))){ embeddingDF = df From 7b1ce6b9812a19353742fec9fa8ff360cbcb5042 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Tue, 28 Mar 2023 09:45:42 -0700 Subject: [PATCH 151/162] remove Shiny version of plotEmbedding fix mainEmbeds and matrixEmbeds to use the original version of plotEmbedding. Remove all shiny-centric updates to plotEmbedding --- R/ShinyArchRExports.R | 207 +++++++++++------------------------------- R/VisualizeData.R | 180 +++++++++++++++--------------------- 2 files changed, 126 insertions(+), 261 deletions(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index bd0ae498..92099db7 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -141,12 +141,6 @@ exportShinyArchR <- function( # Add metadata to ArchRProjShiny ArchRProjShiny@projectMetadata[["groupBy"]] <- groupBy ArchRProjShiny@projectMetadata[["tileSize"]] <- tileSize - units <- tryCatch({ - .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, "/Info/Units"))[1] - },error=function(e){ - "values" - }) - ArchRProjShiny@projectMetadata[["units"]] <- units #copy the RDS corresponding to the ArchRProject to a new directory for use in the Shiny app file.copy(file.path(getOutputDirectory(ArchRProjShiny), savedArchRProjFile), file.path(mainOutputDir), recursive=FALSE) @@ -183,93 +177,36 @@ exportShinyArchR <- function( return(NULL) }, threads = threads) - matrices <- list() - imputeMatrices <- list() - imputeWeights <- getImputeWeights(ArchRProj = ArchRProjShiny) - df <- getEmbedding(ArchRProjShiny, embedding = embedding, returnDF = TRUE) - - if(!file.exists(file.path(subOutputDir, "matrices.rds")) && !file.exists(file.path(subOutputDir, "imputeMatrices.rds"))){ - for(matName in allMatrices){ - if(matName %in% supportedMatrices){ - - featuresNames <- getFeatures(ArchRProj = ArchRProj, useMatrix = matName) - dir.create(file.path(subOutputDir, matName), showWarnings = FALSE) - saveRDS(featuresNames, file.path(subOutputDir, matName, paste0(matName, "_names.rds"))) - - if(!is.null(featuresNames)){ - - mat = Matrix(.getMatrixValues( - ArchRProj = ArchRProjShiny, - name = featuresNames, - matrixName = matName, - log2Norm = FALSE, - threads = threads), sparse = TRUE) - - matrices[[matName]] = mat - matList = mat[,rownames(df), drop=FALSE] - .logThis(matList, paste0(matName,"-Before-Impute"), logFile = logFile) - - if(getArchRVerbose()) message("Imputing Matrix") - - imputeMat <- imputeMatrix(mat = as.matrix(matList), imputeWeights = imputeWeights, logFile = logFile) - - if(!inherits(imputeMat, "matrix")){ - imputeMat <- matrix(imputeMat, ncol = nrow(df)) - colnames(imputeMat) <- rownames(df) - } - imputeMatrices[[matName]] <- imputeMat - - }else{ - stop(matName, " is NULL.") - } - } - } - - matrices$allColorBy= .availableArrays(head(getArrowFiles(ArchRProj), 2)) - saveRDS(matrices, file.path(subOutputDir, "matrices.rds")) - saveRDS(imputeMatrices, file.path(subOutputDir, "imputeMatrices.rds")) - }else{ - - message("Matrices and imputed matrices already exist. Reading from local files...") - - matrices <- readRDS(file.path(subOutputDir, "matrices.rds")) - imputeMatrices <- readRDS(file.path(subOutputDir, "imputeMatrices.rds")) - } - + #Create embedding plots for columns in cellColData message("Generating raster embedding images for cellColData entries...") # mainEmbeds will create an HDF5 file containing the nativeRaster vectors for data stored in cellColData if (!file.exists(file.path(subOutputDir, "mainEmbeds.h5"))) { - .mainEmbeds(ArchRProj = ArchRProjShiny, - outDirEmbed = file.path(subOutputDir), - colorBy = "cellColData", - cellColEmbeddings = cellColEmbeddings, - embeddingDF = df, - matrices = matrices, - imputeMatrices = imputeMatrices, - logFile = createLogFile("mainEmbeds") - ) + .mainEmbeds( + ArchRProj = ArchRProjShiny, + outDirEmbed = file.path(subOutputDir), + colorBy = "cellColData", + cellColEmbeddings = cellColEmbeddings, + embedding = embedding, + logFile = logFile + ) } else{ message("H5 for main embeddings already exists...") } + #Create embedding plots for matrices message("Generating raster embedding images for matrix data...") # matrixEmbeds will create an HDF5 file containing the nativeRaster vectors for data stored in matrices if(!file.exists(file.path(subOutputDir, "plotBlank72.h5"))){ - embeddingDF = df - .matrixEmbeds( ArchRProj = ArchRProj, outDirEmbed = file.path(subOutputDir), colorBy = intersect(supportedMatrices, allMatrices), embedding = embedding, - embeddingDF = df, - matrices = matrices, - imputeMatrices = imputeMatrices, - threads = getArchRThreads(), + threads = threads, verbose = TRUE, - logFile = createLogFile("matrixEmbeds") + logFile = logFile ) }else{ @@ -306,9 +243,6 @@ exportShinyArchR <- function( #' @param cellColEmbeddings A character vector of columns in `cellColData` to plot as part of the Shiny app. No default is provided so this must be set. #' For ex. `c("Sample","Clusters","TSSEnrichment","nFrags")`. #' @param embedding The embedding to use. Default is "UMAP". -#' @param embeddingDF -#' @param matrices List of stored matrices to use for plotEmbedding so that it runs faster. -#' @param imputeMatrices List of stored imputed matrices to use for plotEmbedding so that it runs faster. #' @param threads The number of threads to use for parallel execution. #' @param logFile The path to a file to be used for logging ArchR output. #' @@ -318,9 +252,6 @@ exportShinyArchR <- function( colorBy = "cellColData", cellColEmbeddings = NULL, embedding = "UMAP", - embeddingDF = NULL, - matrices = NULL, - imputeMatrices = NULL, threads = getArchRThreads(), logFile = createLogFile("mainEmbeds") ){ @@ -329,7 +260,6 @@ exportShinyArchR <- function( .validInput(input = colorBy, name = "colorBy", valid = c("character")) .validInput(input = cellColEmbeddings, name = "cellColEmbeddings", valid = c("character")) .validInput(input = embedding, name = "embedding", valid = c("character")) - .validInput(input = embeddingDF, name = "embeddingDF", valid = c("data.frame")) .validInput(input = threads, name = "threads", valid = c("numeric")) .validInput(input = logFile, name = "logFile", valid = c("character")) @@ -339,26 +269,26 @@ exportShinyArchR <- function( if(!file.exists(file.path(outDirEmbed, "embeds.rds"))){ embeds <- .safelapply(1:length(cellColEmbeddings), function(x){ # - name <- cellColEmbeddings[x] + tryCatch({ named_embed <- plotEmbedding( ArchRProj = ArchRProj, baseSize = 12, colorBy = colorBy, - name = name, + name = cellColEmbeddings[x], embedding = embedding, - embeddingDF = embeddingDF, rastr = FALSE, size = 0.5, - matrices = matrices, - imputeMatrices = imputeMatrices, - Shiny = TRUE - )+ggtitle(paste0("Colored by ", name))+theme(text = element_text(size=12), - legend.title = element_text(size = 12),legend.text = element_text(size = 6)) + ) + ggtitle(paste0("Colored by ", cellColEmbeddings[x])) + + theme( + text = element_text(size=12), + legend.title = element_text(size = 12), + legend.text = element_text(size = 6) + ) }, error = function(x){ print(x) }) - return(named_embed) + return(named_embed) }, threads = threads) names(embeds) <- cellColEmbeddings @@ -425,8 +355,6 @@ exportShinyArchR <- function( #' a data matrix in the corresponding ArrowFiles (i.e. "GeneScoreMatrix", "MotifMatrix", "PeakMatrix"). #' @param supportedMatrices #' @param embedding The embedding to use. Default is "UMAP". -#' @param matrices List of stored matrices to use for plotEmbedding so that it runs faster. -#' @param imputeMatrices List of stored imputed matrices to use for plotEmbedding so that it runs faster. #' @param threads The number of threads to use for parallel execution. #' @param verbose A boolean value that determines whether standard output should be printed. #' @param logFile The path to a file to be used for logging ArchR output. @@ -468,46 +396,33 @@ exportShinyArchR <- function( # save the palette embeds_pal_list = list() - allMatrices <- getAvailableMatrices(ArchRProj) - for(mat in colorBy){ - - if(file.exists(paste0(outDirEmbed, "/",mat, "/", mat, "_names.rds"))){ - dir.create(paste0(outDirEmbed, "/",mat, "/embeds"), showWarnings = FALSE) - - featureNames <- readRDS(file.path(outDirEmbed, mat, paste0(mat,"_names.rds"))) + dir.create(paste0(outDirEmbed, "/",mat, "/embeds"), showWarnings = FALSE) + + featureNames <- getFeatures(ArchRProj = ArchRProj, useMatrix = mat) + featureNames <- featureNames[which(!is.na(featureNames))] - if(!is.null(featureNames)){ - - embeds_points <- .safelapply(1:length(featureNames), function(x){ #length(featureNames) - - print(paste0("Creating plots for ", mat,": ",x,": ",round((x/length(featureNames))*100,3), "%")) + message(paste0("Creating plots for ", mat,"...")) - if(!is.na(featureNames[x])){ - - gene_plot <- plotEmbedding( - ArchRProj = ArchRProj, - colorBy = mat, - name = featureNames[x], - embedding = embedding, - quantCut = c(0.01, 0.95), - imputeWeights = getImputeWeights(ArchRProj = ArchRProj), - plotAs = "points", - embeddingDF = embeddingDF, - matrices = matrices, - imputeMatrices = imputeMatrices, - rastr = TRUE - ) - - - }else{ - gene_plot = NULL - } - - if(!is.null(gene_plot)){ + if(!is.null(featureNames)){ + + featurePlots <- plotEmbedding( + ArchRProj = ArchRProj, + colorBy = mat, + name = featureNames, + quantCut = c(0.01, 0.95), + imputeWeights = getImputeWeights(ArchRProj = ArchRProj), + plotAs = "points", + rastr = TRUE, + threads = threads + ) + + embeds_points <- .safelapply(seq_along(featurePlots), function(x){ + featurePlotx <- featurePlots[x][[1]] + if(!is.null(featurePlotx)){ - gene_plot_blank <- gene_plot + theme(axis.title.x = element_blank()) + + featurePlotx_blank <- featurePlotx + theme(axis.title.x = element_blank()) + theme(axis.title.y = element_blank()) + theme(axis.title = element_blank()) + theme(legend.position = "none") + @@ -520,22 +435,20 @@ exportShinyArchR <- function( #save plot without axes etc as a jpg. ggsave(filename = file.path(outDirEmbed, mat, "embeds", paste0(featureNames[x],"_blank72.jpg")), - plot = gene_plot_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) + plot = featurePlotx_blank, device = "jpg", width = 3, height = 3, units = "in", dpi = 72) #read back in that jpg because we need vector in native format blank_jpg72 <- jpeg::readJPEG(source = file.path(outDirEmbed, mat, "embeds", paste0(featureNames[x],"_blank72.jpg")), - native = TRUE) + native = TRUE) - g <- ggplot_build(gene_plot) + g <- ggplot_build(featurePlotx) - res = list(list(plot=as.vector(blank_jpg72), min = round(min(gene_plot$data$color),1), - max = round(max(gene_plot$data$color),1), pal = unique(g$data[[1]][,"colour"]))) + res = list(list(plot=as.vector(blank_jpg72), min = round(min(featurePlotx$data$color),1), + max = round(max(featurePlotx$data$color),1), pal = unique(g$data[[1]][,"colour"]))) return(res) } - - - }, threads = threads) + }, threads = threads) names(embeds_points) <- featureNames embeds_points = embeds_points[!unlist(lapply(embeds_points, is.null))] @@ -558,27 +471,14 @@ exportShinyArchR <- function( embeds_min_max_list[[mat]] = embeds_min_max embeds_pal_list[[mat]] = embeds_points[[length(embeds_points)]][[1]]$pal - - -# -# -# embeds_min_max_list[[mat]] = embeds_min_max -# embeds_pal_list[[mat]] = embeds_points[[length(embeds_points)]][[1]]$pal - + }else{ - - message(mat,".rds file does not exist") - } - - }else{ - message(mat,".rds file does not exist. This file should have been created previously be exportShinyArchR. Skipping...") - } - + + stop("Matrix ", mat,"has no features!") + } } -# nms = names(embeds_pal_list) - for(i in 1:length(embeds_pal_list)){ cols = embeds_pal_list[[i]] @@ -588,7 +488,6 @@ for(i in 1:length(embeds_pal_list)){ } - scale <- embeds_min_max_list pal <- embeds_pal_list diff --git a/R/VisualizeData.R b/R/VisualizeData.R index f586ab33..3a370f60 100644 --- a/R/VisualizeData.R +++ b/R/VisualizeData.R @@ -247,15 +247,11 @@ plotEmbedding <- function( keepAxis = FALSE, baseSize = 10, plotAs = NULL, - Shiny = FALSE, - matrices = NULL, - imputeMatrices = NULL, - embeddingDF = NULL, threads = getArchRThreads(), logFile = createLogFile("plotEmbedding"), ... -){ - + ){ + .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) .validInput(input = embedding, name = "reducedDims", valid = c("character")) .validInput(input = colorBy, name = "colorBy", valid = c("character")) @@ -274,39 +270,34 @@ plotEmbedding <- function( .validInput(input = keepAxis, name = "keepAxis", valid = c("boolean")) .validInput(input = baseSize, name = "baseSize", valid = c("numeric")) .validInput(input = plotAs, name = "plotAs", valid = c("character", "null")) - .validInput(input = Shiny, name = "Shiny", valid = c("boolean")) .validInput(input = threads, name = "threads", valid = c("integer")) .validInput(input = logFile, name = "logFile", valid = c("character")) - + .requirePackage("ggplot2", source = "cran") - + .startLogging(logFile = logFile) .logThis(mget(names(formals()),sys.frame(sys.nframe())), "Input-Parameters", logFile=logFile) - + ############################## # Get Embedding ############################## - .logMessage("Getting Embedding", logFile = logFile) - if(Shiny){ - df <- embeddingDF - } else{ - df <- getEmbedding(ArchRProj, embedding = embedding, returnDF = TRUE) - } + .logMessage("Getting UMAP Embedding", logFile = logFile) + df <- getEmbedding(ArchRProj, embedding = embedding, returnDF = TRUE) if(!all(rownames(df) %in% ArchRProj$cellNames)){ stop("Not all cells in embedding are present in ArchRProject!") } + .logThis(df, name = "Embedding data.frame", logFile = logFile) - if(!is.null(sampleCells)){ if(sampleCells < nrow(df)){ if(!is.null(imputeWeights)){ - stop("Cannot sampleCells with imputeWeights not equal to NULL at this time!") + stop("Cannot sampleCells with imputeWeights not equalt to NULL at this time!") } df <- df[sort(sample(seq_len(nrow(df)), sampleCells)), , drop = FALSE] } } - + #Parameters plotParams <- list(...) plotParams$x <- df[,1] @@ -320,33 +311,29 @@ plotEmbedding <- function( plotParams$rastr <- rastr plotParams$size <- size plotParams$randomize <- randomize - - #Check if Cells To Be Highlighted + + #Check if Cells To Be Highlighed if(!is.null(highlightCells)){ highlightPoints <- match(highlightCells, rownames(df), nomatch = 0) if(any(highlightPoints==0)){ stop("highlightCells contain cells not in Embedding cellNames! Please make sure that these match!") } } - + #Make Sure ColorBy is valid! if(length(colorBy) > 1){ stop("colorBy must be of length 1!") } - - if(!Shiny){ - allColorBy <- c("colData", "cellColData", .availableArrays(head(getArrowFiles(ArchRProj), 2))) - } else { - allColorBy <- c("colData", "cellColData", matrices$allColorBy) - } - + allColorBy <- c("colData", "cellColData", .availableArrays(head(getArrowFiles(ArchRProj), 2))) if(tolower(colorBy) %ni% tolower(allColorBy)){ stop("colorBy must be one of the following :\n", paste0(allColorBy, sep=", ")) } colorBy <- allColorBy[match(tolower(colorBy), tolower(allColorBy))] + .logMessage(paste0("ColorBy = ", colorBy), logFile = logFile) - + if(tolower(colorBy) == "coldata" | tolower(colorBy) == "cellcoldata"){ + colorList <- lapply(seq_along(name), function(x){ colorParams <- list() colorParams$color <- as.vector(getCellColData(ArchRProj, select = name[x], drop = FALSE)[rownames(df), 1]) @@ -363,7 +350,7 @@ plotEmbedding <- function( if(x == 1){ .logThis(colorParams, name = "ColorParams 1", logFile = logFile) } - + if(!is.null(imputeWeights)){ if(getArchRVerbose()) message("Imputing Matrix") colorMat <- matrix(colorParams$color, nrow=1) @@ -372,30 +359,28 @@ plotEmbedding <- function( colorParams$color <- as.vector(colorMat) } colorParams - }) - }else{# plotting embedding for matrix instead of col in cellcoldata + }) + + + }else{ + suppressMessages(message(logFile)) - - if(!Shiny){ - units <- tryCatch({ - .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, "/Info/Units"))[1] - },error=function(e){ - "values" + + units <- tryCatch({ + .h5read(getArrowFiles(ArchRProj)[1], paste0(colorBy, "/Info/Units"))[1] + },error=function(e){ + "values" }) - }else{ - units <- ArchRProj@projectMetadata[["units"]] - } if(is.null(log2Norm) & tolower(colorBy) == "genescorematrix"){ log2Norm <- TRUE } - + if(is.null(log2Norm)){ log2Norm <- FALSE } - - if(!Shiny){ - colorMat <- .getMatrixValues( + + colorMat <- .getMatrixValues( ArchRProj = ArchRProj, name = name, matrixName = colorBy, @@ -403,47 +388,27 @@ plotEmbedding <- function( threads = threads, logFile = logFile ) - }else{ - #get values from pre-saved list - colorMat = tryCatch({ - t(as.matrix(matrices[[colorBy]][name,])) - }, warning = function(warning_condition) { - message(paste("name doesn't exist:", name)) - message(warning_condition) - return(NULL) - }, error = function(error_condition) { - message(paste("name doesn't exist:", name)) - message(error_condition) - return(NA) - }, finally={ - }) - rownames(colorMat)=name - } - + if(!all(rownames(df) %in% colnames(colorMat))){ .logMessage("Not all cells in embedding are present in feature matrix. This may be due to using a custom embedding.", logFile = logFile) stop("Not all cells in embedding are present in feature matrix. This may be due to using a custom embedding.") } - + colorMat <- colorMat[,rownames(df), drop=FALSE] - + .logThis(colorMat, "colorMat-Before-Impute", logFile = logFile) - + if(!is.null(imputeWeights)){ if(getArchRVerbose()) message("Imputing Matrix") - if(!Shiny){ - colorMat <- imputeMatrix(mat = as.matrix(colorMat), imputeWeights = imputeWeights, logFile = logFile) - }else{ - colorMat <- imputeMatrices[[colorBy]][name,] - } - if(!inherits(colorMat, "matrix")){ - colorMat <- matrix(colorMat, ncol = nrow(df)) - colnames(colorMat) <- rownames(df) - } + colorMat <- imputeMatrix(mat = as.matrix(colorMat), imputeWeights = imputeWeights, logFile = logFile) + if(!inherits(colorMat, "matrix")){ + colorMat <- matrix(colorMat, ncol = nrow(df)) + colnames(colorMat) <- rownames(df) + } } - + .logThis(colorMat, "colorMat-After-Impute", logFile = logFile) - + colorList <- lapply(seq_len(nrow(colorMat)), function(x){ colorParams <- list() colorParams$color <- colorMat[x, ] @@ -465,38 +430,39 @@ plotEmbedding <- function( } colorParams }) + } - + if(getArchRVerbose()) message("Plotting Embedding") - + ggList <- lapply(seq_along(colorList), function(x){ - + if(getArchRVerbose()) message(x, " ", appendLF = FALSE) - + plotParamsx <- .mergeParams(colorList[[x]], plotParams) - + if(plotParamsx$discrete){ plotParamsx$color <- paste0(plotParamsx$color) } - + if(!plotParamsx$discrete){ - + if(!is.null(quantCut)){ plotParamsx$color <- .quantileCut(plotParamsx$color, min(quantCut), max(quantCut)) } - + plotParamsx$pal <- paletteContinuous(set = plotParamsx$continuousSet) - + if(!is.null(pal)){ - + plotParamsx$pal <- pal } - + if(is.null(plotAs)){ plotAs <- "hexplot" } - + if(!is.null(log2Norm)){ if(log2Norm){ plotParamsx$color <- log2(plotParamsx$color + 1) @@ -505,62 +471,62 @@ plotEmbedding <- function( plotParamsx$colorTitle <- units } } - + if(tolower(plotAs) == "hex" | tolower(plotAs) == "hexplot"){ - + plotParamsx$discrete <- NULL plotParamsx$continuousSet <- NULL plotParamsx$rastr <- NULL plotParamsx$size <- NULL plotParamsx$randomize <- NULL - + .logThis(plotParamsx, name = paste0("PlotParams-", x), logFile = logFile) gg <- do.call(ggHex, plotParamsx) - + }else{ - + if(!is.null(highlightCells)){ plotParamsx$highlightPoints <- highlightPoints } - + .logThis(plotParamsx, name = paste0("PlotParams-", x), logFile = logFile) gg <- do.call(ggPoint, plotParamsx) - + } - + }else{ if(!is.null(pal)){ plotParamsx$pal <- pal } - + if(!is.null(highlightCells)){ plotParamsx$highlightPoints <- highlightPoints } - + .logThis(plotParamsx, name = paste0("PlotParams-", x), logFile = logFile) gg <- do.call(ggPoint, plotParamsx) - + } - + if(!keepAxis){ gg <- gg + theme(axis.text.x=element_blank(), axis.ticks.x=element_blank(), axis.text.y=element_blank(), axis.ticks.y=element_blank()) } - + gg - + }) names(ggList) <- name if(getArchRVerbose()) message("") - + if(length(ggList) == 1){ ggList <- ggList[[1]] } - + .endLogging(logFile = logFile) - + ggList - + } #' Visualize Groups from ArchR Project From 2b577fbd8cc9712d46ce006d456c97680c4da3f6 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Tue, 28 Mar 2023 09:54:23 -0700 Subject: [PATCH 152/162] bugfix --- R/ShinyArchRExports.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 92099db7..1b8ce108 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -97,7 +97,7 @@ exportShinyArchR <- function( supportedMatrices <- c("GeneScoreMatrix", "GeneIntegrationMatrix", "MotifMatrix") #only these matrices are currently supported for ShinyArchR #subset matrices for use in Shiny app - allMatrices <- getAvailableMatrices(ArchRProjShiny) + allMatrices <- getAvailableMatrices(ArchRProj) if(!is.null(matsToUse)){ if(!all(matsToUse %in% allMatrices)){ stop("Not all matrices defined in matsToUse exist in your ArchRProject. See getAvailableMatrices().") From 3d43d13f25817e7259f038c2ef4f19fc28139116 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Tue, 28 Mar 2023 10:00:32 -0700 Subject: [PATCH 153/162] bugfix make groups apply to both frags and cov --- R/ShinyArchRExports.R | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 1b8ce108..bc7c51d0 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -150,14 +150,15 @@ exportShinyArchR <- function( fragFiles <- list.files(path = file.path(fragDir, pattern = "\\_frags.rds$")) dir.create(file.path(mainOutputDir, "ShinyFragments"), showWarnings = FALSE) + groups <- unique(ArchRProj@cellColData[,groupBy]) + #check for the existence of each expected fragment file and create if not found - fragGroups <- unique(ArchRProj@cellColData[,groupBy]) - fragOut <- .safelapply(seq_along(fragGroups), function(x){ - fragGroupsx <- fragGroups[x] - if(!file.exists(file.path(fragDir,paste0(fragGroupsx,"_frags.rds"))) | force){ + fragOut <- .safelapply(seq_along(groups), function(x){ + groupsx <- groups[x] + if(!file.exists(file.path(fragDir,paste0(groupsx,"_frags.rds"))) | force){ .exportGroupFragmentsRDS(ArchRProj = ArchRProjShiny, groupBy = groupBy, outDir = fragDir, threads = threads) } else { - message(paste0("Fragment file for ", fragGroupsx," already exist. Skipping fragment file generation...")) + message(paste0("Fragment file for ", groupsx," already exist. Skipping fragment file generation...")) } return(NULL) }, threads = threads) From 7872f6ab4776fa42fc906bf86e59cfbe7aef48a6 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Tue, 28 Mar 2023 10:06:56 -0700 Subject: [PATCH 154/162] add threads argument to exportClusterCoverage --- R/GroupExport.R | 9 ++++++--- R/ShinyArchRExports.R | 2 +- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/R/GroupExport.R b/R/GroupExport.R index 5e8a50de..652177ae 100644 --- a/R/GroupExport.R +++ b/R/GroupExport.R @@ -576,6 +576,7 @@ getGroupFragments <- function( #' user-supplied `cellColData` metadata columns (for example, "Clusters"). Cells with the same value annotated in this metadata #' column will be grouped together and their fragments exported to `outputDirectory`/GroupFragments. #' @param outDir the directory to output the group fragment files. +#' @param threads An integer specifying the number of threads for parallel. #' #' @examples #' @@ -629,6 +630,7 @@ getGroupFragments <- function( #' column will be grouped together and the average signal will be plotted. #' @param fragDir The path to the directory containing fragment files. #' @param outDir The path to the desired output directory for storage of coverage files. +#' @param threads An integer specifying the number of threads for parallel. #' .exportClusterCoverageRDS <- function( ArchRProj = NULL, @@ -636,7 +638,8 @@ getGroupFragments <- function( scaleFactor = 1, groupBy = "Clusters", fragDir = file.path(getOutputDirectory(ArchRProj), "fragments"), - outDir = file.path(getOutputDirectory(ArchRProj), "coverage") + outDir = file.path(getOutputDirectory(ArchRProj), "coverage"), + threads = getArchRThreads() ){ fragFiles = list.files(path = fragDir, pattern = "_frags.rds", full.names = TRUE) if(length(fragFiles) < 1){ @@ -687,6 +690,6 @@ getGroupFragments <- function( binnedCoverage <- coverage(bins, weight = bins$reads * scaleFactor ) saveRDS(binnedCoverage, file.path(outDir, paste0(groupID, "_cvg.rds"))) - return(NULL) - }, threads = threads) + }, threads = threads) + return(NULL) } diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index bc7c51d0..221b49b5 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -171,7 +171,7 @@ exportShinyArchR <- function( covOut <- .safelapply(seq_along(groups), function(x){ groupsx <- groups[x] if(!file.exists(file.path(covDir,paste0(groupsx,"_cvg.rds"))) | force){ - .exportClusterCoverageRDS(ArchRProj = ArchRProjShiny, tileSize = tileSize, groupBy = groupBy, outDir = covDir, fragDir = fragDir) + .exportClusterCoverageRDS(ArchRProj = ArchRProjShiny, tileSize = tileSize, groupBy = groupBy, outDir = covDir, fragDir = fragDir, threads = threads) } else { message(paste0("Coverage file for ", groupsx," already exist. Skipping coverage file generation...")) } From 18bdc87f999e5c46a38d8196ad972867416707b7 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Tue, 28 Mar 2023 10:12:20 -0700 Subject: [PATCH 155/162] bugfix addSeqLengths is hidden correct function name --- R/GroupExport.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/GroupExport.R b/R/GroupExport.R index 652177ae..f7714ec7 100644 --- a/R/GroupExport.R +++ b/R/GroupExport.R @@ -683,7 +683,7 @@ getGroupFragments <- function( minoverlap = 0L, type = "any" ) - addSeqLengths(bins, genome) + .addSeqLengths(bins, genome) groupReadsInTSS <- ArchRProj@cellColData$ReadsInTSS[cells %in% cellGroups$groupID] From 0139212be7ded7c041870ad943ab53709d7dcb4a Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Tue, 28 Mar 2023 10:17:24 -0700 Subject: [PATCH 156/162] bugfix old arguments --- R/ShinyArchRExports.R | 11 +---------- 1 file changed, 1 insertion(+), 10 deletions(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 221b49b5..742f7325 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -354,7 +354,6 @@ exportShinyArchR <- function( #' @param outDirEmbed Where the HDF5 and the jpgs will be saved. #' @param colorBy A string indicating whether points in the plot should be colored by a column in `cellColData` ("cellColData") or by #' a data matrix in the corresponding ArrowFiles (i.e. "GeneScoreMatrix", "MotifMatrix", "PeakMatrix"). -#' @param supportedMatrices #' @param embedding The embedding to use. Default is "UMAP". #' @param threads The number of threads to use for parallel execution. #' @param verbose A boolean value that determines whether standard output should be printed. @@ -363,12 +362,8 @@ exportShinyArchR <- function( .matrixEmbeds <- function( ArchRProj = NULL, outDirEmbed = NULL, - colorBy = "cellColData", - supportedMatrices = c("GeneScoreMatrix", "GeneIntegrationMatrix", "MotifMatrix"), + colorBy = NULL, embedding = "UMAP", - embeddingDF = NULL, - matrices = NULL, - imputeMatrices = NULL, threads = getArchRThreads(), verbose = TRUE, logFile = createLogFile("matrixEmbeds") @@ -376,11 +371,7 @@ exportShinyArchR <- function( .validInput(input = ArchRProj, name = "ArchRProj", valid = c("ArchRProj")) .validInput(input = outDirEmbed, name = "outDirEmbed", valid = c("character")) .validInput(input = colorBy, name = "colorBy", valid = c("character")) - .validInput(input = supportedMatrices, name = "supportedMatrices", valid = c("character")) .validInput(input = embedding, name = "embedding", valid = c("character")) - .validInput(input = embeddingDF, name = "embeddingDF", valid = c("data.frame")) - .validInput(input = matrices, name = "matrices", valid = c("list")) - .validInput(input = imputeMatrices, name = "imputeMatrices", valid = c("list")) .validInput(input = threads, name = "threads", valid = c("numeric")) .validInput(input = verbose, name = "verbose", valid = c("boolean")) .validInput(input = logFile, name = "logFile", valid = c("character")) From 5d6cb7453ebf7c7dae456e423bfebbdfaabf4461 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Tue, 28 Mar 2023 10:34:45 -0700 Subject: [PATCH 157/162] add back feature name storage --- R/ShinyArchRExports.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 742f7325..4334d5e9 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -394,6 +394,8 @@ exportShinyArchR <- function( featureNames <- getFeatures(ArchRProj = ArchRProj, useMatrix = mat) featureNames <- featureNames[which(!is.na(featureNames))] + dir.create(file.path(subOutputDir, mat), showWarnings = FALSE) + saveRDS(featuresNames, file.path(subOutputDir, mat, paste0(mat, "_names.rds"))) message(paste0("Creating plots for ", mat,"...")) From 2813105554e047178656d4943eb9529ef400fa81 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Tue, 28 Mar 2023 10:39:39 -0700 Subject: [PATCH 158/162] remove explicit namespace loading from global is this needed? seems like it should not be needed --- Shiny/global.R | 9 --------- 1 file changed, 9 deletions(-) diff --git a/Shiny/global.R b/Shiny/global.R index 2b850fae..f6e8bc5e 100644 --- a/Shiny/global.R +++ b/Shiny/global.R @@ -27,15 +27,6 @@ library(htmltools) ############# NEW ADDITIONS (start) ############################### -# Adjusting ArchR functions -fn <- base::unclass(utils::lsf.str(envir = base::asNamespace("ArchR"), all = TRUE)) -for (i in base::seq_along(fn)) { - base::tryCatch({ - base::eval(base::parse(text = base::paste0(fn[i], "<-ArchR:::", fn[i]))) - }, error = function(x) { - }) -} - # Calling ArchRProj ArchRProj <- ArchR::loadArchRProject(path = ".", shiny = TRUE) ArchRProj <- ArchR::addImputeWeights(ArchRProj = ArchRProj) From 9ad2026d67ecb2c01914f7e6472abbf5af92713b Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Tue, 28 Mar 2023 10:43:23 -0700 Subject: [PATCH 159/162] bugfix dir name --- R/ShinyArchRExports.R | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 4334d5e9..7a31a6ee 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -389,13 +389,12 @@ exportShinyArchR <- function( embeds_pal_list = list() for(mat in colorBy){ - - dir.create(paste0(outDirEmbed, "/",mat, "/embeds"), showWarnings = FALSE) + dir.create(file.path(outDirEmbed, mat), showWarnings = FALSE) + dir.create(file.path(outDirEmbed, mat, "/embeds"), showWarnings = FALSE) featureNames <- getFeatures(ArchRProj = ArchRProj, useMatrix = mat) featureNames <- featureNames[which(!is.na(featureNames))] - dir.create(file.path(subOutputDir, mat), showWarnings = FALSE) - saveRDS(featuresNames, file.path(subOutputDir, mat, paste0(mat, "_names.rds"))) + saveRDS(featuresNames, file.path(outDirEmbed, mat, paste0(mat, "_names.rds"))) message(paste0("Creating plots for ", mat,"...")) From 6fb28fd29bd4a5483b1022b11cf55b9680675186 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Tue, 28 Mar 2023 10:48:50 -0700 Subject: [PATCH 160/162] typo --- R/ShinyArchRExports.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 7a31a6ee..1c73fe71 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -394,7 +394,7 @@ exportShinyArchR <- function( featureNames <- getFeatures(ArchRProj = ArchRProj, useMatrix = mat) featureNames <- featureNames[which(!is.na(featureNames))] - saveRDS(featuresNames, file.path(outDirEmbed, mat, paste0(mat, "_names.rds"))) + saveRDS(featureNames, file.path(outDirEmbed, mat, paste0(mat, "_names.rds"))) message(paste0("Creating plots for ", mat,"...")) From 4807128193a85c4ff61d59b954f22ee327bae473 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Tue, 28 Mar 2023 11:39:42 -0700 Subject: [PATCH 161/162] add status reporting for feature plots --- R/ShinyArchRExports.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 1c73fe71..420e8b07 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -412,6 +412,9 @@ exportShinyArchR <- function( ) embeds_points <- .safelapply(seq_along(featurePlots), function(x){ + if((x %% 100) == 0) { + message("Processing feature #",x," of ",length(featurePlots)," for ", mat,".") + } featurePlotx <- featurePlots[x][[1]] if(!is.null(featurePlotx)){ From b6b1287d9670654a4540aee835324a9f194f5542 Mon Sep 17 00:00:00 2001 From: Ryan Corces Date: Tue, 28 Mar 2023 11:42:51 -0700 Subject: [PATCH 162/162] pass logFile to plotEmbedding --- R/ShinyArchRExports.R | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/R/ShinyArchRExports.R b/R/ShinyArchRExports.R index 420e8b07..76b0291f 100644 --- a/R/ShinyArchRExports.R +++ b/R/ShinyArchRExports.R @@ -280,6 +280,8 @@ exportShinyArchR <- function( embedding = embedding, rastr = FALSE, size = 0.5, + threads = threads, + logFile = logFile ) + ggtitle(paste0("Colored by ", cellColEmbeddings[x])) + theme( text = element_text(size=12), @@ -408,7 +410,8 @@ exportShinyArchR <- function( imputeWeights = getImputeWeights(ArchRProj = ArchRProj), plotAs = "points", rastr = TRUE, - threads = threads + threads = threads, + logFile = logFile ) embeds_points <- .safelapply(seq_along(featurePlots), function(x){