R/subset-internals.R

Defines functions .replace_columns .subset_columns .get_subset_index

.get_subset_index <- function(subset, names) {
  if (is.character(subset)) {
    fmt <- "index out of bounds: %s"
    subset <- SummarizedExperiment:::.SummarizedExperiment.charbound(
                                       subset, names, fmt
                                     )
  }
  as.vector(subset)
}

.subset_columns <- function(x, j, get_slot) {
  tmp <- get_slot(x)
  tmp_subsets <- lapply(tmp, function(x) x[, j, drop = FALSE])
  do.call(
    DataFrame,
    c(lapply(tmp_subsets, I), list(row.names=NULL, check.names=FALSE))
  )
}

.replace_columns <- function(x, j, get_slot, value, i) {
  left <- get_slot(x)
  right <- get_slot(value)
  if (missing(i)) {
    tmp_replaced <- mapply(
      FUN = function(x, y) {
        x[, j] <- y
        x
      }, left, right, SIMPLIFY = FALSE
    )
  } else {
    tmp_replaced <- mapply(
      FUN = function(x, y) {
        x[i, j] <- y
        x
      }, left, right, SIMPLIFY = FALSE
    )
  }
  do.call(
    DataFrame,
    c(lapply(tmp_replaced, I), list(row.names=NULL, check.names=FALSE))
  )
}
jaehyunjoo/poplin documentation built on Jan. 8, 2022, 1:13 a.m.