aboutsummaryrefslogtreecommitdiff
path: root/R/plot.mixed.mmkin.R
diff options
context:
space:
mode:
authorJohannes Ranke <jranke@uni-bremen.de>2021-02-06 18:30:32 +0100
committerJohannes Ranke <jranke@uni-bremen.de>2021-02-06 18:30:32 +0100
commit48c463680b51fa767b4cd7bd62865f192d0354ac (patch)
tree5b66eb08a7fd5e29fb7e6d3a9a8258ccdcaea73e /R/plot.mixed.mmkin.R
parent2ee20b257e34210e2d1f044431f3bfe059c9c5e7 (diff)
Reintroduce interface to saemix
Also after the upgrade from buster to bullseye of my local system, some test results for saemix have changed.
Diffstat (limited to 'R/plot.mixed.mmkin.R')
-rw-r--r--R/plot.mixed.mmkin.R23
1 files changed, 22 insertions, 1 deletions
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),

Contact - Imprint