## ----setup, echo=FALSE-------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, fig.width = 7, fig.height = 3, fig.align = "center", comment = "#>" ) ## ----------------------------------------------------------------------------- sim.seg <- function(seg.mean, size.mean=15){ seg.size <- rpois(1, size.mean) rpois(seg.size, seg.mean) } set.seed(1) seg.mean.vec <- c(1.5, 3.5, 0.5, 4.5, 2.5) z.list <- lapply(seg.mean.vec, sim.seg) (z.rep.vec <- unlist(z.list)) ## ----ggcount------------------------------------------------------------------ count.df <- data.frame( chrom="chrUnknown", chromStart=0:(length(z.rep.vec)-1), chromEnd=1:length(z.rep.vec), count=z.rep.vec) if(require(ggplot2)){ gg.count <- ggplot()+ xlab("position")+ geom_point(aes( chromEnd, count), shape=1, data=count.df) gg.count } ## ----------------------------------------------------------------------------- n.segs <- length(seg.mean.vec) seg.size.vec <- sapply(z.list, length) seg.end.vec <- cumsum(seg.size.vec) change.vec <- seg.end.vec[-n.segs]+0.5 change.df <- data.frame( changepoint=change.vec) if(require(ggplot2)){ gg.change <- gg.count+ geom_vline(aes( xintercept=changepoint, color=model), data=data.frame(change.df, model="simulation"))+ scale_color_manual( values=c( simulation="black", fitted="green")) gg.change } ## ----------------------------------------------------------------------------- fit <- list() (fit$vec <- PeakSegDisk::PeakSegFPOP_vec(z.rep.vec, 10.5)) ## ----------------------------------------------------------------------------- gg.change+ geom_segment(aes( chromStart+0.5, mean, xend=chromEnd+0.5, yend=mean, color=model), data=data.frame(fit$vec$segments, model="fitted")) ## ----------------------------------------------------------------------------- plot(fit$vec) ## ----------------------------------------------------------------------------- (fit$df <- PeakSegDisk::PeakSegFPOP_df(count.df, 10.5)) ## ----------------------------------------------------------------------------- z.rle.vec <- rle(z.rep.vec) chromEnd <- cumsum(z.rle.vec$lengths) rle.df <- data.frame( chrom="chrUnknown", chromStart=c(0L, chromEnd[-length(chromEnd)]), chromEnd, count=z.rle.vec$values) if(require(ggplot2)){ gg.rle <- ggplot()+ geom_segment(aes( chromStart+0.5, count, xend=chromEnd+0.5, yend=count), data=rle.df)+ geom_point(aes( chromEnd, count), shape=1, data=rle.df)+ geom_vline(aes( xintercept=changepoint, color=model), data=data.frame(change.df, model="simulation"))+ scale_color_manual( values=c( simulation="black", fitted="green"))+ xlab("position") gg.rle } ## ----------------------------------------------------------------------------- (fit$rle <- PeakSegDisk::PeakSegFPOP_df(rle.df, 10.5)) if(require(ggplot2)){ gg.rle+ geom_segment(aes( chromStart+0.5, mean, xend=chromEnd+0.5, yend=mean, color=model), data=data.frame(fit$rle$segments, model="fitted")) } ## ----------------------------------------------------------------------------- data.dir <- file.path( tempfile(), with(rle.df, sprintf( "%s-%d-%d", chrom[1], min(chromStart), max(chromEnd)))) dir.create(data.dir, showWarnings=FALSE, recursive=TRUE) coverage.bedGraph <- file.path(data.dir, "coverage.bedGraph") write.table( rle.df, coverage.bedGraph, sep="\t", row.names=FALSE, col.names=FALSE) ## ----------------------------------------------------------------------------- (fit$dir <- PeakSegDisk::PeakSegFPOP_dir(data.dir, 10.5)) ## ----------------------------------------------------------------------------- if(interactive() && requireNamespace("future"))future::plan("multisession") (fit$search <- PeakSegDisk::sequentialSearch_dir(data.dir, 2L, verbose=1)) ## ----------------------------------------------------------------------------- lossDF <- function(L)data.frame(L$loss)[, names(fit$dir$loss)] do.call(rbind, lapply(fit, lossDF)) ## ----------------------------------------------------------------------------- four.peaks <- PeakSegDisk::sequentialSearch_dir(data.dir, 4L) four.peaks$others[, .(iteration, penalty, peaks)]