diff options
Diffstat (limited to 'R')
-rw-r--r-- | R/dimethenamid_2018.R | 14 | ||||
-rw-r--r-- | R/summary.nlmixr.mmkin.R | 14 | ||||
-rw-r--r-- | R/tffm0.R | 6 | ||||
-rw-r--r-- | R/transform_odeparms.R | 13 |
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 @@ -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 { |