@@ -113,8 +113,7 @@ export(".chrName",

        "getScheme",

        "plotTracks")

-exportClasses("AlignedReadTrack",

-              "AlignmentsTrack",

+exportClasses("AlignmentsTrack",

               "AnnotationTrack",

               "DetailsAnnotationTrack",

               "BiomartGeneRegionTrack",

@@ -380,14 +380,6 @@ setMethod("[", signature(x = "DataTrack"), function(x, i, j, ..., drop = FALSE)

     }

     return(x)

 })

-setMethod("[", signature(x = "AlignedReadTrack"), function(x, i, j, ..., drop = TRUE) {

-    if (x@coverageOnly) {

-          stop("This AlignedReadTrack object contains coverage information only and can not be subset")

-      }

-    x@range <- x@range[i, , drop = drop]

-    x <- setCoverage(x)

-    return(x)

-})

 ## Split a RangeTrack or DataTrack by a factor or character

 setMethod("split", signature("RangeTrack"),

@@ -399,19 +391,7 @@ setMethod("split", signature("RangeTrack"),

         })

     }

 )

-setMethod("split", signature("AlignedReadTrack"),

-    definition = function(x, f, ...) {

-        if (x@coverageOnly) {

-              stop("This AlignedReadTrack object contains coverage information only and can not be split")

-          }

-        rs <- split(ranges(x), factor(f))

-        lapply(rs, function(y) {

-            x@range <- y

-            x <- setCoverage(x)

-            return(x)

-        })

-    }

-)

+

 setMethod("split", signature("DataTrack"),

     definition = function(x, f, ...) {

         f <- factor(f)

@@ -427,14 +407,6 @@ setMethod("split", signature("DataTrack"),

     }

 )

-## Extract the coverage information

-setMethod("coverage", signature("AlignedReadTrack"),

-    definition = function(x, strand = "*") {

-        str <- c("+", "-", "*")[.strandName(strand, extended = TRUE) + 1]

-        return(if (!is.null(x@coverage[[str]])) x@coverage[[str]] else Rle())

-    }

-)

-

 ## Annotation accessors ------------------------------------------------------------------------------------------------------

 ##

 ## There are several levels of annotation information for most RangeTrack objects: individual features (e.g. exons, biotype),

@@ -1437,38 +1409,6 @@ setMethod("subset", signature(x = "GenomeAxisTrack"), function(x, from = NULL, t

     return(x)

 })

-## If the object only stores coverage we subset that, otherwise we can use the RangeTrack method

-setMethod("subset", signature(x = "AlignedReadTrack"), function(x, from = NULL, to = NULL, sort = FALSE, stacks = FALSE, ...) {

-    if (x@coverageOnly) {

-        if (is.null(from)) {

-              from <- min(unlist(lapply(x@coverage, function(y) if (length(y)) min(start(y)))))

-          }

-        if (is.null(to)) {

-              to <- max(unlist(lapply(x@coverage, function(y) if (length(y)) max(start(y)))))

-          }

-        x@coverage <- lapply(x@coverage, function(y) {

-            runValue(y)[end(y) < from | start(y) > to] <- 0

-            y

-        })

-        x@coverage <- lapply(x@coverage, function(y) {

-            if (length(y) < to) y <- c(y, Rle(0, to - length(y)))

-            y

-        })

-        ##

-        ## from <- min(unlist(lapply(x@coverage, function(y) if (length(y)) head(start(y), 2)[2])))

-        if (max(unlist(lapply(x@coverage, function(y) {

-            length(runLength(y)[runValue(y) != 0])

-        })))) {

-            from <- min(unlist(lapply(x@coverage, function(y) if (length(y)) head(start(y)[runValue(y) != 0], 1))))

-            to <- max(unlist(lapply(x@coverage, function(y) if (length(y)) tail(end(y), 2)[1])))

-        }

-        x@range <- GRanges(ranges = IRanges(start = from, end = to), strand = names(x@coverage), seqnames = x@chromosome)

-    } else {

-        x <- callNextMethod(x = x, from = from, to = to, sort = sort, stacks = stacks)

-    }

-    return(x)

-})

-

 ## AlignmentTracks can be subset by using the information in the stackRanges slot, but for the actual reads we need to make sure that

 ## we keep all the bits that belong to a given group. We still want to record the requested ranges in the internal '.__plottingRange'

 ## display parameter.

@@ -1758,45 +1698,6 @@ setMethod("drawAxis", signature(GdObject = "AlignmentsTrack"), function(GdObject

 })

-setMethod("drawAxis", signature(GdObject = "AlignedReadTrack"), function(GdObject, from, to, subset = TRUE) {

-    detail <- match.arg(.dpOrDefault(GdObject, "detail", "coverage"), c("coverage", "reads"))

-    if (detail != "coverage") {

-        return(NULL)

-    } else {

-        if (subset) {

-              GdObject <- subset(GdObject, from = from, to = to)

-          }

-        cov <- coverage(GdObject, strand = "*")

-        val <- runValue(coverage(GdObject, strand = "*"))

-        ## We have to figure out the data range, taking transformation into account

-        ylim <- .dpOrDefault(GdObject, "ylim")

-        if (is.null(ylim)) {

-            if (!length(val)) {

-                  ylim <- c(0, 1)

-              } else {

-                ylim <- c(0, range(val, finite = TRUE, na.rm = TRUE)[2])

-                trans <- .dpOrDefault(GdObject, "transformation")[[1]]

-                if (!is.null(trans)) {

-                      ylim <- c(0, trans(ylim[2]))

-                  }

-            }

-        }

-        for (s in c("+", "-"))

-        {

-            pushViewport(viewport(height = 0.5, y = ifelse(s == "-", 0, 0.5), just = c("center", "bottom")))

-            dummy <- DataTrack(

-                start = rep(mean(c(from, to)), 2), end = rep(mean(c(from, to)), 2), data = ylim,

-                genome = genome(GdObject), chromosome = chromosome(GdObject)

-            )

-            oldDp <- displayPars(GdObject, hideInternal = FALSE)

-            oldDp[["ylim"]] <- if (s == "+") ylim else rev(ylim)

-            displayPars(dummy) <- oldDp

-            drawAxis(dummy, from = from, to = to)

-            popViewport(1)

-        }

-    }

-})

-

 ## drawGrid ------------------------------------------------------------------------------------------------------------

 ##

 ## Draw a grid in the background of a GdObject. For some subclasses this is meaningless, and the default function will

@@ -1831,39 +1732,6 @@ setMethod("drawGrid", signature(GdObject = "AnnotationTrack"), function(GdObject

         popViewport(1)

     }

 })

