R/covariate_plots.R

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

#' ETAs vs covariate Plot
#'
#' @description Plot ETAs against a continuous or categorical covariate.
#'
#' @param xpdb An xpose database object.
#' @param covariate Character; String of covariate name
#' @param mapping List of aesthetics mappings to be used for the xpose plot
#' (e.g. \code{point_color}).
#' @param drop_fixed Logical; Logic specifying whether ETAs having same value
#' for the given covariate value should be removed from plotting
#' @param group Grouping variable to be used for lines. \code{ID} by default
#' @param type Character; String setting the type of plot to be used.
#' Must be 'b' for categorical covariates,
#' one or a combination of 'p','l','s' for continuous covariates.
#' @param title Character; Plot title. Use \code{NULL} to remove.
#' @param subtitle Character; Plot subtitle. Use \code{NULL} to remove.
#' @param caption Character; Page caption. Use \code{NULL} to remove.
#' @param tag Character; Plot identification tag. Use \code{NULL} to remove.
#' @param log Character; String assigning logarithmic scale to axes, can be either '',
#' 'x', y' or 'xy'.
#' @param guide Logical; Should the guide (e.g. reference distribution) be displayed.
#' @param onlyfirst Logical; Should the data be filtered to retain first value for each group/facet.
#' @param facets Either a character string to use \code{\link[ggforce]{facet_wrap_paginate}}
#' or a formula to use \code{\link[ggforce]{facet_grid_paginate}}.
#' @param .problem The $problem number to be used. By default returns
#' the last estimation problem.
#' @param quiet Logical, if \code{FALSE} messages are printed to the console.
#' @param ... Any additional aesthetics to be passed on \code{\link[xpose]{xplot_scatter}}
#' or \code{\link{xplot_box}}.
#' @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 point plot: options to \code{geom_point}
#'   \item line plot: options to \code{geom_line}
#'   \item smooth plot: options to \code{geom_smooth}
#'   \item xscale: options to \code{scale_x_continuous} or \code{scale_x_log10}
#'   \item yscale: options to \code{scale_y_continuous} or \code{scale_y_log10}
#' }
#' @seealso \code{\link[xpose]{xplot_scatter}} \code{\link{xplot_box}}
#'
#' @examples
#' eta_vs_cov(xpose::xpdb_ex_pk,
#'   covariate = "WT",
#'   type = "ps",
#'   smooth_color = "red",
#'   point_color = "green",
#'   point_shape = "square",
#'   point_alpha = .5,
#'   point_size = 3
#' )
#'
#' eta_vs_cov(xpose::xpdb_ex_pk,
#'   covariate = "AGE",
#'   type = "ps",
#'   facets = DOSE ~ variable,
#'   guide = TRUE,
#'   guide_color = "red",
#'   guide_slope = 0,
#'   guide_intercept = 0
#' )
#'
#' @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
eta_vs_cov <- function(xpdb,
                       covariate,
                       mapping = NULL,
                       drop_fixed = FALSE,
                       group = "ID",
                       type = "bpls",
                       title = "ETAs vs @x | @run",
                       subtitle = "Based on @nind individuals",
                       caption = "@dir",
                       tag = NULL,
                       log = NULL,
                       guide = FALSE,
                       onlyfirst = TRUE,
                       facets,
                       .problem,
                       quiet,
                       ...) {
  # Check input
  xpose::check_xpdb(xpdb, check = "data")
  if (missing(.problem))
    .problem <- xpose::default_plot_problem(xpdb)
  xpose::check_problem(.problem, .subprob = NULL, .method = NULL)
  if (missing(quiet))
    quiet <- xpdb$options$quiet
  if (missing(facets)) {
    facets <- xpose::add_facet_var(facets = xpdb$xp_theme$facets,
                                   variable = "variable")
  }

  stopifnot(length(covariate) == 1)

  cat_cov_col <- .get_cat_cov(xpdb$data$index[[1]])
  cont_cov_col <- .get_cont_cov(xpdb$data$index[[1]])

  if (covariate %in% cont_cov_col) {
    covtype <- "cont"
  } else if (covariate %in% cat_cov_col) {
    covtype <- "cat"
  } else {
    stop(paste0(
      covariate,
      " not found in list of covariates. See xpose::list_vars(xpdb)."
    ))
  }


  eta_col <- xpose::xp_var(xpdb, .problem, type = "eta")$col
  if (drop_fixed) {
    eta_col <-
      xpose::drop_fixed_cols(xpdb, .problem, cols = eta_col, quiet = quiet)
  }
  if (is.null(eta_col)) {
    stop("No eta column found in the xpdb data index.", call. = FALSE)
  }

  if (xpose::software(xpdb) == "nonmem") {
    post_processing_eta <-
      xpose::reorder_factors(prefix = "ETA(", suffix = ")")
  } else {
    post_processing_eta <- NULL
  }

  if (onlyfirst) {
    filterData <- xpose::only_distinct(xpdb, .problem, facets, quiet)
  } else {
    filterData <- NULL
  }

  if (covtype == "cat") {
    xp <- xplot_box(
      xpdb = xpdb,
      group = group,
      quiet = quiet,
      opt = xpose::data_opt(
        .problem = .problem,
        filter = filterData,
        tidy = TRUE,
        value_col = eta_col,
        post_processing = post_processing_eta
      ),
      mapping = xpose::aes_c(aes_string(x = covariate, y = "value"), mapping),
      type = "b",
      guide = guide,
      facets = facets,
      yscale = xpose::check_scales("y", log),
      title = title,
      subtitle = subtitle,
      caption = caption,
      tag = tag,
      plot_name = as.character(match.call()[[1]]),
      ...
    )
  } else {
    stopifnot(type != "b")
    xp <- xpose::xplot_scatter(
      xpdb = xpdb,
      group = group,
      quiet = quiet,
      opt = xpose::data_opt(
        .problem = .problem,
        filter = filterData,
        tidy = TRUE,
        value_col = eta_col,
        post_processing = post_processing_eta
      ),
      mapping = xpose::aes_c(aes_string(x = covariate, y = "value"), mapping),
      type = gsub("b", "", type),
      guide = guide,
      facets = facets,
      xscale = xpose::check_scales("x", log),
      yscale = xpose::check_scales("y", log),
      title = title,
      subtitle = subtitle,
      caption = caption,
      tag = tag,
      plot_name = as.character(match.call()[[1]]),
      ...
    )
  }

  xp
}


