@@ -48,12 +48,193 @@ plotManyRegions <- function(BSseq, regions = NULL, extend = 0, main = "", addReg

     }

 }

+.bsPlotLines <- function(x, y, col, lty, lwd, plotRange) {

+    if(sum(!is.na(y)) <= 1)

+        return(NULL)

+    xx <- seq(from = plotRange[1], to = plotRange[2], length.out = 500)

+    yy <- approxfun(x, y)(xx)

+    lines(xx, yy, col = col, lty = lty, lwd = lwd)

+}

+

+.bsPlotPoints <- function(x, y, z, col) {

+    points(x[z>pointsMinCov], y[z>pointsMinCov], col = col, pch = 16, cex = 0.5)

+}

+

+.bsHighlightRegions <- function(regions, gr, ylim, regionCol, highlightMain) {

+    if(is.data.frame(regions))

+        regions <- data.frame2Granges(regions)

+    if(highlightMain)

+        regions <- c(regions, gr)

+    if(is.null(regions)) return(NULL)

+    ## regions <- pintersect(region, rep(gr, length(regions)))

+    ## regions <- regions[width(regions) == 0]

+    regions <- subsetByOverlaps(regions, gr)

+    if(length(regions) == 0)

+        return(NULL)

+    rect(xleft = start(regions), xright = end(regions), ybottom = ylim[1],

+         ytop = ylim[2], col = regionCol, border = NA)

+}

+

+.bsGetCol <- function(object, col, lty, lwd) {

+    ## Assumes that object has pData and sampleNames methods

+    if(is.null(col) & "col" %in% names(pData(object)))

+        col <- pData(object)[["col"]]

+    else

+        col <- rep("black", ncol(pData(object)))

+    if(is.null(names(col)))

+        names(col) <- sampleNames(object)

+    

+    if(is.null(lty) & "lty" %in% names(pData(object)))

+        lty <- pData(object)[["lty"]]

+    else

+        lty <- rep(1, ncol(pData(object)))

+    if(is.null(names(lty)))

+        names(lty) <- sampleNames(object)

+    

+    if(is.null(lwd) & "lwd" %in% names(pData(object)))

+        lwd <- pData(object)[["lwd"]]

+    else

+        lwd <- rep(1, ncol(object))

+    if(is.null(names(lwd)))

+        names(lwd) <- sampleNames(object)

+                   

+    return(list(col = col, lty = lty, lwd = lwd))

+}

+.plotSmoothData <- function(BSseq, region, extend, addRegions, col, lty, lwd, regionCol,

+                            addTicks, addPoints, pointsMinCov, highlightMain) {

+    if(is.data.frame(region))

+        region <- data.frame2GRanges(region)

+

+    if(!is.null(region)) {

+        if(is(region, "data.frame"))

+            gr <- data.frame2GRanges(region, keepColumns = FALSE)

+        else

+            gr <- region

+        if(!is(gr, "GRanges") || length(gr) != 1)

+            stop("'region' needs to be either a 'data.frame' (with a single row) or a 'GRanges' (with a single element)")

+    } else {

+        gr <- GRanges(seqnames = seqnames(BSseq)[1],

+                      ranges = IRanges(start = min(start(BSseq)),

+                      end = max(start(BSseq))))

+    }

+    gr <- resize(gr, width = 2*extend + width(gr), fix = "center")

+    BSseq <- subsetByOverlaps(BSseq, gr)

+    

+    ## Extract basic information

+    sampleNames <- sampleNames(BSseq)

+    names(sampleNames) <- sampleNames

+    positions <- start(BSseq)

+    smoothPs <- getMeth(BSseq, type = "smooth")

+    rawPs <- getMeth(BSseq, type = "raw")

+    coverage <- getCoverage(BSseq)

+    plotRange

+    

+    ## get col, lwd, lty

+    colEtc <- bsseq:::.bsGetCol(object = BSseq, col = col, lty = lty, lwd = lwd)

+    

+    ## The actual plotting

+    plot(positions[1], 0.5, type = "n", xaxt = "n", yaxt = "n",

+         ylim = c(0,1), xlim = c(start(gr), end(gr)), xlab = "", ylab = "Methylation")

+    axis(side = 2, at = c(0.2, 0.5, 0.8))

+    if(addTicks)

+        rug(positions)

+

+    .bsHighlightRegions(regions = regions, gr = gr, ylim = c(0,1),

+                        regionCol = regionCol, highlightMain = highlightMain)

+    

+    if(addPoints) {

+        sapply(sampleNames(BSseq), function(samp) {

+            abline(v = positions[rawPs[, samp] > 0.1], col = "grey80", lty = 1)

+        })

+    } # This adds vertical grey lines so we can see where points are plotted

+

+    sapply(sampleNames(BSseq), function(samp) {

+        .bsPlotLines(positions, smoothPs[, samp], col = colEtc$col[samp],

+                     lty = colEtc$lty[samp], lwd = colEtc$lwd[samp],

+                     plotRange = c(start(gr), end(gr)))

+    })

+

+    if(addPoints) {

+        sapply(sampleNames(BSseq), function(samp) {

+            .bsPlotPoints(positions, rawPs[, samp], coverage[, samp],

+                          col = colEtc$col[samp])

+        })

+    }

+}

