author Paul Hoffman Tue, 2 Jan 2018 23:58:25 +0000 (18:58 -0500) committer Paul Hoffman Tue, 2 Jan 2018 23:58:25 +0000 (18:58 -0500)
Adding cells should work, haven't tested it yet so I can't say for sure

 R/internal.R patch | blob | history R/loom.R patch | blob | history man/loom-class.Rd patch | blob | history

index 52018ba16d695977ecfdbfeea7cb719d7b552abc..1b7d8ac9b8e189da51aa20668f498f5aff395b0a 100644 (file)
@@ -57,3 +57,255 @@ validateLoom <- function(object) {
}
}
}
+
+# A function to determine if a vector is a vector and not a list
+#
+# @param x An object
+#
+# @return TRUE if 'x' is a vector or a factor, otherwise FALSE
+#
+is.actual_vector <- function(x) {
+  return((is.vector(x = x) || is.factor(x = x)) && !is.list(x = x))
+}
+
+#
+# @param x A list of vectors to add to /matrix
+# @param n The number of genes needed in each cell
+#
+# @return 'x' as a list of vectors
+#
+check.matrix_data <- function(x, n) {
+  # Coerce x into a list, where each
+  # entry in the list is a new cell added
+  if (is.actual_vector(x = x)) {
+    x <- list(x)
+  } else if (is.matrix(x = x) || is.data.frame(x = x)) {
+    x <- as.list(x = x)
+  }
+  if (!is.list(x = x)) {
+    stop("Matrix data must be a list of vectors")
+  }
+  # Ensure that each entry in the list is a vector of length n
+  vector.check <- vapply(
+    X = x,
+    FUN = is.actual_vector,
+    FUN.VALUE = logical(length = 1L)
+  )
+  if (!all(vector.check)) {
+    stop('Each new cell added must be represented as a vector')
+  }
+  # Ensure each new cell added has data for the number of genes present
+  for (i in 1:length(x = x)) {
+    if (length(x = cell.add) > n) {
+      stop(paste(
+        "Cannot add genes to a loom file, the maximum number of genes allowed is",
+        n
+      ))
+    } else if (length(x = cell.add) < n) {
+    }
+  }
+  return(x)
+}
+
+# Get the number of cells being added to /matrix
+#
+# @param x A list of vectors to add to /matrix
+#
+# @return The number of cells in x
+#
+nCells.matrix_data <- function(x) {
+  return(length(x = x))
+}
+
+#
+# @param x A list of vectors to add to /matrix
+# @param n The number of genes each cell needs
+# @param m2 The number of cells being added to the loom file
+#
+# @return 'x' with the proper number of cells
+#
+addCells.matrix_data <- function(x, n, m2) {
+  if (length(x = x) < m2) {
+    x[(length(x = x) + 1):m2] <- list(rep.int(x = NA, times = n))
+  }
+  return(x)
+}
+
+#
+# @param x A list of matrices to add layers in /layers
+# @param n The number of genes needed for each layer
+# @param layers.names Names found in /layers
+#
+# @return 'x' as a list of matricies with 'n' rows for each layer present in /layers
+#
+check.layers <- function(x, n, layers.names) {
+  # Coerce x into a list of matricies
+  if (is.null(x = x)) {
+    x <- list()
+  } else if (is.matrix(x = x) || is.data.frame(x = x)) {
+    x <- list(as.matrix(x = x))
+  }
+  if (!is.list(x = x)) {
+    stop("Layers data must be a list of matricies")
+  }
+  # Ensure we have enough layer additions for each layer
+  # Manage named lists, taking only those with the same name as in /layers
+  # or is named with an empty string
+  if (!is.null(x = names(x = x))) {
+    x.use <- which(x = names(x = x) %in% layers.names | names(x = x) == '')
+    x <- x[x.use]
+  }
+  if (length(x = x) > length(x = layers.names)) {
+  } else if (length(x = x) < length(x = layers.names)) {
+    x[(length(x = x) + 1):length(x = layers.names)] <- data.frame(rep.int(x = NA, times = n))
+  }
+  # Ensure that we have all genes needed
+  for (i in 1:length(x = x)) {
+    layer <- x[[i]]
+    if (is.data.frame(x = layer)) {
+      layer <- as.matrix(x = layer)
+    } else if (is.actual_vector(x = layer)) {
+      layer <- matrix(data = layer, ncol = 1)
+    }
+    if (!is.matrix(x = layer)) {
+      stop("Layers data must be a list of matrices")
+    }
+    if (nrow(x = layer) > n) {
+      stop(paste(
+        "Cannot add genes to a loom file, the maximum number of genes allowed is",
+        n
+      ))
+    } else if (nrow(x = layer) < n) {
+      layer <- as.data.frame(x = layer)
+      layer[(nrow(x = layer) + 1):n, ] <- NA
+      layer <- as.matrix(x = layer)
+    }
+    x[[i]] <- layer
+  }
+  # Set names
+  x.unnamed <- which(x = !(names(x = x) %in% layers.names))
+  if (length(x = x.unnamed) == 0) {
+    x.unnamed <- 1:length(x = x)
+  }
+  names.unused <- which(x = !(layers.names %in% names(x = x)))
+  names(x = x)[x.unnamed] <- layers.names[names.unused]
+  return(x)
+}
+
+# Get the number of cells being added to /layers
+#
+# @param x A list of matricies to add to /layers
+#
+# @return The number of cells within each matrix
+#
+nCells.layers <- function(x) {
+  return(vapply(X = x, FUN = ncol, FUN.VALUE = integer(length = 1L)))
+}
+
+#
+# @param x A list of matricies to add to /layers
+# @param n The number of genes each cell needs
+# @param m2 The number of cells being added to the loom file
+#
+# @return 'x' with the proper number of cells
+#
+addCells.layers <- function(x, n, m2) {
+  layers.extend <- vapply(X = x, FUN = ncol, FUN.VALUE = integer(length = 1L))
+  layers.extend <- which(x = layers.extend != m2)
+  for (i in layers.extend) {
+    layer <- x[[i]]
+    layer.new <- matrix(nrow = n, ncol = m2)
+    layer.new[, 1:ncol(x = layer)] <- layer
+    x[[i]] <- layer.new
+    gc(verbose = FALSE)
+  }
+  return(x)
+}
+
+#
+# @param x A list of vectors to add to /col_attrs
+# @param attrs.names Names of attributes found in /col_attrs
+#
+# @return 'x' as a list of vectors for each attribute found in /col_attrs
+#
+check.col_attrs <- function(x, attrs.names) {
+  # Coerce x into a list of vectors
+  if (is.null(x = x)) {
+    x <- list()
+  } else if (is.actual_vector(x = x)) {
+    x <- list(x)
+  } else if (is.matrix(x = x) || is.data.frame(x = x)) {
+    x <- as.list(x = x)
+  }
+  if (!is.list(x = x)) {
+    stop("Attribute data must be a list of vectors")
+  }
+  # Ensure we have enough attribute additions for each col_attr
+  # Manage named lists, taking only those with the same name as in /col_attrs
+  # or is named with an empty string
+  if (!is.null(x = names(x = x))) {
+    x.use <- which(x = names(x = x) %in% attrs.names | names(x = x) == '')
+    x <- x[x.use]
+  }
+  if (length(x = x) > length(x = attrs.names)) {
+  } else if (length(x = x) < length(x = attrs.names)) {
+    x[(length(x = x) + 1):length(x = attrs.names)] <- NA
+  }
+  if (!all(vapply(X = x, FUN = is.actual_vector, FUN.VALUE = logical(length = 1L)))) {
+    stop("Attribute data must be a list of vectors")
+  }
+  # Set names
+  x.unnamed <- which(x = !(names(x = x) %in% attrs.names))
+  if (length(x = x.unnamed) == 0) {
+    x.unnamed <- 1:length(x = x)
+  }
+  names.unused <- which(x = !(attrs.names %in% names(x = x)))
+  names(x = x)[x.unnamed] <- attrs.names[names.unused]
+  return(x)
+}
+
+# Get the number of cells being added to /col_attrs
+#
+# @param x A list of vectors to add to /col_attrs
+#
+# @return The number of cells for each attribute
+#
+nCells.col_attrs <- function(x) {
+  return(vapply(X = x, FUN = length, FUN.VALUE = integer(length = 1L)))
+}
+
+#
+# @param x A list of vectors to add to /col_attrs
+# @param m2 The number of cells being added to the loom file
+#
+# @return 'x' with the proper number of cells
+#
+  attrs.extend <- vapply(X = x, FUN = length, FUN.VALUE = integer(length = 1L))
+  attrs.extend <- which(x = attrs.extend != m2)
+  for (i in attrs.extend) {
+    attr <- x[[i]]
+    attr <- c(attr, rep.int(x = NA, times = m2 - length(x = attr)))
+    x[[i]] <- attr
+  }
+  return(x)
+}
+
+# Create a progress bar
+#
+# @return A progress bar
+#
+#' @importFrom utils txtProgressBar
+#
+new.pb <- function() {return(txtProgressBar(style = 3, char = '='))}
index 0c805bdaf2dfa4556b134bb430656e0fdb6fd777..7cb2b8ce6caec60f6e207f799ee0f3b1639abcdd 100644 (file)
--- a/R/loom.R
+++ b/R/loom.R
@@ -14,7 +14,7 @@ NULL
#'
#' @field version Version of loomR object was created under
-#' @field shape Shape of \code{/matrix} in rows (genes) by cells (columns)
+#' @field shape Shape of \code{/matrix} in genes (columns) by cells (rows)
#' @field chunksize Chunks set for this dataset in columns (cells) by rows (genes)
#' @field matrix The main data matrix, stored as columns (cells) by rows (genes)
#' @field layers Additional data matricies, the same shape as \code{/matrix}
@@ -56,6 +56,15 @@ NULL
#'     Map a function onto a dataset within the loom file, returns the result into R.
#'     The result will default to the shape of the dataset used; to change pass either 'vector' or 'matrix' to \code{expected}.
#'   }
+#'   \item{\code{add.cells(matrix.data, attributes.data = NULL, layers.data = NULL, display.progress = TRUE)}}{
+#'     Add m2 cells to a loom file.
+#'     \describe{
+#'       \item{\code{matrix.data}}{a list of m2 cells where each entry is a vector of length n (num genes, \code{self$shape})} +#' \item{\code{attributes.data}}{a list where each entry is named for one of the datasets in \code{self[['col_attrs']]}; each entry is a vector of length m2.} +#' \item{\code{layers.data}}{a list where each entry is named for one of the datasets in \cpde{self[['layers]]}; each entry is an n-by-m2 matrix where n is the number of genes in this loom file and m2 is the number of cells being added.} +#' \item{\code{display.progress}}{display progress} +#' } +#' } #' } #' #' @importFrom iterators nextElem @@ -687,125 +696,86 @@ loom <- R6Class( return(results) }, # Functions that modify `/matrix' - add.cells = function(matrix.data, attributes.data = NULL, layers.data = NULL) { + add.cells = function( + matrix.data, + attributes.data = NULL, + layers.data = NULL, + display.progress = TRUE + ) { if (self$mode == 'r') {
stop("Cannot modify the loom file in read-only mode")
}
-      # matrix.data is a vector of data for one cell or a list of data for several cells
-      # each entry in matrix.data must be the same length as number of genes
-      # attributes.data is an optional list or vector (with optional names) for col_attrs
-      # each entry in col_attrs must be the same length as the number of cells being added (NAs added for those that aren't)
-      # layers.data is an optional list (with optional names) for layers
-      # each entry in layers.data must be an N by M matrix where N is the number of genes and M is the number of cells
-      ##########################################################################
-      # Handle times when matrix.data exists as a vector of data for one cell
-      # Also handle matrix.data as matrix or dataframe
-      if ((is.vector(x = matrix.data) || is.factor(x = matrix.data)) && !is.list(x = matrix.data)) {
-        matrix.data <- list(matrix.data)
-      } else if (is.matrix(x = matrix.data) || is.data.frame(x = matrix.data)) {
-        matrix.data <- as.list(x = as.data.frame(x = matrix.data))
+      # Check inputs
+      n <- self[['matrix']]$dims + if (display.progress) { + cat("Checking inputs...\n", file = stderr()) } - # Check that all inputs are lists - list.check <- vapply( - X = list(matrix.data, attributes.data, layers.data), - FUN = function(x) { - return(is.list(x = x) || is.null(x = x)) - }, - FUN.VALUE = logical(length = 1L) + matrix.data <- check.matrix_data(x = matrix.data, n = n) + layers.data <- check.layers( + x = layers.data, + n = n, + layers.names = names(x = self[['layers']]) ) - if (!all(list.check)) { - stop("'matrix.data', 'attributes.data', and 'layers.data' must be lists") - } - # Check that all components of matrix.data contain the same number of genes the loom file - length.check <- vapply( - X = matrix.data, - FUN = function(x) { - return(length(x = x) == self$shape)
-        },
-        FUN.VALUE = logical(length = 1L)
+      attributes.data <- check.col_attrs(
+        x = attributes.data,
+        attrs.names = names(x = self[['col_attrs']])
)
-      if (!all(length.check)) {
-        stop(paste(
-          "All values passed to matrix.data must have a length of",
-          self$shape - )) - } - # Figure out the maximum number of cells we're adding - # matrix.data: one cell per entry, Mcells = length(x = matrix.data) - # attributes.data: one attribute per entry, multiple cells per entry: - # Mcells = sapply(x = attributes.data, FUN = length) - # layers.data: one layer per entry, multiple cells per layer: - # Mcells = sapply(X = layers.data, FUN = length) if each entry is not a matrix - # Otherwise, Mcells = sapply(X = layers.data, FUN = ncol) - lengths <- vector( - mode = 'integer', - length = 1 + length(x = attributes.data) + length(x = layers.data) + # Get the number of cells we're adding + num.cells <- c( + nCells.matrix_data(x = matrix.data), + nCells.layers(x = layers.data), + nCells.col_attrs(x = attributes.data) ) - # Find Mcells for matrix.data - lengths <- length(x = matrix.data) - attributes.end <- 1 + length(x = attributes.data) - # Find Mcells for attributes.data - if (attributes.end != 1) { - lengths[2:attributes.end] <- vapply( - X = attributes.data, - FUN = length, - FUN.VALUE = integer(length = 1L) - ) + num.cells <- max(num.cells) + # Flesh out the input data to add + if (display.progress) { + cat(paste("Adding", num.cells, "to this loom file\n"), file = stderr()) } - if (attributes.end != length(x = lengths)) { - # Find Mcells for layers.data - lengths[(attributes.end + 1):length(x = lengths)] <- vapply( - X = layers.data, - FUN = function(x) { - # Mcells for matrix/data.frame entries - if (is.matrix(x = x) || is.data.frame(x = x)) { - check = nrow(x = x) - ret = ncol(x = x) - } else { - # Mcells for lists/vectors, cannot have a list of lists - check = length(x = x) - ret = 1L - } - # Check that each entry provides Ngenes entries - if (check != self$shape) {
-              stop("Layer additions must have datapoints for all genes")
-            } else {
-              return(ret)
-            }
-          },
-          FUN.VALUE = integer(length = 1L)
-        )
+      matrix.data <- addCells.matrix_data(x = matrix.data, n = n, m2 = num.cells)
+      layers.data <- addCells.layers(x = layers.data, n = n, m2 = num.cells)
+      attributes.data <- addCells.col_attrs(x = attributes.data, m2 = num.cells)
+      # Add the input to the loom file
+      dims.fill <- self[['matrix']]$dims + dims.fill <- (dims.fill + 1L):(dims.fill + num.cells) + # Matrix data + if (display.progress) { + cat("Adding data to /matrix\n", file = stderr()) } - # Get the maximum number of cells we're adding - num.cells.added <- max(lengths) - # Fill out everything else with NAs - # matrix.data <- c( - # matrix.data, - # rep.int( - # x = list(rep.int(x = NA, times = self$shape)),
-      #     times = num.cells.added - length(x = self$shape) - # ) - # ) - datasets.check <- c( - 'matrix', - grep(pattern = 'layers', x = list.datasets(object = self), value = TRUE) - ) - max.check <- vapply( - X = datasets.check, - FUN = function(dset, ncells) { - return((self[[dset]]$dims + ncells) > self[[dset]]$maxdims) - }, - FUN.VALUE = logical(length = 1L), - ncells = num.cells.added - ) - if (any(max.check)) { - stop() + matrix.data <- t(x = as.matrix(x = data.frame(matrix.data))) + self[['matrix']][dims.fill, ] <- matrix.data + # Layer data + if (display.progress) { + cat("Adding data to /layers\n", file = stderr()) + pb <- new.pb() + counter <- 0 + } + layers.names <- names(x = self[['layers']]) + for (i in layers.names) { + self[['layers', i]][dims.fill, ] <- t(x = layers.data[[i]]) + if (display.progress) { + counter <- counter + 1 + setTxtProgressBar(pb = pb, value = counter / length(x = layers.names)) + } + } + # Column attributes + if (display.progress) { + cat("Adding data to /col_attrs\n", file = stderr()) + pb <- new.pb() + counter <- 0 + } + attrs.names <- names(x = self[['col_attrs']]) + for (i in attrs.names) { + self[['col_attrs', i]][dims.fill] <- attributes.data[[i]] + if (display.progress) { + counter <- counter + 1 + setTxtProgressBar(pb = pb, value = counter / length(x = attrs.names)) + } } # # Load layers and attributes # private$load_layers()
# private$load_attributes(MARGIN = 1) # private$load_attributes(MARGIN = 2)
-      self$shape <- self[['matrix']]$dims
+      self$shape <- self[['matrix']]$dims
}
),
@@ -1028,7 +998,7 @@ connect <- function(filename, mode = "r", skip.validate = FALSE) {
#'
#' @return A loom object connected to \code{filename}
#'
-#' @importFrom utils txtProgressBar setTxtProgressBar
+#' @importFrom utils setTxtProgressBar
#'
#' @export subset.loom
#' @method subset loom
@@ -1042,7 +1012,6 @@ subset.loom <- function(
display.progress = TRUE,
...
) {
-  new.pb <- function() {return(txtProgressBar(style = 3, char = '='))}
# Set some defaults
if (is.null(x = m)) {
m <- 1:x$shape @@ -1052,7 +1021,7 @@ subset.loom <- function( } if (is.null(x = filename)) { filename <- paste( - unlist(x = strsplit(x = lfile$filename, split = '.', fixed = TRUE)),
+      unlist(x = strsplit(x = x$filename, split = '.', fixed = TRUE)), collapse = '_subset.' ) } index dfa234520aa91feb5d8eda495681fa5d55206ce5..9828ec9444ae026daaaedfaf6eeabb38989b4387 100644 (file) @@ -20,7 +20,7 @@ A class for loom files \describe{ \item{\code{version}}{Version of loomR object was created under} -\item{\code{shape}}{Shape of \code{/matrix} in rows (genes) by cells (columns)} +\item{\code{shape}}{Shape of \code{/matrix} in genes (columns) by cells (rows)} \item{\code{chunksize}}{Chunks set for this dataset in columns (cells) by rows (genes)} @@ -69,6 +69,15 @@ A class for loom files Map a function onto a dataset within the loom file, returns the result into R. The result will default to the shape of the dataset used; to change pass either 'vector' or 'matrix' to \code{expected}. } + \item{\code{add.cells(matrix.data, attributes.data = NULL, layers.data = NULL, display.progress = TRUE)}}{ + Add m2 cells to a loom file. + \describe{ + \item{\code{matrix.data}}{a list of m2 cells where each entry is a vector of length n (num genes, \code{self$shape})}
+      \item{\code{attributes.data}}{a list where each entry is named for one of the datasets in \code{self[['col_attrs']]}; each entry is a vector of length m2.}
+      \item{\code{layers.data}}{a list where each entry is named for one of the datasets in \cpde{self[['layers]]}; each entry is an n-by-m2 matrix where n is the number of genes in this loom file and m2 is the number of cells being added.}
+      \item{\code{display.progress}}{display progress}
+    }
+  }
}
}