#' Parameter vs covariate Plot
#'
#' @description Plot Parameters against a continuous or categorical covariate.
#'
#' @inheritParams eta_vs_cov
#' @param drop_fixed Logical; logic specifying whether structural parameters having same value
#' for the given covariate value should be removed from plotting
#' @param guide Logical; Enable guide display (e.g. unity line).
#' @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 point plot: options to \code{geom_point}
#'   \item line plot: options to \code{geom_line}
#'   \item smooth plot: options to \code{geom_smooth}
#'   \item xscale: options to \code{scale_x_continuous} or \code{scale_x_log10}
#'   \item yscale: options to \code{scale_y_continuous} or \code{scale_y_log10}
#' }
#' @seealso \code{\link[xpose]{xplot_scatter}} \code{\link{xplot_box}}
#'
#' @examples
#' prm_vs_cov(xpose::xpdb_ex_pk,
#'   covariate = "AGE", type = "ps",
#'   log = "y",
#'   yscale_breaks = scales::trans_breaks("log10", function(x) 10^x),
#'   yscale_labels = scales::trans_format("log10", scales::math_format(10^.x)),
#'   caption = NULL
#' )
#'
#' prm_vs_cov(xpose::xpdb_ex_pk,
#'   covariate = "SEX",
#'   type = "b",
#'   boxplot_fill = "blue",
#'   boxplot_color = "black",
#'   boxplot_outlier.color = "red"
#' )
#'
#' @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
prm_vs_cov <- function(xpdb,
                       covariate,
                       mapping = NULL,
                       drop_fixed = FALSE,
                       group = "ID",
                       type = "bpls",
                       title = "Parameters vs @x | @run",
                       subtitle = "Based on @nind individuals",
                       caption = "@dir",
                       tag = NULL,
                       log = NULL,
                       guide = FALSE,
                       onlyfirst = FALSE,
                       facets,
                       .problem,
                       quiet,
                       ...) {
  # Check input
  xpose::check_xpdb(xpdb, check = "data")
  if (missing(.problem))
    .problem <- xpose::default_plot_problem(xpdb)
  xpose::check_problem(.problem, .subprob = NULL, .method = NULL)
  if (missing(quiet))
    quiet <- xpdb$options$quiet
  if (missing(facets)) {
    facets <- xpose::add_facet_var(facets = xpdb$xp_theme$facets,
                                   variable = "variable")
  }


  stopifnot(length(covariate) == 1)

  cat_cov_col <- .get_cat_cov(xpdb$data$index[[1]])
  cont_cov_col <- .get_cont_cov(xpdb$data$index[[1]])

  if (covariate %in% cont_cov_col) {
    covtype <- "cont"
  } else if (covariate %in% cat_cov_col) {
    covtype <- "cat"
  } else {
    stop(paste0(
      covariate,
      " not found in list of covariates. See xpose::list_vars(xpdb)."
    ))
  }

  prm_col <- xpose::xp_var(xpdb, .problem, type = "param")$col
  if (drop_fixed) {
    prm_col <-
      xpose::drop_fixed_cols(xpdb, .problem, cols = prm_col, quiet = quiet)
  }
  if (is.null(prm_col)) {
    stop("No parameter column found in the xpdb data index.", call. = FALSE)
  }

  if (onlyfirst) {
    filterData <- xpose::only_distinct(xpdb, .problem, facets, quiet)
  } else {
    filterData <- NULL
  }

  if (covtype == "cat") {
    xp <- xplot_box(
      xpdb = xpdb,
      group = group,
      quiet = quiet,
      opt = xpose::data_opt(
        .problem = .problem,
        filter = filterData,
        tidy = TRUE,
        value_col = prm_col
      ),
      mapping = xpose::aes_c(ggplot2::aes_string(x = covariate, y = "value"), mapping),
      type = "b",
      guide = guide,
      facets = facets,
      yscale = xpose::check_scales("y", log),
      title = title,
      subtitle = subtitle,
      caption = caption,
      tag = tag,
      plot_name = as.character(match.call()[[1]]),
      ...
    )
  } else {
    stopifnot(type != "b")
    xp <- xpose::xplot_scatter(
      xpdb = xpdb,
      group = group,
      quiet = quiet,
      opt = xpose::data_opt(
        .problem = .problem,
        filter = filterData,
        tidy = TRUE,
        value_col = prm_col
      ),
      mapping = xpose::aes_c(aes_string(x = covariate, y = "value"), mapping),
      type = gsub("b", "", type),
      guide = guide,
      facets = facets,
      xscale = xpose::check_scales("x", log),
      yscale = xpose::check_scales("y", log),
      title = title,
      subtitle = subtitle,
      caption = caption,
      tag = tag,
      plot_name = as.character(match.call()[[1]]),
      ...
    )
  }
  xp
}


