diff --git a/DESCRIPTION b/DESCRIPTION index a8bb1585..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' @@ -91,6 +118,7 @@ Collate: 'RcppExports.R' 'ReproduciblePeakSet.R' 'SparseUtils.R' + 'ShinyArchRExports.R' 'Trajectory.R' 'ValidationUtils.R' - 'VisualizeData.R' + 'VisualizeData.R' \ No newline at end of file diff --git a/R/.DS_Store b/R/.DS_Store deleted file mode 100644 index f00a9343..00000000 Binary files a/R/.DS_Store and /dev/null differ diff --git a/R/AllClasses.R b/R/AllClasses.R index a46b9d83..7cbd6abd 100644 --- a/R/AllClasses.R +++ b/R/AllClasses.R @@ -9,21 +9,21 @@ 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 @@ -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. 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 #' #' # Get Small PBMC Project Location @@ -401,132 +403,136 @@ recoverArchRProject <- function(ArchRProj){ loadArchRProject <- function( path = "./", force = FALSE, - showLogo = TRUE - ){ - + 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)){ stop("Could not find previously saved ArchRProject in the path specified!") } - + ArchRProj <- recoverArchRProject(readRDS(path2Proj)) outputDir <- getOutputDirectory(ArchRProj) outputDirNew <- normalizePath(path) - - #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 - + + }else{ + + S4Vectors::metadata(ArchRProj@peakSet)$bgdPeaks <- bgdPeaksNew + + } + } - + } - - 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 - - } - + + #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 - #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. @@ -554,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)) @@ -572,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){ @@ -602,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))) @@ -623,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)){ @@ -641,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){ @@ -656,9 +662,9 @@ saveArchRProject <- function( stopifnot(all(file.exists(zfiles))) } } - + } - + message("Saving ArchRProject...") .safeSaveRDS(newProj, file.path(outputDirectory, "Save-ArchR-Project.rds")) @@ -666,7 +672,7 @@ saveArchRProject <- function( message("Loading ArchRProject...") loadArchRProject(path = outputDirectory) } - + } #' Subset an ArchRProject for downstream analysis @@ -698,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, @@ -724,7 +730,7 @@ subsetArchRProject <- function( logFile = logFile, threads = threads ) - + } #Accessor methods adapted from Seurat @@ -798,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.") } @@ -813,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){ @@ -841,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){ @@ -851,9 +857,9 @@ subsetArchRProject <- function( names(eD2) <- names(eD) x@embeddings <- eD2 rm(eD, eD2) - + return(x) - + } setMethod( @@ -871,9 +877,3 @@ setMethod( rownames(x@cellColData) } ) - - - - - - diff --git a/R/AnnotationGenome.R b/R/AnnotationGenome.R index db5e93f8..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. @@ -384,7 +384,22 @@ 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 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. +.addSeqLengths <- function (gr, genome) { + gr <- .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 f2bcdc83..a725c724 100644 --- a/R/ArchRBrowser.R +++ b/R/ArchRBrowser.R @@ -49,6 +49,7 @@ ArchRBrowser <- function( browserTheme = "cosmo", threads = getArchRThreads(), verbose = TRUE, + ShinyArchR = FALSE, logFile = createLogFile("ArchRBrowser") ){ @@ -64,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) @@ -382,6 +384,7 @@ ArchRBrowser <- function( p <- .bulkTracks( ArchRProj = ArchRProj, + ShinyArchR = ShinyArchR, region = region, tileSize = tileSize, useGroups = useGroups, @@ -524,6 +527,7 @@ ArchRBrowser <- function( p <- .bulkTracks( ArchRProj = ArchRProj, + ShinyArchR = ShinyArchR, region = tmpArchRRegion, tileSize = tileSize, useGroups = useGroups, @@ -698,6 +702,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. @@ -748,6 +754,7 @@ plotBrowserTrack <- function( tickWidth = 0.4, facetbaseSize = 7, geneAnnotation = getGeneAnnotation(ArchRProj), + ShinyArchR = FALSE, title = "", verbose = TRUE, logFile = createLogFile("plotBrowserTrack") @@ -781,6 +788,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") @@ -833,7 +841,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, @@ -1010,6 +1019,7 @@ plotBrowserTrack <- function( ####################################################### .bulkTracks <- function( ArchRProj = NULL, + ShinyArchR = FALSE, region = NULL, tileSize = 100, maxCells = 500, @@ -1035,10 +1045,12 @@ plotBrowserTrack <- function( .requirePackage("ggplot2", source = "cran") + if(is.null(tstart)){ tstart <- Sys.time() } + if(!ShinyArchR){ df <- .groupRegionSumArrows( ArchRProj = ArchRProj, groupBy = groupBy, @@ -1052,6 +1064,21 @@ plotBrowserTrack <- function( verbose = verbose, logFile = logFile ) + } else { + df <- .groupRegionSumCvg( + ArchRProj = ArchRProj, + groupBy = groupBy, + normMethod = normMethod, + useGroups = useGroups, + sampleLabels = sampleLabels, + minCells = minCells, + region = region, + tileSize = tileSize, + threads = threads, + verbose = verbose, + logFile = logFile + ) + } .logThis(split(df, df[,3]), ".bulkTracks df", logFile = logFile) ###################################################### @@ -1330,6 +1357,158 @@ plotBrowserTrack <- function( } +############################################################################## +# Create Average Tracks from Coverage objects +############################################################################## +.groupRegionSumCvg <- function( + ArchRProj = NULL, + useGroups = NULL, + groupBy = NULL, + sampleLabels = "Sample", + 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, sampleLabels, 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 = 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]]) + 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 <- cellGroups + + 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 ####################################################### @@ -2104,10 +2283,3 @@ plotBrowserTrack <- function( p } - - - - - - - diff --git a/R/ArrowRead.R b/R/ArrowRead.R index 1f04247a..75b2a7fa 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/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/GroupExport.R b/R/GroupExport.R index ac68fb94..f7714ec7 100644 --- a/R/GroupExport.R +++ b/R/GroupExport.R @@ -564,3 +564,132 @@ getGroupFragments <- function( unlist(outList) } + +#' 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 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 +#' 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 +#' +#' # Get Test ArchR Project +#' proj <- getTestProject() +#' +#' # Create directory for fragments +#' ArchR:::.exportGroupFragmentsRDS(proj, groupBy = "Clusters", outDir = "./Shiny/Fragments") +#' +.exportGroupFragmentsRDS <- function( + ArchRProj = NULL, + groupBy = NULL, + outDir = file.path(getOutputDirectory(ArchRProj), "fragments"), + threads = getArchRThreads() +){ + dir.create(outDir, showWarnings = FALSE) + + # find barcodes of cells in that groupBy. + cellGroups <- getCellColData(ArchRProj, select = groupBy, drop = TRUE) + cells <- ArchRProj$cellNames + cellGroups <- split(cells, cellGroups) + + # outputs unique cell groups (e.g. cluster). + groupIDs <- names(cellGroups) + + + .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) + fragments <- unlist(fragments, use.names = FALSE) + # 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 +#' +#' 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. +#' 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 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, + tileSize = 100, + scaleFactor = 1, + groupBy = "Clusters", + fragDir = file.path(getOutputDirectory(ArchRProj), "fragments"), + outDir = file.path(getOutputDirectory(ArchRProj), "coverage"), + threads = getArchRThreads() +){ + 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. + cellGroups <- getCellColData(ArchRProj, select = groupBy, drop = TRUE) + cells <- ArchRProj$cellNames + cellGroups <- split(cells, cellGroups) + + # outputs unique cell groups/clusters. + groupIDs <- names(cellGroups) + + chrRegions <- getChromSizes(ArchRProj) + genome <- getGenome(ArchRProj) + + fragOut <- .safelapply(seq_along(fragFiles), function(x){ + + fragments <- readRDS(fragFiles[x]) + 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() + + groupID <- fragFiles[x] %>% basename() %>% gsub(".{4}$", "", .) + # binnedCoverage + message("Creating bins for group ", groupID, "...") + bins <- + unlist(slidingWindows(chrRegions, width = tileSize, step = tileSize)) + + message("Counting overlaps for group ", groupID, "...") + bins$reads <- + countOverlaps( + bins, + insertions, + maxgap = -1L, + minoverlap = 0L, + type = "any" + ) + .addSeqLengths(bins, genome) + + groupReadsInTSS <- + ArchRProj@cellColData$ReadsInTSS[cells %in% cellGroups$groupID] + + binnedCoverage <- coverage(bins, weight = bins$reads * scaleFactor ) + saveRDS(binnedCoverage, file.path(outDir, paste0(groupID, "_cvg.rds"))) + }, threads = threads) + return(NULL) +} diff --git a/R/HiddenUtils.R b/R/HiddenUtils.R index dabfcf9b..d5ed2080 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/InputData.R b/R/InputData.R index 76fc949e..f35d3cd8 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 = c("character")) + .validInput(input = threads, name = "threads", valid = c("integer")) ######### #Make Sure URL doesnt timeout @@ -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]) { @@ -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/MarkerFeatures.R b/R/MarkerFeatures.R index b9d2c7f8..3e066178 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 +# create a sorted list of closest cells between foreground and background +.computeClosestCellsList <- function( data = NULL, query = NULL, k = 50, diff --git a/R/ModuleScore.R b/R/ModuleScore.R index b143f48f..48295348 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)){ @@ -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)) @@ -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/ShinyArchRExports.R b/R/ShinyArchRExports.R new file mode 100644 index 00000000..76b0291f --- /dev/null +++ b/R/ShinyArchRExports.R @@ -0,0 +1,497 @@ +# Functions for exporting an ArchR-based Shiny app ----------------------------------------------------------- +#' +#' 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. +#' @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. +#' 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. +#' @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) +#' proj <- addImputeWeights(proj) +#' +#' exportShinyArchR(ArchRProj = proj, +#' mainDir = "Shiny", +#' subOutDir = "inputData", +#' savedArchRProjFile = "Save-ArchR-Project.rds", +#' groupBy = "Clusters", +#' cellColEmbeddings = "Clusters", +#' embedding = "UMAP", +#' matsToUse = "GeneScoreMatrix", +#' tileSize = 100, +#' force = FALSE, +#' threads = getArchRThreads(), +#' logFile = createLogFile("exportShinyArchR")) +#' +#' @export +exportShinyArchR <- function( + ArchRProj = NULL, + mainDir = "Shiny", + subOutDir = "inputData", + savedArchRProjFile = "Save-ArchR-Project.rds", + groupBy = "Clusters", + cellColEmbeddings = "Clusters", + embedding = "UMAP", + matsToUse = NULL, + tileSize = 100, + force = FALSE, + threads = getArchRThreads(), + logFile = createLogFile("exportShinyArchR") +){ + + .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")) + .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")) + .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")') + + if(length(groupBy) > 1){ + stop("Only one value is allowed for groupBy.") + } + + 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") + } + + #check that groupBy column exists and doesn't have NA values + if (groupBy %ni% colnames(ArchRProj@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.") + } + + supportedMatrices <- c("GeneScoreMatrix", "GeneIntegrationMatrix", "MotifMatrix") #only these matrices are currently supported for ShinyArchR + #subset matrices for use in Shiny app + 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().") + } else { + allMatrices <- allMatrices[which(allMatrices %in% matsToUse)] + } + } + + # get directories paths + projDir <- getOutputDirectory(ArchRProj) + mainOutputDir <- file.path(projDir, mainDir) + subOutputDir <- file.path(projDir, mainDir, subOutDir) + + + # Make directory for Shiny App and download the app, global, server, and ui files if they dont already exist + dir.create(mainOutputDir, showWarnings = FALSE) + + ## 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( + "fe63ffcd28d04001997fe1efb900ac42", + "df9a4773d7dd4b3954446618e29aa197", + "8aa79954bfc191c0189d7ac657cb2b61", + "95a811550e8b8577ead13c3a010c9939" + ), + stringsAsFactors = FALSE + ) + + dl <- .downloadFiles(filesUrl = filesUrl, pathDownload = mainOutputDir, threads = threads) + + dir.create(subOutputDir, showWarnings = FALSE) + + # Create a copy of the ArchRProj + ArchRProjShiny <- ArchRProj + # Add metadata to ArchRProjShiny + ArchRProjShiny@projectMetadata[["groupBy"]] <- groupBy + ArchRProjShiny@projectMetadata[["tileSize"]] <- tileSize + + #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) + + # Create fragment files - should be saved within a dir called ShinyFragments within the ArchRProjShiny output directory + fragDir <- file.path(mainOutputDir, "ShinyFragments", groupBy) + 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 + 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 ", groupsx," already exist. Skipping fragment file generation...")) + } + return(NULL) + }, threads = threads) + + # 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$") + 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, threads = threads) + } else { + message(paste0("Coverage file for ", groupsx," already exist. Skipping coverage file generation...")) + } + return(NULL) + }, threads = threads) + + #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, + 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"))){ + .matrixEmbeds( + ArchRProj = ArchRProj, + outDirEmbed = file.path(subOutputDir), + colorBy = intersect(supportedMatrices, allMatrices), + embedding = embedding, + threads = threads, + verbose = TRUE, + logFile = logFile + ) + + }else{ + message("H5 file already exists...") + } + + ## delete unnecessary files ----------------------------------------------------------------- + unlink(file.path(projDir, "ShinyFragments"), recursive = TRUE) + + ## ready to launch --------------------------------------------------------------- + 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 = ", "c(",paste(shQuote(cellColEmbeddings, type = "cmd"), collapse=", "),")",'\n', + "embedding = ", "'",embedding,"'",'\n', + "availableMatrices = ", "c(",paste(shQuote(allMatrices, type = "cmd"), collapse=", "),")",'\n', + "shiny::runApp('", mainOutputDir, "')" + + ) + +} + +#' 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/") +#' @param outDirEmbed Where the HDF5 and the jpgs will be saved. +#' @param colorBy `cellColData` ("cellColData") only. +#' @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 threads The number of threads to use for parallel execution. +#' @param logFile The path to a file to be used for logging ArchR output. +#' +.mainEmbeds <- function( + ArchRProj = NULL, + outDirEmbed = NULL, + colorBy = "cellColData", + cellColEmbeddings = NULL, + embedding = "UMAP", + 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 = cellColEmbeddings, name = "cellColEmbeddings", valid = c("character")) + .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"))){ + + embeds <- .safelapply(1:length(cellColEmbeddings), function(x){ # + + tryCatch({ + named_embed <- plotEmbedding( + ArchRProj = ArchRProj, + baseSize = 12, + colorBy = colorBy, + name = cellColEmbeddings[x], + embedding = embedding, + rastr = FALSE, + size = 0.5, + threads = threads, + logFile = logFile + ) + 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) + }, threads = threads) + + names(embeds) <- 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()) + + 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 <- 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") + 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")) +} + +#' 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 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 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 = NULL, + embedding = "UMAP", + threads = getArchRThreads(), + verbose = TRUE, + logFile = createLogFile("matrixEmbeds") +){ + .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 = embedding, name = "embedding", 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")) + + .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() + + for(mat in colorBy){ + 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))] + saveRDS(featureNames, file.path(outDirEmbed, mat, paste0(mat, "_names.rds"))) + + message(paste0("Creating plots for ", mat,"...")) + + 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, + logFile = logFile + ) + + 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)){ + + featurePlotx_blank <- featurePlotx + 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, mat, "embeds", paste0(featureNames[x],"_blank72.jpg")), + 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) + + g <- ggplot_build(featurePlotx) + + 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) + + 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(mat,"_plotBlank72.h5"))) + H5Gcreate(points, mat) + + for(i in 1:length(embeds_points)){ + 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[[mat]] = embeds_min_max + embeds_pal_list[[mat]] = embeds_points[[length(embeds_points)]][[1]]$pal + + }else{ + + stop("Matrix ", mat,"has no features!") + } + + } + +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")) + +} + diff --git a/R/Trajectory.R b/R/Trajectory.R index 10a0ebba..5c71d2bb 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 d84d63c6..3a370f60 100644 --- a/R/VisualizeData.R +++ b/R/VisualizeData.R @@ -210,6 +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 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()`. @@ -527,7 +529,6 @@ plotEmbedding <- function( } - #' Visualize Groups from ArchR Project #' #' This function will group, summarize and then plot data from an ArchRProject for visual comparison. diff --git a/Shiny/app.R b/Shiny/app.R new file mode 100644 index 00000000..c91421f5 --- /dev/null +++ b/Shiny/app.R @@ -0,0 +1,6 @@ +# Load libraries so they are available +# Run the app through this file. +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 new file mode 100644 index 00000000..f6e8bc5e --- /dev/null +++ b/Shiny/global.R @@ -0,0 +1,102 @@ +# Setting up ---------------------------------------------------------------------- + +library(shiny) +library(ggplot2) +library(gridExtra) +library(grid) +library(cowplot) +library(farver) +library(rhdf5) +library(plotfunctions) +library(jpeg) +library(ArchR) +library(htmltools) + +#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) +# library(raster) + +############# NEW ADDITIONS (start) ############################### + +# Calling ArchRProj +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' + + + +############# NEW ADDITIONS (end) ############################### + +# EMBED Visualization ------------------------------------------------------------ + +# create a list of dropdown options for EMBED tab +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:base::length(matrices_dropdown)){ + + if(base::file.exists(base::paste0(subOutDir, "/", base::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 = 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=base::readRDS(base::paste0(subOutDir, "/" ,scaffoldName,".rds")) + + p_template1$scales$scales <- gene_plot$scale + + title=base::paste("EMBED of IterativeLSI colored by\n",matrixType," : ",sep="") + + p_template1$labels$title <- base::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 base::names(fileIndexer)) + { + if(gene %in% fileIndexer[[file]]) + { + EMBEDs_data_subset=base::readRDS(base::paste(base::paste0(subOutDir, "/" ,folderName),file,sep="/")) + + return(getEMBEDplotWithCol(gene,EMBEDs_data_subset,scaffoldName,matrixType)) + } + } +} + +# PlotBrowser ------------------------------------------------------------------ + +# create a list of dropdown options for plotbroswer tab +gene_names=base::readRDS(base::paste0(subOutDir, "/GeneScoreMatrix/GeneScoreMatrix_names.rds")) + + diff --git a/Shiny/server.R b/Shiny/server.R new file mode 100644 index 00000000..583acfe6 --- /dev/null +++ b/Shiny/server.R @@ -0,0 +1,385 @@ + +shinyServer <- function(input,output, session){ + + + # EMBEDS ------------------------------------------------------------------------------------ + + plot1 <- shiny::reactive({ + + # availableMatrices <- getAvailableMatrices(ArchRProj) + + if(input$matrix_EMBED1_forComparison %in% availableMatrices){ + mat <- availableMatrices[ availableMatrices %in% input$matrix_EMBED1_forComparison] + + 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) + ) + + plotfunctions::emptyPlot(0,0, axes=FALSE) + 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)) + 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) + + base::print(last_plot, vp=grid::viewport(0.5, 0.6, 1, 1)) + }else{ + 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) + ) + + plotfunctions::emptyPlot(0,0, axes=FALSE) + + 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 <- 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 <- 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) + + base::print(last_plot, vp=grid::viewport(0.5, 0.6, 1, 1)) + } + + }) + + plot2 <- shiny::reactive({ + + # availableMatrices <- getAvailableMatrices(ArchRProj) + + if(input$matrix_EMBED2_forComparison %in% availableMatrices){ + mat <- availableMatrices[ availableMatrices %in% input$matrix_EMBED2_forComparison] + + 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) + ) + + plotfunctions::emptyPlot(0,0, axes=FALSE) + 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)) + 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) + + base::print(last_plot, vp=grid::viewport(0.5, 0.6, 1, 1)) + }else{ + + + 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) + ) + + 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(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 <- 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) + + base::print(last_plot, vp=grid::viewport(0.5, 0.6, 1, 1)) + + } + + }) + + + #Output Handler: Downloads EMBEDS + output$download_EMBED1 <- shiny::downloadHandler( + filename <- function(){ + 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") + {grDevices::pdf(file = file,onefile=FALSE, width = input$EMBED1_plot_width, height = input$EMBED1_plot_height)} + + else if(input$plot_choice_download_EMBED1==".png") + {grDevices::png(file = file, width = input$EMBED1_plot_width, height = input$EMBED1_plot_height,units="in",res=1000)} + + else + {grDevices::tiff(file = file, width = input$EMBED1_plot_width, height = input$EMBED1_plot_height,units="in",res=1000)} + + plot1 = plot1() + + + gridExtra::grid.arrange(plot1) + grDevices::dev.off() + } + ) + + output$download_EMBED2 <- shiny::downloadHandler( + filename <- function(){ + 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") + {grDevices::pdf(file = file,onefile=FALSE, width = input$EMBED2_plot_width, height = input$EMBED2_plot_height)} + + else if(input$plot_choice_download_EMBED2==".png") + {grDevices::png(file = file, width = input$EMBED2_plot_width, height = input$EMBED2_plot_height,units="in",res=1000)} + + else + {grDevices::tiff(file = file, width = input$EMBED2_plot_width, height = input$EMBED2_plot_height,units="in",res=1000)} + + + plot2 <- plot2() + + gridExtra::grid.arrange(plot2) + grDevices::dev.off() + } + ) + + output$EMBED_plot_1 <- DT::renderDT(NULL) + output$EMBED_plot_2 <- DT::renderDT(NULL) + + 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<- shiny::renderPlot({ + + plot1() + + }, height = 450,width=450) + + # #plot EMBED2 + output$EMBED_plot_2<- shiny::renderPlot({ + + plot2() + + } ,height = 450,width=450) + + #update EMBED dropdown based on selected Matrix-------------------------------- + + #Update dropdown for EMBED1 + featureNames1 <- shiny::reactive({ + + if(!(input$matrix_EMBED1_forComparison %in% groupBy)){ + # availableMatrices <- getAvailableMatrices(ArchRProj) + matName <- availableMatrices[ availableMatrices %in% input$matrix_EMBED1_forComparison] + featureNames <- rhdf5::h5read(file = base::paste0(subOutDir, "/", matName, "_plotBlank72.h5"), + name = matName) + Feature_dropdown1 = base::names(featureNames) + return(Feature_dropdown1) + } + + }) + + shiny::observeEvent(input$matrix_EMBED1_forComparison,{ + + if(!(input$matrix_EMBED1_forComparison %in% groupBy)){ + shiny::updateSelectizeInput(session, 'EMBED1_forComparison', label = 'Feature Name', + choices = base::sort(featureNames1()), + server = TRUE, selected = base::sort(featureNames1())[1]) + } + }) + + # }) + + + featureNames2 <- shiny::reactive({ + + if(!(input$matrix_EMBED2_forComparison %in% groupBy)){ + + # availableMatrices <- getAvailableMatrices(ArchRProj) + matName <- availableMatrices[ availableMatrices %in% input$matrix_EMBED2_forComparison] + featureNames <- rhdf5::h5read(file = base::paste0(subOutDir, "/", matName, "_plotBlank72.h5"), + name = matName) + + Feature_dropdown2 = base::names(featureNames) + return(Feature_dropdown2) + + } + + }) + + shiny::observeEvent(input$matrix_EMBED2_forComparison,{ + if(!(input$matrix_EMBED2_forComparison %in% groupBy)){ + shiny::updateSelectizeInput(session, 'EMBED2_forComparison', label = 'Feature Name', + choices = base::sort(featureNames2()), + server = TRUE, selected = base::sort(featureNames2())[1]) + } + }) + + #Update dropdown for EMBED2 + # shiny::observeEvent(input$matrix_EMBED2_forComparison,{ + # if(shiny::isolate(input$matrix_EMBED2_forComparison)=="Motif Matrix") + # { + + # shiny::updateSelectizeInput(session, 'EMBED2_forComparison', label = 'Feature Name', + # choices = base::sort(MM_dropdown), + # server = TRUE, selected = base::sort(MM_dropdown)[2]) + # } + + # else if(shiny::isolate(input$matrix_EMBED2_forComparison)=="Gene Score Matrix") + # { + # shiny::updateSelectizeInput(session, 'EMBED2_forComparison', label = 'Feature Name', + # choices = base::sort(GSM_dropdown), + # server = TRUE, selected = base::sort(GSM_dropdown)[2]) + # } + # else if(shiny::isolate(input$matrix_EMBED2_forComparison)=="Gene Integration Matrix") + # { + + # 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 + shiny::observeEvent(input$range_min, { + shiny::updateSliderInput(session, "range", + value = base::c(input$range_min, base::max(input$range))) + }) + + shiny::observeEvent(input$range_max, { + shiny::updateSliderInput(session, "range", + value = base::c(input$range_min,input$range_max)) + }) + + shiny::observeEvent(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 <- shiny::downloadHandler( + filename <- function(){ + base::paste0("ArchRBrowser-",input$gene_name,input$plot_choice_download_peakBrowser) + }, + content = function(file){ + + if(input$plot_choice_download_peakBrowser==".pdf") + {grDevices::pdf(file = file,onefile=FALSE, width = input$plot_width, height = input$plot_height)} + + else if(input$plot_choice_download_peakBrowser==".png") + {grDevices::png(file = file, width = input$plot_width, height = input$plot_height,units="in",res=1000)} + + else + {grDevices::tiff(file = file, width = input$plot_width, height = input$plot_height,units="in",res=1000)} + + + p_browser_atacClusters<- ArchR::plotBrowserTrack( + ArchRProj = ArchRProj, + ShinyArchR = TRUE, + plotSummary = base::c("bulkTrack", input$selectPlotSummary), + baseSize = 11, + facetbaseSize = 11, + groupBy = input$browserContent, + 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]] + + + gridExtra::grid.arrange(p_browser_atacClusters) + + grDevices::dev.off() + } + ) + output$browser_atacClusters <- DT::renderDT(NULL) + + #handles error + 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<- shiny::renderPlot({ + grid::grid.newpage() + + p_browser_atacClusters<- ArchR::plotBrowserTrack( + ArchRProj = ArchRProj, + ShinyArchR = TRUE, + plotSummary = base::c("bulkTrack", input$selectPlotSummary), + baseSize = 11, + facetbaseSize = 11, + groupBy = input$browserContent, + 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::grid.draw(p_browser_atacClusters) + + },height = 900) + + } + }) +} \ No newline at end of file diff --git a/Shiny/ui.R b/Shiny/ui.R new file mode 100644 index 00000000..1df142a4 --- /dev/null +++ b/Shiny/ui.R @@ -0,0 +1,181 @@ +library(shinybusy) + +# This file contains UI widgets. + +# EMBEDING plotting ---------------------------------------------------------------------- +EMBED_panel <- shiny::tabPanel(id="EMBED_panel", + + shiny::titlePanel(htmltools::h5("scClusters")), + shiny::sidebarPanel( + shiny::titlePanel(htmltools::h3('EMBEDDING 1', align = 'center')), + width = 3, + htmltools::h4(''), + htmltools::hr(style = "border-color: grey"), + + shiny::selectizeInput( + 'matrix_EMBED1_forComparison', + label = 'EMBEDDING type', + choices = base::c(EMBEDs_dropdown, matrices_dropdown), + selected = NULL + ), + + shiny::conditionalPanel( + condition = '!(input.matrix_EMBED1_forComparison %in% EMBEDs_dropdown)', + shiny::selectizeInput( + 'EMBED1_forComparison', + label = 'EMBEDDING 1', + choices = "", + selected = NULL + )), + + 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(htmltools::HTML(" + .shiny-split-layout > div { + overflow: visible;}"))) + ), + + shiny::downloadButton(outputId = "download_EMBED1", label = "Download EMBEDDING 1"), + + shiny::titlePanel(htmltools::h3('EMBEDDING 2', align = 'center')), + htmltools::hr(style = "border-color: grey"), + shiny::selectizeInput( + 'matrix_EMBED2_forComparison', + label = 'EMBEDDING type', + choices = base::c(EMBEDs_dropdown, matrices_dropdown), + selected =NULL + ), + + shiny::conditionalPanel(condition = '!(input.matrix_EMBED2_forComparison %in% EMBEDs_dropdown)', + shiny::selectizeInput( + 'EMBED2_forComparison', + label = 'EMBEDDING 2', + choices ="", + selected = NULL + )), + + + 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 = base::c(".pdf",".png",".tiff"), + selected = ".pdf"), + tags$head(tags$style(htmltools::HTML(" + .shiny-split-layout > div { + overflow: visible;}"))) + ), + shiny::downloadButton(outputId = "download_EMBED2", label = "Download EMBEDDING 2"), + + ), + + shiny::mainPanel( + shiny::verbatimTextOutput("feat"), + shiny::verbatimTextOutput("text"), + shiny::fluidRow(htmltools::h5("Dimension Reduction scClusters EMBEDs" + )), + 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"), + ), + 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 <- shiny::tabPanel( + + shiny::titlePanel(htmltools::h5("scATAC-seq peak browser")), + + shiny::sidebarPanel( + shiny::titlePanel(htmltools::h5('Gene Name', align = 'center')), + width = 3, + htmltools::h4(''), + htmltools::hr(style = "border-color: grey"), + + shiny::actionButton(inputId = "restartButton", label = "Plot Track", icon = shiny::icon("play-circle")), + + + shiny::checkboxGroupInput(inputId = "selectPlotSummary", label = "Select track plots", + choices = c("Feature" = "featureTrack", "Loop" = "loopTrack", "Gene" = "geneTrack"), + selected = c("featureTrack", "loopTrack", "geneTrack"), + inline = TRUE), + + shiny::selectizeInput( + 'browserContent', + label = 'Type', + choices = EMBEDs_dropdown, + selected = EMBEDs_dropdown[1] + ), + + shiny::selectizeInput( + 'gene_name', + label = 'Gene Name', + choices = base::sort(gene_names), + selected = base::sort(base::sort(gene_names))[1] + ), + + 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) + ), + 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) + ), + + htmltools::hr(style = "border-color: grey"), + + 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(htmltools::HTML(" + .shiny-split-layout > div { + overflow: visible;}"))) + ), + shiny::downloadButton(outputId = "down", label = "Download"), + + ), + + shiny::mainPanel(shiny::fluidRow(htmltools::h5("Peak browser of scATAC-seq clusters" + )), + shiny::plotOutput("browser_atacClusters") + ) +) + +ui <- shiny::shinyUI(shiny::fluidPage( + shinybusy::add_busy_spinner(spin = "radar", color = "#CCCCCC", onstart = TRUE, height = "55px", width = "55px"), + + shiny::navbarPage( + EMBED_panel, + scATACbrowser_panel, + title ="ShinyArchR Export", + tags$head(tags$style(".shiny-output-error{color: grey;}")) + ), + + tags$footer(htmltools::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/data/.DS_Store b/data/.DS_Store deleted file mode 100644 index 3048b847..00000000 Binary files a/data/.DS_Store and /dev/null differ diff --git a/docs/.DS_Store b/docs/.DS_Store deleted file mode 100644 index c76c5c78..00000000 Binary files a/docs/.DS_Store and /dev/null differ diff --git a/docs/articles/.DS_Store b/docs/articles/.DS_Store deleted file mode 100644 index 48fc8ecd..00000000 Binary files a/docs/articles/.DS_Store and /dev/null differ diff --git a/docs/articles/Articles/.DS_Store b/docs/articles/Articles/.DS_Store deleted file mode 100644 index 5008ddfc..00000000 Binary files a/docs/articles/Articles/.DS_Store and /dev/null differ diff --git a/man/.DS_Store b/man/.DS_Store deleted file mode 100644 index c1cc8fd8..00000000 Binary files a/man/.DS_Store and /dev/null differ diff --git a/src/.DS_Store b/src/.DS_Store deleted file mode 100644 index 5008ddfc..00000000 Binary files a/src/.DS_Store and /dev/null differ diff --git a/tests/testthat/test_1_arrow.R b/tests/testthat/test_1_arrow.R index 63bab730..c42f4042 100644 --- a/tests/testthat/test_1_arrow.R +++ b/tests/testthat/test_1_arrow.R @@ -275,4 +275,3 @@ for(i in seq_along(files)){ - diff --git a/tests/testthat/test_3_cpp.R b/tests/testthat/test_3_cpp.R index ecb4685f..78f87fbc 100644 --- a/tests/testthat/test_3_cpp.R +++ b/tests/testthat/test_3_cpp.R @@ -96,4 +96,3 @@ test_that("Variance Utils is working...", { -