aboutsummaryrefslogtreecommitdiff
path: root/R/plot.mixed.mmkin.R
diff options
context:
space:
mode:
Diffstat (limited to 'R/plot.mixed.mmkin.R')
-rw-r--r--R/plot.mixed.mmkin.R61
1 files changed, 41 insertions, 20 deletions
diff --git a/R/plot.mixed.mmkin.R b/R/plot.mixed.mmkin.R
index d8a1c2ac..db29376e 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 [saem.mmkin] or [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
@@ -63,31 +63,43 @@ plot.mixed.mmkin <- function(x,
fit_1 <- x$mmkin[[1]]
ds_names <- colnames(x$mmkin)
+ backtransform = TRUE
+
+ if (identical(class(x), "mixed.mmkin")) {
+ degparms_pop <- mean_degparms(x$mmkin)
+
+ degparms_tmp <- parms(x$mmkin, transformed = TRUE)
+ degparms_i <- as.data.frame(t(degparms_tmp[setdiff(rownames(degparms_tmp), names(fit_1$errparms)), ]))
+ residual_type = ifelse(standardized, "standardized", "residual")
+ residuals <- x$data[[residual_type]]
+ }
+
if (inherits(x, "nlme.mmkin")) {
- degparms_optim <- coefficients(x)
+ degparms_i <- coefficients(x)
degparms_pop <- nlme::fixef(x)
residuals <- residuals(x,
type = ifelse(standardized, "pearson", "response"))
}
if (inherits(x, "saem.mmkin")) {
- degparms_optim <- saemix::psi(x$so)
- rownames(degparms_optim) <- ds_names
- degparms_optim_names <- setdiff(names(fit_1$par), names(fit_1$errparms))
- colnames(degparms_optim) <- degparms_optim_names
- residual_type = ifelse(standardized, "residual", "standardized")
+ 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_optim_names
+ 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_optim),
- matrix(rep(degparms_fixed, nrow(degparms_optim)),
+ degparms_all <- cbind(as.matrix(degparms_i),
+ matrix(rep(degparms_fixed, nrow(degparms_i)),
ncol = length(degparms_fixed),
- nrow = nrow(degparms_optim), byrow = TRUE))
- degparms_all_names <- c(names(degparms_optim), names(degparms_fixed))
+ nrow = nrow(degparms_i), byrow = TRUE))
+ degparms_all_names <- c(names(degparms_i), names(degparms_fixed))
colnames(degparms_all) <- degparms_all_names
degparms_all_pop <- c(degparms_pop, degparms_fixed)
@@ -106,10 +118,14 @@ plot.mixed.mmkin <- function(x,
pred_ds <- purrr::map_dfr(i, function(ds_i) {
odeparms_trans <- degparms_all[ds_i, odeparms_names]
names(odeparms_trans) <- odeparms_names # needed if only one odeparm
- odeparms <- backtransform_odeparms(odeparms_trans,
- x$mkinmod,
- transform_rates = fit_1$transform_rates,
- transform_fractions = fit_1$transform_fractions)
+ if (backtransform) {
+ odeparms <- backtransform_odeparms(odeparms_trans,
+ x$mkinmod,
+ transform_rates = fit_1$transform_rates,
+ transform_fractions = fit_1$transform_fractions)
+ } else {
+ odeparms <- odeparms_trans
+ }
odeini <- degparms_all[ds_i, odeini_names]
names(odeini) <- gsub("_0", "", odeini_names)
@@ -121,10 +137,15 @@ plot.mixed.mmkin <- function(x,
})
odeparms_pop_trans <- degparms_all_pop[odeparms_names]
- odeparms_pop <- backtransform_odeparms(odeparms_pop_trans,
- x$mkinmod,
- transform_rates = fit_1$transform_rates,
- transform_fractions = fit_1$transform_fractions)
+
+ if (backtransform) {
+ odeparms_pop <- backtransform_odeparms(odeparms_pop_trans,
+ x$mkinmod,
+ transform_rates = fit_1$transform_rates,
+ transform_fractions = fit_1$transform_fractions)
+ } else {
+ odeparms_pop <- odeparms_pop_trans
+ }
odeini_pop <- degparms_all_pop[odeini_names]
names(odeini_pop) <- gsub("_0", "", odeini_names)

Contact - Imprint