#' A 'ggplot2' geom to draw genes as arrows
#'
#' `geom_gene_arrow` draws genes as arrows, allowing gene maps to be drawn.
#'
#' This geom draws genes arranged along a horizontal 'string' representing the
#' molecule. The start and end positions of the gene are expressed with the
#' `xmin` and `xmax` aesthetics, while the molecule can be specified with the
#' `y` aesthetic.
#'
#' Unless the plot is faceted with a free x scale, all the molecules will share
#' a common x-axis. This means that if the genes are in very different numerical
#' positions, they might appear very small and squished together. To get around
#' this, either facet the plot with `scales = "free_x"`, or normalise the gene
#' positions if their exact positions are not important.
#'
#' See `make_alignment_dummies` for a method to align genes between molecules.
#'
#' @section Aesthetics:
#'
#' \itemize{
#' \item xmin,xmax (start and end of the gene; will be used to determine
#' gene orientation)
#' \item y (molecule)
#' \item alpha
#' \item colour
#' \item fill
#' \item linetype
#' \item size
#' }
#'
#' @param mapping,data,stat,position,na.rm,show.legend,inherit.aes,... As
#' standard for ggplot2.
#' @param arrowhead_width grid::unit object giving the width of the arrowhead.
#' Defaults to 4 mm. If the gene is drawn smaller than this width, only the
#' arrowhead will be drawn, compressed to the length of the gene.
#' @param arrowhead_height grid::unit object giving the height of the arrowhead.
#' Defaults to 4 mm.
#' @param arrow_body_height grid::unit object giving the height of the body of
#' the arrow. Defaults to 3 mm.
#'
#' @examples
#'
#' ggplot2::ggplot(example_genes, ggplot2::aes(xmin = start, xmax = end,
#' y = molecule, fill = gene)) +
#' geom_gene_arrow() +
#' ggplot2::facet_wrap(~ molecule, scales = "free")
#'
#' @seealso theme_genes, make_alignment_dummies
#'
#' @export
geom_gene_arrow <- function(
mapping = NULL,
data = NULL,
stat = "identity",
position = "identity",
na.rm = FALSE,
show.legend = NA,
inherit.aes = TRUE,
arrowhead_width = grid::unit(4, "mm"),
arrowhead_height = grid::unit(4, "mm"),
arrow_body_height = grid::unit(3, "mm"),
...
) {
ggplot2::layer(
geom = GeomGeneArrow, mapping = mapping, data = data, stat = stat,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(
na.rm = na.rm,
arrowhead_width = arrowhead_width,
arrowhead_height = arrowhead_height,
arrow_body_height = arrow_body_height,
...
)
)
}
#' GeomGeneArrow
#' @noRd
GeomGeneArrow <- ggplot2::ggproto("GeomGeneArrow", ggplot2::Geom,
required_aes = c("xmin", "xmax", "y"),
default_aes = ggplot2::aes(
alpha = 1,
colour = "black",
fill = "white",
linetype = 1,
size = 0.3
),
draw_key = function(data, params, size) {
grid::rectGrob(
width = grid::unit(1, "npc") - grid::unit(1, "mm"),
height = grid::unit(1, "npc") - grid::unit(1, "mm"),
gp = grid::gpar(
col = data$colour,
fill = ggplot2::alpha(data$fill, data$alpha),
lty = data$linetype,
lwd = data$size * ggplot2::.pt
)
)
},
draw_panel = function(
data,
panel_scales,
coord,
arrowhead_width,
arrowhead_height,
arrow_body_height
) {
data <- coord$transform(data, panel_scales)
gt <- grid::gTree(
data = data,
cl = "genearrowtree",
arrowhead_width = arrowhead_width,
arrowhead_height = arrowhead_height,
arrow_body_height = arrow_body_height
)
gt$name <- grid::grobName(gt, "geom_gene_arrow")
gt
}
)
#' @importFrom grid makeContent
#' @export
makeContent.genearrowtree <- function(x) {
data <- x$data
# Prepare grob for each gene
grobs <- lapply(1:nrow(data), function(i) {
gene <- data[i, ]
# Determine orientation
orientation <- ifelse(gene$xmax > gene$xmin, 1, -1)
# Arrowhead defaults to 4 mm, unless the gene is shorter in which case the
# gene is 100% arrowhead
arrowhead_width <- as.numeric(grid::convertWidth(x$arrowhead_width, "native"))
gene_width <- abs(gene$xmax - gene$xmin)
arrowhead_width <- ifelse(
arrowhead_width > gene_width,
gene_width,
arrowhead_width
)
# Calculate x-position of flange
flangex <- (-orientation * arrowhead_width) + gene$xmax
# Set arrow and arrowhead heights; it's convenient to divide these by two
# for calculating y positions on the polygon
arrowhead_height <- as.numeric(grid::convertHeight(x$arrowhead_height, "native")) / 2
arrow_body_height <- as.numeric(grid::convertHeight(x$arrow_body_height, "native")) / 2
# Create polygon grob
pg <- grid::polygonGrob(
x = c(
gene$xmin,
gene$xmin,
flangex,
flangex,
gene$xmax,
flangex,
flangex
),
y = c(
gene$y + arrow_body_height,
gene$y - arrow_body_height,
gene$y - arrow_body_height,
gene$y - arrowhead_height,
gene$y,
gene$y + arrowhead_height,
gene$y + arrow_body_height
),
gp = grid::gpar(
fill = ggplot2::alpha(gene$fill, gene$alpha),
col = ggplot2::alpha(gene$colour, gene$alpha),
lty = gene$linetype,
lwd = gene$size * ggplot2::.pt
)
)
# Return the polygon grob
pg
})
class(grobs) <- "gList"
grid::setChildren(x, grobs)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.