R/ggNlme.R

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

#' @importFrom egg ggarrange
#' @importFrom GGally ggpairs wrap
#' @import ggplot2
#'

#' @title Create covariates scatterplot
#'
#' @description Use to create covariates scatterplot.
#'
#' @param xpdb 	An xpose database object.
#' @param covColNames Character vector of covariates to build the matrix
#' @param ggupper See \code{\link[GGally]{ggpairs}()} upper argument.
#' @param gglower See \code{\link[GGally]{ggpairs}()} lower argument.
#' @param ggdiag See \code{\link[GGally]{ggpairs}()} diag argument.
#' @param ... Parameters to be passed to \code{\link[GGally]{ggpairs}()}.
#'
#' @examples
#' nlme.cov.splom(xpdb = xpdb_ex_Nlme,
#' covColNames = c("sex", "wt", "age")
#' )
#'
#' @return \code{\link[GGally]{ggmatrix}} object.
#' @export
#'
nlme.cov.splom <- function(xpdb,
                           covColNames,
                           ggupper = list(continuous = "cor", combo = "box_no_facet", discrete = "count", na = "na"),
                           gglower = list(continuous = GGally::wrap("smooth", alpha = 0.3, size = 0.1), combo = "facethist", discrete = "facetbar", na = "na"),
                           ggdiag = list(continuous = "densityDiag", discrete = "barDiag", na = "naDiag"),
                           ...) {
  dataTibble <- xpdb$data$data[[1]]
  covColNamesList <- .prepare_covariates(xpdb, covColNames)
  catcovColNames <- covColNamesList$catcovColNames
  contcovColNames <- covColNamesList$contcovColNames

  if (length(catcovColNames) > 0) {
    dataTibble <-
      dataTibble %>%
      dplyr::mutate_at(catcovColNames, factor)
  }

  covColNames <- c(contcovColNames, catcovColNames)

  GGally::ggpairs(dataTibble,
    columns = covColNames,
    upper = ggupper,
    lower = gglower,
    diag = ggdiag,
    ...
  ) +
    ggplot2::theme_bw()
}


#' @title Build multiple plots for selected variable vs covariates
#'
#' @description The type of plot depends on the type of covariate: boxplot for categorical,
#' geom_point and geom_smooth for continuous.
#'
#' @param xpdb 	An xpose database object.
#' @param covColNames Character vector of covariates to build the matrix.
#' @param nrow Number of rows.
#' @param ncol Number of columns; if ncol=1, each gtable object is treated separately.
#' @param yVar Variable from xpdb data to build a plot.
#' @param ... Parameters to be passed to \code{\link[egg]{ggarrange}()}
#'
#' @examples
#' nlme.var.vs.cov(
#'   xpdb = xpdb_ex_Nlme,
#'   covColNames = c("sex", "wt", "age"),
#'   yVar = "WRES",
#'   nrow = 2,
#'   ncol = 2
#'   )
#' @return
#' List of \code{\link[gtable]{gtable}}
#' @export
#'
nlme.var.vs.cov <- function(xpdb, covColNames, nrow = 1, ncol = 1, yVar = "WRES", ...) {
  stopifnot(class(xpdb)[1] == "xpose_data")
  stopifnot(is.character(yVar))
  stopifnot(is.numeric(nrow))
  stopifnot(is.numeric(ncol))

  dataTibble <- xpdb$data$data[[1]]
  stopifnot(yVar %in% colnames(dataTibble))
  covColNamesList <- .prepare_covariates(xpdb, covColNames)
  catcovColNames <- covColNamesList$catcovColNames
  contcovColNames <- covColNamesList$contcovColNames

  if (length(catcovColNames) > 0) {
    dataTibble <-
      dataTibble %>%
      dplyr::mutate_at(catcovColNames, factor)
  }

  covColNames <- c(contcovColNames, catcovColNames)
  plotList <- list()
  for (i in 1:length(covColNames)) {
    if (covColNames[i] %in% contcovColNames) {
      plotList[[i]] <-
        ggplot2::ggplot(data = dataTibble, aes_(x = as.name(covColNames[i]), y = as.name(yVar))) +
        ggplot2::geom_point() +
        ggplot2::geom_smooth(method = "gam", formula = y ~ s(x, bs = "cs")) +
        ggplot2::theme_bw()
    } else if (covColNames[i] %in% catcovColNames) {
      plotList[[i]] <-
        ggplot2::ggplot(data = dataTibble, aes_(x = as.name(covColNames[i]), y = as.name(yVar))) +
        ggplot2::geom_boxplot() +
        ggplot2::theme_bw()
    }
  }

  plotListLength <- length(plotList)
  if (plotListLength == 0) {
    stop("No plots were generated. Please check the data.")
  }


  if (missing(nrow)) {
    nrow <- ceiling(plotListLength / ncol)
  } else if (missing(ncol)) {
    ncol <- ceiling(plotListLength / nrow)
  }

  if (ncol == 1) {
    # special case: one by one
    nrow <- 1
  }

  ggarrangeList <- list()
  for (i in seq(1, plotListLength, by = ncol * nrow)) {
    lastPlot <- i + ncol * nrow - 1
    if (lastPlot > plotListLength) {
      lastPlot <- plotListLength
    }

    ggarrangeObj <- egg::ggarrange(plots = plotList[i:lastPlot], nrow = nrow, ncol = ncol, ...)
    ggarrangeList[[length(ggarrangeList) + 1]] <- ggarrangeObj
  }

  ggarrangeList
}


