Skip to content

Commit

Permalink
Merge pull request #41 from m-jahn/dev
Browse files Browse the repository at this point in the history 
fix: various minor issues
  • Loading branch information
@showteeth
showteeth authored Jan 9, 2025
2 parents 3aa2d4d + 1d9174f commit 36ec796
Show file tree
Hide file tree
Showing 12 changed files with 496 additions and 284 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -57,4 +57,4 @@ VignetteBuilder:
knitr
biocViews:
Encoding: UTF-8
RoxygenNote: 7.3.1
RoxygenNote: 7.3.2
1 change: 1 addition & 0 deletions NAMESPACE
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
59 changes: 26 additions & 33 deletions R/geom_coverage.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
#'
Expand Down Expand Up @@ -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)
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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.")
Expand All @@ -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)
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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") {
Expand Down Expand Up @@ -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,
Expand Down
2 changes: 1 addition & 1 deletion R/geom_feature.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
115 changes: 88 additions & 27 deletions R/geom_gene.R
View file
Original file line number Diff line number Diff line change
@@ -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
Expand Down Expand Up @@ -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"
Expand All @@ -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,
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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)) {
Expand Down Expand Up @@ -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(
Expand Down
Loading

0 comments on commit 36ec796

Please sign in to comment.