From f85d4dc4803162fde3cfdac07a411597aa7d9c03 Mon Sep 17 00:00:00 2001 From: Jacques Date: Fri, 12 Jul 2024 16:56:30 -0400 Subject: [PATCH] feat: more geoms --- DESCRIPTION | 1 + NAMESPACE | 5 + R/geoms.R | 274 +++++++++++++++++++++++++++++++++---- R/globals.R | 1 + README.md | 13 +- man/geom_aggrcoverage.Rd | 58 -------- man/ggplot-tidyCoverage.Rd | 112 +++++++++++++++ man/reexports.Rd | 4 +- 8 files changed, 373 insertions(+), 95 deletions(-) delete mode 100644 man/geom_aggrcoverage.Rd create mode 100644 man/ggplot-tidyCoverage.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 8cc1192..e3a3d45 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -40,6 +40,7 @@ Imports: fansi, pillar, rlang, + scales, cli, purrr, vctrs, diff --git a/NAMESPACE b/NAMESPACE index ad55154..58f33e4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -12,6 +12,9 @@ export(as_tibble) export(coarsen) export(expand) export(geom_aggrcoverage) +export(geom_coverage) +export(scale_x_genome) +export(scale_y_coverage) export(show) exportMethods(CoverageExperiment) exportMethods(aggregate) @@ -45,6 +48,8 @@ importFrom(purrr,map_chr) importFrom(rlang,names2) importFrom(rtracklayer,BigWigFile) importFrom(rtracklayer,BigWigFileList) +importFrom(scales,oob_squish) +importFrom(scales,unit_format) importFrom(stats,qt) importFrom(stats,setNames) importFrom(tidyr,all_of) diff --git a/R/geoms.R b/R/geoms.R index 88766d5..cb383db 100644 --- a/R/geoms.R +++ b/R/geoms.R @@ -1,22 +1,29 @@ -#' geom_aggrcoverage +#' Plotting functions #' #' #' @description #' -#' `geom_aggrcoverage()` +#' Plotting functions for tidyCoverage objects #' -#' @name geom_aggrcoverage -#' @rdname geom_aggrcoverage +#' @name ggplot-tidyCoverage +#' @rdname ggplot-tidyCoverage #' -#' @param mapping mapping -#' @param data data -#' @param ... ... -#' @param ci ci -#' @param na.rm na.rm -#' @param show.legend show.legend -#' @param inherit.aes inherit.aes +#' @param mapping Aesthetics for geom_*. By default, no color/fill aesthetic +#' is specified, but they can be assigned to a variable with `mapping = aes(...)`. +#' Note that `x` and `y` are automatically filled. +#' @param data Data frame passed to geom_*. Typically a `CoverageExperiment` object +#' (expanded to a tibble) or a `AggregatedCoverage` object. +#' @param type Choose between "line" and "area" style for `geom_coverage()`. +#' @param ci Should the confidence interval be plotted by `geom_aggrcoverage()`? +#' (default: TRUE) +#' @param unit Rounding of x axis (any of c('b', 'kb', 'Mb')). +#' @param grid Should the plot grid by displayed? (default: FALSE). +#' @param ...,na.rm,show.legend,inherit.aes Argument passed to `ggplot` +#' internal functions #' @return A `ggplot` object` #' #' @import ggplot2 +#' @importFrom scales oob_squish +#' @importFrom scales unit_format #' #' @examples #' library(rtracklayer) @@ -26,15 +33,42 @@ #' TSSs_bed <- system.file("extdata", "TSSs.bed", package = "tidyCoverage") #' features <- list( #' TSS_fwd = import(TSSs_bed) |> filter(strand == '+'), -#' TSS_rev = import(TSSs_bed) |> filter(strand == '-') +#' TSS_rev = import(TSSs_bed) |> filter(strand == '-'), +#' conv_sites = import(system.file("extdata", "conv_transcription_loci.bed", package = "tidyCoverage")) #' ) #' tracks <- list( #' RNA_fwd = system.file("extdata", "RNA.fwd.bw", package = "tidyCoverage"), -#' RNA_rev = system.file("extdata", "RNA.rev.bw", package = "tidyCoverage") +#' RNA_rev = system.file("extdata", "RNA.rev.bw", package = "tidyCoverage"), +#' Scc1 = system.file("extdata", "Scc1.bw", package = "tidyCoverage") #' ) |> map(import, as = 'Rle') -#' df <- CoverageExperiment(tracks, features, width = 5000, ignore.strand = FALSE) |> -#' aggregate() |> -#' as_tibble() +#' ce <- CoverageExperiment(tracks, features, width = 5000, center = TRUE, scale = TRUE) +#' ac <- aggregate(ce) +#' +#' ############################################################################# +#' ## 1. Plotting aggregated coverage +#' ############################################################################# +#' +#' ac |> +#' as_tibble() |> +#' ggplot() + +#' geom_aggrcoverage(aes(col = track)) + +#' facet_grid(track ~ features) + +#' geom_vline(xintercept = 0, color = 'black', linetype = 'dashed', linewidth = 0.5) +#' +#' ############################################################################# +#' ## 2. Plotting track coverages over individual loci +#' ############################################################################# +#' +#' ce2 <- CoverageExperiment( +#' tracks, +#' GRangesList(list(locus1 = "II:400001-455000", locus2 = "IV:720001-775000")), +#' window = 50 +#' ) +#' expand(ce2) |> +#' mutate(coverage = ifelse(track != 'Scc1', scales::oob_squish(coverage, c(0, 50)), coverage)) |> +#' ggplot() + +#' geom_coverage(aes(fill = track)) + +#' facet_grid(track~features, scales = 'free') NULL GeomAggrCoverage <- ggplot2::ggproto("GeomAggrCoverage", ggplot2::Geom, @@ -66,14 +100,53 @@ GeomAggrCoverage <- ggplot2::ggproto("GeomAggrCoverage", ggplot2::Geom, draw_key = ggplot2::draw_key_smooth ) -#' @rdname geom_aggrcoverage +GeomCoverage <- ggplot2::ggproto("GeomCoverage", ggplot2::Geom, + setup_params = function(data, params) { + params$type <- params$type + params + }, + extra_params = c("na.rm"), + required_aes = c("x", "y"), + default_aes = ggplot2::aes( + colour = "black", + fill = "grey", + linewidth = 0.4, + linetype = 1, + alpha = 1 + ), + + draw_group = function(data, params, coord, type, ...) { + + forArea <- transform(data, ymax = y, ymin = 0, colour = NA) + + grid::gList( + if (type == 'line') ggplot2::GeomLine$draw_panel(data, params, coord, ...), + if (type == 'area') ggplot2::GeomArea$draw_panel(forArea, params, coord, ...) + ) + + }, + + draw_key = function(data, params, type, ...) { + if (params$type == 'line') { + ggplot2::draw_key_path(data, params) + } + else { + data <- transform(data, colour = NA) + ggplot2::draw_key_rect(data, params) + } + } +) + +#' @rdname ggplot-tidyCoverage #' @export geom_aggrcoverage <- function( mapping = NULL, data = NULL, ..., + unit = c('kb', 'Mb', 'b'), ci = TRUE, + grid = FALSE, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -81,15 +154,164 @@ geom_aggrcoverage <- function( m <- ggplot2::aes(x = coord, y = mean, ymin = ci_low, ymax = ci_high, group = interaction(.sample, .feature)) if (!is.null(mapping)) m <- utils::modifyList(m, mapping) - ggplot2::layer( - data = data, - mapping = m, - stat = "identity", - geom = GeomAggrCoverage, - position = "identity", - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list(na.rm = na.rm, ci = ci, ...) + unit = match.arg(unit, c('kb', 'Mb', 'b')) + + list( + ggplot2::layer( + data = data, + mapping = m, + stat = "identity", + geom = GeomAggrCoverage, + position = "identity", + show.legend = show.legend, + inherit.aes = inherit.aes, + params = list(na.rm = na.rm, ci = ci, ...) + ), + theme_coverage2(grid = grid), + scale_x_genome(unit = unit) + ) +} + +#' @rdname ggplot-tidyCoverage +#' @export + +geom_coverage <- function( + mapping = NULL, + data = NULL, + ..., + type = c('area', 'line'), + unit = c('kb', 'Mb', 'b'), + grid = FALSE, + na.rm = FALSE, + show.legend = NA, + inherit.aes = TRUE +) { + m <- ggplot2::aes(x = coord, y = coverage, group = interaction(track, features), fill = track) + if (!is.null(mapping)) m <- utils::modifyList(m, mapping) + + unit = match.arg(unit, c('kb', 'Mb', 'b')) + type <- match.arg(type, c('area', 'line')) + + list( + ggplot2::layer( + data = data, + mapping = m, + stat = "identity", + geom = GeomCoverage, + position = "identity", + show.legend = show.legend, + inherit.aes = inherit.aes, + params = list(na.rm = na.rm, type = type, ...) + ), + scale_x_genome(unit = unit), + scale_y_coverage(), + theme_coverage(grid = grid), + ggplot2::guides(y = ggplot2::guide_axis(cap = "both")) ) + } +#' @rdname ggplot-tidyCoverage +#' @export + +scale_y_coverage <- function() { + ggplot2::scale_y_continuous( + expand = ggplot2::expansion(mult = c(0, 0)), + n.breaks = 3 + ) +} + +#' @rdname ggplot-tidyCoverage +#' @export + +scale_x_genome <- function(unit = c('kb', 'Mb', 'b')) { + unit = match.arg(unit, c('kb', 'Mb', 'b')) + scale = dplyr::case_when( + unit == 'b' ~ 1, + unit == 'kb' ~ 1e-3, + unit == 'Mb' ~ 1e-6 + ) + ggplot2::scale_x_continuous( + expand = c(0, 0), + labels = scales::unit_format( + unit = unit, scale = scale, + sep = "", + big.mark = "" + ) + ) +} + +.theme_coverage <- function( + grid = TRUE, + base_size = 11, + base_family = "", + base_line_size = base_size/22, + base_rect_size = base_size/22 +) { + th <- ggplot2::theme_bw( + base_size = base_size, + base_family = base_family, + base_line_size = base_line_size, + base_rect_size = base_rect_size + ) + if (!grid) th <- th %+replace% ggplot2::theme( + panel.grid = ggplot2::element_blank(), + panel.grid.major = ggplot2::element_blank(), + panel.grid.minor = ggplot2::element_blank() + ) + th <- th %+replace% + ggplot2::theme( + legend.position = 'top', + legend.background = ggplot2::element_blank(), + legend.key = ggplot2::element_blank(), + panel.spacing = unit(8, "pt"), + panel.background = ggplot2::element_blank(), + strip.background = ggplot2::element_blank(), + plot.background = ggplot2::element_blank(), + complete = TRUE + ) + th +} + +theme_coverage <- function( + grid = TRUE, + base_size = 11, + base_family = "", + base_line_size = base_size/22, + base_rect_size = base_size/22 +) { + th <- .theme_coverage( + grid = grid, + base_size = base_size, + base_family = base_family, + base_line_size = base_line_size, + base_rect_size = base_rect_size + ) %+replace% + ggplot2::theme( + #panel.border = ggplot2::element_blank(), + axis.line = element_line(color = 'black'), + complete = TRUE + ) + th +} + +theme_coverage2 <- function( + grid = TRUE, + base_size = 11, + base_family = "", + base_line_size = base_size/22, + base_rect_size = base_size/22 +) { + th <- .theme_coverage( + grid = grid, + base_size = base_size, + base_family = base_family, + base_line_size = base_line_size, + base_rect_size = base_rect_size + ) %+replace% + ggplot2::theme( + axis.ticks = ggplot2::element_blank(), + complete = TRUE + ) + th +} \ No newline at end of file diff --git a/R/globals.R b/R/globals.R index d5f7791..2ad5d6b 100644 --- a/R/globals.R +++ b/R/globals.R @@ -4,6 +4,7 @@ utils::globalVariables(c( "ci_high", "coord", "feature", + "features", ".feature", ".sample", "track" diff --git a/README.md b/README.md index 6bf1cac..32e7d59 100644 --- a/README.md +++ b/README.md @@ -42,7 +42,7 @@ tracks <- list( ## Extract coverage for each track over each set of features ```r -CE <- CoverageExperiment(tracks, features, width = 1000, ignore.strand = FALSE) +CE <- CoverageExperiment(tracks, features, width = 5000, ignore.strand = FALSE) ``` ## Plot tracks coverage aggregated over genomic features @@ -55,9 +55,7 @@ CE |> ggplot() + geom_aggrcoverage(aes(col = track)) + facet_grid(track ~ ., scales = "free") + - labs(x = 'Distance from TSS', y = 'Signal coverage') + - theme_bw() + - theme(legend.position = 'top') + labs(x = 'Distance from TSS', y = 'Signal coverage') ``` ![](man/figures/aggr-cov.png) @@ -68,11 +66,8 @@ CE |> CoverageExperiment(tracks, GRanges("II:450001-455000")) |> expand() |> ggplot() + - geom_aggrcoverage(aes(col = track)) + - facet_grid(track~., scales = 'free') + - scale_x_continuous(expand = c(0, 0)) + - theme_bw() + - theme(legend.position = "none", aspect.ratio = 0.1) + geom_coverage(aes(fill = track)) + + facet_grid(track~., scales = 'free') ``` ![](man/figures/cov.png) diff --git a/man/geom_aggrcoverage.Rd b/man/geom_aggrcoverage.Rd deleted file mode 100644 index 50c39b5..0000000 --- a/man/geom_aggrcoverage.Rd +++ /dev/null @@ -1,58 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/geoms.R -\name{geom_aggrcoverage} -\alias{geom_aggrcoverage} -\title{geom_aggrcoverage} -\usage{ -geom_aggrcoverage( - mapping = NULL, - data = NULL, - ..., - ci = TRUE, - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE -) -} -\arguments{ -\item{mapping}{mapping} - -\item{data}{data} - -\item{...}{...} - -\item{ci}{ci} - -\item{na.rm}{na.rm} - -\item{show.legend}{show.legend} - -\item{inherit.aes}{inherit.aes} -} -\value{ -A \code{ggplot} object` -} -\description{ -#' @description -} -\details{ -\code{geom_aggrcoverage()} -} -\examples{ -library(rtracklayer) -library(plyranges) -library(ggplot2) -library(purrr) -TSSs_bed <- system.file("extdata", "TSSs.bed", package = "tidyCoverage") -features <- list( - TSS_fwd = import(TSSs_bed) |> filter(strand == '+'), - TSS_rev = import(TSSs_bed) |> filter(strand == '-') -) -tracks <- list( - RNA_fwd = system.file("extdata", "RNA.fwd.bw", package = "tidyCoverage"), - RNA_rev = system.file("extdata", "RNA.rev.bw", package = "tidyCoverage") -) |> map(import, as = 'Rle') -df <- CoverageExperiment(tracks, features, width = 5000, ignore.strand = FALSE) |> - aggregate() |> - as_tibble() -} diff --git a/man/ggplot-tidyCoverage.Rd b/man/ggplot-tidyCoverage.Rd new file mode 100644 index 0000000..60e7d83 --- /dev/null +++ b/man/ggplot-tidyCoverage.Rd @@ -0,0 +1,112 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/geoms.R +\name{ggplot-tidyCoverage} +\alias{ggplot-tidyCoverage} +\alias{geom_aggrcoverage} +\alias{geom_coverage} +\alias{scale_y_coverage} +\alias{scale_x_genome} +\title{Plotting functions} +\usage{ +geom_aggrcoverage( + mapping = NULL, + data = NULL, + ..., + unit = c("kb", "Mb", "b"), + ci = TRUE, + grid = FALSE, + na.rm = FALSE, + show.legend = NA, + inherit.aes = TRUE +) + +geom_coverage( + mapping = NULL, + data = NULL, + ..., + type = c("area", "line"), + unit = c("kb", "Mb", "b"), + grid = FALSE, + na.rm = FALSE, + show.legend = NA, + inherit.aes = TRUE +) + +scale_y_coverage() + +scale_x_genome(unit = c("kb", "Mb", "b")) +} +\arguments{ +\item{mapping}{Aesthetics for geom_*. By default, no color/fill aesthetic +is specified, but they can be assigned to a variable with \code{mapping = aes(...)}. +Note that \code{x} and \code{y} are automatically filled.} + +\item{data}{Data frame passed to geom_*. Typically a \code{CoverageExperiment} object +(expanded to a tibble) or a \code{AggregatedCoverage} object.} + +\item{..., na.rm, show.legend, inherit.aes}{Argument passed to \code{ggplot} +internal functions} + +\item{unit}{Rounding of x axis (any of c('b', 'kb', 'Mb')).} + +\item{ci}{Should the confidence interval be plotted by \code{geom_aggrcoverage()}? +(default: TRUE)} + +\item{grid}{Should the plot grid by displayed? (default: FALSE).} + +\item{type}{Choose between "line" and "area" style for \code{geom_coverage()}.} +} +\value{ +A \code{ggplot} object` +} +\description{ +#' @description +} +\details{ +Plotting functions for tidyCoverage objects +} +\examples{ +library(rtracklayer) +library(plyranges) +library(ggplot2) +library(purrr) +TSSs_bed <- system.file("extdata", "TSSs.bed", package = "tidyCoverage") +features <- list( + TSS_fwd = import(TSSs_bed) |> filter(strand == '+'), + TSS_rev = import(TSSs_bed) |> filter(strand == '-'), + conv_sites = import(system.file("extdata", "conv_transcription_loci.bed", package = "tidyCoverage")) +) +tracks <- list( + RNA_fwd = system.file("extdata", "RNA.fwd.bw", package = "tidyCoverage"), + RNA_rev = system.file("extdata", "RNA.rev.bw", package = "tidyCoverage"), + Scc1 = system.file("extdata", "Scc1.bw", package = "tidyCoverage") +) |> map(import, as = 'Rle') +ce <- CoverageExperiment(tracks, features, width = 5000, center = TRUE, scale = TRUE) +ac <- aggregate(ce) + +############################################################################# +## 1. Plotting aggregated coverage +############################################################################# + +ac |> + as_tibble() |> + ggplot() + + geom_aggrcoverage(aes(col = track)) + + facet_grid(track ~ features) + + geom_vline(xintercept = 0, color = 'black', linetype = 'dashed', linewidth = 0.5) + +############################################################################# +## 2. Plotting track coverages over individual loci +############################################################################# + +ce2 <- CoverageExperiment( + tracks, + GRangesList(list(locus1 = "II:400001-455000", locus2 = "IV:720001-775000")), + window = 50 +) +expand(ce2) |> + mutate(coverage = ifelse(track != 'Scc1', scales::oob_squish(coverage, c(0, 50)), coverage)) |> + ggplot() + + geom_coverage(aes(fill = track)) + + facet_grid(track~features, scales = 'free') +} diff --git a/man/reexports.Rd b/man/reexports.Rd index 3fa278b..67be81f 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -19,9 +19,9 @@ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ - \item{dplyr}{\code{\link[dplyr]{as_tibble}}} + \item{dplyr}{\code{\link[dplyr:reexports]{as_tibble}}} - \item{S4Vectors}{\code{\link[S4Vectors]{aggregate}}} + \item{S4Vectors}{\code{\link[S4Vectors:aggregate-methods]{aggregate}}} \item{tidyr}{\code{\link[tidyr]{expand}}} }}