Merge pull request satijalab#45 from satijalab/fix/FixedAssay

[WIP] Keep data dimensions static in Assay objects
ws2260 · Apr 12, 2019 · cc45b31 · cc45b31
2 parents 00e888c + 13eba93
commit cc45b31
Show file tree

Hide file tree

Showing 9 changed files with 263 additions and 193 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: Seurat
-Version: 3.0.0.9100
-Date: 2019-04-06
+Version: 3.0.0.9150
+Date: 2019-04-16
 Title: Tools for Single Cell Genomics
 Description: A toolkit for quality control, analysis, and exploration of single cell RNA sequencing data. 'Seurat' aims to enable users to identify and interpret sources of heterogeneity from single cell transcriptomic measurements, and to integrate diverse types of single cell data. See Satija R, Farrell J, Gennert D, et al (2015) <doi:10.1038/nbt.3192>, Macosko E, Basu A, Satija R, et al (2015) <doi:10.1016/j.cell.2015.05.002>, and Butler A and Satija R (2017) <doi:10.1101/164889> for more details.
 Authors@R: c(

diff --git a/NAMESPACE b/NAMESPACE
@@ -12,6 +12,7 @@ S3method("JS<-",JackStrawData)
 S3method("Key<-",Assay)
 S3method("Key<-",DimReduc)
 S3method("Loadings<-",DimReduc)
+S3method("Misc<-",Assay)
 S3method("Misc<-",Seurat)
 S3method("Project<-",Seurat)
 S3method("Tool<-",Seurat)
@@ -61,6 +62,7 @@ S3method(Key,DimReduc)
 S3method(Key,Seurat)
 S3method(Loadings,DimReduc)
 S3method(Loadings,Seurat)
+S3method(Misc,Assay)
 S3method(Misc,Seurat)
 S3method(NormalizeData,Assay)
 S3method(NormalizeData,Seurat)

diff --git a/R/integration.R b/R/integration.R
@@ -556,12 +556,13 @@ IntegrateData <- function(
       assay = new.assay.name,
       slot = 'data'
     )
-    merged.obj <- SetAssayData(
-      object = merged.obj,
-      assay = assay,
-      slot = 'data',
-      new.data = integrated.matrix
-    )
+    # merged.obj <- SetAssayData(
+    #   object = merged.obj,
+    #   assay = assay,
+    #   slot = 'data',
+    #   new.data = integrated.matrix
+    # )
+    merged.obj[[assay]] <- CreateAssayObject(data = integrated.matrix)
     object.list[[as.character(x = ii)]] <- merged.obj
     object.list[[merge.pair[[1]]]] <- NULL
     object.list[[merge.pair[[2]]]] <- NULL

diff --git a/R/objects.R b/R/objects.R
@@ -2379,6 +2379,17 @@ Loadings.Seurat <- function(object, reduction = 'pca', projected = FALSE, ...) {
 
 #' @param slot Name of specific bit of meta data to pull
 #'
+#' @rdname Misc
+#' @export
+#' @method Misc Assay
+#'
+Misc.Assay <- function(object, slot = NULL, ...) {
+  if (is.null(x = slot)) {
+    return(slot(object = object, name = 'misc'))
+  }
+  return(slot(object = object, name = 'misc')[[slot]])
+}
+
 #' @rdname Misc
 #' @export
 #' @method Misc Seurat
@@ -2394,6 +2405,22 @@ Misc.Seurat <- function(object, slot = NULL, ...) {
   return(slot(object = object, name = 'misc')[[slot]])
 }
 
+#' @rdname Misc
+#' @export
+#' @method Misc<- Assay
+#'
+"Misc<-.Assay" <- function(object, slot, ..., value) {
+  if (slot %in% names(x = Misc(object = object))) {
+    warning("Overwriting miscellanous data for ", slot)
+  }
+  if (is.list(x = value)) {
+    slot(object = object, name = 'misc')[[slot]] <- c(value)
+  } else {
+    slot(object = object, name = 'misc')[[slot]] <- value
+  }
+  return(object)
+}
+
 #' @rdname Misc
 #' @export
 #' @method Misc<- Seurat
@@ -2406,7 +2433,11 @@ Misc.Seurat <- function(object, slot = NULL, ...) {
   if (slot %in% names(x = Misc(object = object))) {
     warning("Overwriting miscellanous data for ", slot)
   }
-  slot(object = object, name = 'misc')[[slot]] <- value
+  if (is.list(x = value)) {
+    slot(object = object, name = 'misc')[[slot]] <- c(value)
+  } else {
+    slot(object = object, name = 'misc')[[slot]] <- value
+  }
   return(object)
 }
 
@@ -3182,40 +3213,59 @@ RenameIdents.Seurat <- function(object, ...) {
 SetAssayData.Assay <- function(object, slot, new.data, ...) {
   slots.use <- c('counts', 'data', 'scale.data')
   if (!slot %in% slots.use) {
-    stop("'slot' must be one of ", paste(slots.use, collapse = ', '))
+    stop(
+      "'slot' must be one of ",
+      paste(slots.use, collapse = ', '),
+      call. = FALSE
+    )
   }
-  if (!IsMatrixEmpty(x = new.data) && !slot %in% c('counts', 'scale.data')) {
+  if (!IsMatrixEmpty(x = new.data)) {
     if (ncol(x = new.data) != ncol(x = object)) {
-      stop("The new data doesn't have the same number of cells as the current data")
-    }
-    num.counts <- nrow(x = GetAssayData(object = object, slot = 'counts'))
-    counts.names <- rownames(x = GetAssayData(object = object, slot = 'counts'))
-    if (num.counts <= 1) {
-      num.counts <- nrow(x = object)
-      counts.names <- rownames(x = object)
+      stop(
+        "The new data doesn't have the same number of cells as the current data",
+        call. = FALSE
+      )
     }
-    if (slot == 'counts' && nrow(x = new.data) != num.counts) {
-      warning("The new data doesn't have the same number of features as the current data")
-    } else if (slot %in% c('data', 'scale.data') && nrow(x = new.data) > num.counts) {
-      warning("Adding more features than present in current data")
+    num.counts <- nrow(x = object)
+    counts.names <- rownames(x = object)
+    if (slot == 'scale.data' && nrow(x = new.data) > num.counts) {
+      warning(
+        "Adding more features than present in current data",
+        call. = FALSE,
+        immediate. = TRUE
+      )
+    } else if (slot %in% c('counts', 'data') && nrow(x = new.data) != num.counts) {
+      warning(
+        "The new data doesn't have the same number of features as the current data",
+        call. = FALSE,
+        immediate. = TRUE
+      )
     }
     if (!all(rownames(x = new.data) %in% counts.names)) {
-      warning("Adding features not currently present in the object")
+      warning(
+        "Adding features not currently present in the object",
+        call. = FALSE,
+        immediate. = TRUE
+      )
     }
     new.features <- na.omit(object = match(
       x = counts.names,
       table = rownames(x = new.data)
     ))
-    #if (slot == 'scale.data' && nrow(x = new.data) > nrow(x = object)) {
-    #  stop("Cannot add more features than present in current data")
-    #} else if (slot != 'scale.data' && nrow(x = new.data) != nrow(x = object)) {
-    #  stop("The new data doesn't have the same number of features as the current data")
-    #}
     new.cells <- colnames(x = new.data)
     if (!all(new.cells %in% colnames(x = object))) {
-      stop("All cell names must match current cell names")
+      stop(
+        "All cell names must match current cell names",
+        call. = FALSE
+      )
     }
     new.data <- new.data[new.features, colnames(x = object)]
+    if (slot %in% c('counts', 'data') && !all(dim(x = new.data) == dim(x = object))) {
+      stop(
+        "Attempting to add a different number of cells and/or features",
+        call. = FALSE
+      )
+    }
   }
   slot(object = object, name = slot) <- new.data
   return(object)
@@ -4871,20 +4921,39 @@ setMethod(
   definition = function(x, i, ..., value) {
     meta.data <- x[[]]
     feature.names <- rownames(x = meta.data)
+    if (is.data.frame(x = value)) {
+      value <- lapply(
+        X = 1:ncol(x = value),
+        FUN = function(index) {
+          v <- value[[index]]
+          names(x = v) <- rownames(x = value)
+          return(v)
+        }
+      )
+    }
+    err.msg <- "Cannot add more or fewer meta.features information without values being named with feature names"
     if (length(x = i) > 1) {
       # Add multiple bits of feature-level metadata
       value <- rep_len(x = value, length.out = length(x = i))
       for (index in 1:length(x = i)) {
-        meta.data[i[index]] <- value[index]
+        names.intersect <- intersect(x = names(x = value[[index]]), feature.names)
+        if (length(x = names.intersect) > 0) {
+          meta.data[names.intersect, i[index]] <- value[[index]][names.intersect]
+        } else if (length(x = value) %in% c(nrow(x = meta.data), 1) %||% is.null(x = value)) {
+          meta.data[i[index]] <- value[index]
+        } else {
+          stop(err.msg, call. = FALSE)
+        }
       }
     } else {
       # Add a single column to feature-level metadata
+      value <- unlist(x = value)
       if (length(x = intersect(x = names(x = value), y = feature.names)) > 0) {
         meta.data[, i] <- value[feature.names]
       } else if (length(x = value) %in% c(nrow(x = meta.data), 1) || is.null(x = value)) {
         meta.data[, i] <- value
       } else {
-        stop("Cannot add more or fewer meta.features information without values being named with feature names")
+        stop(err.msg, call. = FALSE)
       }
     }
     slot(object = x, name = 'meta.features') <- meta.data
@@ -5211,6 +5280,16 @@ setMethod(
   }
 )
 
+setMethod(
+  f = 'show',
+  signature = 'AnchorSet',
+  definition = function(object) {
+    cat('An AnchorSet object containing', nrow(x = slot(object = object, name = "anchors")),
+        "anchors between", length(x = slot(object = object, name = "object.list")), "Seurat objects \n",
+        "This can be used as input to IntegrateData, TransferLabels, or TransferFeatures.")
+  }
+)
+
 setMethod(
   f = 'show',
   signature = 'Assay',
@@ -5228,7 +5307,7 @@ setMethod(
     features <- paste0(
       variable,
       ' feature',
-      if (length(x = top.ten) > 1) {'s'}, ":\n"
+      if (length(x = top.ten) != 1) {'s'}, ":\n"
     )
     features <- gsub(pattern = '^\\s+', replacement = '', x = features)
     cat(
@@ -5241,16 +5320,6 @@ setMethod(
   }
 )
 
-setMethod(
-  f = 'show',
-  signature = 'AnchorSet',
-  definition = function(object) {
-    cat('An AnchorSet object containing', nrow(x = slot(object = object, name = "anchors")),
-        "anchors between", length(x = slot(object = object, name = "object.list")), "Seurat objects \n",
-        "This can be used as input to IntegrateData, TransferLabels, or TransferFeatures.")
-  }
-)
-
 setMethod(
   f = 'show',
   signature = 'DimReduc',