setClass("RangedData", contains = c("DataTable", "List"),
representation(ranges = "RangesList", values = "SplitDataFrameList"),
prototype = prototype(ranges = new("SimpleRangesList"),
stop("'value' must have same elementLengths as current 'values'")
} else if (extends(class(value), "DataFrame")) {
stop("'value' must extend class SplitDataFrameList or DataFrame")
stop("rownames of 'value', if non-NULL, must match the ",
if (!identical(lapply(ranges(x), names), lapply(value, names)))
stop("'value' must have same length and names as current 'ranges'")
} else if (extends(class(value), "IRanges")) {
stop("'value' must extend class RangesList or IRanges")
setGeneric("score<-", function(x, ..., value) standardGeneric("score<-"))
stop("number of scores must equal the number of rows")
function(x, do.NULL = TRUE, prefix = "row") {
unlist(rownames(values(x), do.NULL = do.NULL, prefix = prefix),
function(x, do.NULL = TRUE, prefix = "col") {
colnames(values(x), do.NULL = do.NULL, prefix = prefix)[[1L]]
setReplaceMethod("columnMetadata", "RangedData", function(x, value) {
if (!identical(lapply(ranges(x), length), lapply(values(x), nrow)))
else if (!identical(unlist(lapply(ranges(x), names), use.names=FALSE),
else if (!is.character(nms) || anyMissing(nms) || anyDuplicated(nms))
RangedData <- function(ranges = IRanges(), ..., space = NULL, universe = NULL)
hasDots <- (((nargs() - !missing(space)) - !missing(universe)) > 1)
stop("'universe' must be a single string")
warning("since 'class(ranges)' extends RangesList, 'space' argument is ignored")
NAMES <- unlist(lapply(ranges, names), use.names=FALSE)
coerced <- try(as(ranges, "RangedData"), silent=TRUE)
stop("'ranges' must be a Ranges or directly coercible to RangedData")
stop("'space' is a 0-length vector but length of 'ranges' is > 0")
stop("length of 'space' greater than length of 'ranges'")
stop("length of 'ranges' not a multiple of 'space' length")
values <- DataFrame(...) ## at least one column specified
values <- new2("DataFrame", nrows = N, check=FALSE)
stop("length of value(s) in '...' greater than length of 'ranges'")
if (nrow(values) == 0 || N %% nrow(values) != 0)
stop("length of 'ranges' not a multiple of length of value(s) in '...'")
rownames(values) <- NAMES ## ensure these are identical
new2("RangedData", ranges = ranges, values = values, check=FALSE)
if (is.numeric(i) && !is.na(i) && (i < 1L || i > ncol(x)))
!(i %in% c("space", "ranges", colnames(x)))))
spaces <- factor(rep.int(inds, nrows), inds)
setReplaceMethod("$", "RangedData", function(x, name, value) {
stop("parameters in '...' not supported")
return("subscript contains NAs or out of bounds indices")
return("negative and positive indices cannot be mixed")
} else if ((is.character(i) || is.factor(i))) {
prob <- checkIndex(j, ncol(x), colnames(x))
"by a RangesList subscript is not supported")
whichRep <- which(xeltlen != elementLengths(i))
i[[k]] <- rep(i[[k]], length.out = xeltlen[k])
prob <- checkIndex(i, nrow(x), rownames(x))
if (anyMissing(i)) ## cannot subset by NAs yet
starts <- cumsum(c(1L, head(elementLengths(x), -1)))
factor(findInterval(i, starts), levels = seq_len(length(x)))
stop("cannot mix row indices from different spaces")
i <- i - (starts - 1L)[as.integer(igroup)]
prob <- checkIndex(i, length(x), names(x))
setMethod("c", "RangedData", function(x, ..., recursive = FALSE) {
stop("\"c\" method for RangedData objects ",
stop("all arguments in '...' must be RangedData objects")
nms <- lapply(rds, ## figure out names like 'c' on an ordinary vector
function(rd) structure(logical(length(rd)), names = names(rd)))
names(rds) <- NULL # critical for dispatch to work
ranges <- do.call(c, lapply(rds, ranges))
values <- do.call(c, lapply(rds, values))
setMethod("split", "RangedData", function(x, f, drop = FALSE) {
if (length(f) > nrow(x) || nrow(x) %% length(f) > 0)
stop("nrow(x) is not a multiple of length(f)")
splitInd <- split(seq_len(nrow(x)), f, drop)
setMethod("rbind", "RangedData", function(..., deparse.level=1) {
if (!all(sapply(sapply(rls, universe), identical, universe(rls[[1L]]))))
stop("All args in '...' must have the same universe")
nms <- unique(unlist(lapply(args, names), use.names=FALSE))
rls <- lapply(rls, function(x) {y <- as.list(x)[nms];names(y) <- nms;y})
lapply(args, function(x) {y <- as.list(values(x))[nms];names(y) <- nms;y})
rls <- IRangesList(do.call(Map, c(list(safe.c), rls)))
dfs <- SplitDataFrameList(do.call(Map, c(list(safe.rbind), dfs)))
initialize(args[[1L]], ranges = rls, values = dfs)
as.data.frame.RangedData <- function(x, row.names=NULL, optional=FALSE, ...)
stop("'row.names'  must be NULL or a character vector")
ranges = IRangesList("1" = successiveIRanges(runLength(from))),
SplitDataFrameList("1" = DataFrame(score = runValue(from))),
from_ranges <- restrict(ranges(from), 1L, elementLengths(subject),
offset <- (start(from_ranges) - start(score_part))[seqapply(ol, subjectHits)]
ranges <- shift(ranges(ol, score_ranges, score_part), offset)
viewNames <- lapply(from_ranges, function(x) {
score = unlist(runValue(score), use.names = FALSE)[queryHits(ol)],
view = unlist(viewNames, use.names = FALSE)[subjectHits(ol)])
stop("cannot coerce a RangesList object with no names ",
"or duplicated names to a RangedData object")
warning("could not propagate the inner metadata columns of ",
"'from' (accessed with 'mcols(unlist(from))') ",
"to the data columns (aka values) of the returned ",
setMethod("as.env", "RangedData", function(x, enclos = parent.frame(2)) {
makeAccessorBinding <- function(fun, name = deparse(substitute(fun))) {
assign(name, val, env) ## cache for further use
stop("'from' must at least include a 'start' and 'end' column")
datacols <- setdiff(colnames(from), c(required, "space", "width"))
nc, ifelse(nc == 1, " value column across ", " value columns across "),
lo, ifelse(lo == 1, " space\n", " spaces\n"), sep = "")
cbind(space = as.character(space(object)), ranges = showAsCell(ranges),
paste("<", classNameForDisplay(x), ">", sep = "")
rownames(out) <- c(as.character(1:9), "...", as.character((nr-8L):nr))
rownames(out) <- c(head(nms, 9), "...", tail(nms, 9))
prototype = prototype(elementType = "RangedData"),
if (length(listData) == 1 && is.list(listData[[1L]]))
function(x, recursive = TRUE, use.names = TRUE) {
stop("\"unlist\" method for RangedDataList objects ",
spaces <- unlist(lapply(x, space), use.names=FALSE)
rd[[index.var]] <- rep(factor(ids), sapply(x, nrow))[spaceOrd]