Skip to content

Commit

Permalink
add "resize" method for GRangesList objects
Browse files Browse the repository at this point in the history 
git-svn-id: https://hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/GenomicRanges@93786 bc3139a8-67e5-0310-9ffc-ced21a209358
  • Loading branch information
[email protected] committed Sep 4, 2014
1 parent 36519df commit 4ab1f5b
Show file tree
Hide file tree
Showing 5 changed files with 103 additions and 70 deletions.
4 changes: 2 additions & 2 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,13 +7,13 @@ Description: The ability to efficiently represent and manipulate genomic
intervals. Specialized containers for representing and manipulating
short alignments against a reference genome are defined in the
GenomicAlignments package.
Version: 1.17.36
Version: 1.17.37
Author: P. Aboyoun, H. Pages and M. Lawrence
Maintainer: Bioconductor Package Maintainer <[email protected]>
biocViews: Genetics, Infrastructure, Sequencing, Annotation, Coverage,
GenomeAnnotation
Depends: R (>= 2.10), methods, BiocGenerics (>= 0.11.3),
S4Vectors (>= 0.1.0), IRanges (>= 1.99.21), GenomeInfoDb (>= 1.1.3)
S4Vectors (>= 0.1.5), IRanges (>= 1.99.21), GenomeInfoDb (>= 1.1.3)
Imports: methods, utils, stats, BiocGenerics, IRanges, XVector
LinkingTo: S4Vectors, IRanges
Suggests: AnnotationDbi (>= 1.21.1), AnnotationHub,
Expand Down
2 changes: 1 addition & 1 deletion NAMESPACE
View file
Original file line number Diff line number Diff line change
Expand Up @@ -79,7 +79,7 @@ exportMethods(
ranges, "ranges<-", trim,
ngap,
score, "score<-",
shift, narrow, flank, resize, promoters, restrict,
shift, narrow, resize, flank, promoters, restrict,
reduce, gaps, disjoin, isDisjoint, disjointBins,
coverage,
punion, pintersect, psetdiff, pgap,
Expand Down
114 changes: 72 additions & 42 deletions R/intra-range-methods.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -22,16 +22,18 @@ setMethod("shift", "GenomicRanges",
setMethod("shift", "GRangesList",
function(x, shift=0L, use.names=TRUE)
{
if (is(shift, "IntegerList")) {
if (length(shift) != length(x) ||
any(elementLengths(shift) != elementLengths(x))) {
stop("IntegerList 'shift' not of same dimension as 'x'")
}
shift <- unlist(shift, use.names=FALSE)
}
ranges(x@unlistData) <-
shift(x@unlistData@ranges, shift, use.names=use.names)
x
## Unlist 'x'.
unlisted_x <- unlist(x, use.names=FALSE)
## Recycle and unlist 'shift'.
if (!is(shift, "List"))
shift <- as(shift, "List")
shift <- S4Vectors:::VH_recycle(shift, x, "shift", "x")
unlisted_shift <- unlist(shift, use.names=FALSE)
## Compute unlisted 'ans'.
unlisted_ans <- shift(unlisted_x, shift=unlisted_shift,
use.names=use.names)
## Relist and return.
relist(unlisted_ans, x)
}
)

Expand All @@ -50,6 +52,51 @@ setMethod("narrow", "GenomicRanges",
)


### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### resize()
###

setMethod("resize", "GenomicRanges",
function(x, width, fix="start", use.names=TRUE, ignore.strand=FALSE)
{
if (!missing(fix) && length(x) > 0L &&
(length(fix) > length(x) || length(x) %% length(fix) > 0L))
stop("'x' is not a multiple of 'fix' length")
if (!isTRUEorFALSE(ignore.strand))
stop("'ignore.strand' must be TRUE or FALSE")
if (ignore.strand) {
fix <- Rle(rep.int(fix, length(x)))
} else {
revFix <- c(start="end", end="start", center="center")
if (length(x) == 0L)
fix <- character()
else fix <- ifelse(strand(x) == "-", revFix[fix], fix)
}
new_ranges <- resize(ranges(x), width=width, fix=fix,
use.names=use.names)
clone(x, ranges=new_ranges)
}
)

setMethod("resize", "GRangesList",
function(x, width, fix="start", use.names=TRUE, ignore.strand=FALSE)
{
## Unlist 'x'.
unlisted_x <- unlist(x, use.names=FALSE)
## Recycle and unlist 'width'.
if (!is(width, "List"))
width <- as(width, "List")
width <- S4Vectors:::VH_recycle(width, x, "width", "x")
unlisted_width <- unlist(width, use.names=FALSE)
## Compute unlisted 'ans'.
unlisted_ans <- resize(unlisted_x, unlisted_width, fix=fix,
use.names=use.names, ignore.strand=ignore.strand)
## Relist and return.
relist(unlisted_ans, x)
}
)


### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### flank()
###
Expand All @@ -74,11 +121,21 @@ setMethod("flank", "GRangesList",
function(x, width, start=TRUE, both=FALSE, use.names=TRUE,
ignore.strand=FALSE)
{
x@unlistData <- flank(x@unlistData, width = width, start = start,
both = both, use.names = use.names,
ignore.strand = ignore.strand)
x
})
## Unlist 'x'.
unlisted_x <- unlist(x, use.names=FALSE)
## Recycle and unlist 'width'.
if (!is(width, "List"))
width <- as(width, "List")
width <- S4Vectors:::VH_recycle(width, x, "width", "x")
unlisted_width <- unlist(width, use.names=FALSE)
## Compute unlisted 'ans'.
unlisted_ans <- flank(unlisted_x, unlisted_width,
start=start, both=both,
use.names=use.names, ignore.strand=ignore.strand)
## Relist and return.
relist(unlisted_ans, x)
}
)


### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Expand Down Expand Up @@ -129,33 +186,6 @@ setMethod("promoters", "GRangesList",
### TODO: Add "reflect" method for GenomicRanges objects.


### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### resize()
###

setMethod("resize", "GenomicRanges",
function(x, width, fix="start", use.names=TRUE, ignore.strand=FALSE)
{
if (!missing(fix) && length(x) > 0L &&
(length(fix) > length(x) || length(x) %% length(fix) > 0L))
stop("'x' is not a multiple of 'fix' length")
if (!isTRUEorFALSE(ignore.strand))
stop("'ignore.strand' must be TRUE or FALSE")
if (ignore.strand) {
fix <- Rle(rep.int(fix, length(x)))
} else {
revFix <- c(start="end", end="start", center="center")
if (length(x) == 0L)
fix <- character()
else fix <- ifelse(strand(x) == "-", revFix[fix], fix)
}
new_ranges <- resize(ranges(x), width=width, fix=fix,
use.names=use.names)
clone(x, ranges=new_ranges)
}
)


### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### restrict()
###
Expand Down
14 changes: 7 additions & 7 deletions inst/unitTests/test_intra-range-methods.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,7 @@ make_test_GRangesList <- function() {
elementMetadata = DataFrame(score = 1:13, GC = seq(0, 1, length=13))))
}

test_GenomicRanges_shift <- function()
test_shift_GenomicRanges <- function()
{
## empty, reversibility, recycling 'x'
gr <- make_test_GRanges()
Expand Down Expand Up @@ -70,14 +70,14 @@ test_GenomicRanges_shift <- function()
checkIdentical(start(res), -5L)
}

test_GRangesList_shift <- function()
test_shift_GRangesList <- function()
{
grl <- make_test_GRangesList()
shifted <- shift(grl, 10)
checkIdentical(start(grl) + 10L, start(shifted))
}

test_GenomicRanges_flank <- function()
test_flank_GenomicRanges <- function()
{
checkIdentical(flank(GRanges(), 10), GRanges())

Expand Down Expand Up @@ -153,7 +153,7 @@ test_GenomicRanges_flank <- function()
checkIdentical(target_ranges, ranges(current))
}

test_GenomicRanges_promoters <- function()
test_promoters_GenomicRanges <- function()
{
checkTrue(length(promoters(GRanges())) == 0)

Expand Down Expand Up @@ -199,7 +199,7 @@ test_GenomicRanges_promoters <- function()
checkIdentical(seqinfo(gr), seqinfo(current))
}

test_GenomicRanges_resize <- function()
test_resize_GenomicRanges <- function()
{
gr <- make_test_GRanges()
checkException(resize(gr, 10, fix = "middle"), silent = TRUE)
Expand All @@ -215,7 +215,7 @@ test_GenomicRanges_resize <- function()
width = 10, names = head(letters, 10)))
}

test_GenomicRanges_restrict <- function()
test_restrict_GenomicRanges <- function()
{
gr <- make_test_GRanges()
st <- structure(c(4,5), names = c("chr1", "chr2"))
Expand All @@ -230,7 +230,7 @@ test_GenomicRanges_restrict <- function()
checkIdentical(ranges(res), target)
}

