Merge pull request #41 from m-jahn/dev

fix: various minor issues

Author: showteeth

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

@@ -31,7 +31,7 @@
 #' @importFrom stats as.formula
 #' @importFrom ggh4x facet_wrap2 strip_themed elem_list_rect
 #' @importFrom dplyr group_by summarise
-#' @importFrom dplyr %>%
+#' @importFrom dplyr %>% filter
 #' @importFrom ggrepel geom_text_repel
 #' @importFrom utils tail
 #'
@@ -119,16 +119,16 @@ 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
         }
         if (is.null(names(fill.color))) {
           names(fill.color) <- unique(data[, group.key])
         }
-        sacle_fill_cols <- scale_fill_manual(values = fill.color)
+        scale_fill_cols <- scale_fill_manual(values = fill.color)
       } else {
-        sacle_fill_cols <- NULL
+        scale_fill_cols <- NULL
       }
       if (!single.nuc) {
         mapping <- aes_string(xmin = "start", xmax = "end", ymin = "0", ymax = "score", fill = group.key)
@@ -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
@@ -180,9 +180,9 @@ geom_coverage <- function(data, mapping = NULL, color = NULL, rect.color = NA,
             names(fill.color) <- unique(data[, fill.str])
           }
         }
-        sacle_fill_cols <- scale_fill_manual(values = fill.color)
+        scale_fill_cols <- scale_fill_manual(values = fill.color)
       } else {
-        sacle_fill_cols <- NULL
+        scale_fill_cols <- NULL
       }
     } else if (plot.type == "joint") {
       message("For joint visualization, the mapping should contains start, score, 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
@@ -255,8 +255,8 @@ geom_coverage <- function(data, mapping = NULL, color = NULL, rect.color = NA,
     plot.ele <- list(region.rect, region.facet)
 
     # color the track
-    if (!is.null(sacle_fill_cols)) {
-      plot.ele <- append(plot.ele, sacle_fill_cols)
+    if (!is.null(scale_fill_cols)) {
+      plot.ele <- append(plot.ele, scale_fill_cols)
     }
 
     if (range.position == "in") {
@@ -336,36 +336,29 @@ geom_coverage <- function(data, mapping = NULL, color = NULL, rect.color = NA,
   # add rect
   if (!is.null(mark.region)) {
     # get valid mark region
-    region.start <- data[1, "start"]
-    region.end <- data[nrow(data), "end"]
-    valid.region.list <- list()
-    for (r in 1:nrow(mark.region)) {
-      if (mark.region[r, "start"] <= region.end & mark.region[r, "end"] >= region.start) {
-        if (mark.region[r, "end"] >= region.end) {
-          mark.region[r, "end"] <- region.end
-        }
-        if (mark.region[r, "start"] <= region.start) {
-          mark.region[r, "start"] <- region.start
-        }
-        valid.region.list[[r]] <- mark.region[r, ]
-      }
-    }
-    valid.region.df <- do.call(rbind, valid.region.list) %>% as.data.frame()
-    colnames(valid.region.df) <- colnames(mark.region)
-
+    region.start <- min(data$start)
+    region.end <- max(data$end)
+    mark.region <- dplyr::filter(
+      mark.region,
+      .data[["start"]] >= region.start,
+      .data[["end"]] <= region.end
+    )
     region.mark <- geom_rect(
-      data = valid.region.df,
+      data = mark.region,
       aes_string(xmin = "start", xmax = "end", ymin = "-Inf", ymax = "Inf"),
       fill = mark.color, alpha = mark.alpha
     )
     plot.ele <- append(plot.ele, region.mark)
     # add rect label
     if (show.mark.label) {
-      if ("label" %in% colnames(valid.region.df)) {
+      if ("label" %in% colnames(mark.region)) {
         # create mark region label
-        region.label <- valid.region.df
+        region.label <- mark.region
         if (plot.type == "facet") {
-          region.label[, facet.key] <- facet.order[1]
+          region.label[, facet.key] <- factor(
+            rep(facet.order[1], nrow(mark.region)),
+            facet.order
+          )
         }
         region.mark.label <- geom_text_repel(
           data = region.label,

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_gene.R

@@ -1,35 +1,50 @@
 #' Add Gene Annotation to Coverage Plot.
 #'
-#' @param gtf.gr Granges object of GTF, created with \code{\link{import.gff}}. Default: NULL.
+#' @param gtf.gr Granges object of GTF, created with \code{\link{import.gff}}.
+#'   Default: NULL.
 #' @param overlap.gene.gap The gap between gene groups. Default: 0.1.
-#' @param overlap.style The style of gene groups, choose from loose (each gene occupies single line)
-#' and tight (place non-overlap genes in one line). Default: loose.
-#' @param gene.size The line size of gene. Default: 1.
-#' @param utr.size The line size of UTR. Default: 2.
-#' @param exon.size The line size of exon. Default: 3.
-#' @param arrow.size The line size of arrow. Default: 1.5.
+#' @param overlap.style The style of gene groups, choose from loose (each gene
+#'   occupies single line) and tight (place non-overlap genes in one line).
+#'   Default: loose.
+#' @param gene.size Line width of genes. Default: 1.
+#' @param utr.size Line width of UTRs. Default: 2.
+#' @param exon.size Line width of exons. Default: 3.
+#' @param arrow.angle Angle of the arrow head. Default 35°
+#' @param arrow.length Length of arrows. Default: 1.5
+#' @param arrow.type Whether to draw "closed" or "open" (default) arrow heads
+#' @param color.by Color the lines/arrows by variable. Default: "strand".
 #' @param arrow.gap The gap distance between intermittent arrows. Default: NULL.
 #'   Set arrow.num and arrow.gap to NULL to suppress intermittent arrows.
-#' @param arrow.num Total number of intermittent arrows over whole region. Default: 50.
-#'   Set arrow.num and arrow.gap to NULL to suppress intermittent arrows.
-#' @param color.by Color the line by. Default: strand.
+#' @param arrow.num Total number of intermittent arrows over whole region.
+#'   Default: 50. Set arrow.num and arrow.gap to NULL to suppress intermittent
+#'   arrows.
+#' @param arrow.size.im Line width of intermittent arrows. Default: 0.5
+#' @param arrow.length.im Length of intermittent arrows. Default: 1.5
+#' @param arrow.type.im Whether to draw "closed" (default) or "open" heads for
+#'   intermittent arrows
+#' @param color.by.im Color the intermittent arrows by variable. Default: NULL
+#'   (draws semi-transparent, white arrows)
 #' @param fill.color Color used for \code{color.by}.
-#' Default: blue for - (minus strand), green for + (plus strand).
+#'   Default: blue for - (minus strand), green for + (plus strand).
 #' @param show.utr Logical value, whether to show UTR. Default: TRUE.
 #' @param label.size The size of gene label. Default: 3.
 #' @param label.vjust The vjust of gene label. Default: 2.
 #' @param plot.space Top and bottom margin. Default: 0.1.
-#' @param plot.height The relative height of gene annotation to coverage plot. Default: 0.2.
+#' @param plot.height The relative height of gene annotation to coverage plot.
+#'   Default: 0.2.
 #'
 #' @return Plot.
 #' @importFrom dplyr %>%
 #' @importFrom rlang .data
 #' @importFrom GenomicRanges GRanges makeGRangesFromDataFrame setdiff
 #' @importFrom IRanges IRanges subsetByOverlaps findOverlaps
 #' @importFrom dplyr filter select arrange
-#' @importFrom ggplot2 ggplot_add ggplot geom_segment aes_string arrow unit geom_text labs theme_classic theme element_blank
-#' element_text element_rect margin scale_y_continuous scale_color_manual scale_x_continuous coord_cartesian
+#' @importFrom ggplot2 ggplot_add ggplot geom_segment aes_string arrow unit
+#'   geom_text labs theme_classic theme element_blank element_text element_rect
+#'   margin scale_y_continuous scale_color_manual scale_x_continuous
+#'   coord_cartesian
 #' @importFrom patchwork wrap_plots
+#' @importFrom grDevices grey
 #' @export
 #'
 #' @examples
@@ -58,19 +73,40 @@
 #' gtf_gr <- rtracklayer::import.gff(con = gtf_file, format = "gtf")
 #'
 #' # plot coverage and gene annotation
-#' basic.coverage <- ggcoverage(data = track_df, range.position = "out")
-#' basic.coverage +
+#' basic_coverage <- ggcoverage(data = track_df, range.position = "out")
+#' basic_coverage +
 #'   geom_gene(gtf.gr = gtf_gr)
+#'
+#'# plot with custom style
+#' basic_coverage +
+#'   geom_gene(
+#'     gtf.gr = gtf_gr,
+#'     exon.size = 2.0,
+#'     arrow.size.im = 1.0,
+#'     arrow.length.im = 5,
+#'     arrow.type.im = "open",
+#'     color.by.im = "strand",
+#'     fill.color = c(
+#'       "-" = "darkblue",
+#'       "+" = "darkgreen"
+#'     )
+#'   )
 geom_gene <- function(gtf.gr,
                       overlap.gene.gap = 0.1,
                       overlap.style = "loose",
                       gene.size = 1,
                       utr.size = 2,
                       exon.size = 3,
-                      arrow.size = 1.5,
+                      arrow.angle = 35,
+                      arrow.length = 1.5,
+                      arrow.type = "open",
+                      color.by = "strand",
                       arrow.gap = NULL,
                       arrow.num = 50,
-                      color.by = "strand",
+                      arrow.size.im = 0.5,
+                      arrow.length.im = 1.5,
+                      arrow.type.im = "closed",
+                      color.by.im = NULL,
                       fill.color = c(
                         "-" = "cornflowerblue",
                         "+" = "darkolivegreen3"
@@ -88,10 +124,16 @@ geom_gene <- function(gtf.gr,
       gene.size = gene.size,
       utr.size = utr.size,
       exon.size = exon.size,
-      arrow.size = arrow.size,
+      arrow.angle = arrow.angle,
+      arrow.length = arrow.length,
+      arrow.type = arrow.type,
+      color.by = color.by,
       arrow.gap = arrow.gap,
       arrow.num = arrow.num,
-      color.by = color.by,
+      arrow.size.im = arrow.size.im,
+      arrow.length.im = arrow.length.im,
+      arrow.type.im = arrow.type.im,
+      color.by.im = color.by.im,
       fill.color = fill.color,
       show.utr = show.utr,
       label.size = label.size,
@@ -127,12 +169,18 @@ ggplot_add.gene <- function(object, plot, object_name) {
   gene.size <- object$gene.size
   utr.size <- object$utr.size
   exon.size <- object$exon.size
-  arrow.size <- object$arrow.size
+  arrow.angle <- object$arrow.angle
+  arrow.length <- object$arrow.length
+  arrow.type <- object$arrow.type
   color.by <- object$color.by
-  fill.color <- object$fill.color
-  show.utr <- object$show.utr
   arrow.gap <- object$arrow.gap
   arrow.num <- object$arrow.num
+  arrow.size.im <- object$arrow.size.im
+  arrow.length.im <- object$arrow.length.im
+  arrow.type.im <- object$arrow.type.im
+  color.by.im <- object$color.by.im
+  fill.color <- object$fill.color
+  show.utr <- object$show.utr
   label.size <- object$label.size
   label.vjust <- object$label.vjust
   plot.space <- object$plot.space
@@ -203,11 +251,11 @@ ggplot_add.gene <- function(object, plot, object_name) {
     gene.info.used.utr <- gene.exon.utr$utr
   }
   gene.plot <- ggplot() +
-    geom_arrows(gene.info.used.gene, color.by, gene.size, arrow.size) +
-    geom_arrows(gene.info.used.exon, color.by, exon.size, arrow.size)
+    geom_arrows(gene.info.used.gene, color.by, gene.size, arrow.length, arrow.angle, arrow.type) +
+    geom_arrows(gene.info.used.exon, color.by, exon.size, arrow.length, arrow.angle, arrow.type)
   if (show.utr) {
     gene.plot <- gene.plot +
-      geom_arrows(gene.info.used.utr, color.by, utr.size, arrow.size)
+      geom_arrows(gene.info.used.utr, color.by, utr.size, arrow.length, arrow.angle, arrow.type)
   }
 
   if (!is.null(arrow.gap) || !is.null(arrow.num)) {
@@ -251,8 +299,21 @@ ggplot_add.gene <- function(object, plot, object_name) {
     arrow.df$start <- as.numeric(arrow.df$start)
     arrow.df$end <- as.numeric(arrow.df$end)
     arrow.df$group <- as.numeric(arrow.df$group)
+    if (is.null(color.by.im)) {
+      color.by.im <- color.by
+      arrow.df[[color.by]] <- "im"
+      fill.color["im"] <- grDevices::grey(1, alpha = 0.5)
+    } else if (color.by.im %in% colnames(arrow.df)) {
+      stopifnot(unique(arrow.df[[color.by.im]]) %in% names(fill.color))
+    } else {
+      stop(paste0(
+        "The selected variable '",
+        color.by.im ,
+        "' for 'color.by.im' is not available in the data"
+      ))
+    }
     gene.plot <- gene.plot +
-      geom_arrows(arrow.df, color.by, gene.size / 2, arrow.size, 35, TRUE)
+      geom_arrows(arrow.df, color.by.im, arrow.size.im, arrow.length.im, arrow.angle, arrow.type.im)
   }
 
   label.df <- data.frame(