-setMethod("drawGrid", signature(GdObject = "AlignedReadTrack"), function(GdObject, from, to) {

-    detail <- match.arg(.dpOrDefault(GdObject, "detail", "coverage"), c("coverage", "reads"))

-    if (detail == "coverage") {

-        GdObject <- subset(GdObject, from = from, to = to)

-        ## We have to figure out the data range, taking transformation into account

-        ylim <- .dpOrDefault(GdObject, "ylim")

-        if (is.null(ylim)) {

-            maxs <- vapply(c("+", "-"), function(s) {

-                cvr <- coverage(GdObject, strand = s)

-                if (length(cvr)) max(cvr, na.rm = TRUE, finite = TRUE) else 0L

-            }, FUN.VALUE = numeric(1L))

-            y.max <- max(maxs, na.rm = TRUE, finite = TRUE)

-            ylim <- c(0, if (y.max == 0) 1 else y.max)

-            trans <- .dpOrDefault(GdObject, "transformation")[[1]]

-            if (!is.null(trans)) {

-                ylim <- c(0, trans(ylim[2]))

-            }

-        }

-        for (s in c("+", "-")) {

-            pushViewport(viewport(height = 0.5, y = ifelse(s == "-", 0, 0.5), just = c("center", "bottom")))

-            dummy <- DataTrack(

-                start = rep(mean(c(from, to)), 2), end = rep(mean(c(from, to)), 2), data = ylim,

-                genome = genome(GdObject), chromosome = chromosome(GdObject)

-            )

-            oldDp <- displayPars(GdObject, hideInternal = FALSE)

-            oldDp[["ylim"]] <- if (s == "+") ylim else rev(ylim)

-            displayPars(dummy) <- oldDp

-            drawGrid(dummy, from = from, to = to)

-            popViewport(1)

-        }

-    }

-    return(NULL)

-})

 setMethod("drawGrid", signature(GdObject = "AlignmentsTrack"), function(GdObject, from, to) {

     if (.dpOrDefault(GdObject, "grid", FALSE)) {

@@ -3819,537 +3687,6 @@ setMethod("drawGD", signature("DataTrack"), function(GdObject, minBase, maxBase,

 })

-

-

-## drawGD - AlignedReadTrack -------------------------------------------------------------------------------------------

-##

-## Draw a AlignedRead track

-

-setMethod("drawGD", signature("AlignedReadTrack"), function(GdObject, minBase, maxBase, prepare = FALSE, subset = TRUE, ...) {

-    debug <- .dpOrDefault(GdObject, "debug", FALSE)

-    if ((is.logical(debug) && debug) || debug == "prepare") {

-          browser()

-      }

-    imageMap(GdObject) <- NULL

-    detail <- match.arg(.dpOrDefault(GdObject, "detail", "coverage"), c("reads", "coverage"))

-    ## Nothing to do in prepare mode if detail is not 'reads', so we can quit right away, else we need to set the stacking info

-    if (prepare) {

-        if (detail == "read") {

-            if (subset) {

-                  GdObject <- subset(GdObject, from = minBase, to = maxBase)

-              }

-            ## GdObject <- setStacks(GdObject)

-        }

-        return(invisible(GdObject))

-    }

-    if ((is.logical(debug) && debug) || debug == "draw") {

-          browser()

-      }

-    ## We only proceed if there is something to draw within the ranges, but still may have to add the grid and the legend.

-    ## Legend drawing causes another viewport for all the other graphics to be opened and will be called after all other

-    ## drawing has finished, hence we call it in on.exit

-    if (subset) {

-          GdObject <- subset(GdObject, from = minBase, to = maxBase)

-      }

-    alpha <- .dpOrDefault(GdObject, "alpha", 1)

-    ## The optional legend is plotted below the data

-    grpLevels <- .dpOrDefault(GdObject, ".__groupLevels")

-    if (as.logical(.dpOrDefault(GdObject, "legend", FALSE)) && !is.null(grpLevels)) {

-        lSpace <- .dpOrDefault(GdObject, ".__verticalSpace")

-        pushViewport(viewport(

-            y = 1, height = unit(1, "npc") - unit(lSpace, "inches"),

-            just = c(0.5, 1)

-        ))

-        on.exit({

-            popViewport(1)

-            cex <- .dpOrDefault(GdObject, "cex.legend", 0.8)

-            legFactors <- .dpOrDefault(GdObject, ".__legFactors", character())

-            fontsize <- .dpOrDefault(GdObject, "fontsize.legend", 12)

-            fontface <- .dpOrDefault(GdObject, "fontface.legend", 1)

-            lineheight <- .dpOrDefault(GdObject, "lineheight.legend", 1)

-            fontfamily <- .dpOrDefault(GdObject, "fontfamily.legend", 1)

-            fontcolor <- .dpOrDefault(GdObject, "fontcolor.legend", .DEFAULT_SHADED_COL)

-            pushViewport(viewport(

-                y = 0, height = unit(lSpace, "inches"), just = c(0.5, 0),

-                gp = gpar(

-                    cex = cex, fontsize = fontsize, fontface = fontface, fontcolor = fontcolor,

-                    lineheight = lineheight

-                )

-            ))

-            pushViewport(viewport(width = unit(1, "npc") - unit(0.1, "inches"), height = unit(1, "npc") - unit(0.1, "inches")))

-            boxSize <- .dpOrDefault(GdObject, ".__boxSize")

-            spacing <- .dpOrDefault(GdObject, ".__spacing")

-            dims <- .dpOrDefault(GdObject, ".__layoutDims")

-            for (i in seq_along(grpLevels)) {

-                row <- (((i) - 1) %/% dims[2]) + 1

-                col <- (((i) - 1) %% dims[2]) + 1

-                pushViewport(viewport(width = 1 / dims[2], height = 1 / dims[1], x = (1 / dims[2]) * (col - 1), y = 1 - ((1 / dims[1]) * (row - 1)), just = c(0, 1)))

-                if (length(setdiff(legFactors, c("col"))) == 0) {

-                    grid.rect(

-                        width = unit(boxSize, "inches"), height = unit(boxSize, "inches"), x = 0, just = c(0, 0.5),

-                        gp = gpar(fill = pcols$col[i], col = .DEFAULT_SHADED_COL)

-                    )

-                } else {

-                    if (any(c("pch", "col.symbol") %in% legFactors)) {

-                          panel.points(unit(boxSize / 2, "inches"), 0.5, pch = pcols$pch[i], cex = pcols$cex[i], col = pcols$col.symbol[i])

-                      }

-                    if (any(c("lwd", "lty", "col.lines") %in% legFactors)) {

-                          ## panel.lines(unit(c(0,boxSize), "inches"), c(0.5, 0.5), col=pcols$col.line[i], lwd=pcols$lwd[i], lty=pcols$lty[i])

-                          grid.lines(unit(c(0, boxSize), "inches"), c(0.5, 0.5), gp = gpar(col = pcols$col.line[i], lwd = pcols$lwd[i], lty = pcols$lty[i]))

-                      }

-                }

-                grid.text(x = unit(boxSize + spacing, "inches"), y = 0.5, just = c(0, 0.5), label = grpLevels[i], gp = gpar(col = fontcolor))

-                popViewport(1)

-            }

-            popViewport(2)

-        })

-    }

-    if (!length(GdObject)) {

-        if ("g" %in% type) {

-              panel.grid(

-                  h = .dpOrDefault(GdObject, "h", -1), v = .dpOrDefault(GdObject, "v", -1),

-                  col = .dpOrDefault(GdObject, "col.grid", "#e6e6e6"), lty = .dpOrDefault(GdObject, "lty.grid", 1),

-                  lwd = .dpOrDefault(GdObject, "lwd.grid", 1), alpha = alpha

-              )

-          }

-        return(invisible(GdObject))

-    }

-    vals <- values(GdObject)

-    ylim <- suppressWarnings(.dpOrDefault(GdObject, "ylim", range(vals, na.rm = TRUE, finite = TRUE)))

-    if (diff(ylim) == 0) {

-          ylim <- ylim + c(-1, 1)

-      }

-    if (all(is.infinite(ylim))) {

-          ylim <- c(0, 1)

-      }

-    ylimExt <- extendrange(r = ylim, f = 0.05)

-    pushViewport(viewport(xscale = c(minBase, maxBase), yscale = ylimExt, clip = TRUE))

-    ## The plotting parameters, some defaults from the lattice package first

-    plot.symbol <- trellis.par.get("plot.symbol")

-    superpose.symbol <- trellis.par.get("superpose.symbol")

-    superpose.line <- trellis.par.get("superpose.line")

-    groups <- rep(groups, ncol(vals))

-    ## For loess calculation we need some settings

-    span <- .dpOrDefault(GdObject, "span", 1 / 5)

-    degree <- .dpOrDefault(GdObject, "degree", 1)

-    family <- .dpOrDefault(GdObject, "family", c("symmetric", "gaussian"))

-    evaluation <- .dpOrDefault(GdObject, "evaluation", 50)

-    font <- .dpOrDefault(GdObject, "font", if (is.null(groups)) plot.symbol$font else superpose.symbol$font)

-    fontface <- .dpOrDefault(GdObject, "fontface", if (is.null(groups)) plot.symbol$fontface else superpose.symbol$fontface)

-    fontsize <- .dpOrDefault(GdObject, "fontsize", if (is.null(groups)) plot.symbol$fontsize else superpose.symbol$fontsize)

-    ## An optional baseline to be added

-    baseline <- .dpOrDefault(GdObject, "baseline")

-    lwd.baseline <- .dpOrDefault(GdObject, "lwd.baseline", pcols$lwd[1])

-    lty.baseline <- .dpOrDefault(GdObject, "lty.baseline", pcols$lty[1])

-    ## The actual plotting values

-    pos <- position(GdObject)

-    x <- rep(pos, each = nrow(vals))

-    y <- as.numeric(vals)

-    ## A grid should always be plotted first, so we need to catch this here

-    wg <- match("g", type, nomatch = NA_character_)

-    if (!is.na(wg)) {

-        panel.grid(

-            h = .dpOrDefault(GdObject, "h", -1), v = .dpOrDefault(GdObject, "v", -1),

-            col = pcols$col.grid, lty = pcols$lty.grid, lwd = pcols$lwd.grid

-        )

-        type <- type[-wg]

-    }

-    ## The special type 'mountain' has to be handled separately

-    if ("mountain" %in% type) {

-        mbaseline <- if (is.null(baseline)) 0 else baseline[1]

-        fill.mountain <- .dpOrDefault(GdObject, "fill.mountain", superpose.symbol$fill)[c(1, 2)]

-        col.mountain <- .dpOrDefault(GdObject, "col.mountain", pcols$col)[1]

-        col.baseline <- .dpOrDefault(GdObject, "col.baseline", col.mountain)[1]

-        lwd.mountain <- .dpOrDefault(GdObject, "lwd.mountain", pcols$lwd)[1]

-        lty.mountain <- .dpOrDefault(GdObject, "lty.mountain", pcols$lty)[1]

-        .panel.mountain(x, y,

-            col = col.mountain, fill = fill.mountain, span = span, degree = degree, family = family,

-            evaluation = evaluation, lwd = lwd.mountain, lty = lty.mountain, col.line = col.mountain, alpha = alpha,

-            baseline = mbaseline

-        )

-        if (!is.na(mbaseline)) {

-              panel.abline(h = mbaseline, col = col.baseline, lwd = lwd.baseline, lty = lty.baseline, alpha = alpha)

-          }

-    }

-    ## The special type 'polygon' has to be handled separately

-    if ("polygon" %in% type) {

-        mbaseline <- if (is.null(baseline)) 0 else baseline[1]

-        fill.mountain <- .dpOrDefault(GdObject, "fill.mountain", superpose.symbol$fill)[c(1, 2)]

-        col.mountain <- .dpOrDefault(GdObject, "col.mountain", pcols$col)[1]

-        col.baseline <- .dpOrDefault(GdObject, "col.baseline", col.mountain)[1]

-        lwd.mountain <- .dpOrDefault(GdObject, "lwd.mountain", pcols$lwd)[1]

-        lty.mountain <- .dpOrDefault(GdObject, "lty.mountain", pcols$lty)[1]

-        .panel.polygon(x, y,

-            col = col.mountain, fill = fill.mountain, lwd = lwd.mountain,

-            lty = lty.mountain, col.line = col.mountain, alpha = alpha,

-            baseline = mbaseline

-        )

-        if (!is.na(mbaseline)) {

-              panel.abline(h = mbaseline, col = col.baseline, lwd = lwd.baseline, lty = lty.baseline, alpha = alpha)

-          }

-    }

-    ## Also the type 'boxplot' is handled up front

-    if ("boxplot" %in% type) {

-        box.ratio <- .dpOrDefault(GdObject, "box.ratio", 1)

-        box.width <- .dpOrDefault(GdObject, "box.width", (min(diff(unique(sort(x)))) * 0.5) / box.ratio)

-        diff <- .pxResolution(coord = "x")

-        if (!is.null(groups)) {

-            tw <- min(width(GdObject))

-            spacer <- diff

-            nb <- nlevels(groups)

-            bw <- .dpOrDefault(GdObject, "box.width", (tw - (nb + 2) * spacer) / nb)

-            bcex <- min(pcols$cex[1], (bw / diff) / 20)

-            by <- lapply(split(vals, groups), matrix, ncol = ncol(vals))

-            for (j in seq_along(by))

-            {

-                xx <- rep(start(GdObject) + (j * spacer) + (j * bw), each = nrow(by[[j]])) - (bw / 2)

-                .panel.bwplot(xx, as.numeric(by[[j]]),

-                    box.ratio = box.ratio, box.width = (bw / 2) / box.ratio, pch = pcols$pch[1],

-                    lwd = pcols$lwd[1], lty = pcols$lty[1], fontsize = fontsize,

-                    col = pcols$col.histogram, cex = bcex, font = font, fontfamily = font, fontface = fontface,

-                    fill = pcols$col[j], varwidth = .dpOrDefault(GdObject, "varwidth", FALSE),

-                    notch = .dpOrDefault(GdObject, "notch", FALSE), notch.frac = .dpOrDefault(GdObject, "notch.frac", 0.5),

-                    levels.fos = .dpOrDefault(GdObject, "level.fos", sort(unique(xx))),

-                    stats = .dpOrDefault(GdObject, "stats", boxplot.stats), coef = .dpOrDefault(GdObject, "coef", 1.5),

-                    do.out = .dpOrDefault(GdObject, "do.out", TRUE), alpha = alpha

-                )

-            }

-            diffY <- .pxResolution(coord = "y", 2)

-            outline <- apply(vals, 2, range)

-            grid.rect(start(GdObject), outline[1, ] - diffY,

-                width = width(GdObject), height = abs(outline[2, ] - outline[1, ]) + (2 * diffY),

-                gp = gpar(col = pcols$col.histogram, fill = "transparent", alpha = alpha, lty = "dotted"),

-                default.units = "native", just = c("left", "bottom")

-            )

-        } else {

-            bcex <- min(pcols$cex[1], ((box.width * 2) / diff) / 20)

-            .panel.bwplot(x, y,

-                box.ratio = box.ratio, box.width = box.width, pch = pcols$pch[1],

-                lwd = pcols$lwd[1], lty = pcols$lty[1], fontsize = fontsize,

-                col = pcols$col.histogram, cex = bcex, font = font, fontfamily = font, fontface = fontface,

-                fill = pcols$fill[1], varwidth = .dpOrDefault(GdObject, "varwidth", FALSE),

-                notch = .dpOrDefault(GdObject, "notch", FALSE), notch.frac = .dpOrDefault(GdObject, "notch.frac", 0.5),

-                levels.fos = .dpOrDefault(GdObject, "level.fos", sort(unique(x))),

-                stats = .dpOrDefault(GdObject, "stats", boxplot.stats), coef = .dpOrDefault(GdObject, "coef", 1.5),

-                do.out = .dpOrDefault(GdObject, "do.out", TRUE), alpha = alpha

-            )

-        }

-    }

-    ## 'histogram' fills up the full range area if its width is > 1

-    if ("histogram" %in% type) {

-        ylimSort <- sort(ylimExt)

-        yy <- if (ylimSort[1] <= 0 && ylimSort[2] >= 0) 0 else ylimSort[1]

-        if (!is.null(groups) && nlevels(groups) > 1) {

-            valsS <- .dpOrDefault(GdObject, ".__valsS")

-            if (stacked) {

-                curMinPos <- curMaxPos <- rep(yy, nrow(valsS))

-                for (s in seq_len(ncol(valsS)))

-                {

-                    if (!all(is.na(valsS[, s]))) {

-                        sel <- !is.na(valsS[, s]) & valsS[, s] >= 0

-                        yyy <- curMinPos

-                        yyy[sel] <- curMaxPos[sel]

-                        offset <- yyy

-                        offset[offset != yy] <- 0

-                        grid.rect(start(GdObject), yyy,

-                            width = width(GdObject), height = valsS[, s] - offset,

-                            gp = gpar(col = "transparent", fill = pcols$col[s], lwd = pcols$lwd[1], lty = pcols$lty[1], alpha = alpha), default.units = "native",

-                            just = c("left", "bottom")

-                        )

-                        curMaxPos[sel] <- curMaxPos[sel] + (valsS[sel, s] - offset[sel])

-                        curMinPos[!sel] <- curMinPos[!sel] + (valsS[!sel, s] - offset[!sel])

-                    }

-                }

-                diff <- .pxResolution(coord = "x", pcols$lwd[1] + 1)

-                tooNarrow <- width(GdObject) < diff

-                if (!all(tooNarrow)) {

-                      grid.rect(start(GdObject)[!tooNarrow], curMinPos[!tooNarrow],

-                          width = width(GdObject)[!tooNarrow],

-                          height = (curMaxPos - curMinPos)[!tooNarrow],

-                          gp = gpar(fill = "transparent", col = pcols$col.histogram, lwd = pcols$lwd[1], lty = pcols$lty[1], alpha = alpha),

-                          default.units = "native", just = c("left", "bottom")

-                      )

-                  }

-            } else {

-                spacer <- .pxResolution(min.width = 1, coord = "x")

-                yOff <- .pxResolution(min.width = 1, coord = "y")

-                outline <- apply(valsS, 1, function(x) range(c(yy, x), na.rm = TRUE))

-                grid.rect(start(GdObject), outline[1, ] - yOff,

-                    width = width(GdObject), height = apply(outline, 2, diff) + (yOff * 2),

-                    gp = gpar(col = pcols$col.histogram, fill = pcols$fill.histogram, lwd = pcols$lwd[1], lty = pcols$lty[1], alpha = alpha), default.units = "native",

-                    just = c("left", "bottom")

-                )

-                len <- ncol(valsS)

-                subW <- (width(GdObject) - (spacer * (len + 1))) / len

-                sel <- subW > spacer

-                ## FIXME: how do we treat this if there is not enough space to plot?

-                sel <- !logical(length(subW))

-                if (any(sel)) {

-                    subW <- subW[sel]

-                    valsS <- valsS[sel, ]

-                    subX <- rep(start(GdObject)[sel], len) + (subW * rep(seq_len(len) - 1, each = sum(sel))) +

-                        (spacer * rep(seq_len(len), each = sum(sel)))

-                    grid.rect(subX, yy,

-                        width = rep(subW, len), height = valsS - yy,

-                        gp = gpar(

-                            col = "transparent", fill = rep(pcols$col[seq_len(len)], each = sum(sel)),

-                            lwd = pcols$lwd[1], lty = pcols$lty[1], alpha = alpha

-                        ), default.units = "native",

-                        just = c("left", "bottom")

-                    )

-                }

-            }

-        } else {

-            agFun <- .aggregator(GdObject)

-            valsS <- agFun(t(vals))

-            grid.rect(start(GdObject), yy,

-                width = width(GdObject), height = valsS - yy,

-                gp = gpar(col = pcols$col.histogram, fill = pcols$fill.histogram, lwd = pcols$lwd[1], lty = pcols$lty[1], alpha = alpha), default.units = "native",

-                just = c("left", "bottom")

-            )

-        }

-    }

-    ## gradient summarizes the data as a color gradient

-    if ("gradient" %in% type) {

-        ncolor <- .dpOrDefault(GdObject, "ncolor", 100)

-        gradient <- colorRampPalette(.dpOrDefault(GdObject, "gradient", brewer.pal(9, "Blues")))(ncolor)

-        valsScaled <- .z2icol(colMeans(vals, na.rm = TRUE), ncolor, sort(ylim))

-        grid.rect(start(GdObject), sort(ylim)[1],

-            width = width(GdObject), height = abs(diff(ylim)),

-            gp = gpar(col = gradient[valsScaled], fill = gradient[valsScaled], alpha = alpha),

-            default.units = "native", just = c("left", "bottom")

-        )

-    }

-    ## heatmap does the same, but for each sample individually

-    if ("heatmap" %in% type) {

-        ncolor <- .dpOrDefault(GdObject, "ncolor", 100)

-        valsScaled <- .z2icol(vals, ncolor, sort(ylim))

-        nr <- nrow(vals)

-        yy <- seq(min(ylim), max(ylim), len = nr + 1)[-1]

-        ydiff <- .pxResolution(coord = "y")

-        separator <- .dpOrDefault(GdObject, "separator", 0) * ydiff

-        if (!is.null(groups)) {

-            valsS <- split(vals, groups)

-            freq <- table(factor(.dpOrDefault(GdObject, "groups")))

-            cmf <- c(0, cumsum(freq))

-            for (s in seq_along(valsS))

-            {

-                gradient <- colorRampPalette(c("white", pcols$col[s]))(ncolor + 5)[-seq_len(5)]

-                valsScaled <- .z2icol(valsS[[s]], ncolor, sort(ylim))

-                grid.rect(rep(start(GdObject), each = freq[s]), yy[(cmf[s] + 1):cmf[s + 1]],

-                    width = rep(width(GdObject), each = freq[s]),

-                    height = max(ydiff, abs(diff(ylim)) * (1 / nr) - separator),

-                    gp = gpar(col = gradient[valsScaled], fill = gradient[valsScaled], alpha = alpha),

-                    default.units = "native", just = c("left", "top")

-                )

-            }

-        } else {

-            gradient <- colorRampPalette(.dpOrDefault(GdObject, "gradient", brewer.pal(9, "Blues")))(ncolor)

-            grid.rect(rep(start(GdObject), each = nr), yy,

-                width = rep(width(GdObject), each = nr),

-                height = max(ydiff, abs(diff(ylim)) * (1 / nr) - separator),

-                gp = gpar(col = gradient[valsScaled], fill = gradient[valsScaled], alpha = alpha),

-                default.units = "native", just = c("left", "top")

-            )

-        }

-    }

-    ## The rest uses the lattice panel function

-    na.rm <- .dpOrDefault(GdObject, "na.rm", FALSE)

-    sel <- is.na(y)

-    if (na.rm && any(sel)) {

-        x <- x[!sel]

-        y <- y[!sel]

-        groups <- groups[!sel]

-    }

-    panel.xyplot(x, y,

-        type = type, groups = groups, pch = pcols$pch, col = pcols$col, col.line = pcols$col.line, col.symbol = pcols$col.symbol,

-        font = font, fontfamily = font, fontface = fontface, lty = pcols$lty, cex = pcols$cex, fill = pcols$fill, lwd = pcols$lwd, horizontal = FALSE,

-        span = span, degree = degree, family = family, evaluation = evaluation,

-        jitter.x = .dpOrDefault(GdObject, "jitter.x", FALSE), jitter.y = .dpOrDefault(GdObject, "jitter.y", FALSE),

-        factor = .dpOrDefault(GdObject, "factor", 0.5), amount = .dpOrDefault(GdObject, "amount"),

-        subscripts = seq_along(x), alpha = alpha

-    )

-    if (!any(c("mountain", "polygon") %in% type) && !is.null(baseline) && !is.na(baseline)) {

-          panel.abline(h = baseline, col = pcols$col.baseline, lwd = lwd.baseline, lty = lty.baseline, alpha = alpha)

-      }

-    popViewport(1)

-    return(invisible(GdObject))

-})

-

-

-

-

-## drawGD AlignedReadTrack 2 ---------------------------------------------------------------------------------------------

-##

-## Draw a AlignedRead track

-

-setMethod("drawGD", signature("AlignedReadTrack"), function(GdObject, minBase, maxBase, prepare = FALSE, subset = TRUE, ...) {

-    debug <- .dpOrDefault(GdObject, "debug", FALSE)

-    if ((is.logical(debug) && debug) || debug == "prepare") {

-        browser()

-    }

-    imageMap(GdObject) <- NULL

-    detail <- match.arg(.dpOrDefault(GdObject, "detail", "coverage"), c("reads", "coverage"))

-    ## Nothing to do in prepare mode if detail is not 'reads', so we can quit right away, else we need to set the stacking info

-    if (prepare) {

-        if (detail == "read") {

-            if (subset) {

-                GdObject <- subset(GdObject, from = minBase, to = maxBase)

-            }

-            ## GdObject <- setStacks(GdObject)

-        }

-        return(invisible(GdObject))

-    }

-    if ((is.logical(debug) && debug) || debug == "draw") {

-        browser()

-    }

-    ## In plotting mode we either show all the reads (time-consuming), or the coverage only

-    rad <- 0.015

-    xx <- -0.01

-    loc <- vpLocation()$size

-    diff <- .pxResolution(coord = "x")

-    radv <- rad / if (loc["width"] < loc["height"]) c(1, loc[2] / loc[1]) else c(loc[1] / loc[2], 1)

-    if (subset) {

-        GdObject <- subset(GdObject, from = minBase, to = maxBase)

-    }

-    ## If type is 'coverage' all we need to do is compute a coverage vector, create dummy DataTracks and pass everything on

-    if (detail == "coverage") {

-        if (!any(unlist(lapply(GdObject@coverage, function(y) runValue(y) != 0)))) {

-            ## Nothing there, but we still need the strand separator

-            panel.abline(h = 0.5, col = "lightgray", lwd = 2)

-            grid.circle(xx, c(0.25, 0.75), rad, gp = gpar(fill = "lightgray", col = "lightgray"))

-            grid.segments(c(rep(xx - radv[1] + (radv[1] / 2), 2), xx), c(0.25, 0.75, 0.75 - (radv[2] / 2)),

-                c(rep(xx + radv[1] - (radv[1] / 2), 2), xx), c(0.25, 0.75, 0.75 + radv[2] / 2),

-                gp = gpar(col = "white", lwd = 2, lineend = "square"), default.units = "native"

-            )

-            return(invisible(GdObject))

-        } else {

-            ## We want to distinguish between strands, so an extra spitting step is needed for this to work

-            val <- c(0, max(unlist(lapply(c("+", "-"), function(x) {

-                if (length(coverage(GdObject, strand = x))) {

-                    max(coverage(GdObject, strand = x))

-                } else {

-                    NULL

-                }

-            }))))

-            trans <- .dpOrDefault(GdObject, "transformation")[[1]]

-            if (!is.null(trans)) {

-                val[2] <- trans(val[2])

-            }

-            ylim <- .dpOrDefault(GdObject, "ylim", val)

-            for (s in c("+", "-"))

-            {

-                cov <- coverage(GdObject, strand = s)

-                pushViewport(viewport(height = 0.5, y = ifelse(s == "-", 0, 0.5), just = c("center", "bottom")))

-                sel <- suppressWarnings(runValue(cov) != 0) # changed from >

-                dtr <- if (any(sel)) {

-                    DataTrack(

-                        start = start(cov)[sel], end = end(cov)[sel], data = runValue(cov)[sel],

-                        name = names(GdObject), genome = genome(GdObject), chromosome = chromosome(GdObject)

-                    )

-                } else {

-                    DataTrack(name = names(GdObject), genome = genome(GdObject), chromosome = chromosome(GdObject))

-                }

-                displayPars(dtr) <- displayPars(GdObject, hideInternal = FALSE)

-                displayPars(dtr) <- list(ylim = if (s == "+") ylim else rev(ylim))

-                drawGD(dtr, minBase, maxBase, prepare = prepare, ...)

-                popViewport(1)

-            }

-            panel.abline(h = 0.5, col = "lightgray", lwd = 2)

-            grid.circle(xx, c(0.25, 0.75), unit(rad, "native"),

-                gp = gpar(fill = "lightgray", col = "lightgray"),

-                default.units = "native"

-            )

-            grid.segments(c(rep(xx - radv[1] + (radv[1] / 2), 2), xx), c(0.25, 0.75, 0.75 - (radv[2] / 2)),

-                c(rep(xx + radv[1] - (radv[1] / 2), 2), xx), c(0.25, 0.75, 0.75 + radv[2] / 2),

-                gp = gpar(col = "white", lwd = 2, lineend = "square"), default.units = "native"

-            )

-            return(invisible(GdObject))

-        }

-    }

-    if (detail == "reads") {

-        if (!length(GdObject)) {

-            ## No reads, but we still need the strand separator

-            panel.abline(h = 0.5, col = "lightgray", lwd = 2)

-            grid.circle(xx, c(0.25, 0.75), rad, gp = gpar(fill = "lightgray", col = "lightgray"))

-            grid.segments(c(rep(xx - radv[1] + (radv[1] / 2), 2), xx), c(0.25, 0.75, 0.75 - (radv[2] / 2)),

-                c(rep(xx + radv[1] - (radv[1] / 2), 2), xx), c(0.25, 0.75, 0.75 + radv[2] / 2),

-                gp = gpar(col = "white", lwd = 2, lineend = "square"), default.units = "native"

-            )

-            return(invisible(GdObject))

-        } else {

-            if (GdObject@coverageOnly) {

-                pushViewport(viewport())

-                grid.text("Coverage information only for this object.\nUnable to plot read details.",

-                    gp = gpar(col = "darkgray")

-                )

-                panel.abline(h = 0.5, col = "lightgray", lwd = 2)

-                recMid <- c(0.25, 0.75)

-            } else {

-                gdSplit <- split(GdObject, factor(strand(GdObject), levels = c("+", "-")))

-                st <- lapply(gdSplit, function(x) if (length(x)) stacks(setStacks(x)) - 1 else 0)

-                omax <- sum(vapply(st, max, FUN.VALUE = numeric(1L)))

-                space <- 0.1

-                ratios <- lapply(st[c("-", "+")], function(x) if (omax == 0) 0.5 else max(x) / omax) + (space / (2:1))

-                names(ratios) <- c("-", "+")

-                y <- if (ratios[["-"]] < ratios[["+"]]) c(0, ratios[["-"]] + space / 2) else c(0, ratios[["-"]] - space / 2)

-                h <- if (ratios[["-"]] < ratios[["+"]]) {

-                    c(

-                        max(space / 2, ratios["-"] - space / 2),

-                        max(space / 2, ratios["+"] - ratios["-"] - space / 2)

-                    )

-                } else {

-                    c(max(space / 2, ratios["-"] - space), max(space / 2, ratios["+"] - ratios["-"] - space / 2))

-                }

-                names(y) <- names(h) <- names(ratios)

-                pushViewport(viewport(height = 0.95, just = "center", yscale = c(0, max(ratios))))

-                for (s in c("+", "-"))

-                {

-                    gdSub <- gdSplit[[s]]

-                    if (length(gdSub)) {

-                        ylim <- c(0, if (max(st[[s]]) == 0) 1 else max(st[[s]]))

-                        pushViewport(viewport(

-                            height = h[s], y = y[s], just = c("center", "bottom"),

-                            yscale = if (s == "+") ylim else rev(ylim), xscale = c(minBase, maxBase),

-                            default.units = "native"

-                        ))

-                        ## We need to handle the grid here individually

-                        if (.dpOrDefault(GdObject, "grid", FALSE)) {

-                            pushViewport(dataViewport(xData = c(minBase, maxBase), extension = c(0, 0), yData = 0:1, clip = TRUE))

-                            panel.grid(

-                                h = 0, v = .dpOrDefault(GdObject, "v", -1),

-                                col = .dpOrDefault(GdObject, "col.grid", "#e6e6e6"), lty = .dpOrDefault(GdObject, "lty.grid", 1),

-                                lwd = .dpOrDefault(GdObject, "lwd.grid", 1)

-                            )

-                            popViewport(1)

-                        }

-                        grid.segments(start(gdSub), st[[s]], end(gdSub), st[[s]], default.units = "native")

-                        popViewport(1)

-                    }

-                }

-                al <- h["-"] + space / 4

-                panel.abline(h = al, col = "lightgray", lwd = 2)

-                recMid <- c(al / 2, al + (max(ratios) - al) / 2)

-            }

-            grid.circle(xx, recMid, rad, gp = gpar(fill = "lightgray", col = "lightgray"), default.units = "native")

-            grid.segments(c(rep(xx - radv[1] + (radv[1] / 2), 2), xx), c(0.25, 0.75, 0.75 - (radv[2] / 2)),

-                c(rep(xx + radv[1] - (radv[1] / 2), 2), xx), c(0.25, 0.75, 0.75 + radv[2] / 2),

-                gp = gpar(col = "white", lwd = 3, lineend = "square"), default.units = "native"

-            )

-

-            grid.segments(c(rep(xx - radv[1] + (radv[1] / 2), 2), xx), c(recMid, recMid[2] - radv[2] / 2),

-                c(rep(xx + radv[1] - (radv[1] / 2), 2), xx), c(recMid, recMid[2] + radv[2] / 2),

-                gp = gpar(col = "white", lwd = 2, lineend = "square"), default.units = "native"

-            )

-            popViewport(1)

-        }

-    }

-    return(invisible(GdObject))

-})

-

-

-

-

 ## drawGD - IdeogramTrack ----------------------------------------------------------------------------------------------

 ##

 ## Draw an ideogram track

@@ -5538,24 +4875,6 @@ setMethod(

     }

 )

-setMethod(

-    "show", signature(object = "AlignedReadTrack"),

-    function(object) {

-        cat(sprintf(

-            paste("AlignedReadTrack track '%s' \n",

-                "| genome: %s\n",

-                "| active chromosome: %s\n",

-                "| containing %i read%s\n",

-                sep = ""

-            ),

-            names(object), genome(object),

-            gsub("^chr", "", chromosome(object)),

-            length(object),

-            ifelse(length(object) == 1, "", "s")

-        ))

-    }

-)

-

 setMethod("show", "DisplayPars", function(object) {

     cat("Display parameters:\n")

     for (i in base::ls(object@pars))

@@ -161,19 +161,6 @@

 ##    o x: an object inheriting from class GdObject

 ## Value: the relative vertical space needed for the track

 .verticalSpace <- function(x, totalSpace) {

-    if (is(x, "AlignedReadTrack")) {

-        size <- if (is.null(displayPars(x, "size"))) {

-            type <- match.arg(.dpOrDefault(x, "detail", "coverage"), c("reads", "coverage"))

-            if (type == "read") {

-                  if (stacking(x) %in% c("sqish", "full")) 5 else 1

-              } else {

-                7

-            }

-        } else {

-            displayPars(x, "size")

-        }

-        return(size)

-    }

     if (is(x, "DataTrack") && is.null(displayPars(x, "size"))) {

         type <- match.arg(.dpOrDefault(x, "type", "p"), .PLOT_TYPES, several.ok = TRUE)

         size <- if (length(type) == 1L) {

@@ -287,8 +274,7 @@

     }

     atrack <- vapply(objects, function(x) {

         is(x, "NumericTrack") ||

-            (is(x, "AlignmentsTrack") && "coverage" %in% match.arg(.dpOrDefault(x, "type", .ALIGNMENT_TYPES), .ALIGNMENT_TYPES, several.ok = TRUE)) ||

-            (is(x, "AlignedReadTrack") && .dpOrDefault(x, "detail", "coverage") == "coverage")

+            (is(x, "AlignmentsTrack") && "coverage" %in% match.arg(.dpOrDefault(x, "type", .ALIGNMENT_TYPES), .ALIGNMENT_TYPES, several.ok = TRUE))

     }, FUN.VALUE = logical(1L))

     isOnlyHoriz <- vapply(objects, function(x) {

         res <- FALSE

@@ -388,10 +374,10 @@

         if (any(needAxis)) {

             cex.axis <- structure(vapply(trackList, .dpOrDefault, "cex.axis", 0.6, FUN.VALUE = numeric(1L)), names = nn)

             axTicks <- unlist(lapply(trackList, function(GdObject) {

-                if (!is(GdObject, "NumericTrack") && !is(GdObject, "AlignedReadTrack") && !is(GdObject, "AlignmentsTrack")) {

+                if (!is(GdObject, "NumericTrack") && !is(GdObject, "AlignmentsTrack")) {

                     return(NULL)

                 }

-                yvals <- if (is(GdObject, "AlignedReadTrack")) runValue(coverage(GdObject, strand = "*")) else values(GdObject)

+                yvals <- values(GdObject)

                 ylim <- .dpOrDefault(GdObject, "ylim", if (!is.null(yvals) && length(yvals)) {

                     range(yvals, na.rm = TRUE, finite = TRUE)

                 } else {

@@ -2213,7 +2199,7 @@ devDims <- function(width, height, ncol = 12, nrow = 8, res = 72) {

 .makeParMapping <- function() {

     classes <- c(

         "GdObject", "GenomeAxisTrack", "RangeTrack", "NumericTrack", "DataTrack", "IdeogramTrack", "StackedTrack",

-        "AnnotationTrack", "DetailsAnnotationTrack", "GeneRegionTrack", "BiomartGeneRegionTrack", "AlignmentsTrack", "AlignedReadTrack"

+        "AnnotationTrack", "DetailsAnnotationTrack", "GeneRegionTrack", "BiomartGeneRegionTrack", "AlignmentsTrack"

     )

     defs <- try(lapply(classes, function(x) as(getClassDef(x)@prototype@dp, "list")), silent = TRUE)

     if (!is(defs, "try-error") && is.null(.parMappings)) {

@@ -2230,7 +2216,7 @@ availableDisplayPars <- function(class) {

       }

     class <- match.arg(class, c(

         "GdObject", "GenomeAxisTrack", "RangeTrack", "NumericTrack", "DataTrack", "IdeogramTrack", "StackedTrack",

-        "AnnotationTrack", "DetailsAnnotationTrack", "GeneRegionTrack", "BiomartGeneRegionTrack", "AlignedReadTrack",

+        "AnnotationTrack", "DetailsAnnotationTrack", "GeneRegionTrack", "BiomartGeneRegionTrack", 

         "AlignmentsTrack", "SequenceTrack", "SequenceBSgenomeTrack", "SequenceDNAStringSetTrack", "SequenceRNAStringSetTrack"

     ))

     parents <- names(getClassDef(class)@contains)

@@ -14,6 +14,3 @@

   \itemize{

   }

 }

-

-\seealso{

-}