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
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
setMethod(.validity, "ApplyPileupsParam", function(object) {
msg <- NULL
flag <- object@flag
if (2L != length(flag) ||
any(c("keep0", "keep1") != names(flag)))
msg <- c(msg, "'flag' not from scanBamFlag()")
len1elts <- c("minBaseQuality", "minMapQuality", "minDepth",
"maxDepth", "yieldSize", "yieldBy", "yieldAll")
ok <- 1L == sapply(len1elts,
function(x, obj) length(slot(obj, x)),
object)
if (!all(ok))
msg <- c(msg,
sprintf("'%s' must be length 1",
paste(len1elts[!ok], collapse="' '")))
what <- eval(formals(ApplyPileupsParam)[["what"]])
ok <- object@what %in% what
if (!all(ok))
msg <- c(msg, sprintf("'what' must be in '%s'",
paste(what, collapse="' '")))
if (is.null(msg)) TRUE else msg
})
ApplyPileupsParam <-
function(flag=scanBamFlag(),
minBaseQuality=13L,
minMapQuality=0L,
minDepth=0L,
maxDepth=250L,
yieldSize=1L,
yieldBy=c("range", "position"),
yieldAll=FALSE,
which=GRanges(),
what=c("seq", "qual"))
{
yieldBy <- match.arg(yieldBy)
if ("range" == yieldBy && yieldSize != 1)
stop("'yieldSize' must equal 1 when 'yieldBy=\"range\"'")
new("ApplyPileupsParam", flag=flag,
minBaseQuality=as.integer(minBaseQuality),
minMapQuality=as.integer(minMapQuality),
minDepth=as.integer(minDepth),
maxDepth=as.integer(maxDepth),
yieldSize=as.integer(yieldSize),
yieldBy=yieldBy,
yieldAll=as.logical(yieldAll),
which=which, what=what)
}
setAs("ApplyPileupsParam", "list", function(from) {
nms <- slotNames(class(from))
res <- lapply(nms, slot, object=from)
names(res) <- nms
res
})
plpFlag <- function(object) slot(object, "flag")
"plpFlag<-" <- function(object, value)
{
slot(object, "flag") <- value
validObject(object)
object
}
plpMinBaseQuality <-function(object) slot(object, "minBaseQuality")
"plpMinBaseQuality<-" <- function(object, value)
{
slot(object, "minBaseQuality") <- as.integer(value)
validObject(object)
object
}
plpMinMapQuality <-
function(object) slot(object, "minMapQuality")
"plpMinMapQuality<-" <- function(object, value)
{
slot(object, "minMapQuality") <- as.integer(value)
validObject(object)
object
}
plpMinDepth <- function(object) slot(object, "minDepth")
"plpMinDepth<-" <- function(object, value)
{
slot(object, "minDepth") <- as.integer(value)
validObject(object)
object
}
plpMaxDepth <- function(object) slot(object, "maxDepth")
"plpMaxDepth<-" <- function(object, value)
{
slot(object, "maxDepth") <- as.integer(value)
validObject(object)
object
}
plpYieldSize <- function(object) slot(object, "yieldSize")
"plpYieldSize<-" <- function(object, value)
{
slot(object, "yieldSize") <- as.integer(value)
validObject(object)
object
}
plpYieldBy <- function(object) slot(object, "yieldBy")
"plpYieldBy<-" <- function(object, value)
{
slot(object, "yieldBy") <- as.character(value)
validObject(object)
object
}
plpYieldAll <- function(object) slot(object, "yieldAll")
"plpYieldAll<-" <- function(object, value)
{
slot(object, "yieldAll") <- as.logical(value)
validObject(object)
object
}
plpWhich <- function(object) slot(object, "which")
"plpWhich<-" <- function(object, value)
{
slot(object, "which") <- as(value, "GRanges")
validObject(object)
object
}
plpWhat <- function(object) slot(object, "what")
"plpWhat<-" <- function(object, value)
{
slot(object, "what") <- as.character(value)
validObject(object)
object
}
setMethod(show, "ApplyPileupsParam", function(object) {
cat("class:", class(object), "\n")
cat("plpFlag:",
sprintf("%s=%s", names(object@flag), object@flag),
"\n")
len1elts <- c("minBaseQuality", "minMapQuality", "minDepth",
"maxDepth", "yieldSize", "yieldBy", "yieldAll")
for (elt in len1elts)
cat(sprintf("%s: %s",
sub("([[:alpha:]])", "plp\\U\\1", elt, perl=TRUE),
slot(object, elt)), "\n")
cat("plpWhat: '", paste(object@what, collapse="' '"), "'\n", sep="")
cat(sprintf("plpWhich: %s (length %d)\n", class(object@which),
length(object@which)))
})
|
