Dev jg (GreenleafLab#56)

* updates * added better descriptors for LSI results * update save umap model * update * updates 0.1.9 * LSIUpdate * Update IterativeLSI.R * LSIv2 * update docs * pass parallel reading for arrow methods * update params * parallel get matrix values * onload * bugfix chromVAR * fix * updates * updates * documentation * update * update outliers * update reduce dims * stability to enrichment * update * documentation * bugfix drop all * bugfix * update * updates * bug fix featureMatrix * update gene scores * updaetes * add units to matrices * added a few arrow methods * units * update messages * keep single thread for now * update imputation * update integration * bugfix * bugfix * bugfix arrowFiles and rna integration * Update RNAIntegration.R * bugfix * added methods for dropping groups from Arrow * space * group arrow * Update ArrowMethods.R * update documentation * add completion to deviations * correlation methods * added log2 and units * updates heatmap foot * updates * alteration * comment * update correlations
roshan9128 · Mar 9, 2020 · c47c2c1 · c47c2c1
1 parent c81a107
commit c47c2c1
Show file tree

Hide file tree

Showing 55 changed files with 4,350 additions and 1,754 deletions.
diff --git a/.DS_Store b/.DS_Store
diff --git a/.gitignore b/.gitignore
@@ -0,0 +1,2 @@
+
+.DS_Store
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Package: ArchR
 Type: Package
-Date: 2019-02-06
+Date: 2019-02-24
 Title: Analyzing single-cell regulatory chromatin in R.
-Version: 0.1.8
+Version: 0.2.0
 Authors@R: c(
     person("Jeffrey", "Granja", email = "[email protected]", role = c("aut","cre")),
     person("Ryan", "Corces", role = "aut"))
@@ -29,7 +29,7 @@ Imports:
     grid,
     gridExtra,
     Biostrings,
-    ComplexHeatmap,
+    ComplexHeatmap
 Depends:
     ggplot2,
     SummarizedExperiment,
@@ -39,4 +39,4 @@ Depends:
     magrittr,
     S4Vectors (>= 0.9.25),
     BiocGenerics,
-    GenomicRanges,
+    GenomicRanges
diff --git a/NAMESPACE b/NAMESPACE
@@ -28,7 +28,6 @@ export(addGroupCoverages)
 export(addHarmony)
 export(addImputeWeights)
 export(addIterativeLSI)
-export(addLSI)
 export(addMotifAnnotations)
 export(addPeak2GeneLinks)
 export(addPeakAnnotations)
@@ -75,6 +74,7 @@ export(getInputFiles)
 export(getMarkers)
 export(getMatches)
 export(getMatrixFromArrow)
+export(getMatrixFromProject)
 export(getOutputDirectory)
 export(getPeakAnnotation)
 export(getPeakSet)
@@ -93,6 +93,7 @@ export(ggGroup)
 export(ggHex)
 export(ggOneToOne)
 export(ggPoint)
+export(imputeMatrix)
 export(loadArchRProject)
 export(mapLabels)
 export(markerFeatures)

diff --git a/R/AllClasses.R b/R/AllClasses.R
@@ -359,7 +359,8 @@ loadArchRProject <- function(
   if(i=="cellNames"){
     return(rownames(x@cellColData))
   }else{
-    return(x@cellColData[[i, drop = TRUE]])
+    val <- x@cellColData[[i, drop = TRUE]]
+    return(as.vector(val))
   }
 }
 
@@ -370,11 +371,22 @@ loadArchRProject <- function(
 #' @export
 #'
 "$<-.ArchRProject" <- function(x, i, value){
+  if(i == "Sample"){
+    stop("Sample is a protected column in cellColData. Please do not try to overwrite this column!")
+  }
+  if(i == "cellNames"){
+    stop("cellNames is a protected column in cellColData. Please do not try to overwrite this column!")
+  }
+  if(i == "nFrags"){
+    stop("nFrags is a protected column in cellColData. Please do not try to overwrite this column!")
+  }
   if(object.size(Rle(value)) < 2 * object.size(value)){ #Check if Rle is more efficient for storage purposes...
     value <- Rle(value)
   }
-  if(length(value)==1){
-    value <- Rle(value, lengths = nrow(x@cellColData))
+  if(!is.null(value)){
+    if(length(value)==1){
+      value <- Rle(value, lengths = nrow(x@cellColData))
+    }
   }
   x@cellColData[[i]] <- value
   return(x)
@@ -390,14 +402,12 @@ loadArchRProject <- function(
 "[.ArchRProject" <- function(x, i, j){
   cD <- x@cellColData
 
-  if (missing(i) && missing(j)) {
+  if(missing(i)){
     return(x)
   }
-
-  if (missing(i)) {
-    i <- rownames(cD)
-  } else if (missing(j)) {
-    j <- colnames(cD)
+
+  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.")
   }
 
   if (is.logical(i)) {
@@ -407,26 +417,11 @@ loadArchRProject <- function(
     i <- rownames(cD)[i]
   }
 
-  if (is.logical(j)) {
-    if (length(j) != ncol(cD)) {
-      stop("Incorrect number of logical values provided to subset columns in cellColData")
-    }
-    j <- colnames(cD)[j]
-  }
-
   if (is.numeric(i)) {
     i <- rownames(cD)[i]
   }
-
-  if (is.numeric(j)) {
-    j <- colnames(cD)[j]
-  }
 
-  if("Sample" %ni% j){
-    stop("Sample column must be in subsetting by column to continue!")
-  }
-
-  x@cellColData <- cD[i, j, drop=FALSE]
+  x@cellColData <- cD[i, , drop=FALSE]
 
   return(x)
 
@@ -451,3 +446,5 @@ setMethod(
 
 
 
+
+
diff --git a/R/ArchRBrowser.R b/R/ArchRBrowser.R
@@ -1147,7 +1147,7 @@ ArchRBrowserTrack <- function(
       chr = paste0(seqnames(region)), 
       cellNames = cellNames, 
       out = "GRanges"
-    ) %>% subsetByOverlaps(., region, ignore.strand = FALSE)
+    ) %>% subsetByOverlaps(., region, ignore.strand = TRUE)
 
   #Starts
   ts <- match(trunc(start(cellFragsRegion)/tileSize) * tileSize, regionTiles, nomatch = 0)

diff --git a/R/ArchRProjectExports.R b/R/ArchRProjectExports.R
@@ -81,10 +81,109 @@ exportGroupSE <- function(
 
 }
 
-
-
-
-
+# #' Export Group Summarized Experiment JJJ
+# #' 
+# #' This function will group, summarize and export a summarized experiment for a assay in a ArchRProject.
+# #'
+# #' @param ArchRProj An `ArchRProject` object.
+# #' @param useMatrix The name of the matrix in the ArrowFiles. See getAvailableMatrices to see options
+# #' @param groupBy The name of the column in `cellColData` to use for grouping cells together for summarizing.
+# #' @param divideN A boolean describing whether to divide by the number of cells.
+# #' @param scaleTo Depth normalize to this value if not NULL.
+# #' @param threads An integer specifying the number of threads for parallel.
+# #' @param verbose A boolean specifying to print messages during computation.
+# #' @export
+# exportGroupBW <- function(
+#   ArchRProj = NULL,
+#   maxCells = 1000,
+#   groupBy = "Sample",
+#   normBy = "ReadsInTSS",
+#   ceiling = 2,
+#   threads = getArchRThreads(),
+#   verbose = TRUE
+#   ){
+
+#   stop("not functional yet!")
+
+#   normMethods <- c("None", "ReadsInTSS", "nCells")
+#   if(normBy %ni% c("none", "readsintss")){
+#     stop(paste0("normBy not in normMethods : ", paste0(normMethods, collapse=", ")))
+#   }
+#   ArrowFiles <- getArrowFiles(ArchRProj)
+#   Groups <- getCellColData(ArchRProj = ArchRProj, select = groupBy, drop = TRUE)
+#   if(!.isDiscrete(Groups)){
+#     stop("groupBy must be a discrete variable!")
+#   }
+#   Cells <- ArchRProj$cellNames
+
+#   cellGroups <- split(Cells, Groups)
+
+#   if(!is.null(maxCells)){
+#     gnames <- names(cellGroups)
+#     cellGroups <- lapply(seq_along(cellGroups), function(x){
+#       if(length(cellGroups[[x]]) > maxCells){
+#         sample(cellGroups[[x]], maxCells)
+#       }else{
+#         cellGroups[[x]]
+#       }
+#     })
+#     names(cellGroups) <- gnames
+#   }
+
+# }
+
+# .createGroupBW <- function(
+#   i = NULL, 
+#   cellGroups = NULL,
+#   ArrowFiles = NULL, 
+#   cellsInArrow = NULL, 
+#   availableChr = NULL,
+#   chromLengths = NULL, 
+#   tileSize = 100,
+#   bwDir = "bigwigs",
+#   tstart = NULL, 
+#   verboseHeader = TRUE,
+#   verboseAll = FALSE
+#   ){
+
+#   .messageDiffTime(sprintf("Creating Group BW %s of %s", i, length(cellGroups)), tstart, verbose = verboseHeader)
+
+#   #Cells
+#   cellGroupi <- cellGroups[[i]]
+
+#   #Bigwig File!
+#   covFile <- file.path(bwDir, paste0(names(cellGroups)[i], "-ArchR-BW-TileSize-",tileSize,".bw"))
+#   rmf <- .suppressAll(file.remove(covFile))
+
+#   covList <- lapply(seq_along(availableChr), function(k)){
+
+#     message(k)
+
+#     it <- 0
+#     for(j in seq_along(ArrowFiles)){
+#       cellsInI <- sum(cellsInArrow[[names(ArrowFiles)[j]]] %in% cellGroupi)
+#       if(cellsInI > 0){
+#         it <- it + 1
+#         if(it == 1){
+#           fragik <- .getFragsFromArrow(ArrowFiles[j], chr = availableChr[k], out = "GRanges", cellNames = cellGroupi)
+#         }else{
+#           fragik <- c(fragik, .getFragsFromArrow(ArrowFiles[j], chr = availableChr[k], out = "GRanges", cellNames = cellGroupi))
+#         }
+#       }
+#     }
+
+#     fragik <- coverage(
+#       resize(IRanges(start = c( start(fragik), end(fragik) ), width = 1), tileSize, "center"), 
+#       width = chromLengths[availableChr[k]]
+#     )
+
+#     fragik
+
+#   }
+
+#   return(out)
+
+# }