1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
|
### =========================================================================
### Slice the bread
### -------------------------------------------------------------------------
setGeneric("slice", signature="x",
function(x, lower=-Inf, upper=Inf, ...) standardGeneric("slice"))
setMethod("slice", "Rle",
function(x, lower = -Inf, upper = Inf,
includeLower = TRUE, includeUpper = TRUE,
rangesOnly = FALSE)
{
if (!isSingleNumber(lower)) {
stop("'lower' must be a single number")
}
if (!isSingleNumber(upper)) {
stop("'upper' must be a single number")
}
if (!isTRUEorFALSE(includeLower)) {
stop("'includeLower' must be TRUE or FALSE")
}
if (!isTRUEorFALSE(includeUpper)) {
stop("'includeUpper' must be TRUE or FALSE")
}
if (!isTRUEorFALSE(rangesOnly)) {
stop("'rangesOnly' must be TRUE or FALSE")
}
if (lower == -Inf) {
ranges <- Rle(TRUE, length(x))
} else if (includeLower) {
ranges <- (x >= lower)
} else {
ranges <- (x > lower)
}
if (upper < Inf) {
if (includeUpper) {
ranges <- ranges & (x <= upper)
} else {
ranges <- ranges & (x < upper)
}
}
if (rangesOnly) {
as(ranges, "IRanges")
} else {
Views(x, ranges)
}
})
setMethod("slice", "RleList",
function(x, lower = -Inf, upper = Inf,
includeLower = TRUE, includeUpper = TRUE,
rangesOnly = FALSE)
{
if (!isSingleNumber(lower))
stop("'lower' must be a single number")
if (!isSingleNumber(upper))
stop("'upper' must be a single number")
if (!isTRUEorFALSE(includeLower))
stop("'includeLower' must be TRUE or FALSE")
if (!isTRUEorFALSE(includeUpper))
stop("'includeUpper' must be TRUE or FALSE")
if (!isTRUEorFALSE(rangesOnly))
stop("'rangesOnly' must be TRUE or FALSE")
if (lower == -Inf) {
ranges <-
RleList(lapply(elementNROWS(x),
function(len) Rle(TRUE, len)),
compress=FALSE)
} else if (includeLower) {
ranges <- (x >= lower)
} else {
ranges <- (x > lower)
}
if (upper < Inf) {
if (includeUpper) {
ranges <- ranges & (x <= upper)
} else {
ranges <- ranges & (x < upper)
}
}
if (rangesOnly) {
as(ranges, "CompressedIRangesList")
} else {
RleViewsList(rleList = x,
rangesList = as(ranges, "SimpleIRangesList"))
}
})
setMethod("slice", "ANY", function(x, lower=-Inf, upper=Inf, ...) {
slice(as(x, "Rle"), lower=lower, upper=upper, ...)
})
|