#' @title Plot random parameter estimates against covariates
#'
#' @description Use to create a stack of plots of random parameter estimates plotted against covariates.
#'
#' @param xpdb 	An xpose database object.
#' @param covColNames Character vector of covariates to build the matrix.
#' @param nrow Number of rows.
#' @param ncol Number of columns; if ncol=1, each gtable object is treated separately.
#' @param ... Parameters to be passed to \code{\link[egg]{ggarrange}()}
#'
#' @examples
#' nlme.ranpar.vs.cov(xpdb = xpose::xpdb_ex_pk,
#' covColNames = c("SEX", "CLCR", "AGE")
#' )
#'
#' @return
#' List of \code{\link[gtable]{gtable}}
#' @export
#'

nlme.ranpar.vs.cov <- function(xpdb, covColNames, nrow = 1, ncol = 1, ...) {
  stopifnot(class(xpdb)[1] == "xpose_data")
  stopifnot(is.numeric(nrow))
  stopifnot(is.numeric(ncol))

  dataTibble <- xpdb$data$data[[1]]
  covColNamesList <- .prepare_covariates(xpdb, covColNames)
  catcovColNames <- covColNamesList$catcovColNames
  contcovColNames <- covColNamesList$contcovColNames

  if (length(catcovColNames) > 0) {
    dataTibble <-
      dataTibble %>%
      dplyr::mutate_at(catcovColNames, factor)
  }


  etaNames <- .get_eta_names(xpdb$data$index[[1]])

  covColNames <- c(contcovColNames, catcovColNames)
  plotList <- list()
  for (col in covColNames) {
    if (col %in% contcovColNames) {
      for (eta in etaNames) {
        plotList[[col]][[eta]] <-
          ggplot2::ggplot(data = dataTibble, aes_(x = as.name(col), y = as.name(eta))) +
          ggplot2::geom_point() +
          ggplot2::geom_smooth(se = FALSE) +
          ggplot2::theme_bw()
      }
    } else if (col %in% catcovColNames) {
      for (eta in etaNames) {
        plotList[[col]][[eta]] <-
          ggplot2::ggplot(data = dataTibble, aes_(x = as.name(col), y = as.name(eta))) +
          ggplot2::geom_boxplot() +
          ggplot2::theme_bw()
      }
    }
  }

  plotList <- unlist(plotList, recursive = FALSE, use.names = FALSE)

  plotListLength <- length(plotList)
  if (plotListLength == 0) {
    stop("No plots were generated. Please check the data.")
  }


  if (missing(nrow)) {
    nrow <- ceiling(plotListLength / ncol)
  } else if (missing(ncol)) {
    ncol <- ceiling(plotListLength / nrow)
  }

  if (ncol == 1) {
    # special case: one by one
    nrow <- 1
  }


  ggarrangeList <- list()
  for (i in seq(1, plotListLength, by = ncol * nrow)) {
    lastPlot <- i + ncol * nrow - 1
    if (lastPlot > plotListLength) {
      lastPlot <- plotListLength
    }

    ggarrangeObj <- egg::ggarrange(plots = plotList[i:lastPlot], nrow = nrow, ncol = ncol)
    ggarrangeList[[length(ggarrangeList) + 1]] <- ggarrangeObj
  }

  ggarrangeList
}

