diff --git a/NAMESPACE b/NAMESPACE index 68f2f41..fabec76 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -131,6 +131,7 @@ export( ## SummarizedExperiment-class.R: SummarizedExperiment, exptData, "exptData<-", + rowRanges, "rowRanges<-", rowData, "rowData<-", colData, "colData<-", assays, "assays<-", @@ -145,7 +146,7 @@ exportMethods( granges, grglist, rglist, SummarizedExperiment, exptData, "exptData<-", - rowData, "rowData<-", + rowRanges, "rowRanges<-", colData, "colData<-", assays, "assays<-", assay, "assay<-", diff --git a/NEWS b/NEWS index a4b8a8f..2fc94ed 100644 --- a/NEWS +++ b/NEWS @@ -4,6 +4,8 @@ CHANGES IN VERSION 1.20.0 NEW FEATURES o Add 'assayNames', 'assayNames<-' for SummarizedExperiment + o Deprecate 'rowData', 'rowData<-' for SummarizedExperiment + o Add 'rowRanges', 'rowRanges<-' for SummarizedExperiment CHANGES IN VERSION 1.18.0 ------------------------- diff --git a/R/SummarizedExperiment-class.R b/R/SummarizedExperiment-class.R index d39756f..861c8c0 100644 --- a/R/SummarizedExperiment-class.R +++ b/R/SummarizedExperiment-class.R @@ -61,11 +61,11 @@ setClass("SummarizedExperiment", NULL } -.valid.SummarizedExperiment.rowData_dims <- function(x) +.valid.SummarizedExperiment.rowRanges_dims <- function(x) { if (!all(sapply(assays(x, withDimnames=FALSE), nrow) == - length(rowData(x)))) - return("'rowData' length differs from 'assays' nrow") + length(rowRanges(x)))) + return("'rowRanges' length differs from 'assays' nrow") NULL } @@ -79,7 +79,7 @@ setClass("SummarizedExperiment", .valid.SummarizedExperiment.assays_dims <- function(x) { - c(.valid.SummarizedExperiment.rowData_dims(x), + c(.valid.SummarizedExperiment.rowRanges_dims(x), .valid.SummarizedExperiment.colData_dims(x)) } @@ -204,10 +204,22 @@ setGeneric("exptData<-", ## rowData, colData seem too vague, but from eSet derived classes wanted to ## call the rows / cols something different from 'features' or 'samples', so ## might as well avoid the issue -setGeneric("rowData", function(x, ...) standardGeneric("rowData")) +setGeneric("rowRanges", function(x, ...) standardGeneric("rowRanges")) -setGeneric("rowData<-", - function(x, ..., value) standardGeneric("rowData<-")) +setGeneric("rowRanges<-", + function(x, ..., value) standardGeneric("rowRanges<-")) + +rowData <- function(...) +{ + .Deprecated("rowRanges") + rowRanges(...) +} + +`rowData<-` <- function(x, ..., value) +{ + .Deprecated("rowRanges<-") + rowRanges(x, ...) <- value +} setGeneric("colData", function(x, ...) standardGeneric("colData")) @@ -249,24 +261,24 @@ setReplaceMethod("exptData", c("SummarizedExperiment", "list"), clone(x, ..., exptData=SimpleList(value)) }) -setMethod(rowData, "SummarizedExperiment", +setMethod(rowRanges, "SummarizedExperiment", function(x, ...) value(x, "rowData")) -.SummarizedExperiment.rowData.replace <- +.SummarizedExperiment.rowRanges.replace <- function(x, ..., value) { x <- clone(x, ..., rowData=value) - msg <- .valid.SummarizedExperiment.rowData_dims(x) + msg <- .valid.SummarizedExperiment.rowRanges_dims(x) if (!is.null(msg)) stop(msg) x } -setReplaceMethod("rowData", c("SummarizedExperiment", "GenomicRanges"), - .SummarizedExperiment.rowData.replace) +setReplaceMethod("rowRanges", c("SummarizedExperiment", "GenomicRanges"), + .SummarizedExperiment.rowRanges.replace) -setReplaceMethod("rowData", c("SummarizedExperiment", "GRangesList"), - .SummarizedExperiment.rowData.replace) +setReplaceMethod("rowRanges", c("SummarizedExperiment", "GRangesList"), + .SummarizedExperiment.rowRanges.replace) setMethod(colData, "SummarizedExperiment", function(x, ...) value(x, "colData")) @@ -392,23 +404,23 @@ setReplaceMethod("assay", setMethod(dim, "SummarizedExperiment", function(x) { - c(length(rowData(x)), nrow(colData(x))) + c(length(rowRanges(x)), nrow(colData(x))) }) setMethod(dimnames, "SummarizedExperiment", function(x) { - list(names(rowData(x)), rownames(colData(x))) + list(names(rowRanges(x)), rownames(colData(x))) }) setReplaceMethod("dimnames", c("SummarizedExperiment", "list"), function(x, value) { - rowData <- rowData(x) - names(rowData) <- value[[1]] + rowRanges <- rowRanges(x) + names(rowRanges) <- value[[1]] colData <- colData(x) rownames(colData) <- value[[2]] - clone(x, rowData=rowData, colData=colData) + clone(x, rowData=rowRanges, colData=colData) }) setReplaceMethod("dimnames", c("SummarizedExperiment", "NULL"), @@ -482,7 +494,7 @@ setMethod("[", c("SummarizedExperiment", "ANY", "ANY"), if (!missing(i) && !missing(j)) { ii <- as.vector(i) jj <- as.vector(j) - x <- clone(x, ..., rowData=rowData(x)[i], + x <- clone(x, ..., rowData=rowRanges(x)[i], colData=colData(x)[j, , drop=FALSE], assays=.SummarizedExperiment.assays.subset(x, ii, jj)) } else if (missing(i)) { @@ -491,7 +503,7 @@ setMethod("[", c("SummarizedExperiment", "ANY", "ANY"), assays=.SummarizedExperiment.assays.subset(x, j=jj)) } else { # missing(j) ii <- as.vector(i) - x <- clone(x, ..., rowData=rowData(x)[i], + x <- clone(x, ..., rowData=rowRanges(x)[i], assays=.SummarizedExperiment.assays.subset(x, ii)) } x @@ -553,9 +565,9 @@ setReplaceMethod("[", jj <- as.vector(j) x <- clone(x, ..., exptData=c(exptData(x), exptData(value)), rowData=local({ - r <- rowData(x) - r[i] <- rowData(value) - names(r)[ii] <- names(rowData(value)) + r <- rowRanges(x) + r[i] <- rowRanges(value) + names(r)[ii] <- names(rowRanges(value)) r }), colData=local({ c <- colData(x) @@ -580,13 +592,13 @@ setReplaceMethod("[", ii <- as.vector(i) x <- clone(x, ..., exptData=c(exptData(x), exptData(value)), rowData=local({ - r <- rowData(x) - r[i] <- rowData(value) - names(r)[ii] <- names(rowData(value)) + r <- rowRanges(x) + r[i] <- rowRanges(value) + names(r)[ii] <- names(rowRanges(value)) r }), assays=.SummarizedExperiment.assays.subsetgets(x, ii, ..., value=value)) - msg <- .valid.SummarizedExperiment.rowData_dims(x) + msg <- .valid.SummarizedExperiment.rowRanges_dims(x) } if (!is.null(msg)) stop(msg) @@ -609,13 +621,12 @@ setMethod("rbind", "SummarizedExperiment", stop("'...' objects must have the same colnames") if (!.compare(lapply(args, ncol))) stop("'...' objects must have the same number of samples") - rowData <- do.call(c, lapply(args, - function(i) slot(i, "rowData"))) + rowRanges <- do.call(c, lapply(args, rowRanges)) colData <- .cbind.DataFrame(args, colData, "colData") assays <- .bind.arrays(args, rbind, "assays") exptData <- do.call(c, lapply(args, exptData)) - initialize(args[[1]], assays=assays, rowData=rowData, + initialize(args[[1]], assays=assays, rowData=rowRanges, colData=colData, exptData=exptData) } @@ -629,15 +640,15 @@ setMethod("cbind", "SummarizedExperiment", .cbind.SummarizedExperiment <- function(args) { - if (!.compare(lapply(args, rowData), TRUE)) + if (!.compare(lapply(args, rowRanges), TRUE)) stop("'...' object ranges (rows) are not compatible") - rowData <- rowData(args[[1]]) - mcols(rowData) <- .cbind.DataFrame(args, mcols, "mcols") + rowRanges <- rowRanges(args[[1]]) + mcols(rowRanges) <- .cbind.DataFrame(args, mcols, "mcols") colData <- do.call(rbind, lapply(args, colData)) assays <- .bind.arrays(args, cbind, "assays") exptData <- do.call(c, lapply(args, exptData)) - initialize(args[[1]], assays=assays, rowData=rowData, + initialize(args[[1]], assays=assays, rowData=rowRanges, colData=colData, exptData=exptData) } @@ -793,8 +804,8 @@ setMethod(show, "SummarizedExperiment", dlen <- sapply(dimnames, length) if (dlen[[1]]) scat("rownames(%d): %s\n", dimnames[[1]]) else scat("rownames: NULL\n") - scat("rowData metadata column names(%d): %s\n", - names(mcols(rowData(object)))) + scat("rowRanges metadata column names(%d): %s\n", + names(mcols(rowRanges(object)))) if (dlen[[2]]) scat("colnames(%d): %s\n", dimnames[[2]]) else cat("colnames: NULL\n") scat("colData names(%d): %s\n", names(colData(object))) diff --git a/R/SummarizedExperiment-rowData-methods.R b/R/SummarizedExperiment-rowData-methods.R index fb583bf..7f24042 100644 --- a/R/SummarizedExperiment-rowData-methods.R +++ b/R/SummarizedExperiment-rowData-methods.R @@ -14,14 +14,14 @@ setMethod(mcols, "SummarizedExperiment", function(x, use.names=FALSE, ...) { - mcols(rowData(x), use.names=use.names, ...) + mcols(rowRanges(x), use.names=use.names, ...) }) setReplaceMethod("mcols", "SummarizedExperiment", function(x, ..., value) { clone(x, rowData=local({ - r <- rowData(x) + r <- rowRanges(x) mcols(r) <- value r })) @@ -33,26 +33,26 @@ setReplaceMethod("mcols", "SummarizedExperiment", setMethod(elementMetadata, "SummarizedExperiment", function(x, use.names=FALSE, ...) { - elementMetadata(rowData(x), use.names=use.names, ...) + elementMetadata(rowRanges(x), use.names=use.names, ...) }) setReplaceMethod("elementMetadata", "SummarizedExperiment", function(x, ..., value) { - elementMetadata(rowData(x), ...) <- value + elementMetadata(rowRanges(x), ...) <- value x }) setMethod(values, "SummarizedExperiment", function(x, ...) { - values(rowData(x), ...) + values(rowRanges(x), ...) }) setReplaceMethod("values", "SummarizedExperiment", function(x, ..., value) { - values(rowData(x), ...) <- value + values(rowRanges(x), ...) <- value x }) @@ -75,10 +75,10 @@ local({ formals(tmpl) <- formals(generic) fmls <- as.list(formals(tmpl)) fmls[] <- sapply(names(fmls), as.symbol) - fmls[[generic@signature]] <- quote(rowData(x)) + fmls[[generic@signature]] <- quote(rowRanges(x)) if (.fun %in% endomorphisms) body(tmpl) <- substitute({ - rowData(x) <- do.call(FUN, ARGS) + rowRanges(x) <- do.call(FUN, ARGS) x }, list(FUN=.fun, ARGS=fmls)) else @@ -95,7 +95,7 @@ setMethod("granges", "SummarizedExperiment", if (!identical(use.mcols, FALSE)) stop("\"granges\" method for SummarizedExperiment objects ", "does not support the 'use.mcols' argument") - rowData(x) + rowRanges(x) }) ## 2-argument dispatch: @@ -108,9 +108,9 @@ setMethod("granges", "SummarizedExperiment", function(x, y) { if (is(x, "SummarizedExperiment")) - x <- rowData(x) + x <- rowRanges(x) if (is(y, "SummarizedExperiment")) - y <- rowData(y) + y <- rowRanges(y) compare(x, y) } @@ -118,9 +118,9 @@ setMethod("granges", "SummarizedExperiment", function(e1, e2) { if (is(e1, "SummarizedExperiment")) - e1 <- rowData(e1) + e1 <- rowRanges(e1) if (is(e2, "SummarizedExperiment")) - e2 <- rowData(e2) + e2 <- rowRanges(e2) callGeneric(e1=e1, e2=e2) } @@ -129,7 +129,7 @@ setMethod("granges", "SummarizedExperiment", algorithm = c("nclist", "intervaltree"), ignore.strand = FALSE) { select <- match.arg(select) - x <- rowData(x) + x <- rowRanges(x) nearest(x=x, select=select, algorithm=match.arg(algorithm), ignore.strand=ignore.strand) } @@ -138,9 +138,9 @@ setMethod("granges", "SummarizedExperiment", function(x, y, ignore.strand = FALSE, ...) { if (is(x, "SummarizedExperiment")) - x <- rowData(x) + x <- rowRanges(x) if (is(y, "SummarizedExperiment")) - y <- rowData(y) + y <- rowRanges(y) distance(x, y, ignore.strand=ignore.strand, ...) } @@ -149,9 +149,9 @@ setMethod("granges", "SummarizedExperiment", ignore.strand = FALSE, ...) { if (is(x, "SummarizedExperiment")) - x <- rowData(x) + x <- rowRanges(x) if (is(subject, "SummarizedExperiment")) - subject <- rowData(subject) + subject <- rowRanges(subject) distanceToNearest(x, subject, algorithm=match.arg(algorithm), ignore.strand=ignore.strand, ...) } @@ -171,9 +171,9 @@ local({ body(tmpl) <- substitute({ select <- match.arg(select) if (is(x, "SummarizedExperiment")) - x <- rowData(x) + x <- rowRanges(x) if (is(subject, "SummarizedExperiment")) - subject <- rowData(subject) + subject <- rowRanges(subject) FUN(x=x, subject=subject, select=select, ignore.strand=ignore.strand) }, list(FUN=as.symbol(.fun))) @@ -188,9 +188,9 @@ local({ body(tmpl) <- substitute({ select <- match.arg(select) if (is(x, "SummarizedExperiment")) - x <- rowData(x) + x <- rowRanges(x) if (is(subject, "SummarizedExperiment")) - subject <- rowData(subject) + subject <- rowRanges(subject) FUN(x=x, subject=subject, select=select, ignore.strand=ignore.strand) }, list(FUN=as.symbol(.fun))) @@ -211,14 +211,14 @@ local({ setReplaceMethod("strand", "SummarizedExperiment", function(x, ..., value) { - strand(rowData(x)) <- value + strand(rowRanges(x)) <- value x }) setReplaceMethod("ranges", "SummarizedExperiment", function(x, ..., value) { - ranges(rowData(x)) <- value + ranges(rowRanges(x)) <- value x }) @@ -227,7 +227,7 @@ setReplaceMethod("ranges", "SummarizedExperiment", setMethod("order", "SummarizedExperiment", function(..., na.last = TRUE, decreasing = FALSE) { - args <- lapply(list(...), rowData) + args <- lapply(list(...), rowRanges) do.call("order", c(args, list(na.last=na.last, decreasing=decreasing))) }) @@ -237,13 +237,13 @@ setMethod("rank", "SummarizedExperiment", ties.method = c("average", "first", "random", "max", "min")) { ties.method <- match.arg(ties.method) - rank(rowData(x), na.last=na.last, ties.method=ties.method) + rank(rowRanges(x), na.last=na.last, ties.method=ties.method) }) setMethod("sort", "SummarizedExperiment", function(x, decreasing = FALSE, ...) { - x[order(rowData(x), decreasing=decreasing),] + x[order(rowRanges(x), decreasing=decreasing),] }) ## subset @@ -251,7 +251,7 @@ setMethod("sort", "SummarizedExperiment", setMethod("subset", "SummarizedExperiment", function(x, subset, select, ...) { - i <- S4Vectors:::evalqForSubset(subset, rowData(x), ...) + i <- S4Vectors:::evalqForSubset(subset, rowRanges(x), ...) j <- S4Vectors:::evalqForSubset(select, colData(x), ...) x[i, j] }) diff --git a/R/findOverlaps-methods.R b/R/findOverlaps-methods.R index 013ccfa..e59e257 100644 --- a/R/findOverlaps-methods.R +++ b/R/findOverlaps-methods.R @@ -535,7 +535,7 @@ setMethod("findOverlaps", c("SummarizedExperiment", "Vector"), algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE) { - findOverlaps(rowData(query), subject, + findOverlaps(rowRanges(query), subject, maxgap=maxgap, minoverlap=minoverlap, type=match.arg(type), select=match.arg(select), algorithm=match.arg(algorithm), @@ -550,7 +550,7 @@ setMethod("findOverlaps", c("Vector", "SummarizedExperiment"), algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE) { - findOverlaps(query, rowData(subject), + findOverlaps(query, rowRanges(subject), maxgap=maxgap, minoverlap=minoverlap, type=match.arg(type), select=match.arg(select), algorithm=match.arg(algorithm), @@ -565,7 +565,7 @@ setMethod("findOverlaps", c("SummarizedExperiment", "SummarizedExperiment"), algorithm=c("nclist", "intervaltree"), ignore.strand=FALSE) { - findOverlaps(rowData(query), rowData(subject), + findOverlaps(rowRanges(query), rowRanges(subject), maxgap=maxgap, minoverlap=minoverlap, type=match.arg(type), select=match.arg(select), algorithm=match.arg(algorithm), diff --git a/TODO.md b/TODO.md index 6f95f78..44c314b 100644 --- a/TODO.md +++ b/TODO.md @@ -2,7 +2,7 @@ Long term - Separate package -- Separate classes for 'DataFrame' and '*Ranges' rowData +- Separate classes for 'DataFrame' and '\*Ranges' rowData Immediate @@ -11,7 +11,7 @@ Immediate Short term (start of next release cycle) -3. Implement separate classes for DataFrame and *Ranges rowData() +3. Implement separate classes for DataFrame and \*Ranges rowData() Possibilities? @@ -22,14 +22,14 @@ Possibilities? - SummarizedExperimentGR @rowRanges: *Ranges; rowData() == mcols(rowRanges()) - + - SummarizedExperiment as 'DataFrame' base class, SummarizedExperimentGR as derived class - + - SummarizedExperiment @rowData: DataFrame - SummarizedExperimentGR - @rowRanges: *Ranges; no mcols() (rowData() from inheritted + @rowRanges: \*Ranges; no mcols() (rowData() from inheritted @rowData) diff --git a/inst/unitTests/test_SummarizedExperiment-class.R b/inst/unitTests/test_SummarizedExperiment-class.R index 2c11ed8..e4533e1 100644 --- a/inst/unitTests/test_SummarizedExperiment-class.R +++ b/inst/unitTests/test_SummarizedExperiment-class.R @@ -2,21 +2,21 @@ m <- matrix(1, 5, 3, dimnames=list(NULL, NULL)) mlst <- matrix(1, 3, 3, dimnames=list(NULL, NULL)) mList <- list(m, mlst) assaysList <- list(gr=SimpleList(m=m), grl=SimpleList(m=mlst)) -rowDataList <- +rowRangesList <- list(gr=GRanges("chr1", IRanges(1:5, 10)), grl=split(GRanges("chr1", IRanges(1:5, 10)), c(1,1,2,2,3))) -names(rowDataList[["grl"]]) <- NULL +names(rowRangesList[["grl"]]) <- NULL colData <- DataFrame(x=letters[1:3]) ## a list of one SE with GRanges and one with GRangesList ssetList <- list(SummarizedExperiment( assays=assaysList[["gr"]], - rowData=rowDataList[["gr"]], + rowData=rowRangesList[["gr"]], colData=colData), SummarizedExperiment( assays=assaysList[["grl"]], - rowData=rowDataList[["grl"]], + rowData=rowRangesList[["grl"]], colData=colData)) @@ -42,7 +42,7 @@ test_SummarizedExperiment_construction <- function() { sset <- ssetList[[i]] checkTrue(validObject(sset)) checkIdentical(SimpleList(m=mList[[i]]), assays(sset)) - checkIdentical(rowDataList[[i]], rowData(sset)) + checkIdentical(rowRangesList[[i]], rowRanges(sset)) checkIdentical(DataFrame(x=letters[1:3]), colData(sset)) } @@ -66,13 +66,13 @@ test_SummarizedExperiment_construction <- function() { test_SummarizedExperiment_getters <- function() { for (i in length(ssetList)) { sset <- ssetList[[i]] - rowData <- rowDataList[[i]] + rowRanges <- rowRangesList[[i]] ## dim, dimnames - checkIdentical(c(length(rowData), nrow(colData)), dim(sset)) + checkIdentical(c(length(rowRanges), nrow(colData)), dim(sset)) checkIdentical(list(NULL, NULL), dimnames(sset)) ## row / col / exptData - checkIdentical(rowData, rowData(sset)) + checkIdentical(rowRanges, rowRanges(sset)) checkIdentical(colData, colData(sset)) checkIdentical(SimpleList(), exptData(sset)) } @@ -105,13 +105,13 @@ test_SummarizedExperiment_setters <- function() { for (i in length(ssetList)) { sset <- ssetList[[i]] - rowData <- rowDataList[[i]] + rowRanges <- rowRangesList[[i]] ## row / col / exptData<- ss1 <- sset - revData <- rowData[rev(seq_len(length(rowData))),,drop=FALSE] - rowData(ss1) <- revData - checkIdentical(revData, rowData(ss1)) - checkException(rowData(ss1) <- rowData(sset)[1:2,,drop=FALSE], + revData <- rowRanges[rev(seq_len(length(rowRanges))),,drop=FALSE] + rowRanges(ss1) <- revData + checkIdentical(revData, rowRanges(ss1)) + checkException(rowRanges(ss1) <- rowRanges(sset)[1:2,,drop=FALSE], "incorrect row dimensions", TRUE) revData <- colData[rev(seq_len(nrow(colData))),,drop=FALSE] colData(ss1) <- revData @@ -140,9 +140,9 @@ test_SummarizedExperiment_setters <- function() rownames(ss1) <- dimnames[[1]] colnames(ss1) <- dimnames[[2]] checkIdentical(dimnames, dimnames(ss1)) - rowData1 <- rowData - names(rowData1) <- dimnames[[1]] - checkIdentical(rowData1, rowData(ss1)) + rowRanges1 <- rowRanges + names(rowRanges1) <- dimnames[[1]] + checkIdentical(rowRanges1, rowRanges(ss1)) colData1 <- colData row.names(colData1) <- dimnames[[2]] checkIdentical(colData1, colData(ss1)) @@ -158,19 +158,19 @@ test_SummarizedExperiment_subset <- function() { for (i in length(ssetList)) { sset <- ssetList[[i]] - rowData <- rowDataList[[i]] + rowRanges <- rowRangesList[[i]] ## numeric ss1 <- sset[2:3,] checkIdentical(c(2L, ncol(sset)), dim(ss1)) - checkIdentical(rowData(ss1), rowData(sset)[2:3,]) + checkIdentical(rowRanges(ss1), rowRanges(sset)[2:3,]) checkIdentical(colData(ss1), colData(sset)) ss1 <- sset[,2:3] checkIdentical(c(nrow(sset), 2L), dim(ss1)) - checkIdentical(rowData(ss1), rowData(sset)) + checkIdentical(rowRanges(ss1), rowRanges(sset)) checkIdentical(colData(ss1), colData(sset)[2:3,,drop=FALSE]) ss1 <- sset[2:3, 2:3] checkIdentical(c(2L, 2L), dim(ss1)) - checkIdentical(rowData(ss1), rowData(sset)[2:3,,drop=FALSE]) + checkIdentical(rowRanges(ss1), rowRanges(sset)[2:3,,drop=FALSE]) checkIdentical(colData(ss1), colData(sset)[2:3,,drop=FALSE]) ## character @@ -178,8 +178,8 @@ test_SummarizedExperiment_subset <- function() dimnames(ss1) <- list(LETTERS[seq_len(nrow(ss1))], letters[seq_len(ncol(ss1))]) ridx <- c("B", "C") - checkIdentical(rowData(ss1[ridx,]), rowData(ss1)[ridx,]) - checkIdentical(rowData(ss1["C",]), rowData(ss1)["C",,drop=FALSE]) + checkIdentical(rowRanges(ss1[ridx,]), rowRanges(ss1)[ridx,]) + checkIdentical(rowRanges(ss1["C",]), rowRanges(ss1)["C",,drop=FALSE]) checkException(ss1[LETTERS,], "i-index out of bounds", TRUE) cidx <- c("b", "c") checkIdentical(colData(ss1[,cidx]), colData(ss1)[cidx,,drop=FALSE]) @@ -196,14 +196,14 @@ test_SummarizedExperiment_subset <- function() checkIdentical(c(nrow(ss1), 0L), dim(ss1[,FALSE])) idx <- c(TRUE, FALSE) # recycling ss2 <- ss1[idx,] - checkIdentical(rowData(ss1)[idx,,drop=FALSE], rowData(ss2)) + checkIdentical(rowRanges(ss1)[idx,,drop=FALSE], rowRanges(ss2)) ss2 <- ss1[,idx] checkIdentical(colData(ss1)[idx,,drop=FALSE], colData(ss2)) ## Rle ss1 <- sset rle <- rep(c(TRUE, FALSE), each=3, length.out=nrow(ss1)) - checkIdentical(rowData(ss1[rle]), rowData(ss1[Rle(rle)])) + checkIdentical(rowRanges(ss1[rle]), rowRanges(ss1[Rle(rle)])) checkIdentical(assays(ss1[rle]), assays(ss1[Rle(rle)])) } @@ -224,8 +224,8 @@ test_SummarizedExperiment_subsetassign <- function() ## rows ss1 <- sset ss1[1:2,] <- ss1[2:1,] - checkIdentical(rowData(sset)[2:1,], rowData(ss1)[1:2,]) - checkIdentical(rowData(sset[-(1:2),]), rowData(ss1)[-(1:2),]) + checkIdentical(rowRanges(sset)[2:1,], rowRanges(ss1)[1:2,]) + checkIdentical(rowRanges(sset[-(1:2),]), rowRanges(ss1)[-(1:2),]) checkIdentical(colData(sset), colData(ss1)) checkIdentical(c(exptData(sset), exptData(sset)), exptData(ss1)) ## Rle @@ -233,7 +233,7 @@ test_SummarizedExperiment_subsetassign <- function() rle <- rep(c(TRUE, FALSE), each=3, length.out=nrow(ss1)) ss1rle[rle,] <- ss1rle[rle,] ss1Rle[Rle(rle),] <- ss1Rle[Rle(rle),] - checkIdentical(rowData(ss1rle), rowData(ss1Rle)) + checkIdentical(rowRanges(ss1rle), rowRanges(ss1Rle)) checkIdentical(assays(ss1rle), assays(ss1Rle)) ## cols ss1 <- sset @@ -242,12 +242,12 @@ test_SummarizedExperiment_subsetassign <- function() colData(ss1)[1:2,,drop=FALSE]) checkIdentical(colData(sset)[-(1:2),,drop=FALSE], colData(ss1)[-(1:2),,drop=FALSE]) - checkIdentical(rowData(sset), rowData(ss1)) + checkIdentical(rowRanges(sset), rowRanges(ss1)) checkIdentical(c(exptData(sset), exptData(sset)), exptData(ss1)) } ## full replacement ss1 <- ss2 <- ssetList[[1]] - rowData(ss2) <- rev(rowData(ss2)) + rowRanges(ss2) <- rev(rowRanges(ss2)) ss1[,] <- ss2 checkIdentical(ss1, ss2) } @@ -274,11 +274,11 @@ test_SummarizedExperiment_cbind <- function() res <- cbind(se1, se2) checkTrue(nrow(res) == 5) checkTrue(ncol(res) == 5) - ## rowData + ## rowRanges mcols(se1) <- DataFrame("one"=1:5) mcols(se2) <- DataFrame("two"=6:10) res <- quiet(cbind(se1, se2)) - checkIdentical(names(mcols(rowData(res))), c("one", "two")) + checkIdentical(names(mcols(rowRanges(res))), c("one", "two")) mcols(se2) <- DataFrame("one"=6:10, "two"=6:10) checkException(cbind(se1, se2), silent=TRUE) ## colData @@ -319,7 +319,7 @@ test_SummarizedExperiment_rbind <- function() res <- rbind(se1, se2) checkTrue(nrow(res) == 10) checkTrue(ncol(res) == 3) - ## rowData + ## rowRanges mcols(se1) <- DataFrame("one"=1:5) mcols(se2) <- DataFrame("two"=6:10) checkException(rbind(se1, se2), silent=TRUE) diff --git a/inst/unitTests/test_SummarizedExperiment-rowData-methods.R b/inst/unitTests/test_SummarizedExperiment-rowData-methods.R index 7670d19..e1e9f5b 100644 --- a/inst/unitTests/test_SummarizedExperiment-rowData-methods.R +++ b/inst/unitTests/test_SummarizedExperiment-rowData-methods.R @@ -18,21 +18,21 @@ m <- matrix(1, 5, 3, dimnames=list(NULL, NULL)) mlst <- matrix(1, 3, 3, dimnames=list(NULL, NULL)) mList <- list(m, mlst) assaysList <- list(gr=SimpleList(m=m), grl=SimpleList(m=mlst)) -rowDataList <- +rowRangesList <- list(gr=GRanges("chr1", IRanges(1:5, 10)), grl=split(GRanges("chr1", IRanges(1:5, 10)), c(1,1,2,2,3))) -names(rowDataList[["grl"]]) <- NULL +names(rowRangesList[["grl"]]) <- NULL colData <- DataFrame(x=letters[1:3]) ## a list of one SE with GRanges and one with GRangesList ssetList <- list(SummarizedExperiment( assays=assaysList[["gr"]], - rowData=rowDataList[["gr"]], + rowData=rowRangesList[["gr"]], colData=colData), SummarizedExperiment( assays=assaysList[["grl"]], - rowData=rowDataList[["grl"]], + rowData=rowRangesList[["grl"]], colData=colData)) test_SummarizedExperiment_GRanges_API <- function() { @@ -92,16 +92,16 @@ test_SummarizedExperiment_GRanges_values <- function() } for (.fun in needArgs) { - ## all needArgs operate on rowData + ## all needArgs operate on rowRanges generic <- getGeneric(.fun) - x1 <- x; rowData(x1) <- generic(rowData(x1), 5) + x1 <- x; rowRanges(x1) <- generic(rowRanges(x1), 5) checkIdentical(x1, generic(x, 5)) } ## isEndomorphism for (.fun in isEndomorphism) { generic <- getGeneric(.fun) obs <- generic(x) - checkIdentical(generic(rowData(x)), rowData(obs)) + checkIdentical(generic(rowRanges(x)), rowRanges(obs)) checkIdentical(assays(x), assays(obs)) } @@ -110,14 +110,14 @@ test_SummarizedExperiment_GRanges_values <- function() x1 <- shift(x, seq_len(nrow(x)) * 5) for (.fun in .funs) { generic <- getGeneric(.fun) - exp <- generic(rowData(x1), rowData(x1)) + exp <- generic(rowRanges(x1), rowRanges(x1)) obs <- generic(x1, x1) checkIdentical(obs, exp) } # nearest,SummarizedExperiment,missing-method - checkIdentical(nearest(rowData(x1)), nearest(x1)) - checkIdentical(subsetByOverlaps(rowData(x1), rowData(x1)[3]), - rowData(subsetByOverlaps(x1, x1[3]))) + checkIdentical(nearest(rowRanges(x1)), nearest(x1)) + checkIdentical(subsetByOverlaps(rowRanges(x1), rowRanges(x1)[3]), + rowRanges(subsetByOverlaps(x1, x1[3]))) } test_SummarizedExperiment_split <- function() { diff --git a/man/SummarizedExperiment-class.Rd b/man/SummarizedExperiment-class.Rd index 3e9f793..1831ea0 100644 --- a/man/SummarizedExperiment-class.Rd +++ b/man/SummarizedExperiment-class.Rd @@ -36,11 +36,11 @@ \alias{assayNames,SummarizedExperiment-method} \alias{assayNames<-} \alias{assayNames<-,SummarizedExperiment,character-method} -\alias{rowData} -\alias{rowData,SummarizedExperiment-method} -\alias{rowData<-} -\alias{rowData<-,SummarizedExperiment,GenomicRanges-method} -\alias{rowData<-,SummarizedExperiment,GRangesList-method} +\alias{rowRanges} +\alias{rowRanges,SummarizedExperiment-method} +\alias{rowRanges<-} +\alias{rowRanges<-,SummarizedExperiment,GenomicRanges-method} +\alias{rowRanges<-,SummarizedExperiment,GRangesList-method} \alias{colData} \alias{colData,SummarizedExperiment-method} \alias{colData<-} @@ -174,8 +174,8 @@ assays(x, ..., withDimnames=TRUE) assays(x, ..., withDimnames=TRUE) <- value assay(x, i, ...) assay(x, i, ...) <- value -rowData(x, ...) -rowData(x, ...) <- value +rowRanges(x, ...) +rowRanges(x, ...) <- value colData(x, ...) colData(x, ...) <- value exptData(x, ...) @@ -218,7 +218,7 @@ exptData(x, ...) <- value \item{assays}{A \code{list} or \code{SimpleList} of matrix elements, or a \code{matrix}. All elements of the list must have the same dimensions, and dimension names (if present) must be consistent - across elements and with the row names of \code{rowData} and + across elements and with the row names of \code{rowRanges} and \code{colData}.} \item{rowData}{A \code{GRanges} or \code{GRangesList} instance describing @@ -258,7 +258,7 @@ exptData(x, ...) <- value For \code{[,SummarizedExperiment}, \code{[,SummarizedExperiment<-}, \code{i}, \code{j} are instances that can act to subset the - underlying \code{rowData}, \code{colData}, and \code{matrix} + underlying \code{rowRanges}, \code{colData}, and \code{matrix} elements of \code{assays}. For \code{[[,SummarizedExperiment}, @@ -269,7 +269,7 @@ exptData(x, ...) <- value } \item{subset}{An expression which, when evaluated in the - context of \code{rowData(x)}, is a logical vector indicating + context of \code{rowRanges(x)}, is a logical vector indicating elements or rows to keep: missing values are taken as false.} \item{select}{An expression which, when evaluated in the @@ -314,7 +314,7 @@ exptData(x, ...) <- value (in genomic coordinates) of interest. The ranges of interest are described by a \code{\linkS4class{GRanges}-class} or a \code{\linkS4class{GRangesList}-class} instance, accessible using the - \code{rowData} function, described below. The \code{GRanges} and + \code{rowRanges} function, described below. The \code{GRanges} and \code{GRangesList} classes contains sequence (e.g., chromosome) name, genomic coordinates, and strand information. Each range can be annotated with additional data; this data might be used to describe @@ -412,7 +412,7 @@ exptData(x, ...) <- value \item{\code{assayNames(x)}, \code{assayNames(x) <- value}:}{Get or set the names of \code{assay()} elements.} - \item{\code{rowData(x)}, \code{rowData(x) <- value}:}{Get or set the + \item{\code{rowRanges(x)}, \code{rowRanges(x) <- value}:}{Get or set the row data. \code{value} is a \code{GenomicRanges} instance. Row names of \code{value} must be NULL or consistent with the existing row names of \code{x}.} @@ -445,7 +445,7 @@ exptData(x, ...) <- value Many \code{\linkS4class{GRanges}-class} and \code{\linkS4class{GRangesList}-class} operations are supported on \sQuote{SummarizedExperiment} and derived instances, using - \code{rowData}. + \code{rowRanges}. Supported operations include: \code{\link{compare}}, \code{\link{countOverlaps}}, \code{\link{coverage}}, @@ -492,7 +492,7 @@ exptData(x, ...) <- value \item{\code{subset(x, subset, select)}:}{Create a subset of \code{x} using an expression \code{subset} referring to columns of - \code{rowData(x)} (including \sQuote{seqnames}, \sQuote{start}, + \code{rowRanges(x)} (including \sQuote{seqnames}, \sQuote{start}, \sQuote{end}, \sQuote{width}, \sQuote{strand}, and \code{names(mcols(x))}) and / or \code{select} referring to column names of \code{colData(x)}.} @@ -522,13 +522,13 @@ exptData(x, ...) <- value \describe{ \item{\code{cbind(...)}, \code{rbind(...)}:}{ - \code{cbind} combines objects with identical ranges (\code{rowData}) + \code{cbind} combines objects with identical ranges (\code{rowRanges}) but different samples (columns in \code{assays}). The colnames in \code{colData} must match or an error is thrown. Duplicate columns - of \code{mcols(rowData(SummarizedExperiment))} must contain the same + of \code{mcols(rowRanges(SummarizedExperiment))} must contain the same data. - \code{rbind} combines objects with different ranges (\code{rowData}) + \code{rbind} combines objects with different ranges (\code{rowRanges}) and the same subjects (columns in \code{assays}). Duplicate columns of \code{colData} must contain the same data. @@ -604,13 +604,13 @@ exptData(x, ...) <- value \examples{ nrows <- 200; ncols <- 6 counts <- matrix(runif(nrows * ncols, 1, 1e4), nrows) - rowData <- GRanges(rep(c("chr1", "chr2"), c(50, 150)), + rowRanges <- GRanges(rep(c("chr1", "chr2"), c(50, 150)), IRanges(floor(runif(200, 1e5, 1e6)), width=100), strand=sample(c("+", "-"), 200, TRUE)) colData <- DataFrame(Treatment=rep(c("ChIP", "Input"), 3), row.names=LETTERS[1:6]) sset <- SummarizedExperiment(assays=SimpleList(counts=counts), - rowData=rowData, colData=colData) + rowData=rowRanges, colData=colData) sset assayNames(sset) assays(sset) <- endoapply(assays(sset), asinh) diff --git a/vignettes/GenomicRangesHOWTOs.Rnw b/vignettes/GenomicRangesHOWTOs.Rnw index 42bf02a..7c233be 100644 --- a/vignettes/GenomicRangesHOWTOs.Rnw +++ b/vignettes/GenomicRangesHOWTOs.Rnw @@ -585,7 +585,7 @@ identical(length(exbygene), length(assays(se)$counts)) A copy of \Rcode{exbygene} is stored in the \Rcode{rowData} slot: <>= -rowData(se) +rowRanges(se) @ Two popular packages for RNA-Seq differential gene expression are