+

+

+newPlotRegion <- function(BSseq, region = NULL, extend = 0, main = "", addRegions = NULL, annoTrack = NULL,

+                          col = NULL, lty = NULL, lwd = NULL, BSseqTstat = NULL, mainWithWidth = TRUE,

+                          regionCol = alpha("red", 0.1), addTicks = TRUE, addPoints = FALSE,

+                          pointsMinCov = 5, highlightMain = FALSE) {

+    

+    opar <- par(mar = c(0,4.1,0,0), oma = c(5,0,4,2), mfrow = c(1,1))

+    on.exit(par(opar))

+    if(is.null(BSseqTstat))

+        layout(matrix(1:2, ncol = 1), heights = c(2,1))

+    else

+        layout(matrix(1:3, ncol = 1), heights = c(2,2,1))

+

+    bsseq:::.plotSmoothData(BSseq = BSseq, region = region, extend = extend, addRegions = addRegions,

+                            col = col, lty = lty, lwd = lwd, regionCol = regionCol,

+                            addTicks = addTicks, addPoints = addPoints,

+                            pointsMinCov = pointsMinCov, highlightMain = highlightMain)

+

+    if(!is.null(BSseqTstat)) {

+        if(!is.null(BSseqTstat))

+            BSseqTstat <- subsetByOverlaps(BSseqTstat, gr)

+        plot(positions[1], 0.5, type = "n", xaxt = "n", yaxt = "n",

+             ylim = c(-8,8), xlim = plotRange, xlab = "", ylab = "t-stat")

+        axis(side = 2, at = c(-5,0,5))

+        abline(h = 0, col = "grey60")

+        bsseq:::.bsPlotLines(start(BSseqTstat), BSseqTstat@stats[, "tstat"],

+                             lty = 1, plotRange = plotRange, col = "red", lwd = 1)

+        bsseq:::.bsPlotLines(start(BSseqTstat), BSseqTstat@stats[, "tstat.corrected"],

+                             lty = 2, plotRange = plotRange, col = "red", lwd = 1)

+        bsseq:::.bsPlotLines(start(BSseqTstat), 100*BSseqTstat@stats[, "tstat.sd"],

+                             lty = 2, plotRange = plotRange, col = "blue", lwd = 1)

+    }

+    

+    if(!is.null(annoTrack))

+        bsseq:::plotAnnoTrack(gr, annoTrack)

+

+    if(!is.null(main)) {

+        main <- makePlotTitle(gr = gr, extend = extend, main = main, mainWithWidth = mainWithWidth)

+        mtext(side = 3, text = main, outer = TRUE, cex = 1)

+    }

+    return(invisible(NULL))

+}

