Nothing
setMethod(BamViews, c(bamRanges="GRanges"),
function(bamPaths=character(0),
bamIndicies=bamPaths,
bamSamples=DataFrame(row.names=
make.unique(basename(bamPaths))),
bamRanges,
bamExperiment=list(), ...)
{
new("BamViews", ..., bamPaths=bamPaths, bamIndicies=bamIndicies,
bamSamples=bamSamples, bamRanges=bamRanges,
bamExperiment=bamExperiment)
})
setMethod(BamViews, c(bamRanges="missing"),
function(bamPaths=character(0),
bamIndicies=bamPaths,
bamSamples=DataFrame(row.names=
make.unique(basename(bamPaths))),
bamRanges,
bamExperiment=list(), ...,
auto.range=FALSE)
{
if (length(bamPaths) != 0L && auto.range)
{
## Guess ranges from BAM file headers
pathsOk <- sapply(bamPaths, function(fl) {
file.exists(fl) && !file.info(fl)$isdir
})
if (all(pathsOk)) {
rngs <- lapply(scanBamHeader(bamPaths), "[[", "targets")
nms <- unique(unlist(lapply(rngs, names), use.names=FALSE))
ends <- sapply(nms, function(nm, rngs) {
idx <- sapply(rngs, function(rng, nm) {
nm %in% names(rng)
}, nm)
if (sum(idx) > 0)
max(sapply(rngs[idx], "[[", nm))
else
stop("Rsamtools internal: could not determine bamRanges")
}, rngs)
bamRanges <- GRanges(names(ends), IRanges(1L, ends))
} else {
warning("some files do not exist; bamRanges not defined")
bamRanges <- GRanges()
}
} else {
bamRanges <- GRanges()
}
BamViews(bamPaths=bamPaths, bamIndicies=bamIndicies,
bamSamples=bamSamples, bamRanges=bamRanges,
bamExperiment=bamExperiment, ...)
})
setMethod(.validity, "BamViews", function(object) {
msg <- NULL
if (length(bamIndicies(object)) != length(bamPaths(object)))
msg <- c(msg,
"length(bamIndicies(object)) != length(bamPaths(object))")
if (length(bamPaths(object)) != nrow(bamSamples(object)))
msg <- c(msg,
"length(bamPaths(object)) != nrow(bamSamples(object))")
if (is.null(msg)) TRUE else msg
})
bamPaths <-
function(x) setNames(slot(x, "bamPaths"), names(x))
bamIndicies <-
function(x) setNames(slot(x, "bamIndicies"), names(x))
`bamDirname<-` <-
function(x, ..., value)
{
initialize(x,
bamPaths=file.path(value, basename(bamPaths(x))),
bamIndicies=file.path(value, basename(bamIndicies(x))))
}
bamSamples <-
function(x) slot(x, "bamSamples")
`bamSamples<-` <-
function(x, value) initialize(x, bamSamples=value)
bamRanges <-
function(x) slot(x, "bamRanges")
`bamRanges<-` <-
function(x, value) initialize(x, bamRanges=value)
bamExperiment <-
function(x) slot(x, "bamExperiment")
setMethod(dim, "BamViews", function(x) {
c(length(bamRanges(x)), length(bamPaths(x)))
})
setMethod(names, "BamViews", function(x) {
rownames(bamSamples(x))
})
setReplaceMethod("names", "BamViews", function(x, value) {
rownames(bamSamples(x)) <- value
x
})
setMethod(dimnames, "BamViews", function(x) {
list(names(bamRanges(x)),
rownames(bamSamples(x)))
})
setReplaceMethod("dimnames", "BamViews", function(x, value) {
names(bamRanges(x)) <- value[[1]]
rownames(bamSamples(x)) <- value[[2]]
x
})
setMethod("[", c("BamViews", "ANY", "missing"),
function(x, i, j, ..., drop=TRUE)
{
initialize(x, bamRanges=bamRanges(x)[i,])
})
setMethod("[", c("BamViews", "missing", "ANY"),
function(x, i, j, ..., drop=TRUE)
{
if (is.character(j))
j <- match(j, colnames(x))
if (any(is.na(j)))
stop("subscript 'j' out of bounds")
initialize(x, bamPaths=bamPaths(x)[j],
bamIndicies=bamIndicies(x)[j],
bamSamples=bamSamples(x)[j,,drop=FALSE])
})
setMethod("[", c("BamViews", "ANY", "ANY"),
function(x, i, j, ..., drop=TRUE)
{
if (is.character(i))
j <- match(i, rownames(x))
if (is.character(j))
j <- match(j, colnames(x))
if (any(is.na(i)))
stop("subscript 'i' out of bounds")
if (any(is.na(j)))
stop("subscript 'j' out of bounds")
initialize(x, bamRanges=bamRanges(x)[i,],
bamPaths=bamPaths(x)[j],
bamIndicies=bamIndicies(x)[j],
bamSamples=bamSamples(x)[j,,drop=FALSE])
})
## action
.BamViews_which <- function(file, param, missing)
{
grange <- bamRanges(file)
which <- split(ranges(grange), seqnames(grange))
if (!missing && !identical(which, bamWhich(param)))
warning("'bamRanges(file)' and 'bamWhich(param)' differ; using bamRanges(file)")
which
}
.BamViews_delegate <-
function(what, bamViews, fun, ...)
{
idx <- structure(seq_len(ncol(bamViews)), names=names(bamViews))
result <- bplapply(idx, fun, bamViews=bamViews, ...)
errs <- sapply(result, is, "remote-error")
if (any(errs))
stop(sprintf("'%s' failed on '%s'", what,
paste(names(bamViews)[errs], collapse="' '")))
names(result) <- names(bamViews)
do.call(new, list("SimpleList", listData=result,
elementMetadata=bamSamples(bamViews)))
}
setMethod(scanBam, "BamViews",
function(file, index=file, ...,
param=ScanBamParam(what=scanBamWhat()))
{
if (!missing(index))
warning("using bamIndicies(file) for 'index'")
bamWhich(param) <- .BamViews_which(file, param, missing(param))
fun <- function(i, bamViews, ..., verbose)
scanBam(file=bamPaths(bamViews)[i],
index=bamIndicies(bamViews)[i], ...)
.BamViews_delegate("scanBam", file, fun, ..., param=param)
})
setMethod(countBam, "BamViews",
function(file, index=file, ..., param=ScanBamParam())
{
if (!missing(index))
warning("using bamIndicies(file) for 'index'")
bamWhich(param) <- .BamViews_which(file, param, missing(param))
fun <- function(i, bamViews, ..., verbose)
countBam(file=bamPaths(bamViews)[i],
index=bamIndicies(bamViews)[i], ...)
.BamViews_delegate("countBam", file, fun, ..., param=param)
})
## show
setMethod(show, "BamViews", function(object) {
cat(class(object), "dim:",
paste(dim(object), c("ranges", "samples"), collapse=" x "),
"\n")
cat("names:", S4Vectors:::selectSome(names(object)), "\n")
cat("detail: use bamPaths(), bamSamples(), bamRanges(), ...",
"\n")
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.