From 48c463680b51fa767b4cd7bd62865f192d0354ac Mon Sep 17 00:00:00 2001 From: Johannes Ranke Date: Sat, 6 Feb 2021 18:30:32 +0100 Subject: Reintroduce interface to saemix Also after the upgrade from buster to bullseye of my local system, some test results for saemix have changed. --- R/plot.mixed.mmkin.R | 23 ++++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) (limited to 'R/plot.mixed.mmkin.R') diff --git a/R/plot.mixed.mmkin.R b/R/plot.mixed.mmkin.R index 5a0b7412..1674d855 100644 --- a/R/plot.mixed.mmkin.R +++ b/R/plot.mixed.mmkin.R @@ -2,7 +2,7 @@ utils::globalVariables("ds") #' Plot predictions from a fitted nonlinear mixed model obtained via an mmkin row object #' -#' @param x An object of class [mixed.mmkin], [nlme.mmkin] +#' @param x An object of class [mixed.mmkin], [saem.mmkin] or [nlme.mmkin] #' @param i A numeric index to select datasets for which to plot the individual predictions, #' in case plots get too large #' @inheritParams plot.mkinfit @@ -39,6 +39,15 @@ utils::globalVariables("ds") #' f_nlme <- nlme(f, control = list(pnlsMaxIter = 120, tolerance = 1e-3)) #' plot(f_nlme) #' +#' f_saem <- saem(f, transformations = "saemix") +#' plot(f_saem) +#' +#' # We can overlay the two variants if we generate predictions +#' pred_nlme <- mkinpredict(dfop_sfo, +#' f_nlme$bparms.optim[-1], +#' c(parent = f_nlme$bparms.optim[[1]], A1 = 0), +#' seq(0, 180, by = 0.2)) +#' plot(f_saem, pred_over = list(nlme = pred_nlme)) #' } #' @export plot.mixed.mmkin <- function(x, @@ -82,6 +91,18 @@ plot.mixed.mmkin <- function(x, type = ifelse(standardized, "pearson", "response")) } + if (inherits(x, "saem.mmkin")) { + if (x$transformations == "saemix") backtransform = FALSE + degparms_i <- saemix::psi(x$so) + rownames(degparms_i) <- ds_names + degparms_i_names <- setdiff(x$so@results@name.fixed, names(fit_1$errparms)) + colnames(degparms_i) <- degparms_i_names + residual_type = ifelse(standardized, "standardized", "residual") + residuals <- x$data[[residual_type]] + degparms_pop <- x$so@results@fixed.effects + names(degparms_pop) <- degparms_i_names + } + degparms_fixed <- fit_1$fixed$value names(degparms_fixed) <- rownames(fit_1$fixed) degparms_all <- cbind(as.matrix(degparms_i), -- cgit v1.2.1