aboutsummaryrefslogtreecommitdiff
path: root/R
diff options
context:
space:
mode:
authorJohannes Ranke <jranke@uni-bremen.de>2021-06-17 13:58:34 +0200
committerJohannes Ranke <jranke@uni-bremen.de>2021-06-17 13:58:34 +0200
commit05baf3bf92cba127fd2319b779db78be86170e5e (patch)
tree98b0c8c63badd2421afa5ebaf12530290ac9c571 /R
parent28197d5fcbaf85b39f4c032b8180d68b6f6a01b3 (diff)
Let backtransform_odeparms handle nlmixr formation fractions
Also adapt summary.nlmixr.mmkin to correctly handle the way formation fractions are translated to nlmixr
Diffstat (limited to 'R')
-rw-r--r--R/dimethenamid_2018.R14
-rw-r--r--R/summary.nlmixr.mmkin.R14
-rw-r--r--R/tffm0.R6
-rw-r--r--R/transform_odeparms.R13
4 files changed, 29 insertions, 18 deletions
diff --git a/R/dimethenamid_2018.R b/R/dimethenamid_2018.R
index 76b98efe..6e0bda0c 100644
--- a/R/dimethenamid_2018.R
+++ b/R/dimethenamid_2018.R
@@ -31,6 +31,7 @@
#' dmta_ds[["Elliot"]] <- rbind(dmta_ds[["Elliot 1"]], dmta_ds[["Elliot 2"]])
#' dmta_ds[["Elliot 1"]] <- NULL
#' dmta_ds[["Elliot 2"]] <- NULL
+#' \dontrun{
#' dfop_sfo3_plus <- mkinmod(
#' DMTA = mkinsub("DFOP", c("M23", "M27", "M31")),
#' M23 = mkinsub("SFO"),
@@ -42,12 +43,15 @@
#' list("DFOP-SFO3+" = dfop_sfo3_plus),
#' dmta_ds, quiet = TRUE, error_model = "tc")
#' nlmixr_model(f_dmta_mkin_tc)
-#' f_dmta_nlmixr_saem <- nlmixr(f_dmta_mkin_tc, est = "saem",
-#' control = saemControl(print = 500))
-#' summary(f_dmta_nlmixr_saem)
-#' plot(f_dmta_nlmixr_saem)
#' f_dmta_nlmixr_focei <- nlmixr(f_dmta_mkin_tc, est = "focei",
-#' control = foceiControl(print = 500))
+#' control = nlmixr::foceiControl(print = 500))
#' summary(f_dmta_nlmixr_focei)
#' plot(f_dmta_nlmixr_focei)
+#' # saem has a problem with this model/data combination, maybe because of the
+#' # overparameterised error model, to be investigated
+#' #f_dmta_nlmixr_saem <- nlmixr(f_dmta_mkin_tc, est = "saem",
+#' # control = saemControl(print = 500))
+#' #summary(f_dmta_nlmixr_saem)
+#' #plot(f_dmta_nlmixr_saem)
+#' }
"dimethenamid_2018"
diff --git a/R/summary.nlmixr.mmkin.R b/R/summary.nlmixr.mmkin.R
index f2d7c607..a023f319 100644
--- a/R/summary.nlmixr.mmkin.R
+++ b/R/summary.nlmixr.mmkin.R
@@ -85,11 +85,11 @@ summary.nlmixr.mmkin <- function(object, data = FALSE, verbose = FALSE, distimes
mod_vars <- names(object$mkinmod$diffs)
- pnames <- names(object$mean_dp_start)
- np <- length(pnames)
-
conf.int <- confint(object$nm)
- confint_trans <- as.matrix(conf.int[pnames, c(1, 3, 4)])
+ dpnames <- setdiff(rownames(conf.int), names(object$mean_ep_start))
+ ndp <- length(dpnames)
+
+ confint_trans <- as.matrix(conf.int[dpnames, c(1, 3, 4)])
colnames(confint_trans) <- c("est.", "lower", "upper")
bp <- backtransform_odeparms(confint_trans[, "est."], object$mkinmod,
@@ -100,7 +100,7 @@ summary.nlmixr.mmkin <- function(object, data = FALSE, verbose = FALSE, distimes
# with the exception of sets of formation fractions (single fractions are OK).
f_names_skip <- character(0)
for (box in mod_vars) { # Figure out sets of fractions to skip
- f_names <- grep(paste("^f", box, sep = "_"), pnames, value = TRUE)
+ f_names <- grep(paste("^f", box, sep = "_"), dpnames, value = TRUE)
n_paths <- length(f_names)
if (n_paths > 1) f_names_skip <- c(f_names_skip, f_names)
}
@@ -109,7 +109,7 @@ summary.nlmixr.mmkin <- function(object, data = FALSE, verbose = FALSE, distimes
dimnames = list(bpnames, colnames(confint_trans)))
confint_back[, "est."] <- bp
- for (pname in pnames) {
+ for (pname in dpnames) {
if (!pname %in% f_names_skip) {
par.lower <- confint_trans[pname, "lower"]
par.upper <- confint_trans[pname, "upper"]
@@ -131,7 +131,7 @@ summary.nlmixr.mmkin <- function(object, data = FALSE, verbose = FALSE, distimes
object$corFixed <- array(
t(varFix/stdFix)/stdFix,
dim(varFix),
- list(pnames, pnames))
+ list(dpnames, dpnames))
object$confint_trans <- confint_trans
object$confint_back <- confint_back
diff --git a/R/tffm0.R b/R/tffm0.R
index 25787962..bb5f4cf5 100644
--- a/R/tffm0.R
+++ b/R/tffm0.R
@@ -13,7 +13,8 @@
#'
#' @param ff Vector of untransformed formation fractions. The sum
#' must be smaller or equal to one
-#' @param ff_trans
+#' @param ff_trans Vector of transformed formation fractions that can be
+#' restricted to the interval from 0 to 1
#' @return A vector of the transformed formation fractions
#' @export
#' @examples
@@ -33,7 +34,8 @@ tffm0 <- function(ff) {
return(res)
}
#' @rdname tffm0
-#' @return
+#' @export
+#' @return A vector of backtransformed formation fractions for natural use in degradation models
invtffm0 <- function(ff_trans) {
n <- length(ff_trans)
res <- numeric(n)
diff --git a/R/transform_odeparms.R b/R/transform_odeparms.R
index 4fe4e5c2..174e7c2d 100644
--- a/R/transform_odeparms.R
+++ b/R/transform_odeparms.R
@@ -229,13 +229,18 @@ backtransform_odeparms <- function(transparms, mkinmod,
if (length(trans_f) > 0) {
if(transform_fractions) {
if (any(grepl("qlogis", names(trans_f)))) {
- parms[f_names] <- plogis(trans_f)
+ f_tmp <- plogis(trans_f)
+ if (any(grepl("_tffm0_.*_qlogis$", names(f_tmp)))) {
+ parms[f_names] <- invtffm0(f_tmp)
+ } else {
+ parms[f_names] <- f_tmp
+ }
} else {
- f <- invilr(trans_f)
+ f_tmp <- invilr(trans_f)
if (spec[[box]]$sink) {
- parms[f_names] <- f[1:length(f)-1]
+ parms[f_names] <- f_tmp[1:length(f_tmp)-1]
} else {
- parms[f_names] <- f
+ parms[f_names] <- f_tmp
}
}
} else {

Contact - Imprint