Rudimentary support for setting up nlmixr models

- All degradation models are specified as ODE models. This appears to be
fast enough
- Error models are being translated to nlmixr as close to the mkin error
model as possible. When using the 'saem' backend, it appears not to be
possible to use the same error model for more than one observed variable
- No support yet for models with parallel formation of metabolites, where
the ilr transformation is used in mkin per default
- There is a bug in nlmixr which appears to be triggered if the data are
not balanced, see nlmixrdevelopment/nlmixr#530
- There is a print and a plot method, the summary method is not finished

1 files changed, 0 insertions, 55 deletions

diff --git a/R/nlme.R b/R/nlme.R
index d235a094..8762f137 100644
--- a/R/nlme.R
+++ b/R/nlme.R
@@ -125,61 +125,6 @@ nlme_function <- function(object) {
 }
 
 #' @rdname nlme
-#' @return If random is FALSE (default), a named vector containing mean values
-#'   of the fitted degradation model parameters. If random is TRUE, a list with
-#'   fixed and random effects, in the format required by the start argument of
-#'   nlme for the case of a single grouping variable ds.
-#' @param random Should a list with fixed and random effects be returned?
-#' @param test_log_parms If TRUE, log parameters are only considered in
-#'   the mean calculations if their untransformed counterparts (most likely
-#'   rate constants) pass the t-test for significant difference from zero.
-#' @param conf.level Possibility to adjust the required confidence level
-#'   for parameter that are tested if requested by 'test_log_parms'.
-#' @export
-mean_degparms <- function(object, random = FALSE, test_log_parms = FALSE, conf.level = 0.6)
-{
-  if (nrow(object) > 1) stop("Only row objects allowed")
-  parm_mat_trans <- sapply(object, parms, transformed = TRUE)
-
-  if (test_log_parms) {
-      parm_mat_dim <- dim(parm_mat_trans)
-      parm_mat_dimnames <- dimnames(parm_mat_trans)
-
-      log_parm_trans_names <- grep("^log_", rownames(parm_mat_trans), value = TRUE)
-      log_parm_names <- gsub("^log_", "", log_parm_trans_names)
-
-      t_test_back_OK <- matrix(
-        sapply(object, function(o) {
-          suppressWarnings(summary(o)$bpar[log_parm_names, "Pr(>t)"] < (1 - conf.level))
-        }), nrow = length(log_parm_names))
-      rownames(t_test_back_OK) <- log_parm_trans_names
-
-      parm_mat_trans_OK <- parm_mat_trans
-      for (trans_parm in log_parm_trans_names) {
-        parm_mat_trans_OK[trans_parm, ] <- ifelse(t_test_back_OK[trans_parm, ],
-          parm_mat_trans[trans_parm, ], NA)
-      }
-    } else {
-    parm_mat_trans_OK <- parm_mat_trans
-  }
-
-  mean_degparm_names <- setdiff(rownames(parm_mat_trans), names(object[[1]]$errparms))
-  degparm_mat_trans <- parm_mat_trans[mean_degparm_names, , drop = FALSE]
-  degparm_mat_trans_OK <- parm_mat_trans_OK[mean_degparm_names, , drop = FALSE]
-
-  fixed <- apply(degparm_mat_trans_OK, 1, mean, na.rm = TRUE)
-  if (random) {
-    random <- t(apply(degparm_mat_trans[mean_degparm_names, , drop = FALSE], 2, function(column) column - fixed))
-    # If we only have one parameter, apply returns a vector so we get a single row
-    if (nrow(degparm_mat_trans) == 1) random <- t(random)
-    rownames(random) <- levels(nlme_data(object)$ds)
-    return(list(fixed = fixed, random = list(ds = random)))
-  } else {
-    return(fixed)
-  }
-}
-
-#' @rdname nlme
 #' @importFrom purrr map_dfr
 #' @return A \code{\link{groupedData}} object
 #' @export