Merge pull request #20 from m-jahn/colors

fix: Y axis scales and various smaller issues

Author: showteeth

DESCRIPTION

@@ -14,7 +14,7 @@ Description: The goal of 'ggcoverage' is to simplify the process of visualizing
     peak annotation, contact map annotation, link annotation and peotein feature annotation.
 License: MIT + file LICENSE
 Encoding: UTF-8
-RoxygenNote: 7.1.1
+RoxygenNote: 7.3.0
 biocViews:
 Imports: 
     dplyr,
@@ -56,6 +56,5 @@ Suggests:
     htmltools,
     BSgenome.Hsapiens.UCSC.hg19,
     graphics,
-    HiCDataHumanIMR90,
-    GenomeMatrix
+    HiCDataHumanIMR90
 VignetteBuilder: knitr

NAMESPACE

@@ -9,7 +9,6 @@ S3method(ggplot_add,ideogram)
 S3method(ggplot_add,link)
 S3method(ggplot_add,peak)
 S3method(ggplot_add,tad)
-S3method(ggplot_add,tad2)
 S3method(ggplot_add,transcript)
 export(FormatTrack)
 export(GetConsensusPeak)
@@ -57,7 +56,6 @@ importFrom(Biostrings,readDNAStringSet)
 importFrom(GenomeInfoDb,"seqlengths<-")
 importFrom(GenomeInfoDb,seqlengths)
 importFrom(GenomeInfoDb,seqnames)
-importFrom(GenomeMatrix,matrixPlotter)
 importFrom(GenomicAlignments,alphabetFrequencyFromBam)
 importFrom(GenomicAlignments,coverage)
 importFrom(GenomicAlignments,readGAlignments)
@@ -122,6 +120,7 @@ importFrom(ggplot2,theme_classic)
 importFrom(ggplot2,unit)
 importFrom(ggpp,annotate)
 importFrom(ggrepel,geom_text_repel)
+importFrom(grDevices,col2rgb)
 importFrom(grDevices,colorRampPalette)
 importFrom(magrittr,"%>%")
 importFrom(methods,extends)
@@ -140,3 +139,5 @@ importFrom(stringr,str_locate)
 importFrom(utils,menu)
 importFrom(utils,read.csv)
 importFrom(utils,read.table)
+importFrom(utils,tail)
+importFrom(utils,write.table)

R/geom_coverage.R

@@ -26,14 +26,15 @@
 #' @return Layers of ggplot2.
 #' @importFrom ggplot2 aes_string scale_fill_manual geom_rect geom_text aes geom_step
 #' @importFrom rlang .data
-#' @importFrom grDevices colorRampPalette
+#' @importFrom grDevices colorRampPalette col2rgb
 #' @importFrom RColorBrewer brewer.pal
 #' @importFrom rlang as_label
 #' @importFrom stats as.formula
 #' @importFrom ggh4x facet_wrap2 strip_themed elem_list_rect
 #' @importFrom dplyr group_by summarise
 #' @importFrom magrittr %>%
 #' @importFrom ggrepel geom_text_repel
+#' @importFrom utils tail
 #'
 #' @export
 #' @examples
