R/onco.print.alter.func.R

In GRIN2: Genomic Random Interval (GRIN)

#' Construct Oncoprint Alteration Functions
#'
#' @description
#' Internal helper function used by \code{\link{onco.print.props}} to construct
#' the drawing functions used to represent lesion types in an oncoprint.
#' The function defines the background and the color, height, and width of
#' rectangles representing individual lesion categories.
#'
#' @param type.wdth.hgt.clr A data frame containing the graphical properties
#' for each lesion type. The data frame should contain the following columns:
#' \itemize{
#'   \item \code{type}: Lesion type.
#'   \item \code{clr}: Color assigned to the lesion type.
#'   \item \code{hgt}: Relative rectangle height.
#'   \item \code{wdth}: Rectangle width adjustment.
#' }
#'
#' @param bg.clr Background color of the oncoprint cells. Default is
#' \code{"#CCCCCC"}.
#'
#' @param bg.hgt Numeric value controlling the background rectangle height
#' adjustment. Default is \code{2}.
#'
#' @param bg.wdth Numeric value controlling the background rectangle width
#' adjustment. Default is \code{0.00005}.
#'
#' @return
#' A named character vector containing R expressions that define the
#' background and lesion-specific rectangle drawing functions used by
#' the oncoprint.
#'
#' @keywords internal
#' @noRd
onco.print.alter.func <- function(type.wdth.hgt.clr,
                                  bg.clr = "#CCCCCC",
                                  bg.hgt = 2,
                                  bg.wdth = 0.00005)
{
  size = nrow(type.wdth.hgt.clr)

  bg.code = paste0(
    "background = function(x,y,w,h){",
    "grid::grid.rect(x,y,w-unit(", bg.wdth, ',"pt"),',
    "h-unit(", bg.hgt, ',"pt"),',
    "gp = grid::gpar(fill = '", bg.clr, "',col=NA))}"
  )

  names(bg.code) <- "background"

  Rcode = paste0(
    type.wdth.hgt.clr[, "type"], " = function(x,y,w,h){",
    "grid::grid.rect(x,y,w-unit(", type.wdth.hgt.clr[, "wdth"], ',"pt"),',
    "h-unit(h*", (1 - (type.wdth.hgt.clr[, "hgt"] * (1 / (size + 1)))), ',"pt"),',
    "gp = grid::gpar(fill ='", type.wdth.hgt.clr[, "clr"], "',col=NA))}"
  )

  names(Rcode) = type.wdth.hgt.clr[, "type"]

  Rcode = c(bg.code, Rcode)

  return(Rcode)
}