R/session.R

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

#' Create a default session for a custom JBrowse view
#'
#' Creates the necessary configuration string for a default session for your
#' browser. A default session is the set of tracks that are displayed when your
#' browser is first displayed.
#'
#' @param assembly the config string generated by \code{assembly}
#' @param displayed_tracks a vector of tracks generated by a \code{track_*}
#'   command.
#' @param display_assembly a boolean determining whether the reference sequence
#'   is visible or not. TRUE by default.
#'
#' @return a character vector of stringified JSON configuration for the
#'   defaultSession to be used by the browser when first loaded
#'
#' @export
#'
#' @examples
#' # create the assembly configuration
#' assembly <- assembly("https://jbrowse.org/genomes/hg19/fasta/hg19.fa.gz", bgzip = TRUE)
#'
#' # create variant and wiggle tracks
#' variant <- track_variant(
#'  "clinvar.vcf.gz",
#'  assembly
#' )
#' wiggle <- track_wiggle(
#'  "read-cov.bw",
#'  assembly
#' )
#'
#' # create a default session with those tracks open by default
#' default_session <- default_session(
#'  assembly,
#'  c(variant, wiggle)
#' )
default_session <- function(assembly, displayed_tracks, display_assembly = TRUE) {
  reference_track <- get_reference_track(assembly, display_assembly)
  tracks <- get_tracks(assembly, displayed_tracks, display_assembly)

  as.character(
    stringr::str_glue(
      "{{ ",
      '"name": "My Session", ',
      '"view": {{ ',
      '"id": "LinearGenomeView", ',
      '"type": "LinearGenomeView", ',
      '"tracks": [ ',
      "{reference_track} ",
      "{tracks} ",
      "] ",
      "}} ",
      "}}"
    )
  )
}

get_reference_track <- function(assembly, display_assembly) {
  assembly_name <- get_assembly_name(assembly)
  configuration <- stringr::str_c(assembly_name, "-ReferenceSequenceTrack")

  if (display_assembly) {
    as.character(
      stringr::str_glue(
        "{{ ",
        '"type": "ReferenceSequenceTrack", ',
        '"configuration": "{configuration}", ',
        '"displays": [ ',
        "{{ ",
        '"type": "LinearReferenceSequenceDisplay", ',
        '"configuration": "{stringr::str_c(configuration, "-LinearReferenceSequenceDisplay")}"',
        "}} ",
        "]",
        "}}"
      )
    )
  } else {
    ""
  }
}

get_tracks <- function(assembly, tracks, display_assembly) {
  tracks_result <- c()

  for (i in seq_along(tracks)) {
    track_list <- jsonlite::fromJSON(tracks[i])
    result <- switch(track_list$type,
      AlignmentsTrack = get_alignments_track(track_list),
      VariantTrack = get_variant_track(track_list),
      QuantitativeTrack = get_quantitative_track(track_list),
      FeatureTrack = get_feature_track(track_list)
    )
    tracks_result <- c(tracks_result, result)
  }

  tracks_result <- stringr::str_c(tracks_result, collapse = ", ")

  # append a comma to front if preceded by the assembly
  if (display_assembly) {
    stringr::str_c("", tracks_result, sep = ", ")
  } else {
    tracks_result
  }
}

get_alignments_track <- function(track_list) {
  as.character(
    stringr::str_glue(
      "{{ ",
      '"type": "AlignmentsTrack", ',
      '"configuration": "{track_list$trackId}", ',
      '"displays": [ ',
      "{{",
      '"type": "LinearAlignmentsDisplay", ',
      '"configuration": "{stringr::str_c(track_list$trackId, "-LinearAlignmentsDisplay")}" ',
      "}}",
      "]",
      "}}"
    )
  )
}

get_variant_track <- function(track_list) {
  as.character(
    stringr::str_glue(
      "{{ ",
      '"type": "VariantTrack", ',
      '"configuration": "{track_list$trackId}", ',
      '"displays": [ ',
      "{{",
      '"type": "LinearVariantDisplay", ',
      '"configuration": "{stringr::str_c(track_list$trackId, "-LinearVariantDisplay")}" ',
      "}}",
      "]",
      "}}"
    )
  )
}

get_quantitative_track <- function(track_list) {
  as.character(
    stringr::str_glue(
      "{{ ",
      '"type": "QuantitativeTrack", ',
      '"configuration": "{track_list$trackId}", ',
      '"displays": [ ',
      "{{",
      '"type": "LinearWiggleDisplay", ',
      '"configuration": "{stringr::str_c(track_list$trackId, "-LinearWiggleDisplay")}" ',
      "}}",
      "]",
      "}}"
    )
  )
}

get_feature_track <- function(track_list) {
  as.character(
    stringr::str_glue(
      "{{ ",
      '"type": "FeatureTrack", ',
      '"configuration": "{track_list$trackId}", ',
      '"displays": [ ',
      "{{",
      '"type": "LinearBasicDisplay", ',
      '"configuration": "{stringr::str_c(track_list$trackId, "-LinearBasicDisplay")}" ',
      "}}",
      "]",
      "}}"
    )
  )
}