\documentclass{article}
\title{A probabilistic cutoff for calling peaks}

\usepackage[text={178mm,230mm},centering]{geometry}
\usepackage{Sweave}

\SweaveOpts{keep.source=TRUE,eps=FALSE,pdf=TRUE,width=9,height=11,prefix.string=figs/figs-mousepeaks}
\setkeys{Gin}{width=0.98\textwidth}

\begin{document}

\maketitle

\raggedright

<<setup,echo=FALSE,results=hide>>=

library(chipseq)
library(lattice)
## library(hexbin)
## library(latticeExtra)

load("myodMyo.rda")
load("myodFibro.rda")
load("pairedReads.rda")

set.seed(20081008)

islandDepthSummary <- function(x, g = extendReads(x))
{
    s <- slice(coverage(g, width = max(end(g))), lower = 1)
    tab <- table(viewMaxs(s))
    ans <- data.frame(depth = as.numeric(names(tab)), count = as.numeric(tab))
    ans
}

plotDepthDistribution <- 
    function(data, chr = "chr1", depth.cutoff = 20, fit = TRUE, ...)
{
    xyplot(log(count) ~ depth | chromosome + lane, data, 
           subset = (chromosome %in% chr & depth <= depth.cutoff),
           main = "Distribution of island depths",
           ## layout = c(length(chr), nlevels(data$lane)), 
           pch = 16, type = c("p", "g"), as.table = TRUE,
           strip = FALSE, strip.left = TRUE, # aspect = 0.4,
           panel = if (fit) function(x, y, ...) {
               lambda <- 2 * exp(y[2]) / exp(y[1])
               null.est <- function(xx) {
                   xx * log(lambda) - lambda - lgamma(xx + 1)
               }
               log.N.hat <- null.est(1) - y[1] # both already log-transformed
               panel.lines(1:10, -log.N.hat + null.est(1:10))
               panel.xyplot(x, y, ...)
           } else function(x, y, ...) {
               panel.lmline(x[1:2], y[1:2])
               panel.xyplot(x, y, ...)
           }, ...)
}


## Crude FDR calculation. For each cutoff, what is FDR = #FD / #D.  We know 
## what #D is, but not #FD. Suppose we have a null model; then we can compute 
## expected #FD.  Note: our estimated null model (Poisson) is crude.


fdr.est <- function(y)
{
    lambda <- 2 * y[2] / y[1]
    n <- exp(log(y[1]) - dpois(1, lambda, log = TRUE))
    k <- 4:10
    exp.fd <- n * ppois(k-1, lambda, lower.tail = FALSE)
    obs.d <- rev(cumsum(rev(y)))[k]
    data.frame(k = k, FDR = exp.fd / obs.d)
}

panel.fdrplot <- function(x, y, ...) 
{
    ## x is depth value, y is count
    yy <- integer(max(x))
    yy[x] <- y
    with(fdr.est(yy), 
         panel.xyplot(k, FDR, ...))
}

fdrplot <- function(data, main = deparse(substitute(data)), ...)
{
    xyplot(count ~ depth | lane, data,
           groups = chromosome, main = main,
           type = c("g", "l"),
           prepanel = function(...) list(xlim = c(4, 10), ylim = c(0, 0.5)),
           panel = panel.superpose,
           panel.groups = panel.fdrplot, ...)
}


@ 


\section*{Depth distribution over all lanes}


<<>>=

myodMyoDepth <- 
    summarizeReads(myodMyo, 
                   summary.fun = islandDepthSummary)

plotDepthDistribution(myodMyoDepth, chr = "chr1", 
                      fit = FALSE, aspect = 0.35)

@ 

\newpage

\begin{center}
<<fig=TRUE,echo=FALSE>>=
plot(trellis.last.object())
@ 
\end{center}



\newpage

\section*{Combining myotube and myoblast lanes}


<<>>=

seqRanges <- lapply(myodMyo, extendReads)

combinedMyo <- 
    list(cblasts = combineLanes(seqRanges[c("1","3","6")]),
         ctubes = combineLanes(seqRanges[c("2","4","7")]))

combinedMyoDepth <- 
    summarizeReads(combinedMyo, 
                   summary.fun = function(x) {
                       islandDepthSummary(g = x)
                   })

plotDepthDistribution(combinedMyoDepth, chr = "chr1", 
                      fit = FALSE, aspect = 0.35)


@ 

\newpage

\begin{center}
<<fig=TRUE,echo=FALSE,height=8>>=
plot(trellis.last.object())
@ 
\end{center}


\newpage


\section*{A null model for island depths}

