diff options
Diffstat (limited to 'R')
| -rw-r--r-- | R/endpoints.R | 4 | ||||
| -rw-r--r-- | R/mean_degparms.R | 3 | ||||
| -rw-r--r-- | R/nlmixr.R | 29 | ||||
| -rw-r--r-- | R/summary.nlmixr.mmkin.R | 50 |
4 files changed, 51 insertions, 35 deletions
diff --git a/R/endpoints.R b/R/endpoints.R index f1f47581..6bf52f07 100644 --- a/R/endpoints.R +++ b/R/endpoints.R @@ -10,8 +10,8 @@ #' Additional DT50 values are calculated from the FOMC DT90 and k1 and k2 from #' HS and DFOP, as well as from Eigenvalues b1 and b2 of any SFORB models #' -#' @param fit An object of class [mkinfit], [nlme.mmkin] or -#' [saem.mmkin]. Or another object that has list components +#' @param fit An object of class [mkinfit], [nlme.mmkin], [saem.mmkin] or +#' [nlmixr.mmkin]. Or another object that has list components #' mkinmod containing an [mkinmod] degradation model, and two numeric vectors, #' bparms.optim and bparms.fixed, that contain parameter values #' for that model. diff --git a/R/mean_degparms.R b/R/mean_degparms.R index ec7f4342..ec20c068 100644 --- a/R/mean_degparms.R +++ b/R/mean_degparms.R @@ -4,6 +4,7 @@ #' 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 object An mmkin row object containing several fits of the same model to different datasets #' @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 @@ -51,7 +52,7 @@ mean_degparms <- function(object, random = FALSE, test_log_parms = FALSE, conf.l # For nlmixr we can specify starting values for standard deviations eta, and # we ignore uncertain parameters if test_log_parms is FALSE - eta <- apply(degparm_mat_trans_OK, 1, sd, na.rm = TRUE) + eta <- apply(degparm_mat_trans_OK, 1, stats::sd, na.rm = TRUE) return(list(fixed = fixed, random = list(ds = random), eta = eta)) } else { @@ -1,4 +1,7 @@ -utils::globalVariables(c("predicted", "std")) +utils::globalVariables(c("predicted", "std", "ID", "TIME", "CMT", "DV", "IPRED", "IRES", "IWRES")) + +#' @export +nlmixr::nlmixr #' Fit nonlinear mixed models using nlmixr #' @@ -10,8 +13,10 @@ utils::globalVariables(c("predicted", "std")) #' obtained by fitting the same model to a list of datasets using [mkinfit]. #' #' @importFrom nlmixr nlmixr tableControl +#' @importFrom dplyr %>% #' @param object An [mmkin] row object containing several fits of the same #' [mkinmod] model to different datasets +#' @param data Not used, the data are extracted from the mmkin row object #' @param est Estimation method passed to [nlmixr::nlmixr] #' @param degparms_start Parameter values given as a named numeric vector will #' be used to override the starting values obtained from the 'mmkin' object. @@ -21,22 +26,28 @@ utils::globalVariables(c("predicted", "std")) #' when calculating mean degradation parameters using [mean_degparms]. #' @param conf.level Possibility to adjust the required confidence level #' for parameter that are tested if requested by 'test_log_parms'. -#' @param solution_type Possibility to specify the solution type in case the -#' automatic choice is not desired -#' @param control Passed to [nlmixr::nlmixr]. +#' @param data Not used, as the data are extracted from the mmkin row object +#' @param table Passed to [nlmixr::nlmixr] +#' @param error_model Possibility to override the error model which is being +#' set based on the error model used in the mmkin row object. +#' @param control Passed to [nlmixr::nlmixr] #' @param \dots Passed to [nlmixr_model] +#' @param save Passed to [nlmixr::nlmixr] +#' @param envir Passed to [nlmixr::nlmixr] #' @return An S3 object of class 'nlmixr.mmkin', containing the fitted #' [nlmixr::nlmixr] object as a list component named 'nm'. The #' object also inherits from 'mixed.mmkin'. #' @seealso [summary.nlmixr.mmkin] [plot.mixed.mmkin] #' @examples +#' \dontrun{ #' ds <- lapply(experimental_data_for_UBA_2019[6:10], #' function(x) subset(x$data[c("name", "time", "value")])) #' names(ds) <- paste("Dataset", 6:10) +#' #' f_mmkin_parent <- mmkin(c("SFO", "FOMC", "DFOP", "HS"), ds, quiet = TRUE, cores = 1) #' f_mmkin_parent_tc <- mmkin(c("SFO", "FOMC", "DFOP"), ds, error_model = "tc", #' cores = 1, quiet = TRUE) -#' +#' #' f_nlmixr_sfo_saem <- nlmixr(f_mmkin_parent["SFO", ], est = "saem") #' f_nlmixr_sfo_focei <- nlmixr(f_mmkin_parent["SFO", ], est = "focei") #' @@ -66,7 +77,6 @@ utils::globalVariables(c("predicted", "std")) #' # solution, the two-component error model does not improve it #' plot(f_nlmixr_fomc_saem) #' -#' \dontrun{ #' sfo_sfo <- mkinmod(parent = mkinsub("SFO", "A1"), #' A1 = mkinsub("SFO")) #' fomc_sfo <- mkinmod(parent = mkinsub("FOMC", "A1"), @@ -167,7 +177,8 @@ nlmixr.mmkin <- function(object, data = NULL, return_data <- nlmixr_df %>% dplyr::transmute(ds = ID, name = CMT, time = TIME, value = DV, predicted = IPRED, residual = IRES, - std = IRES/IWRES, standardized = IWRES) + std = IRES/IWRES, standardized = IWRES) %>% + dplyr::arrange(ds, name, time) bparms_optim <- backtransform_odeparms(f_nlmixr$theta, object[[1]]$mkinmod, @@ -227,6 +238,9 @@ print.nlmixr.mmkin <- function(x, digits = max(3, getOption("digits") - 3), ...) } #' @rdname nlmixr.mmkin +#' @param add_attributes Should the starting values used for degradation model +#' parameters and their distribution and for the error model parameters +#' be returned as attributes? #' @return An function defining a model suitable for fitting with [nlmixr::nlmixr]. #' @export nlmixr_model <- function(object, @@ -435,6 +449,7 @@ nlmixr_model <- function(object, if (add_attributes) { attr(f, "mean_dp_start") <- degparms_optim + attr(f, "eta_start") <- degparms_mmkin$eta attr(f, "mean_ep_start") <- errparms_ini } diff --git a/R/summary.nlmixr.mmkin.R b/R/summary.nlmixr.mmkin.R index ae8e32cf..f2d7c607 100644 --- a/R/summary.nlmixr.mmkin.R +++ b/R/summary.nlmixr.mmkin.R @@ -6,8 +6,9 @@ #' endpoints such as formation fractions and DT50 values. Optionally #' (default is FALSE), the data are listed in full. #' -#' @param object an object of class [nlmix.mmkin] -#' @param x an object of class [summary.nlmix.mmkin] +#' @importFrom stats confint sd +#' @param object an object of class [nlmixr.mmkin] +#' @param x an object of class [summary.nlmixr.mmkin] #' @param data logical, indicating whether the full data should be included in #' the summary. #' @param verbose Should the summary be verbose? @@ -23,9 +24,7 @@ #' \item{diffs}{The differential equations used in the degradation model} #' \item{use_of_ff}{Was maximum or minimum use made of formation fractions} #' \item{data}{The data} -#' \item{confint_trans}{Transformed parameters as used in the optimisation, with confidence intervals} #' \item{confint_back}{Backtransformed parameters, with confidence intervals if available} -#' \item{confint_errmod}{Error model parameters with confidence intervals} #' \item{ff}{The estimated formation fractions derived from the fitted #' model.} #' \item{distimes}{The DT50 and DT90 values for each observed variable.} @@ -78,7 +77,7 @@ #' # The following takes a very long time but gives #' f_nlmixr_dfop_sfo_focei <- nlmixr(f_mmkin_dfop_sfo, est = "focei") #' AIC(f_nlmixr_dfop_sfo_saem$nm, f_nlmixr_dfop_sfo_focei$nm) -#' summary(f_nlmixr_dfop_sfo, data = TRUE) +#' summary(f_nlmixr_dfop_sfo_sfo, data = TRUE) #' } #' #' @export @@ -134,6 +133,7 @@ summary.nlmixr.mmkin <- function(object, data = FALSE, verbose = FALSE, distimes dim(varFix), list(pnames, pnames)) + object$confint_trans <- confint_trans object$confint_back <- confint_back object$date.summary = date() @@ -141,31 +141,29 @@ summary.nlmixr.mmkin <- function(object, data = FALSE, verbose = FALSE, distimes object$diffs <- object$mkinmod$diffs object$print_data <- data # boolean: Should we print the data? - predict(object$nm) - so_pred <- object$so@results@predictions names(object$data)[4] <- "observed" # rename value to observed object$verbose <- verbose object$fixed <- object$mmkin_orig[[1]]$fixed - object$AIC = AIC(object$so) - object$BIC = BIC(object$so) - object$logLik = logLik(object$so, method = "is") + object$AIC = AIC(object$nm) + object$BIC = BIC(object$nm) + object$logLik = logLik(object$nm) ep <- endpoints(object) if (length(ep$ff) != 0) object$ff <- ep$ff if (distimes) object$distimes <- ep$distimes if (length(ep$SFORB) != 0) object$SFORB <- ep$SFORB - class(object) <- c("summary.saem.mmkin") + class(object) <- c("summary.nlmixr.mmkin") return(object) } -#' @rdname summary.saem.mmkin +#' @rdname summary.nlmixr.mmkin #' @export -print.summary.saem.mmkin <- function(x, digits = max(3, getOption("digits") - 3), verbose = x$verbose, ...) { - cat("saemix version used for fitting: ", x$saemixversion, "\n") +print.summary.nlmixr.mmkin <- function(x, digits = max(3, getOption("digits") - 3), verbose = x$verbose, ...) { + cat("nlmixr version used for fitting: ", x$nlmixrversion, "\n") cat("mkin version used for pre-fitting: ", x$mkinversion, "\n") cat("R version used for fitting: ", x$Rversion, "\n") @@ -181,25 +179,29 @@ print.summary.saem.mmkin <- function(x, digits = max(3, getOption("digits") - 3) length(unique(x$data$name)), "variable(s) grouped in", length(unique(x$data$ds)), "datasets\n") - cat("\nModel predictions using solution type", x$solution_type, "\n") + cat("\nDegradation model predictions using RxODE\n") - cat("\nFitted in", x$time[["elapsed"]], "s using", paste(x$so@options$nbiter.saemix, collapse = ", "), "iterations\n") + cat("\nFitted in", x$time[["elapsed"]], "s\n") cat("\nVariance model: ") cat(switch(x$err_mod, const = "Constant variance", obs = "Variance unique to each observed variable", - tc = "Two-component variance function"), "\n") + tc = "Two-component variance function", + obs_tc = "Two-component variance unique to each observed variable"), "\n") cat("\nMean of starting values for individual parameters:\n") print(x$mean_dp_start, digits = digits) + cat("\nMean of starting values for error model parameters:\n") + print(x$mean_ep_start, digits = digits) + cat("\nFixed degradation parameter values:\n") if(length(x$fixed$value) == 0) cat("None\n") else print(x$fixed, digits = digits) cat("\nResults:\n\n") - cat("Likelihood computed by importance sampling\n") + cat("Likelihood calculated by", nlmixr::getOfvType(x$nm), " \n") print(data.frame(AIC = x$AIC, BIC = x$BIC, logLik = x$logLik, row.names = " "), digits = digits) @@ -212,16 +214,14 @@ print.summary.saem.mmkin <- function(x, digits = max(3, getOption("digits") - 3) print(corr, title = "\nCorrelation:", ...) } - cat("\nRandom effects:\n") - print(x$confint_ranef, digits = digits) + cat("\nRandom effects (omega):\n") + print(x$nm$omega, digits = digits) cat("\nVariance model:\n") - print(x$confint_errmod, digits = digits) + print(x$nm$sigma, digits = digits) - if (x$transformations == "mkin") { - cat("\nBacktransformed parameters:\n") - print(x$confint_back, digits = digits) - } + cat("\nBacktransformed parameters:\n") + print(x$confint_back, digits = digits) printSFORB <- !is.null(x$SFORB) if(printSFORB){ |