R/position_variant.R

In gggenomes: A Grammar of Graphics for Comparative Genomics

#' Plot types of mutations with different offsets
#'
#' `position_variant()` allows the user to plot the different mutation types (e.g. del, ins, snps) at different offsets from the base.
#' This can especially be useful to highlight in which regions certain types of mutations have higher prevalence.
#' This position adjustment is most relevant for the analysis/visualization of VCF files with the function `geom_variant()`.
#'
#' @param offset Shifts the data up/down based on the type of mutation.
#' By default `offset = c(del=0.1, snp=0, ins=-0.1)`.
#' The user can supply an own vector to `offset` to indicate at which offsets the different mutation types should be plotted.
#' *Types of mutations that have not been specified within the vector, will be plotted with an offset of 0.*
#' @param base How to align the offsets relative to the sequence. At base = 0, plotting of the offsets starts
#'   from the sequence. `base` thus moves the entire feature up/down.
#' @return A ggproto object to be used in `geom_variant()`.
#' @export
#' @examples
#' # Creation of example data.
#' testposition <- tibble::tibble(
#'   type = c("ins", "snp", "snp", "del", "del", "snp", "snp", "ins", "snp", "ins", "snp"),
#'   start = c(10, 20, 30, 35, 40, 60, 65, 90, 90, 100, 120),
#'   end = start + 1,
#'   seq_id = c(rep("A", 11))
#' )
#' testseq <- tibble::tibble(
#'   seq_id = "A",
#'   start = 0,
#'   end = 150,
#'   length = end - start
#' )
#'
#' p <- gggenomes(seqs = testseq, feats = testposition)
#'
#' # This first plot shows what is being plotted when only geom_variant is called
#' p + geom_variant()
#'
#' # Next lets use position_variant, and change the shape aesthetic by column `type`
#' p + geom_variant(aes(shape = type), position = position_variant())
#'
#' # Now lets create a plot with different offsets by inserting a self-created vector.
#' p + geom_variant(
#'   aes(shape = type),
#'   position = position_variant(c(del = 0.4, ins = -0.4))
#' ) + scale_shape_variant()
#'
#' # Changing the base will shift all points up/down relatively from the sequence.
#' p + geom_variant(
#'   aes(shape = type),
#'   position = position_variant(base = 0.5)
#' ) + geom_seq()
#'
position_variant <- function(offset = c(del = 0.1, snp = 0, ins = -0.1), base = 0) {
  ggproto(NULL, PositionVariant, offset = offset, base = base)
}

PositionVariant <- ggproto("PositionVariant", Position,
  offset = c(del = 0.1, snp = 0, ins = -0.1),
  base = 0,
  required_aes = c("y"),
  optional_aes = c("yend"),
  setup_params = function(self, data) {
    list(offset = self$offset, base = self$base)
  },
  compute_panel = function(data, params, scales) {
    offsetdf <- tibble::enframe(params$offset)
    # Enframe creates a dataframe where offset values are stored in column 'value' and the type of mutation in column `name`.
    data <- left_join(data, offsetdf, by = c("type" = "name"))
    data <- replace_na(data, list(value = 0))

    # Gives a warning when the offset of certain (mutation) types is not mentioned.
    data <- mutate(data, logical = ifelse(data$type %in% offsetdf$name, TRUE, FALSE))
    if (sum(data$logical) / length(data$logical) < 1) {
      rlang::warn("Some mutation types are not mentioned within the offset argument. These types will have an offset of 0 by default")
    }

    if ("yend" %in% names(data)) {
      data <- mutate(data, y = y + as.numeric(value) + params$base, yend = yend + as.numeric(value) + params$base)
    } else {
      data <- mutate(data, y = y + as.numeric(value) + params$base)
    }
    data
  }
)