+

+    

 plotRegion <- function(BSseq, region = NULL, extend = 0, main = "", addRegions = NULL, annoTrack = NULL,

                        col = NULL, lty = NULL, lwd = NULL, BSseqTstat = NULL, mainWithWidth = TRUE,

                        regionCol = alpha("red", 0.1), addTicks = TRUE, addPoints = FALSE,

                        pointsMinCov = 5, highlightMain = FALSE) {

+    makeTitle <- function(gr, extend, main, mainWithWidth) {

+        if(length(gr) > 1) {

+            warning("plotTitle: gr has more than one element")

+            gr <- gr[1]

+        }

+        plotChr <- as.character(seqnames(gr))

+        plotRange <- c(start(gr), end(gr))

+        regionCoord <- sprintf("%s: %s - %s", plotChr, 

+                               format(plotRange[1], big.mark = ",", scientific = FALSE),

+                               format(plotRange[2], big.mark = ",", scientific = FALSE))

+        if(mainWithWidth) {

+            regionWidth <- sprintf("width = %s, extended = %s", 

+                                   format(width(gr) - 2*extend, big.mark = ",", scientific = FALSE),

+                                   format(extend, big.mark = ",", scientific = FALSE))

+            regionCoord <- sprintf("%s (%s)", regionCoord, regionWidth)

+        }

+        if(main != "") {

+            main <- sprintf("%s\n%s", main, regionCoord)

+        } else {

+            main <- regionCoord

+        }

+        main

+    }

     plotRects <- function(ylim) {

         if(!is.null(addRegions))

             rect(xleft = addRegions$start, xright = addRegions$end, ybottom = ylim[1],

@@ -117,29 +298,11 @@ plotRegion <- function(BSseq, region = NULL, extend = 0, main = "", addRegions =

     if(!is.null(BSseqTstat))

         BSseqTstat <- subsetByOverlaps(BSseqTstat, gr)

     positions <- start(BSseq)

-    if(length(positions) == 0)

-        stop("No overlap between BSseq data and region")

-

-    ## This next section manages the plot title

-    regionCoord <- sprintf("%s: %s - %s", plotChr, 

-                               format(plotRange[1], big.mark = ",", scientific = FALSE),

-                               format(plotRange[2], big.mark = ",", scientific = FALSE))

-    regionWidth <- sprintf("width = %s, extended = %s", 

-                           format(origWidth, big.mark = ",", scientific = FALSE),

-                           format(extend, big.mark = ",", scientific = FALSE))

-    if(mainWithWidth)

-        regionCoord <- sprintf("%s (%s)", regionCoord, regionWidth)

-    

-    if(is.null(main)) {

-        main <- ""

-    } else {

-        if(main != "") {

-            main <- sprintf("%s\n%s", main, regionCoord)

-        } else {

-            main <- regionCoord

-        }

+    if(length(positions) == 0) {

+        warning("No overlap between BSseq data and region")

+        return(NULL)

     }

-

+        

     ## Now for some plotting

     opar <- par(mar = c(0,4.1,0,0), oma = c(5,0,4,2), mfrow = c(1,1))

     on.exit(par(opar))

@@ -219,8 +382,11 @@ plotRegion <- function(BSseq, region = NULL, extend = 0, main = "", addRegions =

     if(!is.null(annoTrack))

         bsseq:::plotAnnoTrack(gr, annoTrack)

-    

-    mtext(side = 3, text = main, outer = TRUE, cex = 1)

+

+    if(!is.null(main)) {

+        main <- makePlotTitle(gr = gr, extend = extend, main = main, mainWithWidth = mainWithWidth)

+        mtext(side = 3, text = main, outer = TRUE, cex = 1)

+    }

     return(invisible(NULL))

 }