Consider a slightly different problem:
\begin{itemize}
\item For each extended read $[a_i, b_i]$, where $a_i < b_i$ and $b_i
  - a_i = 200$, let $X_i$ be the number of other start points $a_j \in
  [a_i, b_i], j \neq i$.
\item $X_i = k$ implies island of depth $k$ (or more).
\item island of depth $k$ implies $X_i = k$ for some $i$ in that island.
\end{itemize}
We will pretend that $X_i$-s are a reasonable first approximation to
island depths.  Note that the following analysis applies directly to
the number of reads (rather than depth) per island as well.


$X_i \sim Poisson(\lambda)$ for some unknown $\lambda$ (approximately
$200 N / G$, where $N$ is the number of reads, and $G$ is the length
of the genome).  
\[
f_\lambda(x) = P(X_i = x) = \lambda^x \frac{e^{-\lambda}}{x!}
\]
so
\[
\log(f_\lambda(x)) = -\lambda + x \log \lambda - \log \Gamma(x+1)
\]
The shape of this function depends on $\lambda$.  Note that 
\[
\frac{f_\lambda(2)}{f_\lambda(1)} = \lambda/2 
\]
so a crude estimate of $\lambda$ is
\[
\hat \lambda = 2 X_2 / X_1
\]
Using this as a more sophisticated estimate of the null distribution,
we get
<<>>=

plotDepthDistribution(myodMyoDepth, chr = "chr1", fit = TRUE,
                      ylim = c(0, 12), aspect = 0.35)

@ 

\newpage

\begin{center}
<<fig=TRUE,echo=FALSE>>=
plot(trellis.last.object())
@ 
\end{center}


\newpage

<<>>=

plotDepthDistribution(combinedMyoDepth, chr = "chr1", fit = TRUE,
                      ylim = c(0, 12), aspect = 0.35)

@ 


\begin{center}
<<fig=TRUE,echo=FALSE,height=8>>=
plot(trellis.last.object())
@ 
\end{center}

\newpage

\section*{Fibroblast run}


<<>>=

myodFibroDepth <- summarizeReads(myodFibro, summary.fun = islandDepthSummary)
plotDepthDistribution(myodFibroDepth, chr = "chr1", fit = TRUE, ylim = c(0, 12), aspect = 0.35)

@ 

\begin{center}
<<fig=TRUE,echo=FALSE,height=9>>=
plot(trellis.last.object())
@ 
\end{center}

\newpage


\section*{How do we do in simulation?}


<<>>=
load("simulatedReads.rda")

subsim <- 
    list(sim = list(chr1 = list("+" = sample(simulatedReads$chr1$"+", 5e5), 
                                "-" = integer(0)),
                    chr2 = list("+" = sample(simulatedReads$chr2$"+", 5e5), 
                                "-" = integer(0))))



simulationDepth <- 
    summarizeReads(subsim, 
                   summary.fun = islandDepthSummary)

t(plotDepthDistribution(simulationDepth, chr = c("chr1", "chr2"), 
                        fit = TRUE, aspect = 0.35))

@ 


\begin{center}
<<fig=TRUE,echo=FALSE,height=8>>=
plot(trellis.last.object())
@ 
\end{center}


\section*{Variability by chromosome}

<<>>=

combMyoDist <- 
    plotDepthDistribution(combinedMyoDepth, chr = paste("chr", 1:19, sep = ""),
                          fit = TRUE, depth.cutoff = 15, aspect = 0.5, 
                          layout = c(3, 7))

@ 

\begin{center}
<<fig=TRUE,echo=FALSE,height=9>>=
plot(combMyoDist[, 1])
@ 
\end{center}

\begin{center}
<<fig=TRUE,echo=FALSE,height=9>>=
plot(combMyoDist[, 2])
@ 
\end{center}


\section*{Crude FDR estimates}

We can compute a crude FDR based on the Poisson approximation. For
each cutoff, we define FDR is E(number of False Discoveries) / (number
of Discoveries).  We know what the number of Discoveries is, but not
the expected number of False Discoveries. We compute this (and the
total number of ``events'' under the null) from the Poisson null model
estimated from the number of singleton and doubleton islands.

\newpage

<<fig=TRUE>>=
plot(fdrplot(myodFibroDepth))
@

\newpage

<<fig=TRUE>>=
plot(fdrplot(myodMyoDepth))
@

\newpage

<<fig=TRUE>>=
plot(fdrplot(combinedMyoDepth))
@

\newpage

<<fig=TRUE>>=
plot(fdrplot(simulationDepth))
@

\newpage

<<fig=TRUE>>=
plot(fdrplot(summarizeReads(pairedReads, summary.fun = islandDepthSummary)))
@





\end{document}
