R/data_frame.R

In GMOD/JBrowseR: An R Interface to the JBrowse 2 Genome Browser

#' Create a track from an R data frame for a custom JBrowse 2 view
#'
#' Creates the necessary configuration string for an R data frame so that it can
#' be viewed as a track in a JBrowse custom linear genome view.
#'
#' @param track_data the data frame with track data. Must have cols:
#'   \code{chrom}, \code{start}, \code{end}, \code{name}. The column
#'   \code{additional} can optionally be include with more feature information.
#'   If a \code{score} column is present, it will be used and the track will
#'   be rendered to display quantitative features.
#' @param track_name the name to use for the track
#' @param assembly the config string generated by \code{assembly}
#'
#' @return a character vector of stringified track JSON configuration
#'
#' @export
#'
#' @examples
#' assembly <- assembly("https://jbrowse.org/genomes/hg19/fasta/hg19.fa.gz", bgzip = TRUE)
#'
#' df <- data.frame(
#'         chrom = c(1, 2),
#'         start = c(123, 456),
#'         end = c(789, 101112),
#'         name = c('feature1', 'feature2')
#'       )
#'
#' track_data_frame(df, "my_features", assembly)
track_data_frame <- function(track_data, track_name, assembly) {
  check_df(track_data)

  if (is.element("score", colnames(track_data))) {
    type <- "QuantitativeTrack"
  } else {
    type <- "FeatureTrack"
  }
  name <- track_name
  assembly_name <- get_assembly_name(assembly)
  track_id <- stringr::str_c(assembly_name, "_", name)
  adapter <- get_from_config_adapter(track_data)

  as.character(
    stringr::str_glue(
      "{{ ",
      '"type": "{type}", ',
      '"name": "{name}", ',
      '"assemblyNames": ["{assembly_name}"], ',
      '"trackId": "{track_id}", ',
      "{adapter} ",
      '}}'
    )
  )
}

check_df <- function(track_data) {
  if (!is.data.frame(track_data)) {
    stop("track data must be a data frame.")
  }
  if (invalid_cols(track_data)) {
   stop("data frame must contain columns: chrom, start, end, name.")
  }
}

invalid_cols <- function(df) {
  columns_present <- is.element(c("chrom", "start", "end", "name"), colnames(df))
  is.element(FALSE, columns_present)
}

get_from_config_adapter <- function(track_data) {
  feature_data <- get_feature_data(track_data)

  as.character(
    stringr::str_glue(
      '"adapter": {{ ',
      '"type": "FromConfigAdapter", ',
      '"features": [{feature_data}] ',
      "}}"
    )
  )
}

get_feature_data <- function(track_data) {
  if (!is.element("additional", colnames(track_data))) {
    track_data[["additional"]] <- ""
  }

  if (is.element("score", colnames(track_data))) {
    new_df <- track_data %>%
      dplyr::mutate(
        string_val = stringr::str_glue(
          "{{",
          '"refName": "{chrom}", ',
          '"start": {start}, ',
          '"end": {end}, ',
          '"uniqueId": "{ids::random_id()}", ',
          '"name": "{name}", ',
          '"type": "", ',
          '"score": {score}, ',
          '"additional": "{additional}" ',
          "}}"
        )
      )
  } else {
    new_df <- track_data %>%
      dplyr::mutate(
        string_val = stringr::str_glue(
          "{{",
          '"refName": "{chrom}", ',
          '"start": {start}, ',
          '"end": {end}, ',
          '"uniqueId": "{ids::random_id()}", ',
          '"name": "{name}", ',
          '"type": "", ',
          '"additional": "{additional}" ',
          "}}"
        )
      )
  }

  stringr::str_c(new_df$string_val, collapse = ", ")
}