| 4a79c077 |
.set_seqinfo <- function(tracks) {
n <- names(tracks)
sls <- lapply(tracks, lengths)
has_seqlengths <- any(!is.na(lapply(sls, sum)))
if (!has_seqlengths) {
sis <- lapply(tracks, function(rle) {
Seqinfo(
names(lengths(rle)),
lengths(rle)
)
}) |> unique()
if (length(unique(sis)) > 1)
|
| b6b23e70 |
warning("EXPERIMENTAL: More than 1 seqinfo inferred from the tracks. Using `seqinfo` from the first track.")
|
| 4a79c077 |
si <- sis[[1]]
}
else {
sl <- sls[[which(!is.na(lapply(sls, sum)))[[1]]]]
si <- list(Seqinfo(
names(sl),
sl
))
}
tracks <- lapply(tracks, function(rle) {
GenomeInfoDb::seqinfo(rle) <- si
return(rle)
})
names(tracks) <- n
return(tracks)
}
|
| 1951d87e |
.set_seqinfo_bwfl <- function(tracks) {
n <- names(tracks)
sis <- lapply(tracks, seqinfo) |> unique()
if (length(sis) > 1)
|
| b6b23e70 |
warning("EXPERIMENTAL: More than 1 seqinfo inferred from the tracks. Using `seqinfo` from the first track.")
|
| 1951d87e |
si <- sis[[1]]
return(tracks)
}
|
| 48d7a977 |
.resize_granges <- function(gr, w, seqinfo) {
|
| 4a79c077 |
GenomeInfoDb::seqlevels(gr, pruning.mode = "coarse") <- GenomeInfoDb::seqlevels(seqinfo)
GenomeInfoDb::seqinfo(gr) <- seqinfo
|
| 48d7a977 |
if (is.null(w)) {
w <- width(gr) |> unlist() |> unique()
}
else {
gr <- suppressWarnings(resize(gr, fix = 'center', width = w))
}
|
| 4a79c077 |
gr <- trim(gr)
gr <- gr[width(gr) == w]
|
| 48d7a977 |
gr
}
.check_granges_widths <- function(features) {
ws <- lapply(features, width) |> unlist() |> unique()
if (length(ws) > 1)
stop("Input GRanges do not all have the same width.
Use resize() to fix width prior to coverage data extraction.")
|
| 4a79c077 |
}
#' @importFrom IRanges NumericList
#' @importFrom stats qt
|
| bee1fd8b |
.compute_cov <- function(scores, gr, center, scale, ignore.strand = TRUE) {
|
| 1ec67e40 |
m <- as.matrix(scores)
|
| 957d8fb5 |
if (!ignore.strand) {
|
| 1ec67e40 |
m <- data.frame(m)
|
| 957d8fb5 |
which.flip <- which(as.vector(strand(gr)) == '-')
|
| 1ec67e40 |
m[which.flip, ] <- rev(m[which.flip, ])
m <- as.matrix(m)
|
| 957d8fb5 |
}
|
| 48d7a977 |
if (any(c(center, scale))) {
m <- t(scale(t(m), center = center, scale = scale))
}
|
| 1ec67e40 |
m
|
| 1951d87e |
}
|
| 4a79c077 |
.summarize_cov <- function(scores) {
mean <- colMeans(scores, na.rm = TRUE)
median <- apply(scores, 2, median, na.rm = TRUE)
min <- apply(scores, 2, min, na.rm = TRUE)
max <- apply(scores, 2, max, na.rm = TRUE)
sd <- apply(scores, 2, sd, na.rm = TRUE)
se <- sd/sqrt(nrow(scores))
ci_low <- mean - stats::qt(1 - (0.05 / 2), nrow(scores) - 1) * se
ci_high <- mean + stats::qt(1 - (0.05 / 2), nrow(scores) - 1) * se
data.frame(
coord = seq(-ncol(scores)/2, ncol(scores)/2-1, 1),
mean = mean, median = median, min = min, max = max,
sd = sd, se = se, ci_low = ci_low, ci_high = ci_high
)
}
|
| 5aa65e57 |
.coarsen_vec <- function(x, bin, FUN, ...) {
|
| 2fa1ecb8 |
if ({length(x) %% bin} != 0) stop(
"The length of the provided vector should be divided by the bin size without remainder.
Please adjust `bin` argument."
)
|
| 4a79c077 |
stats::aggregate(
x,
by = list(rep(seq(1, length(x)/bin), each = bin)),
|
| 031b5afd |
FUN = FUN, ...
|
| 4a79c077 |
)$x
}
|
| 5aa65e57 |
|
| 45537aab |
.coarsen_mat <- function(x, bin, FUN = mean, ...) {
|
| 2fa1ecb8 |
if ({ncol(x) %% bin} != 0) stop(
"The column number of the provided matrix should be divided by the window size without remainder.
Please adjust `window` argument."
)
|
| 5aa65e57 |
apply(x, 1, function(vec) {
stats::aggregate(
vec,
by = list(rep(seq(1, length(vec)/bin), each = bin)),
|
| 031b5afd |
FUN = FUN, ...
|
| 5aa65e57 |
)$x
|
| 45537aab |
}) |> t()
|
| 5aa65e57 |
}
|
