dim(object) <- c(nrow(object), prod(tail(dim(object), -1)))
df <- as.data.frame(object[, head(seq_len(ncol(object)), 3), drop = FALSE])
setMethod("values", "Vector", function(x, ...) elementMetadata(x, ...))
stop("replacement 'elementMetadata' value must be a DataTable object or NULL")
if ("elementMetadata" %in% names(attributes(x))) {
if (!is.null(value) && length(x) != nrow(value))
stop("the number of rows in elementMetadata 'value' ",
"(if non-NULL) must match the length of 'x'")
setGeneric("mcols<-", function(x, ..., value) standardGeneric("mcols<-"))
function(x, ..., value) `elementMetadata<-`(x, ..., value=value)
setGeneric("values<-", function(x, ..., value) standardGeneric("values<-"))
setGeneric("rename", function(x, value, ...) standardGeneric("rename"))
.renameVector <- function(x, value, ...) {
stop("Some 'from' names in value not found on 'x': ",
if (!isSingleInteger(x_len) || x_len < 0L)
return("'length(x)' must be a single non-negative integer")
return("'length(x)' must be an unnamed number")
return("'names(x)' must be NULL or an unnamed character vector")
return("when not NULL, 'names(x)' must have the length of 'x'")
return("'mcols(x)' must be a DataTable object or NULL")
msg <- c("number of rows in DataTable 'mcols(x)' ",
if (!is.null(rownames(x_mcols)) && !identical(rownames(x_mcols), names(x))) {
msg <- c("the rownames of DataTable 'mcols(x)' ",
setMethod("extractROWS", "NULL", function(x, i) NULL)
.extractROWSFromArray <- function(x, i) {
args <- c(list(x), args, list(drop = FALSE))
setMethod("extractROWS", "matrix", function(x, i) {
ans <- .Call2("vector_seqselect", x, start(i), width(i),
stop("extractROWS does not support objects of class ",
i <- extractROWS(setNames(seq_along(x), names(x)), i)
i <- extractROWS(setNames(idx, names(x)), i)
idx[i] <- length(x) + seq_len(length(value))
value <- extractROWS(value, rep(seq_len(lv), length.out=li))
seqselect <- function(x, start=NULL, end=NULL, width=NULL) .Defunct()
`seqselect<-` <- function(x, start=NULL, end=NULL, width=NULL, value) .Defunct()
subsetByRanges <- function(x, i) .Defunct()
window.Vector <- function(x, start=NA, end=NA, width=NA,
i <- solveUserSEWForSingleSeq(NROW(x), start, end, width)
if (!is.null(frequency) || !is.null(delta)) {
`window<-.Vector` <- function(x, start=NA, end=NA, width=NA, ..., value)
`window<-.factor` <- function(x, start=NA, end=NA, width=NA, ..., value)
function(x, subset, select, drop = FALSE, ...) {
i <- eval(substitute(subset), mcols(x), parent.frame(2))
as.data.frame.Vector <- function(x, row.names=NULL, optional=FALSE, ...)
newDf <- function(nr) new("DataFrame", nrows = nr)
allCols <- unique(do.call(c, lapply(l_mcols, colnames)))
.c.Vector <- function(x, ..., recursive = FALSE)
stop("missing 'c' method for Vector class ", class(x)))
c(head(x, n=after), values, tail(x, n=-after))
setGeneric("mstack", function(..., .index.var = "name")
setMethod("mstack", "Vector", function(..., .index.var = "name") {
stop("'.index.var' must be a single, non-NA string")
df <- DataFrame(.stack.ind(args, .index.var), combined)
function(X, INDEX, FUN = NULL, ..., simplify = TRUE)
if (!is.list(INDEX) && !is(INDEX, "Rle"))
runValue(offset) <- ngroup * (as.integer(runValue(index)) - one)
ans <- lapply(groupRanges, function(i) FUN(extractROWS(X, i), ...))
if (simplify && all(unlist(lapply(ans, length), use.names=FALSE) == 1L)) {
ansmat <- array(dim = extent, dimnames = namelist)
array(vector("list", prod(extent)), dim = extent,
function(SHIFT, X, Y, FUN, ..., OFFSET = 0L, simplify = TRUE, verbose = FALSE)
shiftedStartX <- rep.int(1L + OFFSET, length(SHIFT))
shiftedEndY <- rep.int(N - OFFSET, length(SHIFT))
FUN(window(X, start = shiftedStartX[i], end = shiftedEndX[i]),
window(Y, start = shiftedStartY[i], end = shiftedEndY[i]),
setGeneric("shiftApply", signature = c("X", "Y"),
setMethod("shiftApply", signature(X = "Vector", Y = "Vector"),
setMethod("shiftApply", signature(X = "vector", Y = "vector"),
return(callGeneric(x = as.data.frame(x), by = by, FUN = FUN, ...))