#' Residuals vs covariate plot
#'
#' @description Plot Residuals against a continuous or categorical covariate.
#'
#' @inheritParams eta_vs_cov
#' @param res Character; String of residual name; CWRES by default.
#' @param guide Logical; Should the guide (e.g. reference distribution) be displayed.
#'
#' @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. \code{boxplot_fill = 'blue'}, etc.
#' \itemize{
#'   \item box plot: options to \code{geom_boxplot}
#'   \item point plot: options to \code{geom_point}
#'   \item line plot: options to \code{geom_line}
#'   \item smooth plot: options to \code{geom_smooth}
#'   \item xscale: options to \code{scale_x_continuous} or \code{scale_x_log10}
#'   \item yscale: options to \code{scale_y_continuous} or \code{scale_y_log10}
#' }
#' @seealso \code{\link[xpose]{xplot_scatter}} \code{\link{xplot_box}}
#'
#' @examples
#' res_vs_cov(xpose::xpdb_ex_pk,
#'   covariate = "SEX",
#'   type = "b",
#'   res = "WRES"
#' )
#'
#' res_vs_cov(xpose::xpdb_ex_pk,
#'   covariate = "AGE",
#'   type = "ps",
#'   res = c("CWRES", "WRES", "IRES", "IWRES")
#' )
#'
#' @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
res_vs_cov <- function(xpdb,
                       mapping = NULL,
                       covariate,
                       res = "CWRES",
                       group = "ID",
                       type = "bpls",
                       title = "Residuals vs @x | @run",
                       subtitle = "Based on @nind individuals",
                       caption = "@dir",
                       tag = NULL,
                       log = NULL,
                       guide = TRUE,
                       facets,
                       .problem,
                       quiet,
                       ...) {
  # Check input
  xpose::check_xpdb(xpdb, check = "data")
  if (missing(.problem))
    .problem <- xpose::default_plot_problem(xpdb)
  xpose::check_problem(.problem, .subprob = NULL, .method = NULL)
  if (missing(quiet))
    quiet <- xpdb$options$quiet

  stopifnot(length(covariate) == 1)

  cat_cov_col <- .get_cat_cov(xpdb$data$index[[1]])
  cont_cov_col <- .get_cont_cov(xpdb$data$index[[1]])

  if (covariate %in% cont_cov_col) {
    covtype <- "cont"
  } else if (covariate %in% cat_cov_col) {
    covtype <- "cat"
  } else {
    stop(paste0(
      covariate,
      " not found in list of covariates. See xpose::list_vars(xpdb)."
    ))
  }

  res_col <- xpose::xp_var(xpdb, .problem, type = "res")$col

  if (is.null(res_col)) {
    stop("No residuals column found in the xpdb data index.", call. = FALSE)
  }

  if (length(res) > 1) {
    if (missing(facets)) {
      facets <- xpose::add_facet_var(facets = xpdb$xp_theme$facets,
                                     variable = "variable")
    }
    # If specifying more than one residual, we set tidy = TRUE and provide value_col

    opt <- xpose::data_opt(
      .problem = .problem,
      filter = xpose::only_obs(xpdb, .problem, quiet),
      tidy = TRUE,
      value_col = res
    )
    vars <-
      xpose::aes_c(aes_string(x = covariate, y = "value"), mapping)
  } else {
    # If specifying one residual, we set tidy = FALSE
    if (missing(facets))
      facets <- xpdb$xp_theme$facets
    opt <- xpose::data_opt(
      .problem = .problem,
      filter = xpose::only_obs(xpdb, .problem, quiet),
      tidy = FALSE
    )
    vars <-
      xpose::aes_c(aes_string(x = covariate, y = toupper(res)), mapping)
  }


  if (covtype == "cat") {
    xp <- xplot_box(
      xpdb = xpdb,
      group = group,
      quiet = quiet,
      opt = opt,
      mapping = vars,
      type = 'b',
      guide = guide,
      facets = facets,
      yscale = xpose::check_scales("y", log),
      title = title,
      subtitle = subtitle,
      caption = caption,
      tag = tag,
      plot_name = as.character(match.call()[[1]]),
      ...
    )
  } else {
    stopifnot(type != "b")
    xp <- xpose::xplot_scatter(
      xpdb = xpdb,
      group = group,
      quiet = quiet,
      opt = opt,
      mapping = vars,
      type = gsub("b", "", type),
      guide = guide,
      facets = facets,
      xscale = xpose::check_scales("x", log),
      yscale = xpose::check_scales("y", log),
      title = title,
      subtitle = subtitle,
      caption = caption,
      tag = tag,
      plot_name = as.character(match.call()[[1]]),
      ...
    )
  }
  xp
}