aboutsummaryrefslogtreecommitdiff
path: root/R/intervals.R
diff options
context:
space:
mode:
authorJohannes Ranke <jranke@uni-bremen.de>2022-03-07 12:03:40 +0100
committerJohannes Ranke <jranke@uni-bremen.de>2022-03-07 14:55:21 +0100
commit7035cde3a53781721fe15a8893fdf328c789bdd2 (patch)
treea1e4929faf9d645caedc0ed4dcc5036252497c63 /R/intervals.R
parent77c248ca40b82ec00a756cd82f12968131f78959 (diff)
Remove nlmixr interface for release of mkin 1.1.0
I am postponing my attempts to get the nlmixr interface to CRAN, given some problems with nlmixr using R-devel under Windows, see https://github.com/nlmixrdevelopment/nlmixr/issues/596 and https://github.com/r-hub/rhub/issues/512, which is fixed by the removal of nlmixr from the testsuite. For the tests to be more platform independent, the biphasic mixed effects models test dataset was defined in a way that fitting should be more robust (less ill-defined).
Diffstat (limited to 'R/intervals.R')
-rw-r--r--R/intervals.R84
1 files changed, 0 insertions, 84 deletions
diff --git a/R/intervals.R b/R/intervals.R
index 8ab2b7ec..258eb4ad 100644
--- a/R/intervals.R
+++ b/R/intervals.R
@@ -95,87 +95,3 @@ intervals.saem.mmkin <- function(object, level = 0.95, backtransform = TRUE, ...
attr(res, "level") <- level
return(res)
}
-
-#' Confidence intervals for parameters in nlmixr.mmkin objects
-#'
-#' @param object The fitted saem.mmkin object
-#' @param level The confidence level.
-#' @param backtransform Should we backtransform the parameters where a one to
-#' one correlation between transformed and backtransformed parameters exists?
-#' @param \dots For compatibility with the generic method
-#' @importFrom nlme intervals
-#' @return An object with 'intervals.saem.mmkin' and 'intervals.lme' in the
-#' class attribute
-#' @export
-intervals.nlmixr.mmkin <- function(object, level = 0.95, backtransform = TRUE, ...)
-{
-
- # Fixed effects
- mod_vars <- names(object$mkinmod$diffs)
-
- conf.int <- confint(object$nm)
- dpnames <- setdiff(rownames(conf.int), names(object$mean_ep_start))
- ndp <- length(dpnames)
-
- confint_trans <- as.matrix(conf.int[dpnames, c(3, 1, 4)])
- colnames(confint_trans) <- c("lower", "est.", "upper")
-
- if (backtransform) {
- bp <- backtransform_odeparms(confint_trans[, "est."], object$mkinmod,
- object$transform_rates, object$transform_fractions)
- bpnames <- names(bp)
-
- # Transform boundaries of CI for one parameter at a time,
- # 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 = "_"), dpnames, value = TRUE)
- n_paths <- length(f_names)
- if (n_paths > 1) f_names_skip <- c(f_names_skip, f_names)
- }
-
- confint_back <- matrix(NA, nrow = length(bp), ncol = 3,
- dimnames = list(bpnames, colnames(confint_trans)))
- confint_back[, "est."] <- bp
-
- for (pname in dpnames) {
- if (!pname %in% f_names_skip) {
- par.lower <- confint_trans[pname, "lower"]
- par.upper <- confint_trans[pname, "upper"]
- names(par.lower) <- names(par.upper) <- pname
- bpl <- backtransform_odeparms(par.lower, object$mkinmod,
- object$transform_rates,
- object$transform_fractions)
- bpu <- backtransform_odeparms(par.upper, object$mkinmod,
- object$transform_rates,
- object$transform_fractions)
- confint_back[names(bpl), "lower"] <- bpl
- confint_back[names(bpu), "upper"] <- bpu
- }
- }
- confint_ret <- confint_back
- } else {
- confint_ret <- confint_trans
- }
- attr(confint_ret, "label") <- "Fixed effects:"
-
- # Random effects
- ranef_ret <- as.matrix(data.frame(lower = NA,
- "est." = sqrt(diag(object$nm$omega)), upper = NA))
- rownames(ranef_ret) <- paste0(gsub("eta\\.", "sd(", rownames(ranef_ret)), ")")
- attr(ranef_ret, "label") <- "Random effects:"
-
- # Error model
- enames <- names(object$nm$sigma)
- err_ret <- as.matrix(conf.int[enames, c(3, 1, 4)])
- colnames(err_ret) <- c("lower", "est.", "upper")
-
- res <- list(
- fixed = confint_ret,
- random = ranef_ret,
- errmod = err_ret
- )
- class(res) <- c("intervals.nlmixr.mmkin", "intervals.lme")
- attr(res, "level") <- level
- return(res)
-}

Contact - Imprint