From 05baf3bf92cba127fd2319b779db78be86170e5e Mon Sep 17 00:00:00 2001
From: Johannes Ranke <jranke@uni-bremen.de>
Date: Thu, 17 Jun 2021 13:58:34 +0200
Subject: Let backtransform_odeparms handle nlmixr formation fractions

Also adapt summary.nlmixr.mmkin to correctly handle the way
formation fractions are translated to nlmixr
---
 R/dimethenamid_2018.R    | 14 +++++++++-----
 R/summary.nlmixr.mmkin.R | 14 +++++++-------
 R/tffm0.R                |  6 ++++--
 R/transform_odeparms.R   | 13 +++++++++----
 4 files changed, 29 insertions(+), 18 deletions(-)

(limited to 'R')

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 {
-- 
cgit v1.2.1