R/get_toplevel_sequence_info.R

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

toplevel_sequence_info_tbl <- function(species_name = character(),
                                       toplevel_sequence = character(),
                                       is_chromosome = logical(),
                                       coordinate_system = character(),
                                       assembly_exception_type = character(),
                                       is_circular = logical(),
                                       assembly_name = character(),
                                       length = double()) {
  tibble::tibble(species_name = species_name,
                 toplevel_sequence = toplevel_sequence,
                 is_chromosome = is_chromosome,
                 coordinate_system = coordinate_system,
                 assembly_exception_type = assembly_exception_type,
                 is_circular = is_circular,
                 assembly_name = assembly_name,
                 length = length)
}

parse_toplevel_sequence_info <- function(species_name, toplevel_sequence, lst) {

  toplevel_sequence_info_tbl(species_name = species_name,
                             toplevel_sequence = toplevel_sequence,
                             is_chromosome = as.logical(lst$is_chromosome),
                             coordinate_system = lst$coordinate_system,
                             assembly_exception_type = lst$assembly_exception_type,
                             is_circular = as.logical(lst$is_circular),
                             assembly_name = lst$assembly_name,
                             length = lst$length)
}

#' Get toplevel sequences details
#'
#' This function retrieves a few extra details about a toplevel sequence. These
#' sequences correspond to genomic regions in the genome assembly that are not a
#' component of another sequence region. Thus, toplevel sequences will be
#' chromosomes and any unlocalised or unplaced scaffolds.
#'
#' @param species_name The species name, i.e., the scientific name, all letters
#'   lowercase and space replaced by underscore. Examples: \code{'homo_sapiens'}
#'   (human), \code{'ovis_aries'} (Domestic sheep) or \code{'capra_hircus'}
#'   (Goat).
#' @param toplevel_sequence A toplevel sequence name, e.g. chromosome names such
#'   as `"1"`, `"X"`, or `"Y"`, or a non-chromosome sequence, e.g., a scaffold
#'   such as `"KI270757.1"`.
#' @param verbose Whether to be chatty.
#' @param warnings Whether to print warnings.
#' @param progress_bar Whether to show a progress bar.
#'
#' @return A \code{\link[tibble]{tibble}}, each row being a toplevel sequence,
#'   of 8 variables:
#' \describe{
#' \item{`species_name`}{Ensembl species name: this is the name used internally
#' by Ensembl to uniquely identify a species by name. It is the scientific name
#' but formatted without capitalisation and spacing converted with an
#' underscore, e.g., \code{'homo_sapiens'}.}
#' \item{`toplevel_sequence`}{Name of the toplevel sequence.}
#' \item{`is_chromosome`}{A logical indicating whether the toplevel sequence is
#' a chromosome (`TRUE`) or not (`FALSE`).}
#' \item{`coord_system`}{Coordinate system type.}
#' \item{`assembly_exception_type`}{Coordinate system type.}
#' \item{`is_circular`}{A logical indicating whether the toplevel sequence is a
#' circular sequence (`TRUE`) or not (`FALSE`).}
#' \item{`assembly_name`}{Assembly name.}
#' \item{`length`}{Genomic length toplevel sequence in base pairs.}
#' }
#'
#'
#' @md
#' @examples
#' # Get details about human chromosomes (default)
#' get_toplevel_sequence_info()
#'
#' # Get details about a scaffold
#' # (To find available toplevel sequences to query use the function
#' # `get_toplevel_sequences()`)
#' get_toplevel_sequence_info(species_name = 'homo_sapiens', toplevel_sequence = 'KI270757.1')
#'
#' @seealso [get_toplevel_sequences()]
#'
#' @export
get_toplevel_sequence_info <- function(species_name = 'homo_sapiens',
                                       toplevel_sequence = c(1:22, 'X', 'Y', 'MT'),
                                       verbose = FALSE,
                                       warnings = TRUE,
                                       progress_bar = TRUE) {

  error_msg <- glue::glue(
    'All arguments must have consistent lengths, ',
    'only values of length one are recycled:\n',
    '* Length of `species_name`: {length(species_name)}\n',
    '* Length of `toplevel_sequence`: {length(toplevel_sequence)}\n'
  )

  if (!are_vec_recyclable(species_name,
                          toplevel_sequence)) {
    rlang::abort(error_msg)
  }

  recycled_args <- vctrs::vec_recycle_common(species_name,
                                             toplevel_sequence)

  # The order of names here should be same as passed to
  # vctrs::vec_recycle_common()
  names(recycled_args) <-
    c(
      'species_name',
      'toplevel_sequence'
    )

  resource_urls <- glue::glue('/info/assembly/',
                              '{recycled_args$species_name}/{recycled_args$toplevel_sequence}')

  responses <-
    request_parallel(
      resource_urls,
      verbose = verbose,
      warnings = warnings,
      progress_bar = progress_bar
    )

  # Only keep those responses that responded successfully, i.e. with status == "OK".
  responses_ok <-
    purrr::keep(responses,
                ~ identical(.x$status, 'OK') &&
                  !rlang::is_empty(.x$content))
  if (rlang::is_empty(responses_ok))
    return(toplevel_sequence_info_tbl())

  return(purrr::imap_dfr(
    .x = responses_ok,
    .f = ~ parse_toplevel_sequence_info(
      species_name = recycled_args$species_name[.y],
      toplevel_sequence = recycled_args$toplevel_sequence[.y],
      lst = .x$content
    )
  ))

}