Merge pull request #16 from m-jahn/colors

improved handling of colors with grouping vs facetting

Author: showteeth

R/geom_coverage.R

@@ -3,7 +3,7 @@
 #' @param data Track prepared by \code{\link{FormatTrack}}.
 #' @param mapping Set of aesthetic mappings created by \code{aes} or \code{aes_}. Default: NULL.
 #' @param color Track color. Default: NULL (select automatically).
-#' @param rect.color The color of every bin. Default: NA.
+#' @param rect.color The color of every bin. Default: NA
 #' @param single.nuc Logical value, whether to visualize at single nucleotide level (use bar plot). Default: FALSE.
 #' @param plot.type The type of the plot, choose from facet (separate plot for every sample) and
 #' joint (combine all sample in a single plot). Default: facet.
@@ -37,20 +37,63 @@
 #'
 #' @export
 #' @examples
-#' # library(ggcoverage)
-#' # library(utils)
-#' # library(ggplot2)
-#' # meta.file <- system.file("extdata", "RNA-seq", "meta_info.csv", package = "ggcoverage")
-#' # sample.meta <- utils::read.csv(meta.file)
-#' # track folder
-#' # track.folder <- system.file("extdata", "RNA-seq", package = "ggcoverage")
-#' # load bigwig file
-#' # track.df <- LoadTrackFile(
-#' #   track.folder = track.folder, format = "bw",
-#' #   meta.info = sample.meta
-#' # )
-#' # ggplot() +
-#' #   geom_coverage(data = track.df, color = "auto", mark.region = NULL)
+#' library(ggcoverage)
+#' library(ggplot2)
+#'
+#' # import track data
+#' meta.file <- system.file("extdata", "RNA-seq", "meta_info.csv", package = "ggcoverage")
+#' sample.meta <- utils::read.csv(meta.file)
+#' track.folder <- system.file("extdata", "RNA-seq", package = "ggcoverage")
+#'
+#' track.df <- LoadTrackFile(
+#'   track.folder = track.folder, format = "bw",
+#'   meta.info = sample.meta
+#' )
+#'
+#' # plot tracks with coloring by 'Group' variable
+#' ggplot() +
+#'   geom_coverage(data = track.df, facet.key = "Type", group.key = "Group")
+#'
+#' # plot tracks without coloring by any group
+#' ggplot() +
+#'   geom_coverage(data = track.df, facet.key = "Type", group.key = NULL)
+#'
+#' # plot tracks with coloring each facet differently (facet.key == group.key)
+#' ggplot() +
+#'   geom_coverage(data = track.df, facet.key = "Type", group.key = "Type")
+#'
+#' # supply your own colors
+#' ggplot() +
+#'   geom_coverage(
+#'     data = track.df, facet.key = "Type",
+#'     group.key = "Type", color = 1:4,
+#'     facet.color = 1:4
+#'   )
+#'
+#' # plot tracks together in one panel instead of separately;
+#' # 'facet.key' is not needed
+#' ggplot() +
+#'   geom_coverage(
+#'     data = track.df, group.key = "Type",
+#'     plot.type = "joint"
+#'   )
+#'
+#' # use a custom theme
+#' ggplot() +
+#'   geom_coverage(data = track.df, facet.key = "Type") +
+#'   theme_bw()
+#'
+#' # mark a region
+#' ggplot() +
+#'   geom_coverage(
+#'     data = track.df, facet.key = "Type",
+#'     mark.region = data.frame(
+#'       start = c(21678900,21732001,21737590),
+#'       end = c(21679900,21732400,21737650),
+#'       label=c("M1", "M2", "M3")),
+#'     mark.color = grey(0.4)
+#'   )
+#'
 geom_coverage <- function(data, mapping = NULL, color = NULL, rect.color = NA,
                           single.nuc = FALSE, plot.type = c("facet", "joint"),
                           facet.key = "Type", joint.avg = FALSE, facet.order = NULL,
@@ -67,32 +110,28 @@ geom_coverage <- function(data, mapping = NULL, color = NULL, rect.color = NA,
   if (is.null(mapping)) {
     if (plot.type == "facet") {
       if (!is.null(color)) {
-        if (length(color) != length(unique(data[, facet.key]))) {
-          warning("The color you provided is not as long as ", facet.key, " column in data, select automatically!")
+        testcolors <- sapply(color, function(x) {
+          tryCatch(is.matrix(col2rgb(x)),
+                   error = function(e) FALSE)
+        })
+        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
-          tmp.color <- AutoColor(data = data, n = 9, name = "Set1", key = group.key)
-          # change facet key color color
-          if (facet.key == group.key) {
-            fill.color.df <- merge(unique(data[c(facet.key)]), data.frame(color = tmp.color), by.x = group.key, by.y = 0)
-          } else {
-            fill.color.df <- merge(unique(data[c(facet.key, group.key)]), data.frame(color = tmp.color), by.x = group.key, by.y = 0)
-          }
-          fill.color <- fill.color.df$color
-          names(fill.color) <- fill.color.df[, facet.key]
+          fill.color <- AutoColor(data = data, n = 9, name = "Set1", key = group.key)
         } else {
           fill.color <- color
-          if (is.null(names(fill.color))) {
-            names(fill.color) <- unique(data[, facet.key])
-          }
+        }
+        if (is.null(names(fill.color))) {
+          names(fill.color) <- unique(data[, group.key])
         }
         sacle_fill_cols <- scale_fill_manual(values = fill.color)
       } else {
         sacle_fill_cols <- NULL
       }
       if (!single.nuc) {
-        mapping <- aes_string(xmin = "start", xmax = "end", ymin = "0", ymax = "score", fill = facet.key)
+        mapping <- aes_string(xmin = "start", xmax = "end", ymin = "0", ymax = "score", fill = group.key)
       } else {
-        mapping <- aes_string(x = "start", y = "score", fill = facet.key)
+        mapping <- aes_string(x = "start", y = "score", fill = group.key)
       }
     } else if (plot.type == "joint") {
       if (!is.null(color)) {
@@ -189,11 +228,13 @@ geom_coverage <- function(data, mapping = NULL, color = NULL, rect.color = NA,
     facet.formula <- as.formula(paste0("~ ", facet.key))
     if (!single.nuc) {
       region.rect <- geom_rect(data = data, mapping = mapping, show.legend = F, colour = rect.color)
+      ymax.str <- rlang::as_label(mapping$ymax)
     } else {
       region.rect <- geom_bar(
         data = data, mapping = mapping, show.legend = F, colour = rect.color,
         stat = "identity"
       )
+      ymax.str <- rlang::as_label(mapping$y)
     }
     # prepare facet scale
     if (facet.y.scale == "free") {
@@ -214,14 +255,14 @@ geom_coverage <- function(data, mapping = NULL, color = NULL, rect.color = NA,
       plot.ele <- append(plot.ele, sacle_fill_cols)
     }
 
-    # add range text to track
-    ymax.str <- rlang::as_label(mapping$ymax)
     if (range.position == "in") {
       data.range <- data %>%
         dplyr::group_by(.data[[facet.key]]) %>%
-        dplyr::summarise(max_score = max(.data[[ymax.str]]))
-      data.range$max_score <- sapply(data.range$max_score, CeilingNumber)
-      data.range$label <- paste0("[0, ", data.range$max_score, "]")
+        dplyr::summarise(.groups = "drop_last",
+                         min_score = CeilingNumber(min(.data[[ymax.str]])),
+                         max_score = CeilingNumber(max(.data[[ymax.str]]))
+        )
+      data.range$label <- paste0("[", data.range$min_score, ", ", data.range$max_score, "]")
       region.range <- geom_text(
         data = data.range,
         mapping = aes(x = -Inf, y = Inf, label = label),
@@ -310,7 +351,7 @@ geom_coverage <- function(data, mapping = NULL, color = NULL, rect.color = NA,
 
     region.mark <- geom_rect(
       data = valid.region.df,
-      aes_string(xmin = "start", xmax = "end", ymin = "0", ymax = "Inf"),
+      aes_string(xmin = "start", xmax = "end", ymin = "-Inf", ymax = "Inf"),
       fill = mark.color, alpha = mark.alpha
     )
     plot.ele <- append(plot.ele, region.mark)

R/ggcoverage.R

@@ -40,19 +40,64 @@
 #' @export
 #'
 #' @examples
-#' # library(ggcoverage)
-#' # library(utils)
-#' # library(rtracklayer)
-#' # meta.file <- system.file("extdata", "RNA-seq", "meta_info.csv", package = "ggcoverage")
-#' # sample.meta <- utils::read.csv(meta.file)
-#' # track folder
-#' # track.folder <- system.file("extdata", "RNA-seq", package = "ggcoverage")
-#' # load bigwig file
-#' # track.df <- LoadTrackFile(track.folder = track.folder, format = "bw",region = "chr14:21,677,306-21,737,601",
-#' #                           extend = 2000, meta.info = sample.meta)
-#' # gtf.file <- system.file("extdata", "used_hg19.gtf", package = "ggcoverage")
-#' # gtf.gr <- rtracklayer::import.gff(con = gtf.file, format = "gtf")
-#' # ggcoverage(data = track.df, color = "auto", range.position = "out")
+#' library(ggcoverage)
+#' library(rtracklayer)
+#' library(ggplot2)
+#'
+#' # import track data
+#' meta.file <- system.file("extdata", "RNA-seq", "meta_info.csv", package = "ggcoverage")
+#' sample.meta <- read.csv(meta.file)
+#' track.folder <- system.file("extdata", "RNA-seq", package = "ggcoverage")
+#'
+#' track.df <- LoadTrackFile(
+#'   track.folder = track.folder, format = "bw",
+#'   region = "chr14:21,677,306-21,737,601",
+#'   extend = 2000, meta.info = sample.meta
+#' )
+#'
+#' gtf.file <- system.file("extdata", "used_hg19.gtf", package = "ggcoverage")
+#' gtf.gr <- rtracklayer::import.gff(con = gtf.file, format = "gtf")
+#'
+#' # plot tracks with coloring by 'Group' variable
+#' ggcoverage(data = track.df, facet.key = "Type", group.key = "Group")
+#'
+#' # plot tracks without coloring by any group
+#' ggcoverage(data = track.df, facet.key = "Type", group.key = NULL)
+#'
+#' # plot tracks with coloring each facet differently (facet.key == group.key)
+#' ggcoverage(data = track.df, facet.key = "Type", group.key = "Type")
+#'
+#' # supply your own colors
+#' ggcoverage(
+#'   data = track.df, facet.key = "Type",
+#'   group.key = "Type", color = 1:4,
+#'   facet.color = 1:4
+#' )
+#'
+#' # plot tracks together in one panel instead of separately;
+#' # 'facet.key' is not needed
+#' ggcoverage(
+#'   data = track.df, group.key = "Type",
+#'   plot.type = "joint"
+#' )
+#'
+#' # use a custom theme
+#' ggcoverage(data = track.df, facet.key = "Type") +
+#'   theme_bw()
+#'
+#' # mark a region
+#' ggcoverage(
+#'   data = track.df, facet.key = "Type",
+#'   mark.region = data.frame(
+#'     start = c(21678900,21732001,21737590),
+#'     end = c(21679900,21732400,21737650),
+#'     label=c("M1", "M2", "M3")),
+#'   mark.color = grey(0.4)
+#' )
+#'
+#' # position range labels outside of tracks
+#' ggcoverage(data = track.df, facet.key = "Type", range.position = "out")
+#'
 ggcoverage <- function(data, single.nuc = FALSE, mapping = NULL, color = NULL,
                        rect.color = NA, plot.type = c("facet", "joint"), facet.key = "Type", joint.avg = FALSE,
                        facet.order = NULL, facet.color = NULL, facet.y.scale = c("free", "fixed"),

R/utils.R

@@ -66,28 +66,21 @@ AutoColor <- function(data, n, name, key) {
 
 # ceiling for number bigger than zero, floor for number smaller than zero
 CeilingNumber <- function(x, digits = 2) {
-  # mark number
-  if (x < 0) {
-    flag <- -1
-    x <- abs(x)
-  } else {
-    flag <- 1
-  }
-  # transfrom
-  if (x > 1) {
-    x.ceiling <- round(x + 5 * 10^(-digits - 1), digits)
-  } else if (x > 0) {
-    x.split <- unlist(strsplit(formatC(x, format = "e"), "e"))
-    num.part <- as.numeric(x.split[1])
-    sci.part <- as.numeric(x.split[2])
-    valid.digits <- digits - 1
-    x.ceiling <- round(num.part + 5 * 10^(-valid.digits - 1), valid.digits) * 10^(sci.part)
+  if (x == 0) {
+    "0"
+  } else if (abs(x) >= 10^6) {
+    formatC(x, format = "e", digits = 2)
+  } else if (abs(x) >= 10000) {
+    formatC(round(x), format = "f", digits = 0)
+  } else if (abs(x) >= 1) {
+    if ((x %% floor(x)) != 0) {
+      formatC(x, format = "f", digits = 2)
+    } else {
+      formatC(x, format = "f", digits = 0)
+    }
   } else {
-    x.ceiling <- 0
+    formatC(x, format = "f", digits = 2)
   }
-  # final number
-  x.final <- x.ceiling * flag
-  return(x.final)
 }
 
 # create aa plot dataframe with padding offset

README.Rmd

@@ -122,15 +122,15 @@ The basic coverage plot has **two types**:
 #### joint view
 Create line plot for **every sample** (`facet.key = "Type"`) and color by **every sample** (`group.key = "Type"`):
 ```{r basic_coverage_joint, warning=FALSE, fig.height = 4, fig.width = 12, fig.align = "center"}
-basic.coverage = ggcoverage(data = track.df, color = "auto", 
+basic.coverage = ggcoverage(data = track.df,
                             plot.type = "joint", facet.key = "Type", group.key = "Type",
                             mark.region = mark.region, range.position = "out")
 basic.coverage
 ```
 
 Create **group average line plot** (sample is indicated by `facet.key = "Type"`, group is indicated by `group.key = "Group"`):
 ```{r basic_coverage_joint_avg, warning=FALSE, fig.height = 4, fig.width = 12, fig.align = "center"}
-basic.coverage = ggcoverage(data = track.df, color = "auto", 
+basic.coverage = ggcoverage(data = track.df,
                             plot.type = "joint", facet.key = "Type", group.key = "Group", 
                             joint.avg = TRUE,
                             mark.region = mark.region, range.position = "out")
@@ -139,22 +139,22 @@ basic.coverage
 
 #### facet view
 ```{r basic_coverage, warning=FALSE, fig.height = 6, fig.width = 12, fig.align = "center"}
-basic.coverage = ggcoverage(data = track.df, color = "auto", plot.type = "facet",
+basic.coverage = ggcoverage(data = track.df, plot.type = "facet",
                             mark.region = mark.region, range.position = "out")
 basic.coverage
 ```
 
 #### Custom Y-axis style
 **Change the Y-axis scale label in/out of plot region with `range.position`**:
 ```{r basic_coverage_2, warning=FALSE, fig.height = 6, fig.width = 12, fig.align = "center"}
-basic.coverage = ggcoverage(data = track.df, color = "auto", plot.type = "facet",
+basic.coverage = ggcoverage(data = track.df, plot.type = "facet",
                             mark.region = mark.region, range.position = "in")
 basic.coverage
 ```
 
 **Shared/Free Y-axis scale with `facet.y.scale`**:
 ```{r basic_coverage_3, warning=FALSE, fig.height = 6, fig.width = 12, fig.align = "center"}
-basic.coverage = ggcoverage(data = track.df, color = "auto", plot.type = "facet",
+basic.coverage = ggcoverage(data = track.df, plot.type = "facet",
                             mark.region = mark.region, range.position = "in", 
                             facet.y.scale = "fixed")
 basic.coverage
@@ -422,7 +422,7 @@ mark.region
 
 ### Basic coverage
 ```{r basic_coverage_chip, warning=FALSE, fig.height = 6, fig.width = 12, fig.align = "center"}
-basic.coverage = ggcoverage(data = track.df, color = "auto", 
+basic.coverage = ggcoverage(data = track.df,
                             mark.region=mark.region, show.mark.label = FALSE)
 basic.coverage
 ```