R/genomic_range.R

In ramiromagno/ensemblr: R Client for the Ensembl REST API

#' Create genomic range strings
#'
#' This function converts three vectors: \code{chr}, \code{start}, and \code{end}
#' to strings of the form \{chr\}:\{start\}..\{end\}.
#'
#' @param chr A character vector of chromosome names.
#' @param start An integer vector of start positions.
#' @param end An integer vector of end positions.
#' @param starting_position_index Use this argument to indicate if the positions
#' are 0-based (\code{0L}) or 1-based (\code{1L}). This value is used to check
#' if positions are equal or above this number.
#' @return Returns a character vector whose strings are genomic ranges of the
#' form \{chr\}:\{start\}..\{end\}.
#'
#' @examples
#' genomic_range("1", 10000L, 20000L) # Returns "1:10000..20000"
#'
#' @export
genomic_range <- function(chr, start, end, starting_position_index = 1L) {
  if (!(identical(starting_position_index, 0L) || identical(starting_position_index, 1L))) {
    stop("starting_position_index must be either 0L or 1L.")
  }

  if (!is.character(chr)) {
    stop("chr needs to a character vector.")
  }

  if (identical(length(chr), 0L)) {
    stop("chr is empty, must have at least one chromosome name.")
  }

  if (!is.integer(start)) {
    stop("start needs to an integer vector.")
  }

  if (identical(length(start), 0L)) {
    stop("start is empty, must have at least one start position.")
  }

  if (!is.integer(end)) {
    stop("end needs to an integer vector.")
  }

  if (identical(length(end), 0L)) {
    stop("end is empty, must have at least one end position.")
  }

  n_chr <- length(chr)
  n_start <- length(start)
  n_end <- length(end)
  if (!(identical(n_start, n_end) && identical(n_start, n_chr))) { # identical(n_end, n_chr) == TRUE follows.
    stop(
      "chr, start and end vectors should be of same length: ",
      "len(chr) = ", n_chr, ", ",
      "len(start) = ", n_start, ", and ",
      "len(end) = ", n_end, "."
    )
  }

  is_start_below_starting_pos <- start < starting_position_index
  if (any(is_start_below_starting_pos)) {
    stop(
      "All start positions must be greater than ", starting_position_index, ", these are not: ",
      concatenate::cc_and(start[is_start_below_starting_pos], oxford = TRUE), "."
    )
  }

  is_end_below_starting_pos <- end < starting_position_index
  if (any(is_end_below_starting_pos)) {
    stop(
      "All end positions must be greater than ", starting_position_index, ", these are not: ",
      concatenate::cc_and(end[is_end_below_starting_pos], oxford = TRUE), "."
    )
  }

  # Generate genomic ranges strings.
  gen_ranges <- sprintf("%s:%d..%d", chr, start, end)

  # When is start greater than end? (should not happen.)
  start_gr_end <- start > end
  if (any(start_gr_end)) {
    stop(
      "start positions cannot be larger than end positions: ",
      concatenate::cc_and(gen_ranges[start_gr_end], oxford = TRUE), "."
    )
  }

  # Check that all genomic ranges' strings conform to criteria of is_genomic_range.
  is_gen_ranges <- is_genomic_range(gen_ranges)
  if (!all(is_gen_ranges)) {
    stop(
      "The following are not well-formed genomic ranges: ",
      concatenate::cc_and(gen_ranges[!is_gen_ranges], oxford = TRUE), "."
    )
  }

  return(gen_ranges)
}

is_genomic_range <- function(genomic_range) {
  stringr::str_detect(genomic_range, "\\w+:\\d+\\.\\.\\d+")
}

split_genomic_range <- function(genomic_range) {
  split_coordinates <- stringr::str_match(
    genomic_range,
    "^(\\w+):(\\d+)\\.\\.(\\d+)$"
  )[, -1, drop = FALSE]

  colnames(split_coordinates) <- c("chromosome", "start", "end")
  return(split_coordinates)
}