R/xplot_box.R

In Certara.Xpose.NLME: Enhances 'xpose' Diagnostics for Pharmacometric Models from 'Certara.RsNLME' and Phoenix NLME

#' Default xpose box plot function
#'
#' @description Manually generate categorical covariate box plots against eta.
#'
#' @param xpdb An xpose database object.
#' @param mapping List of aesthetics mappings to be used for the xpose plot
#' (e.g. \code{point_color}).
#' @param type String setting the type of plot to be used. Only 'b' applicable.
#' @param guide Should the guide (e.g. reference distribution) be displayed.
#' @param yscale Scale type for y axis (e.g. 'continuous', 'discrete', 'log10').
#' @param title Plot title. Use \code{NULL} to remove.
#' @param subtitle Plot subtitle. Use \code{NULL} to remove.
#' @param caption Page caption. Use \code{NULL} to remove.
#' @param tag Plot identification tag. Use \code{NULL} to remove.
#' @param plot_name Name to be used by \code{xpose::xpose_save()} when saving the plot.
#' @param opt A list of options in order to create appropriate data input for
#' ggplot2. For more information see \code{\link[xpose]{data_opt}}.
#' @param guide Enable guide display (e.g. unity line).
#' @param quiet Logical, if \code{FALSE} messages are printed to the console.
#' @param gg_theme A complete ggplot2 theme object (e.g.
#'   \code{ggplot2::theme_classic}), a function returning a complete
#'   ggplot2 theme, or a change to the current \code{gg_theme}.
#' @param xp_theme A complete xpose theme object (e.g.
#'   \code{\link[xpose]{theme_xp_default}}) or a list of modifications to the current
#'   \code{xp_theme} (e.g. \code{list(point_color = 'red', line_linetype =
#'   'dashed')}).
#' @param ... Any additional aesthetics to be passed on \code{\link[xpose]{xplot_scatter}}.
#'
#' @section Faceting:
#' Every xpose plot function has built-in faceting functionalities. Faceting arguments
#' are passed to the functions \code{\link[ggforce]{facet_wrap_paginate}} when the \code{facets}
#' argument is a character string (e.g. \code{facets = c('SEX', 'MED1')}) or
#' \code{\link[ggforce]{facet_grid_paginate}} when facets is a formula (e.g. \code{facets = SEX~MED1}).
#' All xpose plot functions accept all the arguments for the \code{\link[ggforce]{facet_wrap_paginate}}
#' and \code{\link[ggforce]{facet_grid_paginate}} functions e.g. \code{dv_vs_ipred(xpdb_ex_pk,
#' facets = SEX~MED1, ncol = 3, nrow = 3, page = 1, margins = TRUE, labeller = 'label_both')}.
#'
#' Faceting options can either be defined in plot functions (e.g. \code{dv_vs_ipred(xpdb_ex_pk,
#' facets = 'SEX')}) or assigned globally to an xpdb object via the \code{xp_theme} (e.g. \code{xpdb
#' <- update_themes(xpdb_ex_pk, xp_theme = list(facets = 'SEX'))}). In the latter example all plots
#' generate from this xpdb will automatically be stratified by `SEX`.
#'
#' By default, some plot functions use a custom stratifying variable named `variable`, e.g.
#' \code{eta_distrib()}. When using the \code{facets} argument, `variable` needs to be added manually
#' e.g. \code{facets = c('SEX', 'variable')} or \code{facets = c('SEX', 'variable')}, but is optional,
#' when using the \code{facets} argument in \code{xp_theme} variable is automatically added whenever needed.
#'
#' @section Layers mapping:
#' Plots can be customized by mapping arguments to specific layers. The naming convention is
#' layer_option where layer is one of the names defined in the list below and option is
#' any option supported by this layer e.g. boxplot_fill = 'blue', etc.
#' \itemize{
#'   \item box plot: options to \code{geom_boxplot}
#'   \item yscale: options to \code{scale_y_continuous} or \code{scale_y_log10}
#' }
#' @seealso \code{\link[xpose]{xplot_scatter}} \code{\link[xpose]{xplot_qq}}
#'
#' @examples
#' # Categorical Covariate MED1 vs ETA1
#' xplot_box(xpose::xpdb_ex_pk, ggplot2::aes(x = MED1, y = ETA1))
#'
#' # Categorical Covariate SEX vs CL
#' xplot_box(xpose::xpdb_ex_pk, ggplot2::aes(x = SEX, y = CL))
#'
#' @return
#' An object of class \code{xpose_plot}, \code{ggplot}, and \code{gg}. This object represents a customized plot created using \code{ggplot2}.
#' The \code{xpose_plot} class provides additional metadata and integration with \code{xpose} workflows, allowing for advanced
#' customization and compatibility with other \code{xpose} functions. Users can interact with the plot object as they
#' would with any \code{ggplot2} object, including modifying aesthetics, adding layers, or saving the plot.
#' @export
xplot_box <- function(xpdb,
                      mapping = NULL,
                      type = "b",
                      guide = FALSE,
                      yscale = "continuous",
                      title = NULL,
                      subtitle = NULL,
                      caption = NULL,
                      tag = NULL,
                      plot_name = "box_plot",
                      gg_theme,
                      xp_theme,
                      opt,
                      quiet,
                      ...) {
  # Check input
  xpose::check_xpdb(xpdb, check = FALSE)
  if (missing(quiet)) quiet <- xpdb$options$quiet

  # Fetch data
  if (missing(opt)) opt <- xpose::data_opt()
  data <- xpose::fetch_data(xpdb,
    quiet = quiet, .problem = opt$problem, .subprob = opt$subprob,
    .method = opt$method, .source = opt$source, simtab = opt$simtab,
    filter = opt$filter, tidy = opt$tidy, index_col = opt$index_col,
    value_col = opt$value_col, post_processing = opt$post_processing
  )

  if (is.null(data) || nrow(data) == 0) {
    stop("No data available for plotting. Please check the variable mapping and filering options.",
      call. = FALSE
    )
  }

  # Check type
  xpose::check_plot_type(type, allowed = c("b"))

  # Assign xp_theme
  if (!missing(xp_theme)) xpdb <- xpose::update_themes(xpdb = xpdb, xp_theme = xp_theme)

  # Assign gg_theme
  if (missing(gg_theme)) {
    gg_theme <- xpdb$gg_theme
  } else {
    gg_theme <- xpose::update_themes(xpdb = xpdb, gg_theme = gg_theme)$gg_theme
  }
  if (is.function(gg_theme)) {
    gg_theme <- do.call(gg_theme, args = list())
  }

  # Create ggplot base
  xp <- ggplot2::ggplot(data = data, mapping = xpose::aes_filter(mapping, keep_only = c("x", "y"))) + gg_theme # aes_filter not working

  # Add box plot
  if (stringr::str_detect(type, stringr::fixed("b", ignore_case = TRUE))) {
    xp <- xp + xpose::xp_geoms(
      mapping = mapping,
      xp_theme = xpdb$xp_theme,
      name = "boxplot",
      ggfun = "geom_boxplot",
      ...
    )
  }



  # Add reference distibution
  if (guide) {
    xpose::msg("Reference distribution not yet available.", TRUE) # Add reference normal distribution
    # xp <- xp + xp_geoms(xp_theme = xpdb$xp_theme,
    #                     name     = 'guide',
    #                     ggfun    = 'geom_line',
    #                     ...)
  }

  # Define scales
  xp <- xp +
    ggplot2::scale_x_discrete() +
    xpose::xp_geoms(
      mapping = mapping,
      xp_theme = xpdb$xp_theme,
      name = "yscale",
      ggfun = paste0("scale_y_", yscale),
      ...
    )

  # Define panels
  if (!is.null(list(...)[["facets"]])) {
    xp <- xp + xpose::xpose_panels(
      xp_theme = xpdb$xp_theme,
      extra_args = list(...)
    )
  }

  # Add labels
  xp <- xp + labs(title = title, subtitle = subtitle, caption = caption)

  if (utils::packageVersion("ggplot2") >= "3.0.0") {
    xp <- xp + labs(tag = tag)
  }

  # Add metadata to plots
  xp$xpose <- list(
    fun = plot_name,
    summary = xpdb$summary,
    problem = attr(data, "problem"),
    subprob = attr(data, "subprob"),
    method = attr(data, "method"),
    quiet = quiet,
    xp_theme = xpdb$xp_theme[stringr::str_c(c(
      "title", "subtitle",
      "caption", "tag"
    ), "_suffix")]
  )

  # Ouptut the plot
  xpose::as.xpose.plot(xp)
}