test_GenomicRanges_trim <- function()
test_trim_GenomicRanges <- function()
{
checkIdentical(trim(GRanges()), GRanges())

Expand Down
39 changes: 21 additions & 18 deletions man/intra-range-methods.Rd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,10 @@
\alias{narrow}
\alias{narrow,GenomicRanges-method}

\alias{resize}
\alias{resize,GenomicRanges-method}
\alias{resize,GRangesList-method}

\alias{flank}
\alias{flank,GenomicRanges-method}
\alias{flank,GRangesList-method}
Expand All @@ -17,9 +21,6 @@
\alias{promoters,GenomicRanges-method}
\alias{promoters,GRangesList-method}

\alias{resize}
\alias{resize,GenomicRanges-method}

\alias{restrict}
\alias{restrict,GenomicRanges-method}
\alias{restrict,GRangesList-method}
Expand Down Expand Up @@ -57,6 +58,11 @@

\S4method{narrow}{GenomicRanges}(x, start=NA, end=NA, width=NA, use.names=TRUE)

\S4method{resize}{GenomicRanges}(x, width, fix="start", use.names=TRUE,
ignore.strand=FALSE)
\S4method{resize}{GRangesList}(x, width, fix="start", use.names=TRUE,
ignore.strand=FALSE)

\S4method{flank}{GenomicRanges}(x, width, start=TRUE, both=FALSE,
use.names=TRUE, ignore.strand=FALSE)
\S4method{flank}{GRangesList}(x, width, start=TRUE, both=FALSE,
Expand All @@ -65,9 +71,6 @@
\S4method{promoters}{GenomicRanges}(x, upstream=2000, downstream=200, ...)
\S4method{promoters}{GRangesList}(x, upstream=2000, downstream=200, ...)

\S4method{resize}{GenomicRanges}(x, width, fix="start", use.names=TRUE,
ignore.strand=FALSE)

\S4method{restrict}{GenomicRanges}(x, start=NA, end=NA, keep.all.ranges=FALSE,
use.names=TRUE)
\S4method{restrict}{GRangesList}(x, start=NA, end=NA, keep.all.ranges=FALSE,
Expand Down Expand Up @@ -106,6 +109,14 @@
The returned object is \emph{parallel} (i.e. same length and names)
to the original object \code{x}.
}
\item{}{\code{resize} returns an object of the same type and length as
\code{x} containing intervals that have been resized to width
\code{width} based on the \code{strand(x)} values. Elements where
\code{strand(x) == "+"} or \code{strand(x) == "*"} are anchored at
\code{start(x)} and elements where \code{strand(x) == "-"} are anchored
at the \code{end(x)}. The \code{use.names} argument determines whether
or not to keep the names on the ranges.
}
\item{}{\code{flank} returns an object of the same type and length
as \code{x} containing intervals of width \code{width} that flank
the intervals in \code{x}. The \code{start} argument takes a
Expand Down Expand Up @@ -138,14 +149,6 @@
\code{seqlengths} are not \code{NA} the promoter ranges are kept within
the bounds of the defined \code{seqlengths}.
}
\item{}{\code{resize} returns an object of the same type and length as
\code{x} containing intervals that have been resized to width
\code{width} based on the \code{strand(x)} values. Elements where
\code{strand(x) == "+"} or \code{strand(x) == "*"} are anchored at
\code{start(x)} and elements where \code{strand(x) == "-"} are anchored
at the \code{end(x)}. The \code{use.names} argument determines whether
or not to keep the names on the ranges.
}
\item{}{\code{restrict} returns an object of the same type and length as
\code{x} containing restricted ranges for distinct seqnames. The
\code{start} and \code{end} arguments can be a named numeric vector of
Expand Down Expand Up @@ -187,8 +190,8 @@ gr

shift(gr, 1)
narrow(gr[-10], start=2, end=-2)
flank(gr, 10)
resize(gr, 10)
resize(gr, width=10)
flank(gr, width=10)
restrict(gr, start=3, end=7)

gr <- GRanges("chr1", IRanges(rep(10, 3), width=6), c("+", "-", "*"))
Expand All @@ -205,8 +208,8 @@ gr3 <- GRanges(c("chr1", "chr2"), IRanges(c(1, 4), c(3, 9)),
grl <- GRangesList(gr1= gr1, gr2=gr2, gr3=gr3)
grl

flank(grl, width =20)

resize(grl, width=20)
flank(grl, width=20)
restrict(grl, start=3)
}

Expand Down

0 comments on commit 4ab1f5b

Please sign in to comment.