From a8514e92fbb23d60db686ddf153592fb28c48a77 Mon Sep 17 00:00:00 2001
From: Johannes Ranke <jranke@uni-bremen.de>
Date: Thu, 23 Mar 2023 16:42:31 +0100
Subject: Support covariates in endpoints()

---
 R/endpoints.R | 33 +++++++++++++++++++++++++++------
 R/saem.R      |  4 ++--
 2 files changed, 29 insertions(+), 8 deletions(-)

(limited to 'R')

diff --git a/R/endpoints.R b/R/endpoints.R
index 9ea0e598..0aafd728 100644
--- a/R/endpoints.R
+++ b/R/endpoints.R
@@ -14,10 +14,11 @@
 #' another object that has list components mkinmod containing an [mkinmod]
 #' degradation model, and two numeric vectors, bparms.optim and bparms.fixed,
 #' that contain parameter values for that model.
-#' @param \dots Possibility to specify values for the covariates in the model.
-#' In case more than one vector is given, they either have to be of the same
-#' length, or of length one, in which case the respective covariate values are
-#' recycled.
+#' @param covariates Numeric vector with covariate values for all variables in
+#' any covariate models in the object. If given, it overrides 'covariate_quantile'.
+#' @param covariate_quantile This argument only has an effect if the fitted
+#' object has covariate models. If so, the default is to show endpoints
+#' for the median of the covariate values (50th percentile).
 #' @importFrom stats optimize
 #' @return A list with a matrix of dissipation times named distimes, and, if
 #' applicable, a vector of formation fractions named ff and, if the SFORB model
@@ -38,14 +39,34 @@
 #'   }
 #'
 #' @export
-endpoints <- function(fit, ..., covariates = mean) {
+endpoints <- function(fit, covariates = NULL, covariate_quantile = 0.5) {
   mkinmod <- fit$mkinmod
   obs_vars <- names(mkinmod$spec)
 
-  degparms <- c(fit$bparms.optim, fit$bparms.fixed)
+  if (!is.null(fit$covariate_models)) {
+    if (is.null(covariates)) {
+      covariates = as.data.frame(
+        apply(fit$covariates, 2, quantile,
+          covariate_quantile, simplify = FALSE))
+    } else {
+      covariates <- data.frame("User" = covariates)
+    }
+    degparms_trans <- parms(fit, covariates = covariates)[, 1]
+    if (inherits(fit, "saem.mmkin") & (fit$transformations == "saemix")) {
+      degparms <- degparms_trans
+    } else {
+      degparms <- backtransform_odeparms(degparms_trans,
+        fit$mkinmod,
+        transform_rates = fit$transform_rates,
+        transform_fractions = fit$transform_fractions)
+    }
+  } else {
+    degparms <- c(fit$bparms.optim, fit$bparms.fixed)
+  }
 
   # Set up object to return
   ep <- list()
+  ep$covariates <- covariates
   ep$ff <- vector()
   ep$SFORB <- vector()
   ep$distimes <- data.frame(
diff --git a/R/saem.R b/R/saem.R
index 865f174e..2fa770bb 100644
--- a/R/saem.R
+++ b/R/saem.R
@@ -802,14 +802,14 @@ update.saem.mmkin <- function(object, ..., evaluate = TRUE) {
 }
 
 #' @export
-#' @rdname saem
+#' @rdname parms
 #' @param ci Should a matrix with estimates and confidence interval boundaries
 #' be returned? If FALSE (default), a vector of estimates is returned if no
 #' covariates are given, otherwise a matrix of estimates is returned, with
 #' each column corresponding to a row of the data frame holding the covariates
 #' @param covariates A data frame holding covariate values for which to
 #' return parameter values. Only has an effect if 'ci' is FALSE.
-parms.saem.mmkin <- function(object, ci = FALSE, covariates = NULL, covariate_quantiles = ...) {
+parms.saem.mmkin <- function(object, ci = FALSE, covariates = NULL, ...) {
   cov.mod <- object$sm@covariance.model
   n_cov_mod_parms <- sum(cov.mod[upper.tri(cov.mod, diag = TRUE)])
   n_parms <- length(object$sm@name.modpar) +
-- 
cgit v1.2.1