#' @title Plot parameter estimates against covariates
#'
#' @description Use to create a stack of plots of parameter estimates plotted against covariates.
#'
#' @param xpdb 	An xpose database object.
#' @param covColNames Character vector of covariates to build the matrix.
#' @param nrow Number of rows.
#' @param ncol Number of columns; if ncol=1, each gtable object is treated separately.
#' @param ... Parameters to be passed to \code{\link[egg]{ggarrange}()}.
#'
#' @examples
#' nlme.par.vs.cov(
#'   xpdb = xpdb_ex_Nlme,
#'   covColNames = c("sex", "wt", "age")
#' )
#'
#' @return
#' List of \code{\link[gtable]{gtable}}
#' @export
#'
nlme.par.vs.cov <- function(xpdb, covColNames, nrow = 1, ncol = 1, ...) {
  stopifnot(class(xpdb)[1] == "xpose_data")
  stopifnot(is.numeric(nrow))
  stopifnot(is.numeric(ncol))

  dataTibble <- xpdb$data$data[[1]]
  covColNamesList <- .prepare_covariates(xpdb, covColNames)
  catcovColNames <- covColNamesList$catcovColNames
  contcovColNames <- covColNamesList$contcovColNames

  if (length(catcovColNames) > 0) {
    dataTibble <-
      dataTibble %>%
      dplyr::mutate_at(catcovColNames, factor)
  }


  paramNames <- .get_param_names(xpdb$data$index[[1]])

  covColNames <- c(contcovColNames, catcovColNames)
  plotList <- list()
  for (col in covColNames) {
    if (col %in% contcovColNames) {
      for (param in paramNames) {
        plotList[[col]][[param]] <-
          ggplot2::ggplot(data = dataTibble, aes_(x = as.name(col), y = as.name(param))) +
          ggplot2::geom_point() +
          ggplot2::geom_smooth(se = FALSE) +
          ggplot2::theme_bw()
      }
    } else if (col %in% catcovColNames) {
      for (param in paramNames) {
        plotList[[col]][[param]] <-
          ggplot2::ggplot(data = dataTibble, aes_(x = as.name(col), y = as.name(param))) +
          ggplot2::geom_boxplot() +
          ggplot2::theme_bw()
      }
    }
  }

  plotList <- unlist(plotList, recursive = FALSE, use.names = FALSE)

  plotListLength <- length(plotList)
  if (plotListLength == 0) {
    stop("No plots were generated. Please check the data.")
  }


  if (missing(nrow)) {
    nrow <- ceiling(plotListLength / ncol)
  } else if (missing(ncol)) {
    ncol <- ceiling(plotListLength / nrow)
  }

  if (ncol == 1) {
    # special case: one by one
    nrow <- 1
  }


  ggarrangeList <- list()
  for (i in seq(1, plotListLength, by = ncol * nrow)) {
    lastPlot <- i + ncol * nrow - 1
    if (lastPlot > plotListLength) {
      lastPlot <- plotListLength
    }

    ggarrangeObj <- egg::ggarrange(plots = plotList[i:lastPlot], nrow = nrow, ncol = ncol)
    ggarrangeList[[length(ggarrangeList) + 1]] <- ggarrangeObj
  }

  ggarrangeList
}