feat: added functions to customize colors in geom_peak

Author: m-jahn

DESCRIPTION

@@ -57,4 +57,4 @@ VignetteBuilder:
     knitr
 biocViews:
 Encoding: UTF-8
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2

NAMESPACE

@@ -114,6 +114,7 @@ importFrom(ggplot2,ggplot_add)
 importFrom(ggplot2,labs)
 importFrom(ggplot2,margin)
 importFrom(ggplot2,rel)
+importFrom(ggplot2,scale_color_continuous)
 importFrom(ggplot2,scale_color_gradientn)
 importFrom(ggplot2,scale_color_manual)
 importFrom(ggplot2,scale_fill_manual)

R/geom_coverage.R

@@ -119,7 +119,7 @@ geom_coverage <- function(data, mapping = NULL, color = NULL, rect.color = NA,
         if (length(color) < length(unique(data[, group.key]))) {
           warning("Fewer colors provided than there are groups in ", group.key, " variable, falling back to default colors")
           # sample group with same color
-          fill.color <- AutoColor(data = data, n = 9, name = "Set1", key = group.key)
+          fill.color <- AutoColor(data = data[[group.key]], pal = "Set1")
         } else {
           fill.color <- color
         }
@@ -140,7 +140,7 @@ geom_coverage <- function(data, mapping = NULL, color = NULL, rect.color = NA,
         if (length(color) != length(unique(data[, group.key]))) {
           warning("The color you provided is not as long as ", group.key, " column in data, select automatically!")
           # sample group with same color
-          tmp.color <- AutoColor(data = data, n = 9, name = "Set1", key = group.key)
+          tmp.color <- AutoColor(data = data[[group.key]], pal = "Set1")
           # change group key color
           color.color.df <- merge(unique(data[c(group.key)]), data.frame(color = tmp.color), by.x = group.key, by.y = 0)
           color.color <- color.color.df$color
@@ -169,7 +169,7 @@ geom_coverage <- function(data, mapping = NULL, color = NULL, rect.color = NA,
         fill.str.len <- length(unique(data[, fill.str]))
         if (is.null(color) | length(color) != fill.str.len) {
           # sample group with same color
-          tmp.color <- AutoColor(data = data, n = 9, name = "Set1", key = group.key)
+          tmp.color <- AutoColor(data = data[[group.key]], pal = "Set1")
           # change color
           fill.color.df <- merge(unique(data[c(fill.str, group.key)]), data.frame(color = tmp.color), by.x = group.key, by.y = 0)
           fill.color <- fill.color.df$color
@@ -191,7 +191,7 @@ geom_coverage <- function(data, mapping = NULL, color = NULL, rect.color = NA,
         color.str.len <- length(unique(data[, color.str]))
         if (is.null(color) | length(color) != color.str.len) {
           # sample group with same color
-          tmp.color <- AutoColor(data = data, n = 9, name = "Set1", key = group.key)
+          tmp.color <- AutoColor(data = data[[group.key]], pal = "Set1")
           # change color
           if (color.str == group.key) {
             color.color.df <- merge(unique(data[c(color.str)]), data.frame(color = tmp.color), by.x = group.key, by.y = 0)
@@ -223,7 +223,7 @@ geom_coverage <- function(data, mapping = NULL, color = NULL, rect.color = NA,
 
     # facet color
     if (is.null(facet.color)) {
-      facet.color <- AutoColor(data = data, n = 12, name = "Set3", key = facet.key)
+      facet.color <- AutoColor(data = data[[facet.key]], pal = "Set3")
     }
 
     # facet formula

R/geom_feature.R

@@ -99,7 +99,7 @@ ggplot_add.feature <- function(object, plot, object_name) {
     }
   } else {
     warning("The color you provided is smaller than Type column in data, select automatically!")
-    used.feature.color <- AutoColor(data = valid.feature, n = 9, name = "Set1", key = "Type")
+    used.feature.color <- AutoColor(data = valid.feature$Type, pal = "Set1")
   }
 
   # create plot

R/geom_peak.R

@@ -2,81 +2,91 @@
 #'
 #' @param bed.file The path to consensus peaks file. Default: NULL.
 #' @param peak.df The dataframe contains consensus peaks. Default: NULL.
-#' @param peak.color Peak color. Default: black.
+#' @param peak.color Peak colors. Default: NULL.
 #' @param peak.size The line size of peak. Default: 5.
+#' @param color.by Name of optional column in bed file/data frame which is used for coloring. Default: NULL.
 #' @param plot.space Top and bottom margin. Default: 0.1.
-#' @param plot.height The relative height of peak annotation to coverage plot. Default: 0.2.
+#' @param plot.height The relative height of peak annotation to coverage plot. Default: 0.1.
 #'
 #' @return Plot.
 #' @importFrom utils read.table
 #' @importFrom dplyr arrange
 #' @importFrom dplyr %>%
-#' @importFrom ggplot2 ggplot_add ggplot geom_segment aes_string theme_classic theme element_blank element_text
-#' element_rect margin scale_x_continuous scale_y_continuous coord_cartesian
+#' @importFrom ggplot2 ggplot_add ggplot geom_segment aes_string theme_classic
+#'   theme element_blank element_text element_rect margin scale_x_continuous
+#'   scale_y_continuous scale_color_continuous coord_cartesian
 #' @export
 #'
 #' @examples
-#' # library(ggcoverage)
-#' # library(rtracklayer)
-#' # sample.meta <- data.frame(
-#' #   SampleName = c("Chr18_MCF7_ER_1", "Chr18_MCF7_ER_2", "Chr18_MCF7_ER_3", "Chr18_MCF7_input"),
-#' #   Type = c("MCF7_ER_1", "MCF7_ER_2", "MCF7_ER_3", "MCF7_input"),
-#' #   Group = c("IP", "IP", "IP", "Input")
-#' # )
-#' # track folder
-#' # track.folder <- system.file("extdata", "ChIP-seq", package = "ggcoverage")
-#' # load bigwig file
-#' # track.df <- LoadTrackFile(
-#' #   track.folder = track.folder, format = "bw",
-#' #   meta.info = sample.meta
-#' # )
-#' # gtf.file <- system.file("extdata", "used_hg19.gtf", package = "ggcoverage")
-#' # gtf.gr <- rtracklayer::import.gff(con = gtf.file, format = "gtf")
-#' # create mark region
-#' # mark.region <- data.frame(start = c(76822533), end = c(76823743), label = c("Promoter"))
-#' # basic.coverage <- ggcoverage(
-#' #   data = track.df, color = "auto", region = "chr18:76822285-76900000",
-#' #   mark.region = mark.region, show.mark.label = FALSE
-#' # )
-#' # get consensus peak file
-#' # peak.file <- system.file("extdata", "ChIP-seq", "consensus.peak", package = "ggcoverage")
-#' # basic.coverage + geom_gene(gtf.gr = gtf.gr) + geom_peak(bed.file = peak.file)
-geom_peak <- function(bed.file = NULL, peak.df = NULL, peak.color = "black", peak.size = 5,
-                      plot.space = 0.1, plot.height = 0.1) {
+#' # load metadata
+#' sample_meta <- data.frame(
+#'   SampleName = c(
+#'     "Chr18_MCF7_ER_1",
+#'     "Chr18_MCF7_ER_2",
+#'     "Chr18_MCF7_ER_3",
+#'     "Chr18_MCF7_input"
+#'   ),
+#'   Type = c("MCF7_ER_1", "MCF7_ER_2", "MCF7_ER_3", "MCF7_input"),
+#'   Group = c("IP", "IP", "IP", "Input")
+#' )
+#'
+#' # import coverage track
+#' track_folder <- system.file("extdata", "ChIP-seq", package = "ggcoverage")
+#' track_df <- LoadTrackFile(
+#'   track.folder = track_folder,
+#'   format = "bw",
+#'   region = "chr18:76822285-76900000",
+#'   meta.info = sample_meta
+#' )
+#'
+#' # create mock peak file
+#' df_peaks <- data.frame(
+#'   seqnames = c("chr18", "chr18", "chr18"),
+#'   start = c(76822533, 76846900, 76880000),
+#'   end = c(76836900, 76860000, 76887000),
+#'   score = c(4, 6, 13)
+#' )
+#'
+#' # plot with default color
+#' ggcoverage(data = track_df) +
+#'   geom_peak(peak.df = df_peaks, peak.size = 3)
+#'
+#' # plot with color by 'score' variable
+#' ggcoverage(data = track_df) +
+#'   geom_peak(peak.df = df_peaks, peak.size = 3, color.by = "score")
+#'
+#' # plot with color by 'score' variable and custom color scale
+#' ggcoverage(data = track_df) +
+#'   geom_peak(peak.df = df_peaks, peak.size = 3, color.by = "score", peak.color = rainbow(5))
+#'
+geom_peak <- function(bed.file = NULL, peak.df = NULL, peak.color = NULL, peak.size = 5,
+                      color.by = NULL, plot.space = 0.1, plot.height = 0.1) {
   structure(
     list(
       bed.file = bed.file, peak.df = peak.df, peak.color = peak.color, peak.size = peak.size,
-      plot.space = plot.space, plot.height = plot.height
+      color.by = color.by, plot.space = plot.space, plot.height = plot.height
     ),
     class = "peak"
   )
 }
 
 #' @export
 ggplot_add.peak <- function(object, plot, object_name) {
-  # get plot data
-  # plot.data <- plot$layers[[1]]$data
-  # get plot data, plot data should contain bins
   if ("patchwork" %in% class(plot)) {
     plot.data <- plot[[1]]$layers[[1]]$data
   } else {
     plot.data <- plot$layers[[1]]$data
   }
-  # prepare plot range
-  # the plot region are not normal, so start is minimum value
   plot.chr <- as.character(plot.data[1, "seqnames"])
-  # plot.region.start <- plot$coordinates$limits$x[1]
-  # plot.region.end <- plot$coordinates$limits$x[2]
-  # plot.region.start <- plot.data[1, "start"]
   plot.region.start <- min(plot.data[, "start"])
-  # plot.region.end <- plot.data[nrow(plot.data), "end"]
   plot.region.end <- max(plot.data[, "end"])
 
   # get parameters
   bed.file <- object$bed.file
   peak.df <- object$peak.df
   peak.color <- object$peak.color
   peak.size <- object$peak.size
+  color.by <- object$color.by
   plot.space <- object$plot.space
   plot.height <- object$plot.height
 
@@ -86,30 +96,55 @@ ggplot_add.peak <- function(object, plot, object_name) {
   } else if (!is.null(peak.df)) {
     bed.info <- peak.df
   }
-  bed.info <- bed.info[c(1, 2, 3)]
-  colnames(bed.info) <- c("seqnames", "start", "end")
-  # convert to 1-based
+  colnames(bed.info)[c(1, 2, 3)] <- c("seqnames", "start", "end")
   bed.info$start <- as.numeric(bed.info$start) + 1
-
-  # get valid bed
   valid.bed <- GetRegion(chr = plot.chr, df = bed.info, start = plot.region.start, end = plot.region.end)
 
+  # color management
+  if (!is.null(color.by)) {
+    if (is.numeric(valid.bed[[color.by]])) {
+      if (!is.null(peak.color)) {
+        scale_colors <- scale_color_gradientn(colours = peak.color)
+      } else {
+        scale_colors <- scale_color_continuous()
+      }
+    } else {
+      if (length(peak.color) < length(unique(valid.bed[[color.by]]))) {
+        warning("Fewer colors provided than there are groups in ", color.by, " variable, falling back to default colors")
+        auto_colors <- AutoColor(data = valid.bed[[color.by]], pal = "Set3")
+        scale_colors <- scale_color_manual(values = auto_colors)
+      } else {
+        scale_colors <- scale_color_manual(values = peak.color)
+      }
+    }
+  } else {
+    color.by <- "color"
+    if (is.null(peak.color)) {
+      peak.color <- "black"
+    }
+    valid.bed$color <- peak.color[1]
+    scale_colors <- scale_color_manual(values = peak.color)
+  }
+
   peak.plot <- ggplot() +
     geom_segment(
       data = valid.bed,
       mapping = aes_string(
         x = "start",
         y = "1",
         xend = "end",
-        yend = "1"
+        yend = "1",
+        color = color.by
       ),
       size = peak.size,
-      color = peak.color
     ) +
+    scale_colors +
     labs(y = "Peak")
 
   # add theme
-  peak.plot <- peak.plot + theme_peak(margin.len = plot.space, x.range = c(plot.region.start, plot.region.end))
+  peak.plot <- peak.plot +
+    theme_peak(margin.len = plot.space, x.range = c(plot.region.start, plot.region.end)) +
+    theme(legend.position = "none")
   # assemble plot
   patchwork::wrap_plots(plot + theme(plot.margin = margin(t = plot.space, b = plot.space)),
     peak.plot,

R/utils.R

@@ -55,18 +55,18 @@ PrepareRegion <- function(region = NULL,
 }
 
 # select color automatically
-AutoColor <- function(data, n, name, key) {
+AutoColor <- function(data, pal) {
   palettes <- list(
     Set1 = c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3", "#FF7F00", "#FFFF33", "#A65628", "#F781BF", "#999999"),
     Set2 = c("#66C2A5", "#FC8D62", "#8DA0CB", "#E78AC3", "#A6D854", "#FFD92F", "#E5C494", "#B3B3B3"),
     Set3 = c("#8DD3C7", "#FFFFB3", "#BEBADA", "#FB8072", "#80B1D3", "#FDB462", "#B3DE69", "#FCCDE5", "#D9D9D9")
   )
-  getPalette <- grDevices::colorRampPalette(palettes[[name]])
+  get_palette <- grDevices::colorRampPalette(palettes[[pal]])
   # sample group with same color
-  group.info <- unique(data[, key])
-  fill.color <- getPalette(length(group.info))
-  names(fill.color) <- group.info
-  return(fill.color)
+  data_levels <- unique(data)
+  cols <- get_palette(length(data_levels))
+  names(cols) <- data_levels
+  return(cols)
 }
 
 # create aa plot dataframe with padding offset