@@ -239,8 +240,10 @@ geom_coverage <- function(data, mapping = NULL, color = NULL, rect.color = NA,
     # prepare facet scale
     if (facet.y.scale == "free") {
       facet.ys <- "free_y"
+      data.range <- dplyr::group_by(data, .data[[facet.key]])
     } else if (facet.y.scale == "fixed") {
       facet.ys <- "fixed"
+      data.range <- data
     }
     region.facet <- facet_wrap2(
       facets = facet.formula, ncol = 1, scales = facet.ys, strip.position = "right",
@@ -256,11 +259,10 @@ geom_coverage <- function(data, mapping = NULL, color = NULL, rect.color = NA,
     }
 
     if (range.position == "in") {
-      data.range <- data %>%
-        dplyr::group_by(.data[[facet.key]]) %>%
+      data.range <- data.range %>%
         dplyr::summarise(.groups = "drop_last",
-                         min_score = CeilingNumber(min(.data[[ymax.str]])),
-                         max_score = CeilingNumber(max(.data[[ymax.str]]))
+                         min_score = pretty(.data[[ymax.str]])[1],
+                         max_score = tail(pretty(.data[[ymax.str]]), 1)
         )
       data.range$label <- paste0("[", data.range$min_score, ", ", data.range$max_score, "]")
       region.range <- geom_text(

R/geom_link.R

@@ -26,18 +26,24 @@
 #'
 #' @examples
 #' library(ggcoverage)
-#' # create test dataframe (random)
+#' # create test dataframe
+#' # (random, but use seed to obtain same result every time)
+#' set.seed(123)
 #' df <- data.frame(
-#'   seqnames = "chr9", start = seq(from = 4000000, to = 5999000, by = 1000),
-#'   end = seq(from = 4001000, to = 6000000, by = 1000), score = sample(1:100, 2000, replace = TRUE),
+#'   seqnames = "chr2L", start = seq(from = 8000000, to = 8300000, by = 1000),
+#'   end = seq(from = 8001000, to = 8301000, by = 1000), score = sample(1:100, 301, replace = TRUE),
 #'   Type = "Example", Group = "Example"
 #' )
+#' # get links
+#' link.file = system.file("extdata", "HiC", "HiC_link.bedpe", package = "ggcoverage")
+#'
 #' # create plot
 #' ggcoverage(
-#'   data = df, color = "grey", region = "chr9:4000000-6000000",
+#'   data = df, color = "grey",
 #'   mark.region = NULL, range.position = "out"
 #' ) +
 #'   geom_link(link.file = link.file, file.type = "bedpe", show.rect = TRUE)
+#'
 geom_link <- function(link.file, file.type = "bedpe", score.col = NULL, score.threshold = NULL,
                       score.color = c("blue", "grey", "red"), scale.range = 10,
                       plot.space = 0.1, plot.height = 0.2, show.rect = FALSE) {

R/geom_protein.R

@@ -35,13 +35,13 @@
 #' @export
 #'
 #' @examples
-#' # library(ggplot2)
-#' # library(ggcoverage)
-#' # coverage.file <- system.file("extdata", "Proteomics", "MS_BSA_coverage.xlsx", package = "ggcoverage")
-#' # fasta.file <- system.file("extdata", "Proteomics", "MS_BSA_coverage.fasta", package = "ggcoverage")
-#' # protein.id = "sp|
-#' # ggplot() +
-#' #     geom_peptide(coverage.file = coverage.file, fasta.file = fasta.file, protein.id = protein.id)
+#' library(ggplot2)
+#' library(ggcoverage)
+#' coverage.file <- system.file("extdata", "Proteomics", "MS_BSA_coverage.xlsx", package = "ggcoverage")
+#' fasta.file <- system.file("extdata", "Proteomics", "MS_BSA_coverage.fasta", package = "ggcoverage")
+#' protein.id = "sp|P02769|ALBU_BOVIN"
+#' ggplot() +
+#'   geom_protein(coverage.file = coverage.file, fasta.file = fasta.file, protein.id = protein.id)
 geom_protein <- function(coverage.file, fasta.file, protein.id, XCorr.threshold = 2,
                          confidence = "High", contaminant = NULL, remove.na = TRUE,
                          color = "grey", mark.bare = TRUE, mark.color = "red", mark.alpha = 0.5,
@@ -187,7 +187,7 @@ geom_protein <- function(coverage.file, fasta.file, protein.id, XCorr.threshold
   # range position
   if (range.position == "in") {
     # prepare range
-    max.abundance <- CeilingNumber(max(coverage.final$abundance))
+    max.abundance <- max(pretty(coverage.final$abundance))
     abundance.range <- data.frame(label = paste0("[0, ", scales::scientific(max.abundance, digits = 2), "]"))
     range.text <- geom_text(
       data = abundance.range,

R/geom_tad.R

@@ -21,9 +21,54 @@
 #' @importFrom ggplot2 ggplot_add ggplot labs theme_classic theme element_blank element_rect
 #' element_text margin scale_y_continuous scale_x_continuous
 #' @importFrom patchwork wrap_plots
+#' @importFrom utils write.table
 #'
-#' @export
+#' @examples
+#' library(ggcoverage)
+#' library(GenomicRanges)
+#'
+#' # prepare track dataframe
+#' track.file = system.file("extdata", "HiC", "H3K36me3.bw", package = "ggcoverage")
+#' track.df = LoadTrackFile(track.file = track.file, format = "bw",
+#'                          region = "chr2L:8050000-8300000", extend = 0)
+#' track.df$score = ifelse(track.df$score <0, 0, track.df$score)
+#' # check the data
+#' head(track.df)
+#'
+#' # Load Hi-C data
+#' hic.mat.file = system.file("extdata", "HiC", "HiC_mat.txt", package = "ggcoverage")
+#' hic.mat = read.table(file = hic.mat.file, sep = "\t")
+#' hic.mat = as.matrix(hic.mat)
+#'
+#' # bin data
+#' hic.bin.file = system.file("extdata", "HiC", "HiC_bin.txt", package = "ggcoverage")
+#' hic.bin = read.table(file = hic.bin.file, sep = "\t")
+#' colnames(hic.bin) = c("chr", "start", "end")
+#' hic.bin.gr = GenomicRanges::makeGRangesFromDataFrame(df = hic.bin)
+#'
+#' # transfrom function
+#' FailSafe_log10 <- function(x){
+#'   x[is.na(x) | is.nan(x) | is.infinite(x)] <- 0
+#'   return(log10(x+1))
+#' }
 #'
+#' # load link data: prepare arcs
+#' link.file = system.file("extdata", "HiC", "HiC_link.bedpe", package = "ggcoverage")
+#'
+#' # basic coverage
+#' basic.coverage = ggcoverage(
+#'   data = track.df, color = "grey",
+#'   mark.region = NULL, range.position = "out"
+#' )
+#'
+#' # add annotations
+#' basic.coverage +
+#'   geom_tad(matrix = hic.mat, granges = hic.bin.gr, value.cut = 0.99,
+#'            color.palette = "viridis", transform.fun = FailSafe_log10,
+#'            top = FALSE, show.rect = TRUE) +
+#'   geom_link(link.file = link.file, file.type = "bedpe", show.rect = TRUE)
+#'
+#' @export
 geom_tad <- function(matrix, granges, color.palette = NULL, value.cut = NULL,
                      transform.fun = NULL, plot.space = 0.1, plot.height = 1,
                      top = TRUE, show.rect = FALSE) {
@@ -35,7 +80,6 @@ geom_tad <- function(matrix, granges, color.palette = NULL, value.cut = NULL,
   class = "tad"
   )
 }
-
 #' @export
 ggplot_add.tad <- function(object, plot, object_name) {
   # get plot data

R/geom_tad2.R

@@ -20,7 +20,10 @@ theme_coverage <- function(space = 0.2) {
       axis.title = element_blank()
     ),
     ggplot2::annotate("segment", x = -Inf, xend = Inf, y = -Inf, yend = -Inf, size = rel(1)),
-    scale_y_continuous(expand = expansion(mult = c(0))),
+    scale_y_continuous(
+      limits = ~ c(pretty(.x)[1], tail(pretty(.x), 1)),
+      expand = expansion(mult = c(0))
+    ),
     scale_x_continuous(labels = scales::comma, expand = c(0, 0))
   )
 }
@@ -39,7 +42,7 @@ theme_coverage <- function(space = 0.2) {
 theme_coverage2 <- function(space = 0.2) {
   list(
     scale_y_continuous(
-      limits = ~ c(0, CeilingNumber(max(.x))),
+      limits = ~ range(pretty(.x)),
       breaks = ~ .x[2],
       expand = expansion(mult = c(0))
     ),
@@ -484,7 +487,7 @@ theme_cnv <- function(x.range, margin.len) {
   )
 }
 
-# theme for ggprotein: suitable for range position is in
+# theme for ggprotein: suitable for range.position = "in"
 #' Theme for geom_protein.
 #'
 #' @return List of layers.
@@ -508,7 +511,7 @@ theme_protein <- function() {
   )
 }
 
-# theme for ggprotein: suitable for range position is out
+# theme for ggprotein: suitable for range.position = "out"
 #' Theme for geom_protein.
 #'
 #' @return List of layers.
@@ -520,7 +523,7 @@ theme_protein <- function() {
 theme_protein2 <- function() {
   list(
     scale_y_continuous(
-      limits = ~ c(0, CeilingNumber(max(.x)), digits = 2),
+      limits = ~ range(pretty(.x)),
       breaks = ~ .x[2],
       expand = expansion(mult = c(0)),
       labels = function(x) format(x, scientific = TRUE, digits = 2)