R/jellyfisher.R

In jellyfisher: Visualize Spatiotemporal Tumor Evolution with Jellyfish Plots

# Auto-generated by generate-R-code.mjs
# Do not edit this file manually

#' Creates a Jellyfish plot
#'
#' Creates a Jellyfish plot from samples, a phylogeny, and subclonal compositions.
#'
#' The format of the data frames is described with examples in Jellyfish documentation:
#' https://github.com/HautaniemiLab/jellyfish?tab=readme-ov-file#input-data
#'
#' @param tables A named list of data frames. The list must contain the following elements:
#'   \describe{
#'     \item{\code{samples}}{A data frame with sample data. The expected columns are:
#'   \describe{
#'   \item{sample}{specifies the unique identifier for each sample. (string)}
#'   \item{displayName}{allows for specifying a custom name for each sample. If the column is omitted, the `sample` column is used as the display name. (string, optional)}
#'   \item{rank}{specifies the position of each sample in the Jellyfish plot. For example, different stages of a disease can be ranked in chronological order: diagnosis (1), interval (2), and relapse (3). The zeroth rank is reserved for the root of the sample tree. Ranks can be any integer, and unused ranks are automatically excluded from the plot. If the `rank` column is (integer)}
#'   \item{parent}{identifies the parent sample for each entry. Samples without a specified parent are treated as children of an imaginary root sample. (string)}
#'   }
#'     }
#'     \item{\code{phylogeny}}{A data frame with phylogeny data. The expected columns are:
#'   \describe{
#'   \item{subclone}{specifies subclone IDs, which can be any string. (string)}
#'   \item{parent}{designates the parent subclone. The subclone without a parent is considered the root of the phylogeny. (string)}
#'   \item{color}{specifies the color for the subclone. If the column is omitted, colors will be generated automatically. (string, optional)}
#'   \item{branchLength}{specifies the length of the branch leading to the subclone. The length may be based on, for example, the number of unique mutations in the subclone. The branch length is shown in the Jellyfish plot's legend as a bar chart. It is also used when generating a phylogeny-aware color scheme. (number)}
#'   }
#'     }
#'     \item{\code{compositions}}{A data frame with subclonal compositions. The expected columns are:
#'   \describe{
#'   \item{sample}{specifies the sample ID. (string)}
#'   \item{subclone}{specifies the subclone ID. (string)}
#'   \item{clonalPrevalence}{specifies the clonal prevalence of the subclone in the sample. The clonal prevalence is the proportion of the subclone in the sample. The clonal prevalences in a sample must sum to 1. (number)}
#'   }
#'     }
#'     \item{\code{ranks}}{An optional data frame with ranks. The expected columns are:
#'   \describe{
#'   \item{rank}{specifies the rank number. The zeroth rank is reserved for the inferred root of the sample tree. However, you are free to define a title for it. (integer)}
#'   \item{title}{specifies the title for the rank. (string)}
#'   }
#'     }
#'   }
#' @param options A named list of options to configure the plot. Available options:
#'   \describe{
#'   \item{crossingWeight}{Weight for tentacle bundles between two pairs of samples crossing each other. Defaults to \code{10}.}
#'   \item{pathLengthWeight}{Weight for the total length of the paths (tentacle bundles) connecting samples. Defaults to \code{2}.}
#'   \item{orderMismatchWeight}{Weight for the mismatch in the order of samples. The order is based on the "phylogenetic center of mass" computed from the subclonal compositions. Defaults to \code{2}.}
#'   \item{bundleMismatchWeight}{Weight for the mismatch in the placement of bundles. The "optimal" placement is based on the subclonal compositions, but such placement may produce excessively long tentacle bundles. Defaults to \code{3}.}
#'   \item{divergenceWeight}{Weight for the sum of divergences between adjacent samples. Defaults to \code{4}.}
#'   \item{bellTipShape}{The shape of the bell tip. 0 is a sharp tip, 1 is a blunt tip. Defaults to \code{0.1}.}
#'   \item{bellTipSpread}{How much to spread nested bell tips. 0 is no spread, 1 is full spread. Defaults to \code{0.5}.}
#'   \item{bellStrokeWidth}{The width of strokes in the bell. Defaults to \code{1}.}
#'   \item{bellStrokeDarkening}{How much the stroke color of the bells is darkened. Defaults to \code{0.6}.}
#'   \item{bellPlateauPos}{Where the bell has fully appeared and the plateau starts. Defaults to \code{0.75}.}
#'   \item{sampleHeight}{Height of real sample nodes Defaults to \code{110}.}
#'   \item{sampleWidth}{Width of sample nodes Defaults to \code{90}.}
#'   \item{inferredSampleHeight}{Height of inferred sample nodes Defaults to \code{120}.}
#'   \item{gapHeight}{Height of gaps between samples. Gaps are routes for tentacle bundles. Defaults to \code{60}.}
#'   \item{sampleSpacing}{Vertical space between samples Defaults to \code{60}.}
#'   \item{columnSpacing}{Horizontal space between columns Defaults to \code{90}.}
#'   \item{tentacleWidth}{Width of tentacles in pixels Defaults to \code{2}.}
#'   \item{tentacleSpacing}{Space between tentacles in a bundle, in pixels Defaults to \code{5}.}
#'   \item{inOutCPDistance}{Relative distance of tentacle control points from the edge of the sample node Defaults to \code{0.3}.}
#'   \item{bundleCPDistance}{Relative distance of tentacle bundle's control points. The higher the value, the longer the individual tentacles stay together before diverging. Defaults to \code{0.6}.}
#'   \item{sampleFontSize}{Font size for sample labels Defaults to \code{12}.}
#'   \item{showLegend}{Whether to show the legend Defaults to \code{TRUE}.}
#'   \item{phylogenyColorScheme}{Whether to use a color scheme based on phylogeny Defaults to \code{TRUE}.}
#'   \item{phylogenyHueOffset}{Offset for the hue of the phylogeny color scheme. If the automatically generated hues are not to your liking, you can adjust the hue offset to get a different color scheme. Defaults to \code{0}.}
#'   \item{sampleTakenGuide}{Type of the "sample taken" guide. `"none"` for no guides, `"line"` for a faint dashed line in all samples, `"text"` same as line, but with a text label in one of the samples. `"text-all"` same as text, but with a text label in all samples. Defaults to \code{"text"}.}
#'   \item{showRankTitles}{Whether to show rank titles above the samples (if provided). Defaults to \code{TRUE}.}
#'   \item{normalsAtPhylogenyRoot}{Whether the root of the phylogenetic tree contains normal cells. If true, no tentacles will be drawn for the root clone and its color will be white if phylogenyColorScheme is used. Defaults to \code{FALSE}.}
#'   }
#' @param controls An optional parameter to set the initial state of the controls. Can be "open", "closed", or "hidden".
#' @param width The width of the widget
#' @param height The height of the widget
#' @param elementId An optional element ID for the widget
#'
#' @return A Jellyfish plot HTML widget
#'
#' @examples
#' # Plot the bundled example data
#' jellyfisher(jellyfisher_example_tables,
#'             options = list(
#'               sampleHeight = 70,
#'               sampleTakenGuide = "none",
#'               showLegend = FALSE
#'             ))
#'
#' @import htmlwidgets
#' @importFrom utils modifyList
#' @export
jellyfisher <- function(tables,
                        options = list(),
                        controls = "closed",
                        width = NULL,
                        height = NULL,
                        elementId = NULL) {
  validate_tables(tables)

  # Define default options
  defaultOptions <- list(
    crossingWeight = 10,
    pathLengthWeight = 2,
    orderMismatchWeight = 2,
    bundleMismatchWeight = 3,
    divergenceWeight = 4,
    bellTipShape = 0.1,
    bellTipSpread = 0.5,
    bellStrokeWidth = 1,
    bellStrokeDarkening = 0.6,
    bellPlateauPos = 0.75,
    sampleHeight = 110,
    sampleWidth = 90,
    inferredSampleHeight = 120,
    gapHeight = 60,
    sampleSpacing = 60,
    columnSpacing = 90,
    tentacleWidth = 2,
    tentacleSpacing = 5,
    inOutCPDistance = 0.3,
    bundleCPDistance = 0.6,
    sampleFontSize = 12,
    showLegend = TRUE,
    phylogenyColorScheme = TRUE,
    phylogenyHueOffset = 0,
    sampleTakenGuide = "text",
    showRankTitles = TRUE,
    normalsAtPhylogenyRoot = FALSE
  )

  # Merge user options with defaults
  options <- modifyList(defaultOptions, options)

  # Validate options
  if (!is.null(options$crossingWeight)) {
    if (!is.numeric(options$crossingWeight)) stop("crossingWeight must be numeric")
    if (options$crossingWeight < 0) stop("crossingWeight must be at least 0")
  }
  if (!is.null(options$pathLengthWeight)) {
    if (!is.numeric(options$pathLengthWeight)) stop("pathLengthWeight must be numeric")
    if (options$pathLengthWeight < 0) stop("pathLengthWeight must be at least 0")
  }
  if (!is.null(options$orderMismatchWeight)) {
    if (!is.numeric(options$orderMismatchWeight)) stop("orderMismatchWeight must be numeric")
    if (options$orderMismatchWeight < 0) stop("orderMismatchWeight must be at least 0")
  }
  if (!is.null(options$bundleMismatchWeight)) {
    if (!is.numeric(options$bundleMismatchWeight)) stop("bundleMismatchWeight must be numeric")
    if (options$bundleMismatchWeight < 0) stop("bundleMismatchWeight must be at least 0")
  }
  if (!is.null(options$divergenceWeight)) {
    if (!is.numeric(options$divergenceWeight)) stop("divergenceWeight must be numeric")
    if (options$divergenceWeight < 0) stop("divergenceWeight must be at least 0")
  }
  if (!is.null(options$bellTipShape)) {
    if (!is.numeric(options$bellTipShape)) stop("bellTipShape must be numeric")
    if (options$bellTipShape < 0) stop("bellTipShape must be at least 0")
    if (options$bellTipShape > 1) stop("bellTipShape must be no greater than 1")
  }
  if (!is.null(options$bellTipSpread)) {
    if (!is.numeric(options$bellTipSpread)) stop("bellTipSpread must be numeric")
    if (options$bellTipSpread < 0) stop("bellTipSpread must be at least 0")
    if (options$bellTipSpread > 1) stop("bellTipSpread must be no greater than 1")
  }
  if (!is.null(options$bellStrokeWidth)) {
    if (!is.numeric(options$bellStrokeWidth)) stop("bellStrokeWidth must be numeric")
    if (options$bellStrokeWidth < 0) stop("bellStrokeWidth must be at least 0")
    if (options$bellStrokeWidth > 10) stop("bellStrokeWidth must be no greater than 10")
  }
  if (!is.null(options$bellStrokeDarkening)) {
    if (!is.numeric(options$bellStrokeDarkening)) stop("bellStrokeDarkening must be numeric")
    if (options$bellStrokeDarkening < 0) stop("bellStrokeDarkening must be at least 0")
    if (options$bellStrokeDarkening > 2) stop("bellStrokeDarkening must be no greater than 2")
  }
  if (!is.null(options$bellPlateauPos)) {
    if (!is.numeric(options$bellPlateauPos)) stop("bellPlateauPos must be numeric")
    if (options$bellPlateauPos < 0) stop("bellPlateauPos must be at least 0")
    if (options$bellPlateauPos > 1) stop("bellPlateauPos must be no greater than 1")
  }
  if (!is.null(options$sampleHeight)) {
    if (!is.numeric(options$sampleHeight)) stop("sampleHeight must be numeric")
    if (options$sampleHeight < 10) stop("sampleHeight must be at least 10")
  }
  if (!is.null(options$sampleWidth)) {
    if (!is.numeric(options$sampleWidth)) stop("sampleWidth must be numeric")
    if (options$sampleWidth < 10) stop("sampleWidth must be at least 10")
  }
  if (!is.null(options$inferredSampleHeight)) {
    if (!is.numeric(options$inferredSampleHeight)) stop("inferredSampleHeight must be numeric")
    if (options$inferredSampleHeight < 10) stop("inferredSampleHeight must be at least 10")
  }
  if (!is.null(options$gapHeight)) {
    if (!is.numeric(options$gapHeight)) stop("gapHeight must be numeric")
    if (options$gapHeight < 0) stop("gapHeight must be at least 0")
  }
  if (!is.null(options$sampleSpacing)) {
    if (!is.numeric(options$sampleSpacing)) stop("sampleSpacing must be numeric")
    if (options$sampleSpacing < 0) stop("sampleSpacing must be at least 0")
  }
  if (!is.null(options$columnSpacing)) {
    if (!is.numeric(options$columnSpacing)) stop("columnSpacing must be numeric")
    if (options$columnSpacing < 10) stop("columnSpacing must be at least 10")
  }
  if (!is.null(options$tentacleWidth)) {
    if (!is.numeric(options$tentacleWidth)) stop("tentacleWidth must be numeric")
    if (options$tentacleWidth < 0) stop("tentacleWidth must be at least 0")
  }
  if (!is.null(options$tentacleSpacing)) {
    if (!is.numeric(options$tentacleSpacing)) stop("tentacleSpacing must be numeric")
    if (options$tentacleSpacing < 0) stop("tentacleSpacing must be at least 0")
  }
  if (!is.null(options$inOutCPDistance)) {
    if (!is.numeric(options$inOutCPDistance)) stop("inOutCPDistance must be numeric")
    if (options$inOutCPDistance < 0) stop("inOutCPDistance must be at least 0")
    if (options$inOutCPDistance > 0.45) stop("inOutCPDistance must be no greater than 0.45")
  }
  if (!is.null(options$bundleCPDistance)) {
    if (!is.numeric(options$bundleCPDistance)) stop("bundleCPDistance must be numeric")
    if (options$bundleCPDistance < 0) stop("bundleCPDistance must be at least 0")
    if (options$bundleCPDistance > 1.2) stop("bundleCPDistance must be no greater than 1.2")
  }
  if (!is.null(options$sampleFontSize)) {
    if (!is.numeric(options$sampleFontSize)) stop("sampleFontSize must be numeric")
    if (options$sampleFontSize < 0) stop("sampleFontSize must be at least 0")
  }
  if (!is.null(options$showLegend)) {
    if (!is.logical(options$showLegend)) stop("showLegend must be a boolean (TRUE or FALSE)")
  }
  if (!is.null(options$phylogenyColorScheme)) {
    if (!is.logical(options$phylogenyColorScheme)) stop("phylogenyColorScheme must be a boolean (TRUE or FALSE)")
  }
  if (!is.null(options$phylogenyHueOffset)) {
    if (!is.numeric(options$phylogenyHueOffset)) stop("phylogenyHueOffset must be numeric")
    if (options$phylogenyHueOffset < 0) stop("phylogenyHueOffset must be at least 0")
    if (options$phylogenyHueOffset > 360) stop("phylogenyHueOffset must be no greater than 360")
  }
  if (!is.null(options$sampleTakenGuide)) {
    if (!options$sampleTakenGuide %in% c("none", "line", "text", "text-all")) stop("sampleTakenGuide must be one of: none, line, text, text-all")
  }
  if (!is.null(options$showRankTitles)) {
    if (!is.logical(options$showRankTitles)) stop("showRankTitles must be a boolean (TRUE or FALSE)")
  }
  if (!is.null(options$normalsAtPhylogenyRoot)) {
    if (!is.logical(options$normalsAtPhylogenyRoot)) stop("normalsAtPhylogenyRoot must be a boolean (TRUE or FALSE)")
  }

  # Forward options using x
  x <- list(
    tables = tables,
    options = options,
    controls = controls 
  )

  # Create widget
  htmlwidgets::createWidget(
    name = "jellyfisher",
    x,
    width = width,
    height = height,
    package = "jellyfisher",
    elementId = elementId,
    sizingPolicy = htmlwidgets::sizingPolicy(
      viewer.padding = 0,
      viewer.fill = TRUE,
      defaultWidth = "100%",
      defaultHeight = "500px"
    )
  )
}