diff options
33 files changed, 1672 insertions, 129 deletions
diff --git a/DESCRIPTION b/DESCRIPTION index 544af139..3642ac5c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -17,7 +17,8 @@ Description: Calculation routines based on the FOCUS Kinetics Report (2006, equation models are solved using compiled C functions. Please note that no warranty is implied for correctness of results or fitness for a particular purpose. -Imports: stats, graphics, methods, deSolve, R6, inline, parallel, numDeriv +Imports: stats, graphics, methods, deSolve, R6, inline, parallel, numDeriv, + lmtest Suggests: knitr, rbenchmark, tikzDevice, testthat, rmarkdown, covr, vdiffr, benchmarkme, tibble, stats4 License: GPL @@ -4,6 +4,7 @@ S3method("[",mmkin) S3method(AIC,mmkin) S3method(confint,mkinfit) S3method(logLik,mkinfit) +S3method(lrtest,mkinfit) S3method(mkinpredict,mkinfit) S3method(mkinpredict,mkinmod) S3method(parms,mkinfit) @@ -14,7 +15,9 @@ S3method(print,mkinds) S3method(print,mkinmod) S3method(print,nafta) S3method(print,summary.mkinfit) +S3method(residuals,mkinfit) S3method(summary,mkinfit) +S3method(update,mkinfit) export(CAKE_export) export(DFOP.solution) export(FOMC.solution) @@ -28,6 +31,7 @@ export(endpoints) export(ilr) export(invilr) export(logistic.solution) +export(lrtest) export(max_twa_dfop) export(max_twa_fomc) export(max_twa_hs) @@ -59,6 +63,7 @@ importFrom(R6,R6Class) importFrom(grDevices,dev.cur) importFrom(inline,cfunction) importFrom(inline,getDynLib) +importFrom(lmtest,lrtest) importFrom(methods,signature) importFrom(parallel,detectCores) importFrom(parallel,mclapply) @@ -66,6 +71,7 @@ importFrom(parallel,parLapply) importFrom(stats,aggregate) importFrom(stats,cov2cor) importFrom(stats,dist) +importFrom(stats,logLik) importFrom(stats,nlminb) importFrom(stats,optimize) importFrom(stats,pt) @@ -74,4 +80,5 @@ importFrom(stats,qf) importFrom(stats,qnorm) importFrom(stats,qt) importFrom(stats,rnorm) +importFrom(stats,update) importFrom(utils,write.table) @@ -1,5 +1,13 @@ # mkin 0.9.49.6 (unreleased) +- Implement a likelihood ratio test as a method for 'lrtest' from the lmtest package + +- Add an 'update' method for mkinfit objects which remembers fitted parameters if appropriate + +- Add a 'residuals' method for mkinfit objects that supports scaling based on the error model + +- Fix a bug in 'mkinfit' that prevented summaries of objects fitted with fixed parameters to be generated + - Add 'parms' and 'confint' methods for mkinfit objects. Confidence intervals based on the quadratic approximation as in the summary, and based on the profile likelihood - Move long-running tests to tests/testthat/slow with a separate test log. They currently take around 7 minutes on my system diff --git a/R/confint.mkinfit.R b/R/confint.mkinfit.R index fadd14ae..5e1703d6 100644 --- a/R/confint.mkinfit.R +++ b/R/confint.mkinfit.R @@ -57,7 +57,8 @@ #' # c("k_parent_sink", "k_parent_m1", "k_m1_sink", "sigma"), cores = 1)) #' # If we exclude parent_0 (the confidence of which is often of minor interest), we get a nice #' # performance improvement from about 30 seconds to about 12 seconds -#' # system.time(ci_profile_no_parent_0 <- confint(f_d_1, c("k_parent_sink", "k_parent_m1", "k_m1_sink", "sigma"), cores = 4)) +#' # system.time(ci_profile_no_parent_0 <- confint(f_d_1, +#' # c("k_parent_sink", "k_parent_m1", "k_m1_sink", "sigma"), cores = 4)) #' ci_profile #' ci_quadratic_transformed <- confint(f_d_1, method = "quadratic") #' ci_quadratic_transformed diff --git a/R/logLik.mkinfit.R b/R/logLik.mkinfit.R index 4ec3d7d4..cadc0d0a 100644 --- a/R/logLik.mkinfit.R +++ b/R/logLik.mkinfit.R @@ -1,9 +1,10 @@ #' Calculated the log-likelihood of a fitted mkinfit object #' -#' This function simply calculates the product of the likelihood densities -#' calculated using \code{\link{dnorm}}, i.e. assuming normal distribution, -#' with of the mean predicted by the degradation model, and the standard -#' deviation predicted by the error model. +#' This function returns the product of the likelihood densities of each +#' observed value, as calculated as part of the fitting procedure using +#' \code{\link{dnorm}}, i.e. assuming normal distribution, and with the means +#' predicted by the degradation model, and the standard deviations predicted by +#' the error model. #' #' The total number of estimated parameters returned with the value of the #' likelihood is calculated as the sum of fitted degradation model parameters diff --git a/R/lrtest.mkinfit.R b/R/lrtest.mkinfit.R new file mode 100644 index 00000000..9c0a9039 --- /dev/null +++ b/R/lrtest.mkinfit.R @@ -0,0 +1,57 @@ +#' @importFrom lmtest lrtest +#' @export +lmtest::lrtest + +#' Likelihood ratio test for mkinfit models +#' +#' Compare two mkinfit models based on their likelihood. If two fitted +#' mkinfit objects are given as arguments, it is checked if they have been +#' fitted to the same data. It is the responsibility of the user to make sure +#' that the models are nested, i.e. one of them has less degrees of freedom +#' and can be expressed by fixing the parameters of the other. +#' +#' Alternatively, an argument to mkinfit can be given which is then passed +#' to \code{\link{update.mkinfit}} to obtain the alternative model. +#' +#' The comparison is then made by the \code{\link[lmtest]{lrtest.default}} +#' method from the lmtest package. The model with the higher number of fitted +#' parameters (alternative hypothesis) is listed first, then the model with the +#' lower number of fitted parameters (null hypothesis). +#' +#' @importFrom stats logLik update +#' @param object An \code{\link{mkinfit}} object +#' @param object_2 Optionally, another mkinfit object fitted to the same data. +#' @param \dots Argument to \code{\link{mkinfit}}, passed to +#' \code{\link{update.mkinfit}} for creating the alternative fitted object. +#' @examples +#' \dontrun{ +#' test_data <- subset(synthetic_data_for_UBA_2014[[12]]$data, name == "parent") +#' sfo_fit <- mkinfit("SFO", test_data, quiet = TRUE) +#' dfop_fit <- mkinfit("DFOP", test_data, quiet = TRUE) +#' lrtest(dfop_fit, sfo_fit) +#' lrtest(sfo_fit, dfop_fit) +#' lrtest(dfop_fit, error_model = "tc") +#' lrtest(dfop_fit, fixed_parms = c(k2 = 0)) +#' } +#' @export +lrtest.mkinfit <- function(object, object_2 = NULL, ...) { + + name_function <- function(x) { + paste(x$mkinmod$name, "with error model", x$err_mod) + } + + if (is.null(object_2)) { + object_2 <- update(object, ...) + } else { + data_object <- object$data[c("time", "variable", "observed")] + data_object_2 <- object_2$data[c("time", "variable", "observed")] + if (!identical(data_object, data_object_2)) { + stop("It seems that the mkinfit objects have not been fitted to the same data") + } + } + if (attr(logLik(object), "df") > attr(logLik(object_2), "df")) { + lmtest::lrtest.default(object, object_2, name = name_function) + } else { + lmtest::lrtest.default(object_2, object, name = name_function) + } +} diff --git a/R/mkinfit.R b/R/mkinfit.R index a3e39053..27c769db 100644 --- a/R/mkinfit.R +++ b/R/mkinfit.R @@ -52,7 +52,9 @@ if(getRversion() >= '2.15.1') utils::globalVariables(c("name", "time", "value")) #' default values. Otherwise, inital values for all error model parameters #' must be given. #' @param fixed_parms The names of parameters that should not be optimised but -#' rather kept at the values specified in \code{parms.ini}. +#' rather kept at the values specified in \code{parms.ini}. Alternatively, +#' a named numeric vector of parameters to be fixed, regardless of the values +#' in parms.ini. #' @param fixed_initials The names of model variables for which the initial #' state at time 0 should be excluded from the optimisation. Defaults to all #' state variables except for the first one. @@ -253,6 +255,12 @@ mkinfit <- function(mkinmod, observed, trace_parms = FALSE, ...) { + call <- match.call() + + # Derive the name used for the model + if (is.character(mkinmod)) mkinmod_name <- mkinmod + else mkinmod_name <- deparse(substitute(mkinmod)) + # Check mkinmod and generate a model for the variable whith the highest value # if a suitable string is given parent_models_available = c("SFO", "FOMC", "DFOP", "HS", "SFORB", "IORE", "logistic") @@ -302,6 +310,14 @@ mkinfit <- function(mkinmod, observed, # Define starting values for parameters where not specified by the user if (parms.ini[[1]] == "auto") parms.ini = vector() + # Override parms.ini for parameters given as a numeric vector in + # fixed_parms + if (is.numeric(fixed_parms)) { + fixed_parm_names <- names(fixed_parms) + parms.ini[fixed_parm_names] <- fixed_parms + fixed_parms <- fixed_parm_names + } + # Warn for inital parameter specifications that are not in the model wrongpar.names <- setdiff(names(parms.ini), mkinmod$parms) if (length(wrongpar.names) > 0) { @@ -384,15 +400,22 @@ mkinfit <- function(mkinmod, observed, # Set default for state.ini if appropriate parent_name = names(mkinmod$spec)[[1]] + parent_time_0 = subset(observed, time == 0 & name == parent_name)$value + parent_time_0_mean = mean(parent_time_0, na.rm = TRUE) + if (is.na(parent_time_0_mean)) { + state.ini_auto = c(100, rep(0, length(mkinmod$diffs) - 1)) + } else { + state.ini_auto = c(parent_time_0_mean, rep(0, length(mkinmod$diffs) - 1)) + } + names(state.ini_auto) <- mod_vars + if (state.ini[1] == "auto") { - parent_time_0 = subset(observed, time == 0 & name == parent_name)$value - parent_time_0_mean = mean(parent_time_0, na.rm = TRUE) - if (is.na(parent_time_0_mean)) { - state.ini = c(100, rep(0, length(mkinmod$diffs) - 1)) - } else { - state.ini = c(parent_time_0_mean, rep(0, length(mkinmod$diffs) - 1)) - } + state.ini_used <- state.ini_auto + } else { + state.ini_used <- state.ini_auto + state.ini_used[names(state.ini)] <- state.ini } + state.ini <- state.ini_used # Name the inital state variable values if they are not named yet if(is.null(names(state.ini))) names(state.ini) <- mod_vars @@ -799,19 +822,21 @@ mkinfit <- function(mkinmod, observed, names(c(degparms, errparms))) # Backtransform parameters - bparms.optim = backtransform_odeparms(fit$par, mkinmod, + bparms.optim = backtransform_odeparms(degparms, mkinmod, transform_rates = transform_rates, transform_fractions = transform_fractions) bparms.fixed = c(state.ini.fixed, parms.fixed) bparms.all = c(bparms.optim, parms.fixed) - fit$hessian_notrans <- try(numDeriv::hessian(cost_function, c(bparms.all, errparms), + fit$hessian_notrans <- try(numDeriv::hessian(cost_function, c(bparms.optim, errparms), OLS = FALSE, trans = FALSE, update_data = FALSE), silent = TRUE) - dimnames(fit$hessian_notrans) <- list(names(c(bparms.all, errparms)), - names(c(bparms.all, errparms))) + dimnames(fit$hessian_notrans) <- list(names(c(bparms.optim, errparms)), + names(c(bparms.optim, errparms))) }) + fit$call <- call + fit$error_model_algorithm <- error_model_algorithm if (fit$convergence != 0) { @@ -831,8 +856,9 @@ mkinfit <- function(mkinmod, observed, fit$calls <- calls fit$time <- fit_time - # We also need the model for summary and plotting + # We also need the model and a model name for summary and plotting fit$mkinmod <- mkinmod + fit$mkinmod$name <- mkinmod_name # We need data and predictions for summary and plotting fit$observed <- observed diff --git a/R/residuals.mkinfit.R b/R/residuals.mkinfit.R new file mode 100644 index 00000000..96bcf01c --- /dev/null +++ b/R/residuals.mkinfit.R @@ -0,0 +1,31 @@ +#' Extract residuals from an mkinfit model +#' +#' @param object An \code{\link{mkinfit}} object +#' @param standardized Should the residuals be standardized by dividing by the +#' standard deviation obtained from the fitted error model? +#' @param \dots Not used +#' @export +#' @examples +#' f <- mkinfit("DFOP", FOCUS_2006_C, quiet = TRUE) +#' residuals(f) +#' residuals(f, standardized = TRUE) +residuals.mkinfit <- function(object, standardized = FALSE, ...) { + res <- object$data[["residual"]] + if (standardized) { + if (object$err_mod == "const") { + sigma_fitted <- object$errparms["sigma"] + } + if (object$err_mod == "obs") { + sigma_names = paste0("sigma_", object$data[["variable"]]) + sigma_fitted <- object$errparms[sigma_names] + } + if (object$err_mod == "tc") { + sigma_fitted <- sigma_twocomp(object$data[["predicted"]], + sigma_low = object$errparms[1], + rsd_high = object$errparms[2]) + } + return(res / sigma_fitted) + } + return(res) +} + diff --git a/R/update.mkinfit.R b/R/update.mkinfit.R new file mode 100644 index 00000000..2f0814e0 --- /dev/null +++ b/R/update.mkinfit.R @@ -0,0 +1,57 @@ +#' Update an mkinfit model with different arguments +#' +#' This function will return an updated mkinfit object. The fitted degradation +#' model parameters from the old fit are used as starting values for the +#' updated fit. Values specified as 'parms.ini' and/or 'state.ini' will +#' override these starting values. +#' +#' @param object An mkinfit object to be updated +#' @param \dots Arguments to \code{\link{mkinfit}} that should replace +#' the arguments from the original call. Arguments set to NULL will +#' remove arguments given in the original call +#' @param evaluate Should the call be evaluated or returned as a call +#' @examples +#' \dontrun{ +#' fit <- mkinfit("DFOP", subset(FOCUS_2006_D, value != 0), quiet = TRUE) +#' update(fit, error_model = "tc") +#' } +#' @export +update.mkinfit <- function(object, ..., evaluate = TRUE) +{ + call <- object$call + + update_arguments <- match.call(expand.dots = FALSE)$... + + # Get optimised ODE parameters and let parms.ini override them + ode_optim_names <- intersect(names(object$bparms.optim), names(object$bparms.ode)) + ode_start <- object$bparms.optim[ode_optim_names] + if ("parms.ini" %in% names(update_arguments)) { + ode_start[names(update_arguments["parms.ini"])] <- update_arguments["parms.ini"] + } + if (length(ode_start)) update_arguments[["parms.ini"]] <- ode_start + + # Get optimised values for initial states and let state.ini override them + state_optim_names <- intersect(names(object$bparms.optim), paste0(names(object$bparms.state), "_0")) + state_start <- object$bparms.optim[state_optim_names] + names(state_start) <- gsub("_0$", "", names(state_start)) + if ("state.ini" %in% names(update_arguments)) { + state_start[names(update_arguments["state.ini"])] <- update_arguments["state.ini"] + } + if (length(state_start)) update_arguments[["state.ini"]] <- state_start + + if (length(update_arguments) > 0) { + update_arguments_in_call <- !is.na(match(names(update_arguments), names(call))) + + for (a in names(update_arguments)[update_arguments_in_call]) { + call[[a]] <- update_arguments[[a]] + } + + update_arguments_not_in_call <- !update_arguments_in_call + if(any(update_arguments_not_in_call)) { + call <- c(as.list(call), update_arguments[update_arguments_not_in_call]) + call <- as.call(call) + } + } + if(evaluate) eval(call, parent.frame()) + else call +} diff --git a/_pkgdown.yml b/_pkgdown.yml index bbf63301..2409bc85 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -17,15 +17,14 @@ reference: desc: Functions working with mkinfit objects contents: - plot.mkinfit + - summary.mkinfit - parms.mkinfit - confint.mkinfit - - summary.mkinfit - - logLik.mkinfit - - mkinresplot - - mkinparplot - - mkinerrplot - - endpoints + - update.mkinfit + - lrtest.mkinfit - mkinerrmin + - endpoints + - CAKE_export - title: Work with mmkin objects desc: Functions working with aggregated results contents: @@ -53,7 +52,7 @@ reference: - nafta - print.nafta - plot.nafta - - title: Helper functions + - title: Helper functions mainly used internally contents: - mkinsub - max_twa_parent @@ -64,7 +63,11 @@ reference: - transform_odeparms - ilr - sigma_twocomp - - CAKE_export + - logLik.mkinfit + - residuals.mkinfit + - mkinresplot + - mkinparplot + - mkinerrplot - title: Analytical solutions desc: Parent only model solutions contents: diff --git a/docs/news/index.html b/docs/news/index.html index 1322f75d..52bc3458 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -134,6 +134,10 @@ <a href="#mkin-0-9-49-6-unreleased" class="anchor"></a>mkin 0.9.49.6 (unreleased)<small> Unreleased </small> </h1> <ul> +<li><p>Implement a likelihood ratio test as a method for ‘lrtest’ from the lmtest package</p></li> +<li><p>Add an ‘update’ method for mkinfit objects which remembers fitted parameters if appropriate</p></li> +<li><p>Add a ‘residuals’ method for mkinfit objects that supports scaling based on the error model</p></li> +<li><p>Fix a bug in ‘mkinfit’ that prevented summaries of objects fitted with fixed parameters to be generated</p></li> <li><p>Add ‘parms’ and ‘confint’ methods for mkinfit objects. Confidence intervals based on the quadratic approximation as in the summary, and based on the profile likelihood</p></li> <li><p>Move long-running tests to tests/testthat/slow with a separate test log. They currently take around 7 minutes on my system</p></li> <li><p>‘mkinfit’: Clean the code and return functions to calculate the log-likelihood and the sum of squared residuals</p></li> diff --git a/docs/reference/confint.mkinfit.html b/docs/reference/confint.mkinfit.html index 27fdb304..6fb806fc 100644 --- a/docs/reference/confint.mkinfit.html +++ b/docs/reference/confint.mkinfit.html @@ -236,13 +236,14 @@ machines, cores > 1 is not supported.</p></td> <span class='kw'>use_of_ff</span> <span class='kw'>=</span> <span class='st'>"max"</span>, <span class='kw'>quiet</span> <span class='kw'>=</span> <span class='fl'>TRUE</span>) <span class='no'>f_d_1</span> <span class='kw'><-</span> <span class='fu'><a href='mkinfit.html'>mkinfit</a></span>(<span class='no'>SFO_SFO</span>, <span class='fu'><a href='https://rdrr.io/r/base/subset.html'>subset</a></span>(<span class='no'>FOCUS_2006_D</span>, <span class='no'>value</span> <span class='kw'>!=</span> <span class='fl'>0</span>), <span class='kw'>quiet</span> <span class='kw'>=</span> <span class='fl'>TRUE</span>) <span class='fu'><a href='https://rdrr.io/r/base/system.time.html'>system.time</a></span>(<span class='no'>ci_profile</span> <span class='kw'><-</span> <span class='fu'><a href='https://rdrr.io/r/stats/confint.html'>confint</a></span>(<span class='no'>f_d_1</span>, <span class='kw'>cores</span> <span class='kw'>=</span> <span class='fl'>1</span>, <span class='kw'>quiet</span> <span class='kw'>=</span> <span class='fl'>TRUE</span>))</div><div class='output co'>#> User System verstrichen -#> 50.787 0.000 50.815 </div><div class='input'><span class='co'># The following does not save much time, as parent_0 takes up most of the time</span> +#> 50.987 0.008 51.023 </div><div class='input'><span class='co'># The following does not save much time, as parent_0 takes up most of the time</span> <span class='co'># system.time(ci_profile <- confint(f_d_1, cores = 5))</span> <span class='co'># system.time(ci_profile <- confint(f_d_1,</span> <span class='co'># c("k_parent_sink", "k_parent_m1", "k_m1_sink", "sigma"), cores = 1))</span> <span class='co'># If we exclude parent_0 (the confidence of which is often of minor interest), we get a nice</span> <span class='co'># performance improvement from about 30 seconds to about 12 seconds</span> -<span class='co'># system.time(ci_profile_no_parent_0 <- confint(f_d_1, c("k_parent_sink", "k_parent_m1", "k_m1_sink", "sigma"), cores = 4))</span> +<span class='co'># system.time(ci_profile_no_parent_0 <- confint(f_d_1, </span> +<span class='co'># c("k_parent_sink", "k_parent_m1", "k_m1_sink", "sigma"), cores = 4))</span> <span class='no'>ci_profile</span></div><div class='output co'>#> 2.5% 97.5% #> parent_0 96.456003650 1.027703e+02 #> k_parent_sink 0.040762501 5.549764e-02 diff --git a/docs/reference/index.html b/docs/reference/index.html index fa424060..8987db96 100644 --- a/docs/reference/index.html +++ b/docs/reference/index.html @@ -185,45 +185,39 @@ more datasets</p></td> </tr><tr> <td> - <p><code><a href="parms.html">parms()</a></code> </p> - </td> - <td><p>Extract model parameters from mkinfit models</p></td> - </tr><tr> - - <td> - <p><code><a href="confint.mkinfit.html">confint(<i><mkinfit></i>)</a></code> </p> + <p><code><a href="summary.mkinfit.html">summary(<i><mkinfit></i>)</a></code> <code><a href="summary.mkinfit.html">print(<i><summary.mkinfit></i>)</a></code> </p> </td> - <td><p>Confidence intervals for parameters of mkinfit objects</p></td> + <td><p>Summary method for class "mkinfit"</p></td> </tr><tr> <td> - <p><code><a href="summary.mkinfit.html">summary(<i><mkinfit></i>)</a></code> <code><a href="summary.mkinfit.html">print(<i><summary.mkinfit></i>)</a></code> </p> + <p><code><a href="parms.html">parms()</a></code> </p> </td> - <td><p>Summary method for class "mkinfit"</p></td> + <td><p>Extract model parameters from mkinfit models</p></td> </tr><tr> <td> - <p><code><a href="logLik.mkinfit.html">logLik(<i><mkinfit></i>)</a></code> </p> + <p><code><a href="confint.mkinfit.html">confint(<i><mkinfit></i>)</a></code> </p> </td> - <td><p>Calculated the log-likelihood of a fitted mkinfit object</p></td> + <td><p>Confidence intervals for parameters of mkinfit objects</p></td> </tr><tr> <td> - <p><code><a href="mkinresplot.html">mkinresplot()</a></code> </p> + <p><code><a href="update.mkinfit.html">update(<i><mkinfit></i>)</a></code> </p> </td> - <td><p>Function to plot residuals stored in an mkin object</p></td> + <td><p>Update an mkinfit model with different arguments</p></td> </tr><tr> <td> - <p><code><a href="mkinparplot.html">mkinparplot()</a></code> </p> + <p><code><a href="lrtest.mkinfit.html">lrtest(<i><mkinfit></i>)</a></code> </p> </td> - <td><p>Function to plot the confidence intervals obtained using mkinfit</p></td> + <td><p>Likelihood ratio test for mkinfit models</p></td> </tr><tr> <td> - <p><code><a href="mkinerrplot.html">mkinerrplot()</a></code> </p> + <p><code><a href="mkinerrmin.html">mkinerrmin()</a></code> </p> </td> - <td><p>Function to plot squared residuals and the error model for an mkin object</p></td> + <td><p>Calculate the minimum error to assume in order to pass the variance test</p></td> </tr><tr> <td> @@ -234,9 +228,9 @@ with mkinfit</p></td> </tr><tr> <td> - <p><code><a href="mkinerrmin.html">mkinerrmin()</a></code> </p> + <p><code><a href="CAKE_export.html">CAKE_export()</a></code> </p> </td> - <td><p>Calculate the minimum error to assume in order to pass the variance test</p></td> + <td><p>Export a list of datasets format to a CAKE study file</p></td> </tr> </tbody><tbody> <tr> @@ -380,7 +374,7 @@ of an mmkin object</p></td> </tbody><tbody> <tr> <th colspan="2"> - <h2 id="section-helper-functions" class="hasAnchor"><a href="#section-helper-functions" class="anchor"></a>Helper functions</h2> + <h2 id="section-helper-functions-mainly-used-internally" class="hasAnchor"><a href="#section-helper-functions-mainly-used-internally" class="anchor"></a>Helper functions mainly used internally</h2> <p class="section-desc"></p> </th> </tr> @@ -442,9 +436,33 @@ kinetic models fitted with mkinfit</p></td> </tr><tr> <td> - <p><code><a href="CAKE_export.html">CAKE_export()</a></code> </p> + <p><code><a href="logLik.mkinfit.html">logLik(<i><mkinfit></i>)</a></code> </p> </td> - <td><p>Export a list of datasets format to a CAKE study file</p></td> + <td><p>Calculated the log-likelihood of a fitted mkinfit object</p></td> + </tr><tr> + + <td> + <p><code><a href="residuals.mkinfit.html">residuals(<i><mkinfit></i>)</a></code> </p> + </td> + <td><p>Extract residuals from an mkinfit model</p></td> + </tr><tr> + + <td> + <p><code><a href="mkinresplot.html">mkinresplot()</a></code> </p> + </td> + <td><p>Function to plot residuals stored in an mkin object</p></td> + </tr><tr> + + <td> + <p><code><a href="mkinparplot.html">mkinparplot()</a></code> </p> + </td> + <td><p>Function to plot the confidence intervals obtained using mkinfit</p></td> + </tr><tr> + + <td> + <p><code><a href="mkinerrplot.html">mkinerrplot()</a></code> </p> + </td> + <td><p>Function to plot squared residuals and the error model for an mkin object</p></td> </tr> </tbody><tbody> <tr> @@ -536,7 +554,7 @@ kinetic models fitted with mkinfit</p></td> <li><a href="#section-work-with-mmkin-objects">Work with mmkin objects</a></li> <li><a href="#section-datasets-and-known-results">Datasets and known results</a></li> <li><a href="#section-nafta-guidance">NAFTA guidance</a></li> - <li><a href="#section-helper-functions">Helper functions</a></li> + <li><a href="#section-helper-functions-mainly-used-internally">Helper functions mainly used internally</a></li> <li><a href="#section-analytical-solutions">Analytical solutions</a></li> <li><a href="#section-generate-synthetic-datasets">Generate synthetic datasets</a></li> <li><a href="#section-deprecated-functions">Deprecated functions</a></li> diff --git a/docs/reference/logLik.mkinfit.html b/docs/reference/logLik.mkinfit.html index c79146a9..9a54496e 100644 --- a/docs/reference/logLik.mkinfit.html +++ b/docs/reference/logLik.mkinfit.html @@ -36,10 +36,11 @@ <meta property="og:title" content="Calculated the log-likelihood of a fitted mkinfit object — logLik.mkinfit" /> -<meta property="og:description" content="This function simply calculates the product of the likelihood densities -calculated using dnorm, i.e. assuming normal distribution, -with of the mean predicted by the degradation model, and the standard -deviation predicted by the error model." /> +<meta property="og:description" content="This function returns the product of the likelihood densities of each +observed value, as calculated as part of the fitting procedure using +dnorm, i.e. assuming normal distribution, and with the means +predicted by the degradation model, and the standard deviations predicted by +the error model." /> <meta name="twitter:card" content="summary" /> @@ -136,10 +137,11 @@ deviation predicted by the error model." /> </div> <div class="ref-description"> - <p>This function simply calculates the product of the likelihood densities -calculated using <code><a href='https://rdrr.io/r/stats/Normal.html'>dnorm</a></code>, i.e. assuming normal distribution, -with of the mean predicted by the degradation model, and the standard -deviation predicted by the error model.</p> + <p>This function returns the product of the likelihood densities of each +observed value, as calculated as part of the fitting procedure using +<code><a href='https://rdrr.io/r/stats/Normal.html'>dnorm</a></code>, i.e. assuming normal distribution, and with the means +predicted by the degradation model, and the standard deviations predicted by +the error model.</p> </div> <pre class="usage"><span class='co'># S3 method for mkinfit</span> diff --git a/docs/reference/lrtest.mkinfit.html b/docs/reference/lrtest.mkinfit.html new file mode 100644 index 00000000..dd47d91d --- /dev/null +++ b/docs/reference/lrtest.mkinfit.html @@ -0,0 +1,231 @@ +<!-- Generated by pkgdown: do not edit by hand --> +<!DOCTYPE html> +<html lang="en"> + <head> + <meta charset="utf-8"> +<meta http-equiv="X-UA-Compatible" content="IE=edge"> +<meta name="viewport" content="width=device-width, initial-scale=1.0"> + +<title>Likelihood ratio test for mkinfit models — lrtest.mkinfit • mkin</title> + + +<!-- jquery --> +<script src="https://cdnjs.cloudflare.com/ajax/libs/jquery/3.3.1/jquery.min.js" integrity="sha256-FgpCb/KJQlLNfOu91ta32o/NMZxltwRo8QtmkMRdAu8=" crossorigin="anonymous"></script> +<!-- Bootstrap --> + +<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/3.3.7/css/bootstrap.min.css" integrity="sha256-916EbMg70RQy9LHiGkXzG8hSg9EdNy97GazNG/aiY1w=" crossorigin="anonymous" /> + +<script src="https://cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/3.3.7/js/bootstrap.min.js" integrity="sha256-U5ZEeKfGNOja007MMD3YBI0A3OSZOQbeG6z2f2Y0hu8=" crossorigin="anonymous"></script> + +<!-- Font Awesome icons --> +<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/5.7.1/css/all.min.css" integrity="sha256-nAmazAk6vS34Xqo0BSrTb+abbtFlgsFK7NKSi6o7Y78=" crossorigin="anonymous" /> +<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/5.7.1/css/v4-shims.min.css" integrity="sha256-6qHlizsOWFskGlwVOKuns+D1nB6ssZrHQrNj1wGplHc=" crossorigin="anonymous" /> + +<!-- clipboard.js --> +<script src="https://cdnjs.cloudflare.com/ajax/libs/clipboard.js/2.0.4/clipboard.min.js" integrity="sha256-FiZwavyI2V6+EXO1U+xzLG3IKldpiTFf3153ea9zikQ=" crossorigin="anonymous"></script> + +<!-- headroom.js --> +<script src="https://cdnjs.cloudflare.com/ajax/libs/headroom/0.9.4/headroom.min.js" integrity="sha256-DJFC1kqIhelURkuza0AvYal5RxMtpzLjFhsnVIeuk+U=" crossorigin="anonymous"></script> +<script src="https://cdnjs.cloudflare.com/ajax/libs/headroom/0.9.4/jQuery.headroom.min.js" integrity="sha256-ZX/yNShbjqsohH1k95liqY9Gd8uOiE1S4vZc+9KQ1K4=" crossorigin="anonymous"></script> + +<!-- pkgdown --> +<link href="../pkgdown.css" rel="stylesheet"> +<script src="../pkgdown.js"></script> + + + + +<meta property="og:title" content="Likelihood ratio test for mkinfit models — lrtest.mkinfit" /> +<meta property="og:description" content="Compare two mkinfit models based on their likelihood. If two fitted +mkinfit objects are given as arguments, it is checked if they have been +fitted to the same data. It is the responsibility of the user to make sure +that the models are nested, i.e. one of them has less degrees of freedom +and can be expressed by fixing the parameters of the other." /> +<meta name="twitter:card" content="summary" /> + + + + +<!-- mathjax --> +<script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js" integrity="sha256-nvJJv9wWKEm88qvoQl9ekL2J+k/RWIsaSScxxlsrv8k=" crossorigin="anonymous"></script> +<script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/config/TeX-AMS-MML_HTMLorMML.js" integrity="sha256-84DKXVJXs0/F8OTMzX4UR909+jtl4G7SPypPavF+GfA=" crossorigin="anonymous"></script> + +<!--[if lt IE 9]> +<script src="https://oss.maxcdn.com/html5shiv/3.7.3/html5shiv.min.js"></script> +<script src="https://oss.maxcdn.com/respond/1.4.2/respond.min.js"></script> +<![endif]--> + + + + </head> + + <body> + <div class="container template-reference-topic"> + <header> + <div class="navbar navbar-default navbar-fixed-top" role="navigation"> + <div class="container"> + <div class="navbar-header"> + <button type="button" class="navbar-toggle collapsed" data-toggle="collapse" data-target="#navbar" aria-expanded="false"> + <span class="sr-only">Toggle navigation</span> + <span class="icon-bar"></span> + <span class="icon-bar"></span> + <span class="icon-bar"></span> + </button> + <span class="navbar-brand"> + <a class="navbar-link" href="../index.html">mkin</a> + <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Released version">0.9.49.6</span> + </span> + </div> + + <div id="navbar" class="navbar-collapse collapse"> + <ul class="nav navbar-nav"> + <li> + <a href="../reference/index.html">Functions and data</a> +</li> +<li class="dropdown"> + <a href="#" class="dropdown-toggle" data-toggle="dropdown" role="button" aria-expanded="false"> + Articles + + <span class="caret"></span> + </a> + <ul class="dropdown-menu" role="menu"> + <li> + <a href="../articles/mkin.html">Introduction to mkin</a> + </li> + <li> + <a href="../articles/FOCUS_D.html">Example evaluation of FOCUS Example Dataset D</a> + </li> + <li> + <a href="../articles/FOCUS_L.html">Example evaluation of FOCUS Laboratory Data L1 to L3</a> + </li> + <li> + <a href="../articles/web_only/FOCUS_Z.html">Example evaluation of FOCUS Example Dataset Z</a> + </li> + <li> + <a href="../articles/web_only/compiled_models.html">Performance benefit by using compiled model definitions in mkin</a> + </li> + <li> + <a href="../articles/twa.html">Calculation of time weighted average concentrations with mkin</a> + </li> + <li> + <a href="../articles/web_only/NAFTA_examples.html">Example evaluation of NAFTA SOP Attachment examples</a> + </li> + </ul> +</li> +<li> + <a href="../news/index.html">News</a> +</li> + </ul> + <ul class="nav navbar-nav navbar-right"> + + </ul> + + </div><!--/.nav-collapse --> + </div><!--/.container --> +</div><!--/.navbar --> + + + + </header> + +<div class="row"> + <div class="col-md-9 contents"> + <div class="page-header"> + <h1>Likelihood ratio test for mkinfit models</h1> + + <div class="hidden name"><code>lrtest.mkinfit.Rd</code></div> + </div> + + <div class="ref-description"> + <p>Compare two mkinfit models based on their likelihood. If two fitted +mkinfit objects are given as arguments, it is checked if they have been +fitted to the same data. It is the responsibility of the user to make sure +that the models are nested, i.e. one of them has less degrees of freedom +and can be expressed by fixing the parameters of the other.</p> + </div> + + <pre class="usage"><span class='co'># S3 method for mkinfit</span> +<span class='fu'><a href='https://rdrr.io/pkg/lmtest/man/lrtest.html'>lrtest</a></span>(<span class='no'>object</span>, <span class='kw'>object_2</span> <span class='kw'>=</span> <span class='kw'>NULL</span>, <span class='no'>...</span>)</pre> + + <h2 class="hasAnchor" id="arguments"><a class="anchor" href="#arguments"></a>Arguments</h2> + <table class="ref-arguments"> + <colgroup><col class="name" /><col class="desc" /></colgroup> + <tr> + <th>object</th> + <td><p>An <code><a href='mkinfit.html'>mkinfit</a></code> object</p></td> + </tr> + <tr> + <th>object_2</th> + <td><p>Optionally, another mkinfit object fitted to the same data.</p></td> + </tr> + <tr> + <th>...</th> + <td><p>Argument to <code><a href='mkinfit.html'>mkinfit</a></code>, passed to +<code><a href='update.mkinfit.html'>update.mkinfit</a></code> for creating the alternative fitted object.</p></td> + </tr> + </table> + + <h2 class="hasAnchor" id="details"><a class="anchor" href="#details"></a>Details</h2> + + <p>Alternatively, an argument to mkinfit can be given which is then passed +to <code><a href='update.mkinfit.html'>update.mkinfit</a></code> to obtain the alternative model.</p> +<p>The comparison is then made by the <code><a href='https://rdrr.io/pkg/lmtest/man/lrtest.html'>lrtest.default</a></code> +method from the lmtest package. The model with the higher number of fitted +parameters (alternative hypothesis) is listed first, then the model with the +lower number of fitted parameters (null hypothesis).</p> + + <h2 class="hasAnchor" id="examples"><a class="anchor" href="#examples"></a>Examples</h2> + <pre class="examples"><div class='input'><span class='co'># \dontrun{</span> +<span class='no'>test_data</span> <span class='kw'><-</span> <span class='fu'><a href='https://rdrr.io/r/base/subset.html'>subset</a></span>(<span class='no'>synthetic_data_for_UBA_2014</span><span class='kw'>[[</span><span class='fl'>12</span>]]$<span class='no'>data</span>, <span class='no'>name</span> <span class='kw'>==</span> <span class='st'>"parent"</span>) +<span class='no'>sfo_fit</span> <span class='kw'><-</span> <span class='fu'><a href='mkinfit.html'>mkinfit</a></span>(<span class='st'>"SFO"</span>, <span class='no'>test_data</span>, <span class='kw'>quiet</span> <span class='kw'>=</span> <span class='fl'>TRUE</span>) +<span class='no'>dfop_fit</span> <span class='kw'><-</span> <span class='fu'><a href='mkinfit.html'>mkinfit</a></span>(<span class='st'>"DFOP"</span>, <span class='no'>test_data</span>, <span class='kw'>quiet</span> <span class='kw'>=</span> <span class='fl'>TRUE</span>) +<span class='fu'><a href='https://rdrr.io/pkg/lmtest/man/lrtest.html'>lrtest</a></span>(<span class='no'>dfop_fit</span>, <span class='no'>sfo_fit</span>)</div><div class='output co'>#> Likelihood ratio test +#> +#> Model 1: DFOP with error model const +#> Model 2: SFO with error model const +#> #Df LogLik Df Chisq Pr(>Chisq) +#> 1 5 -42.453 +#> 2 3 -63.954 -2 43.002 4.594e-10 *** +#> --- +#> Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1</div><div class='input'><span class='fu'><a href='https://rdrr.io/pkg/lmtest/man/lrtest.html'>lrtest</a></span>(<span class='no'>sfo_fit</span>, <span class='no'>dfop_fit</span>)</div><div class='output co'>#> Likelihood ratio test +#> +#> Model 1: DFOP with error model const +#> Model 2: SFO with error model const +#> #Df LogLik Df Chisq Pr(>Chisq) +#> 1 5 -42.453 +#> 2 3 -63.954 -2 43.002 4.594e-10 *** +#> --- +#> Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1</div><div class='input'><span class='fu'><a href='https://rdrr.io/pkg/lmtest/man/lrtest.html'>lrtest</a></span>(<span class='no'>dfop_fit</span>, <span class='kw'>error_model</span> <span class='kw'>=</span> <span class='st'>"tc"</span>)</div><div class='output co'>#> <span class='error'>Error in mkinfit(mkinmod = "DFOP", observed = test_data, quiet = TRUE, error_model = "tc", parms.ini = c(k1 = 0.359673923258109, k2 = 0.0219997339436148, g = 0.692423284341522), state.ini = c(parent = 103.83323992643)): Objekt 'test_data' nicht gefunden</span></div><div class='input'><span class='fu'><a href='https://rdrr.io/pkg/lmtest/man/lrtest.html'>lrtest</a></span>(<span class='no'>dfop_fit</span>, <span class='kw'>fixed_parms</span> <span class='kw'>=</span> <span class='fu'><a href='https://rdrr.io/r/base/c.html'>c</a></span>(<span class='kw'>k2</span> <span class='kw'>=</span> <span class='fl'>0</span>))</div><div class='output co'>#> <span class='error'>Error in mkinfit(mkinmod = "DFOP", observed = test_data, quiet = TRUE, fixed_parms = ..1, parms.ini = c(k1 = 0.359673923258109, k2 = 0.0219997339436148, g = 0.692423284341522), state.ini = c(parent = 103.83323992643)): Objekt 'test_data' nicht gefunden</span></div><div class='input'># } +</div></pre> + </div> + <div class="col-md-3 hidden-xs hidden-sm" id="sidebar"> + <h2>Contents</h2> + <ul class="nav nav-pills nav-stacked"> + <li><a href="#arguments">Arguments</a></li> + <li><a href="#details">Details</a></li> + <li><a href="#examples">Examples</a></li> + </ul> + + </div> +</div> + + + <footer> + <div class="copyright"> + <p>Developed by Johannes Ranke.</p> +</div> + +<div class="pkgdown"> + <p>Site built with <a href="https://pkgdown.r-lib.org/">pkgdown</a> 1.4.1.</p> +</div> + + </footer> + </div> + + + + + </body> +</html> + + diff --git a/docs/reference/mkinfit.html b/docs/reference/mkinfit.html index 6c98bc38..c72d1cd0 100644 --- a/docs/reference/mkinfit.html +++ b/docs/reference/mkinfit.html @@ -218,7 +218,9 @@ must be given.</p></td> <tr> <th>fixed_parms</th> <td><p>The names of parameters that should not be optimised but -rather kept at the values specified in <code>parms.ini</code>.</p></td> +rather kept at the values specified in <code>parms.ini</code>. Alternatively, +a named numeric vector of parameters to be fixed, regardless of the values +in parms.ini.</p></td> </tr> <tr> <th>fixed_initials</th> @@ -400,15 +402,15 @@ estimators.</p> <span class='no'>fit</span> <span class='kw'><-</span> <span class='fu'>mkinfit</span>(<span class='st'>"FOMC"</span>, <span class='no'>FOCUS_2006_C</span>, <span class='kw'>quiet</span> <span class='kw'>=</span> <span class='fl'>TRUE</span>) <span class='fu'><a href='https://rdrr.io/r/base/summary.html'>summary</a></span>(<span class='no'>fit</span>)</div><div class='output co'>#> mkin version used for fitting: 0.9.49.6 #> R version used for fitting: 3.6.1 -#> Date of fit: Fri Oct 25 02:08:07 2019 -#> Date of summary: Fri Oct 25 02:08:07 2019 +#> Date of fit: Thu Oct 31 01:48:29 2019 +#> Date of summary: Thu Oct 31 01:48:29 2019 #> #> Equations: #> d_parent/dt = - (alpha/beta) * 1/((time/beta) + 1) * parent #> #> Model predictions using solution type analytical #> -#> Fitted using 222 model solutions performed in 0.453 s +#> Fitted using 222 model solutions performed in 0.455 s #> #> Error model: Constant variance #> @@ -480,7 +482,7 @@ estimators.</p> <span class='kw'>m1</span> <span class='kw'>=</span> <span class='fu'><a href='mkinsub.html'>mkinsub</a></span>(<span class='st'>"SFO"</span>))</div><div class='output co'>#> <span class='message'>Successfully compiled differential equation model from auto-generated C code.</span></div><div class='input'><span class='co'># Fit the model to the FOCUS example dataset D using defaults</span> <span class='fu'><a href='https://rdrr.io/r/base/print.html'>print</a></span>(<span class='fu'><a href='https://rdrr.io/r/base/system.time.html'>system.time</a></span>(<span class='no'>fit</span> <span class='kw'><-</span> <span class='fu'>mkinfit</span>(<span class='no'>SFO_SFO</span>, <span class='no'>FOCUS_2006_D</span>, <span class='kw'>solution_type</span> <span class='kw'>=</span> <span class='st'>"eigen"</span>, <span class='kw'>quiet</span> <span class='kw'>=</span> <span class='fl'>TRUE</span>)))</div><div class='output co'>#> <span class='warning'>Warning: Observations with value of zero were removed from the data</span></div><div class='output co'>#> User System verstrichen -#> 1.447 0.000 1.448 </div><div class='input'><span class='fu'><a href='https://rdrr.io/r/stats/coef.html'>coef</a></span>(<span class='no'>fit</span>)</div><div class='output co'>#> NULL</div><div class='input'><span class='fu'><a href='endpoints.html'>endpoints</a></span>(<span class='no'>fit</span>)</div><div class='output co'>#> $ff +#> 1.464 0.000 1.465 </div><div class='input'><span class='fu'><a href='https://rdrr.io/r/stats/coef.html'>coef</a></span>(<span class='no'>fit</span>)</div><div class='output co'>#> NULL</div><div class='input'><span class='fu'><a href='endpoints.html'>endpoints</a></span>(<span class='no'>fit</span>)</div><div class='output co'>#> $ff #> parent_sink parent_m1 m1_sink #> 0.485524 0.514476 1.000000 #> @@ -553,7 +555,7 @@ estimators.</p> #> Sum of squared residuals at call 126: 371.2134 #> Sum of squared residuals at call 135: 371.2134 #> Negative log-likelihood at call 145: 97.22429</div><div class='output co'>#> <span class='message'>Optimisation successfully terminated.</span></div><div class='output co'>#> User System verstrichen -#> 1.032 0.000 1.032 </div><div class='input'><span class='fu'><a href='https://rdrr.io/r/stats/coef.html'>coef</a></span>(<span class='no'>fit.deSolve</span>)</div><div class='output co'>#> NULL</div><div class='input'><span class='fu'><a href='endpoints.html'>endpoints</a></span>(<span class='no'>fit.deSolve</span>)</div><div class='output co'>#> $ff +#> 1.047 0.000 1.047 </div><div class='input'><span class='fu'><a href='https://rdrr.io/r/stats/coef.html'>coef</a></span>(<span class='no'>fit.deSolve</span>)</div><div class='output co'>#> NULL</div><div class='input'><span class='fu'><a href='endpoints.html'>endpoints</a></span>(<span class='no'>fit.deSolve</span>)</div><div class='output co'>#> $ff #> parent_sink parent_m1 m1_sink #> 0.485524 0.514476 1.000000 #> @@ -589,8 +591,8 @@ estimators.</p> <span class='no'>SFO_SFO.ff</span> <span class='kw'><-</span> <span class='fu'><a href='mkinmod.html'>mkinmod</a></span>(<span class='kw'>parent</span> <span class='kw'>=</span> <span class='fu'><a href='mkinsub.html'>mkinsub</a></span>(<span class='st'>"SFO"</span>, <span class='st'>"m1"</span>), <span class='kw'>m1</span> <span class='kw'>=</span> <span class='fu'><a href='mkinsub.html'>mkinsub</a></span>(<span class='st'>"SFO"</span>), <span class='kw'>use_of_ff</span> <span class='kw'>=</span> <span class='st'>"max"</span>)</div><div class='output co'>#> <span class='message'>Successfully compiled differential equation model from auto-generated C code.</span></div><div class='input'><span class='no'>f.noweight</span> <span class='kw'><-</span> <span class='fu'>mkinfit</span>(<span class='no'>SFO_SFO.ff</span>, <span class='no'>FOCUS_2006_D</span>, <span class='kw'>quiet</span> <span class='kw'>=</span> <span class='fl'>TRUE</span>)</div><div class='output co'>#> <span class='warning'>Warning: Observations with value of zero were removed from the data</span></div><div class='input'><span class='fu'><a href='https://rdrr.io/r/base/summary.html'>summary</a></span>(<span class='no'>f.noweight</span>)</div><div class='output co'>#> mkin version used for fitting: 0.9.49.6 #> R version used for fitting: 3.6.1 -#> Date of fit: Fri Oct 25 02:08:22 2019 -#> Date of summary: Fri Oct 25 02:08:22 2019 +#> Date of fit: Thu Oct 31 01:48:44 2019 +#> Date of summary: Thu Oct 31 01:48:44 2019 #> #> Equations: #> d_parent/dt = - k_parent * parent @@ -598,7 +600,7 @@ estimators.</p> #> #> Model predictions using solution type deSolve #> -#> Fitted using 421 model solutions performed in 1.062 s +#> Fitted using 421 model solutions performed in 1.136 s #> #> Error model: Constant variance #> @@ -706,8 +708,8 @@ estimators.</p> #> 120 m1 25.15 28.78984 -3.640e+00 #> 120 m1 33.31 28.78984 4.520e+00</div><div class='input'><span class='no'>f.obs</span> <span class='kw'><-</span> <span class='fu'>mkinfit</span>(<span class='no'>SFO_SFO.ff</span>, <span class='no'>FOCUS_2006_D</span>, <span class='kw'>error_model</span> <span class='kw'>=</span> <span class='st'>"obs"</span>, <span class='kw'>quiet</span> <span class='kw'>=</span> <span class='fl'>TRUE</span>)</div><div class='output co'>#> <span class='warning'>Warning: Observations with value of zero were removed from the data</span></div><div class='input'><span class='fu'><a href='https://rdrr.io/r/base/summary.html'>summary</a></span>(<span class='no'>f.obs</span>)</div><div class='output co'>#> mkin version used for fitting: 0.9.49.6 #> R version used for fitting: 3.6.1 -#> Date of fit: Fri Oct 25 02:08:25 2019 -#> Date of summary: Fri Oct 25 02:08:25 2019 +#> Date of fit: Thu Oct 31 01:48:47 2019 +#> Date of summary: Thu Oct 31 01:48:47 2019 #> #> Equations: #> d_parent/dt = - k_parent * parent @@ -715,7 +717,7 @@ estimators.</p> #> #> Model predictions using solution type deSolve #> -#> Fitted using 978 model solutions performed in 2.523 s +#> Fitted using 978 model solutions performed in 2.512 s #> #> Error model: Variance unique to each observed variable #> @@ -838,8 +840,8 @@ estimators.</p> #> 120 m1 25.15 28.80429 -3.654e+00 #> 120 m1 33.31 28.80429 4.506e+00</div><div class='input'><span class='no'>f.tc</span> <span class='kw'><-</span> <span class='fu'>mkinfit</span>(<span class='no'>SFO_SFO.ff</span>, <span class='no'>FOCUS_2006_D</span>, <span class='kw'>error_model</span> <span class='kw'>=</span> <span class='st'>"tc"</span>, <span class='kw'>quiet</span> <span class='kw'>=</span> <span class='fl'>TRUE</span>)</div><div class='output co'>#> <span class='warning'>Warning: Observations with value of zero were removed from the data</span></div><div class='input'><span class='fu'><a href='https://rdrr.io/r/base/summary.html'>summary</a></span>(<span class='no'>f.tc</span>)</div><div class='output co'>#> mkin version used for fitting: 0.9.49.6 #> R version used for fitting: 3.6.1 -#> Date of fit: Fri Oct 25 02:08:34 2019 -#> Date of summary: Fri Oct 25 02:08:34 2019 +#> Date of fit: Thu Oct 31 01:48:56 2019 +#> Date of summary: Thu Oct 31 01:48:56 2019 #> #> Equations: #> d_parent/dt = - k_parent * parent @@ -847,7 +849,7 @@ estimators.</p> #> #> Model predictions using solution type deSolve #> -#> Fitted using 2289 model solutions performed in 9.136 s +#> Fitted using 2289 model solutions performed in 9.124 s #> #> Error model: Two-component variance function #> diff --git a/docs/reference/reexports.html b/docs/reference/reexports.html new file mode 100644 index 00000000..90cbec1a --- /dev/null +++ b/docs/reference/reexports.html @@ -0,0 +1,180 @@ +<!-- Generated by pkgdown: do not edit by hand --> +<!DOCTYPE html> +<html lang="en"> + <head> + <meta charset="utf-8"> +<meta http-equiv="X-UA-Compatible" content="IE=edge"> +<meta name="viewport" content="width=device-width, initial-scale=1.0"> + +<title>Objects exported from other packages — reexports • mkin</title> + + +<!-- jquery --> +<script src="https://cdnjs.cloudflare.com/ajax/libs/jquery/3.3.1/jquery.min.js" integrity="sha256-FgpCb/KJQlLNfOu91ta32o/NMZxltwRo8QtmkMRdAu8=" crossorigin="anonymous"></script> +<!-- Bootstrap --> + +<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/3.3.7/css/bootstrap.min.css" integrity="sha256-916EbMg70RQy9LHiGkXzG8hSg9EdNy97GazNG/aiY1w=" crossorigin="anonymous" /> + +<script src="https://cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/3.3.7/js/bootstrap.min.js" integrity="sha256-U5ZEeKfGNOja007MMD3YBI0A3OSZOQbeG6z2f2Y0hu8=" crossorigin="anonymous"></script> + +<!-- Font Awesome icons --> +<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/5.7.1/css/all.min.css" integrity="sha256-nAmazAk6vS34Xqo0BSrTb+abbtFlgsFK7NKSi6o7Y78=" crossorigin="anonymous" /> +<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/5.7.1/css/v4-shims.min.css" integrity="sha256-6qHlizsOWFskGlwVOKuns+D1nB6ssZrHQrNj1wGplHc=" crossorigin="anonymous" /> + +<!-- clipboard.js --> +<script src="https://cdnjs.cloudflare.com/ajax/libs/clipboard.js/2.0.4/clipboard.min.js" integrity="sha256-FiZwavyI2V6+EXO1U+xzLG3IKldpiTFf3153ea9zikQ=" crossorigin="anonymous"></script> + +<!-- headroom.js --> +<script src="https://cdnjs.cloudflare.com/ajax/libs/headroom/0.9.4/headroom.min.js" integrity="sha256-DJFC1kqIhelURkuza0AvYal5RxMtpzLjFhsnVIeuk+U=" crossorigin="anonymous"></script> +<script src="https://cdnjs.cloudflare.com/ajax/libs/headroom/0.9.4/jQuery.headroom.min.js" integrity="sha256-ZX/yNShbjqsohH1k95liqY9Gd8uOiE1S4vZc+9KQ1K4=" crossorigin="anonymous"></script> + +<!-- pkgdown --> +<link href="../pkgdown.css" rel="stylesheet"> +<script src="../pkgdown.js"></script> + + + + +<meta property="og:title" content="Objects exported from other packages — reexports" /> +<meta property="og:description" content="These objects are imported from other packages. Follow the links +below to see their documentation. + + lmtestlrtest + +" /> +<meta name="twitter:card" content="summary" /> + + + + +<!-- mathjax --> +<script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js" integrity="sha256-nvJJv9wWKEm88qvoQl9ekL2J+k/RWIsaSScxxlsrv8k=" crossorigin="anonymous"></script> +<script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/config/TeX-AMS-MML_HTMLorMML.js" integrity="sha256-84DKXVJXs0/F8OTMzX4UR909+jtl4G7SPypPavF+GfA=" crossorigin="anonymous"></script> + +<!--[if lt IE 9]> +<script src="https://oss.maxcdn.com/html5shiv/3.7.3/html5shiv.min.js"></script> +<script src="https://oss.maxcdn.com/respond/1.4.2/respond.min.js"></script> +<![endif]--> + + + + </head> + + <body> + <div class="container template-reference-topic"> + <header> + <div class="navbar navbar-default navbar-fixed-top" role="navigation"> + <div class="container"> + <div class="navbar-header"> + <button type="button" class="navbar-toggle collapsed" data-toggle="collapse" data-target="#navbar" aria-expanded="false"> + <span class="sr-only">Toggle navigation</span> + <span class="icon-bar"></span> + <span class="icon-bar"></span> + <span class="icon-bar"></span> + </button> + <span class="navbar-brand"> + <a class="navbar-link" href="../index.html">mkin</a> + <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Released version">0.9.49.6</span> + </span> + </div> + + <div id="navbar" class="navbar-collapse collapse"> + <ul class="nav navbar-nav"> + <li> + <a href="../reference/index.html">Functions and data</a> +</li> +<li class="dropdown"> + <a href="#" class="dropdown-toggle" data-toggle="dropdown" role="button" aria-expanded="false"> + Articles + + <span class="caret"></span> + </a> + <ul class="dropdown-menu" role="menu"> + <li> + <a href="../articles/mkin.html">Introduction to mkin</a> + </li> + <li> + <a href="../articles/FOCUS_D.html">Example evaluation of FOCUS Example Dataset D</a> + </li> + <li> + <a href="../articles/FOCUS_L.html">Example evaluation of FOCUS Laboratory Data L1 to L3</a> + </li> + <li> + <a href="../articles/web_only/FOCUS_Z.html">Example evaluation of FOCUS Example Dataset Z</a> + </li> + <li> + <a href="../articles/web_only/compiled_models.html">Performance benefit by using compiled model definitions in mkin</a> + </li> + <li> + <a href="../articles/twa.html">Calculation of time weighted average concentrations with mkin</a> + </li> + <li> + <a href="../articles/web_only/NAFTA_examples.html">Example evaluation of NAFTA SOP Attachment examples</a> + </li> + </ul> +</li> +<li> + <a href="../news/index.html">News</a> +</li> + </ul> + <ul class="nav navbar-nav navbar-right"> + + </ul> + + </div><!--/.nav-collapse --> + </div><!--/.container --> +</div><!--/.navbar --> + + + + </header> + +<div class="row"> + <div class="col-md-9 contents"> + <div class="page-header"> + <h1>Objects exported from other packages</h1> + + <div class="hidden name"><code>reexports.Rd</code></div> + </div> + + <div class="ref-description"> + <p>These objects are imported from other packages. Follow the links +below to see their documentation.</p> +<dl class='dl-horizontal'> + <dt>lmtest</dt><dd><p><code><a href='https://rdrr.io/pkg/lmtest/man/lrtest.html'>lrtest</a></code></p></dd> + +</dl> + </div> + + + + + </div> + <div class="col-md-3 hidden-xs hidden-sm" id="sidebar"> + <h2>Contents</h2> + <ul class="nav nav-pills nav-stacked"> + </ul> + + </div> +</div> + + + <footer> + <div class="copyright"> + <p>Developed by Johannes Ranke.</p> +</div> + +<div class="pkgdown"> + <p>Site built with <a href="https://pkgdown.r-lib.org/">pkgdown</a> 1.4.1.</p> +</div> + + </footer> + </div> + + + + + </body> +</html> + + diff --git a/docs/reference/residuals.mkinfit.html b/docs/reference/residuals.mkinfit.html new file mode 100644 index 00000000..7dd25012 --- /dev/null +++ b/docs/reference/residuals.mkinfit.html @@ -0,0 +1,196 @@ +<!-- Generated by pkgdown: do not edit by hand --> +<!DOCTYPE html> +<html lang="en"> + <head> + <meta charset="utf-8"> +<meta http-equiv="X-UA-Compatible" content="IE=edge"> +<meta name="viewport" content="width=device-width, initial-scale=1.0"> + +<title>Extract residuals from an mkinfit model — residuals.mkinfit • mkin</title> + + +<!-- jquery --> +<script src="https://cdnjs.cloudflare.com/ajax/libs/jquery/3.3.1/jquery.min.js" integrity="sha256-FgpCb/KJQlLNfOu91ta32o/NMZxltwRo8QtmkMRdAu8=" crossorigin="anonymous"></script> +<!-- Bootstrap --> + +<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/3.3.7/css/bootstrap.min.css" integrity="sha256-916EbMg70RQy9LHiGkXzG8hSg9EdNy97GazNG/aiY1w=" crossorigin="anonymous" /> + +<script src="https://cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/3.3.7/js/bootstrap.min.js" integrity="sha256-U5ZEeKfGNOja007MMD3YBI0A3OSZOQbeG6z2f2Y0hu8=" crossorigin="anonymous"></script> + +<!-- Font Awesome icons --> +<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/5.7.1/css/all.min.css" integrity="sha256-nAmazAk6vS34Xqo0BSrTb+abbtFlgsFK7NKSi6o7Y78=" crossorigin="anonymous" /> +<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/5.7.1/css/v4-shims.min.css" integrity="sha256-6qHlizsOWFskGlwVOKuns+D1nB6ssZrHQrNj1wGplHc=" crossorigin="anonymous" /> + +<!-- clipboard.js --> +<script src="https://cdnjs.cloudflare.com/ajax/libs/clipboard.js/2.0.4/clipboard.min.js" integrity="sha256-FiZwavyI2V6+EXO1U+xzLG3IKldpiTFf3153ea9zikQ=" crossorigin="anonymous"></script> + +<!-- headroom.js --> +<script src="https://cdnjs.cloudflare.com/ajax/libs/headroom/0.9.4/headroom.min.js" integrity="sha256-DJFC1kqIhelURkuza0AvYal5RxMtpzLjFhsnVIeuk+U=" crossorigin="anonymous"></script> +<script src="https://cdnjs.cloudflare.com/ajax/libs/headroom/0.9.4/jQuery.headroom.min.js" integrity="sha256-ZX/yNShbjqsohH1k95liqY9Gd8uOiE1S4vZc+9KQ1K4=" crossorigin="anonymous"></script> + +<!-- pkgdown --> +<link href="../pkgdown.css" rel="stylesheet"> +<script src="../pkgdown.js"></script> + + + + +<meta property="og:title" content="Extract residuals from an mkinfit model — residuals.mkinfit" /> +<meta property="og:description" content="Extract residuals from an mkinfit model" /> +<meta name="twitter:card" content="summary" /> + + + + +<!-- mathjax --> +<script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js" integrity="sha256-nvJJv9wWKEm88qvoQl9ekL2J+k/RWIsaSScxxlsrv8k=" crossorigin="anonymous"></script> +<script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/config/TeX-AMS-MML_HTMLorMML.js" integrity="sha256-84DKXVJXs0/F8OTMzX4UR909+jtl4G7SPypPavF+GfA=" crossorigin="anonymous"></script> + +<!--[if lt IE 9]> +<script src="https://oss.maxcdn.com/html5shiv/3.7.3/html5shiv.min.js"></script> +<script src="https://oss.maxcdn.com/respond/1.4.2/respond.min.js"></script> +<![endif]--> + + + + </head> + + <body> + <div class="container template-reference-topic"> + <header> + <div class="navbar navbar-default navbar-fixed-top" role="navigation"> + <div class="container"> + <div class="navbar-header"> + <button type="button" class="navbar-toggle collapsed" data-toggle="collapse" data-target="#navbar" aria-expanded="false"> + <span class="sr-only">Toggle navigation</span> + <span class="icon-bar"></span> + <span class="icon-bar"></span> + <span class="icon-bar"></span> + </button> + <span class="navbar-brand"> + <a class="navbar-link" href="../index.html">mkin</a> + <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Released version">0.9.49.6</span> + </span> + </div> + + <div id="navbar" class="navbar-collapse collapse"> + <ul class="nav navbar-nav"> + <li> + <a href="../reference/index.html">Functions and data</a> +</li> +<li class="dropdown"> + <a href="#" class="dropdown-toggle" data-toggle="dropdown" role="button" aria-expanded="false"> + Articles + + <span class="caret"></span> + </a> + <ul class="dropdown-menu" role="menu"> + <li> + <a href="../articles/mkin.html">Introduction to mkin</a> + </li> + <li> + <a href="../articles/FOCUS_D.html">Example evaluation of FOCUS Example Dataset D</a> + </li> + <li> + <a href="../articles/FOCUS_L.html">Example evaluation of FOCUS Laboratory Data L1 to L3</a> + </li> + <li> + <a href="../articles/web_only/FOCUS_Z.html">Example evaluation of FOCUS Example Dataset Z</a> + </li> + <li> + <a href="../articles/web_only/compiled_models.html">Performance benefit by using compiled model definitions in mkin</a> + </li> + <li> + <a href="../articles/twa.html">Calculation of time weighted average concentrations with mkin</a> + </li> + <li> + <a href="../articles/web_only/NAFTA_examples.html">Example evaluation of NAFTA SOP Attachment examples</a> + </li> + </ul> +</li> +<li> + <a href="../news/index.html">News</a> +</li> + </ul> + <ul class="nav navbar-nav navbar-right"> + + </ul> + + </div><!--/.nav-collapse --> + </div><!--/.container --> +</div><!--/.navbar --> + + + + </header> + +<div class="row"> + <div class="col-md-9 contents"> + <div class="page-header"> + <h1>Extract residuals from an mkinfit model</h1> + + <div class="hidden name"><code>residuals.mkinfit.Rd</code></div> + </div> + + <div class="ref-description"> + <p>Extract residuals from an mkinfit model</p> + </div> + + <pre class="usage"><span class='co'># S3 method for mkinfit</span> +<span class='fu'><a href='https://rdrr.io/r/stats/residuals.html'>residuals</a></span>(<span class='no'>object</span>, <span class='kw'>standardized</span> <span class='kw'>=</span> <span class='fl'>FALSE</span>, <span class='no'>...</span>)</pre> + + <h2 class="hasAnchor" id="arguments"><a class="anchor" href="#arguments"></a>Arguments</h2> + <table class="ref-arguments"> + <colgroup><col class="name" /><col class="desc" /></colgroup> + <tr> + <th>object</th> + <td><p>An <code><a href='mkinfit.html'>mkinfit</a></code> object</p></td> + </tr> + <tr> + <th>standardized</th> + <td><p>Should the residuals be standardized by dividing by the +standard deviation obtained from the fitted error model?</p></td> + </tr> + <tr> + <th>...</th> + <td><p>Not used</p></td> + </tr> + </table> + + + <h2 class="hasAnchor" id="examples"><a class="anchor" href="#examples"></a>Examples</h2> + <pre class="examples"><div class='input'><span class='no'>f</span> <span class='kw'><-</span> <span class='fu'><a href='mkinfit.html'>mkinfit</a></span>(<span class='st'>"DFOP"</span>, <span class='no'>FOCUS_2006_C</span>, <span class='kw'>quiet</span> <span class='kw'>=</span> <span class='fl'>TRUE</span>) +<span class='fu'><a href='https://rdrr.io/r/stats/residuals.html'>residuals</a></span>(<span class='no'>f</span>)</div><div class='output co'>#> [1] 0.09726306 -0.13912135 -0.15351176 0.73388319 -0.08657030 -0.93204730 +#> [7] -0.03269102 1.45347805 -0.88423710</div><div class='input'><span class='fu'><a href='https://rdrr.io/r/stats/residuals.html'>residuals</a></span>(<span class='no'>f</span>, <span class='kw'>standardized</span> <span class='kw'>=</span> <span class='fl'>TRUE</span>)</div><div class='output co'>#> [1] 0.13969820 -0.19981894 -0.22048777 1.05407086 -0.12434027 -1.33869248 +#> [7] -0.04695387 2.08761953 -1.27002305</div></pre> + </div> + <div class="col-md-3 hidden-xs hidden-sm" id="sidebar"> + <h2>Contents</h2> + <ul class="nav nav-pills nav-stacked"> + <li><a href="#arguments">Arguments</a></li> + <li><a href="#examples">Examples</a></li> + </ul> + + </div> +</div> + + + <footer> + <div class="copyright"> + <p>Developed by Johannes Ranke.</p> +</div> + +<div class="pkgdown"> + <p>Site built with <a href="https://pkgdown.r-lib.org/">pkgdown</a> 1.4.1.</p> +</div> + + </footer> + </div> + + + + + </body> +</html> + + diff --git a/docs/reference/update.mkinfit.html b/docs/reference/update.mkinfit.html new file mode 100644 index 00000000..b4040a1b --- /dev/null +++ b/docs/reference/update.mkinfit.html @@ -0,0 +1,544 @@ +<!-- Generated by pkgdown: do not edit by hand --> +<!DOCTYPE html> +<html lang="en"> + <head> + <meta charset="utf-8"> +<meta http-equiv="X-UA-Compatible" content="IE=edge"> +<meta name="viewport" content="width=device-width, initial-scale=1.0"> + +<title>Update an mkinfit model with different arguments — update.mkinfit • mkin</title> + + +<!-- jquery --> +<script src="https://cdnjs.cloudflare.com/ajax/libs/jquery/3.3.1/jquery.min.js" integrity="sha256-FgpCb/KJQlLNfOu91ta32o/NMZxltwRo8QtmkMRdAu8=" crossorigin="anonymous"></script> +<!-- Bootstrap --> + +<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/3.3.7/css/bootstrap.min.css" integrity="sha256-916EbMg70RQy9LHiGkXzG8hSg9EdNy97GazNG/aiY1w=" crossorigin="anonymous" /> + +<script src="https://cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/3.3.7/js/bootstrap.min.js" integrity="sha256-U5ZEeKfGNOja007MMD3YBI0A3OSZOQbeG6z2f2Y0hu8=" crossorigin="anonymous"></script> + +<!-- Font Awesome icons --> +<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/5.7.1/css/all.min.css" integrity="sha256-nAmazAk6vS34Xqo0BSrTb+abbtFlgsFK7NKSi6o7Y78=" crossorigin="anonymous" /> +<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/5.7.1/css/v4-shims.min.css" integrity="sha256-6qHlizsOWFskGlwVOKuns+D1nB6ssZrHQrNj1wGplHc=" crossorigin="anonymous" /> + +<!-- clipboard.js --> +<script src="https://cdnjs.cloudflare.com/ajax/libs/clipboard.js/2.0.4/clipboard.min.js" integrity="sha256-FiZwavyI2V6+EXO1U+xzLG3IKldpiTFf3153ea9zikQ=" crossorigin="anonymous"></script> + +<!-- headroom.js --> +<script src="https://cdnjs.cloudflare.com/ajax/libs/headroom/0.9.4/headroom.min.js" integrity="sha256-DJFC1kqIhelURkuza0AvYal5RxMtpzLjFhsnVIeuk+U=" crossorigin="anonymous"></script> +<script src="https://cdnjs.cloudflare.com/ajax/libs/headroom/0.9.4/jQuery.headroom.min.js" integrity="sha256-ZX/yNShbjqsohH1k95liqY9Gd8uOiE1S4vZc+9KQ1K4=" crossorigin="anonymous"></script> + +<!-- pkgdown --> +<link href="../pkgdown.css" rel="stylesheet"> +<script src="../pkgdown.js"></script> + + + + +<meta property="og:title" content="Update an mkinfit model with different arguments — update.mkinfit" /> +<meta property="og:description" content="This function will return an updated mkinfit object. The fitted degradation +model parameters from the old fit are used as starting values for the +updated fit. Values specified as 'parms.ini' and/or 'state.ini' will +override these starting values." /> +<meta name="twitter:card" content="summary" /> + + + + +<!-- mathjax --> +<script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js" integrity="sha256-nvJJv9wWKEm88qvoQl9ekL2J+k/RWIsaSScxxlsrv8k=" crossorigin="anonymous"></script> +<script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/config/TeX-AMS-MML_HTMLorMML.js" integrity="sha256-84DKXVJXs0/F8OTMzX4UR909+jtl4G7SPypPavF+GfA=" crossorigin="anonymous"></script> + +<!--[if lt IE 9]> +<script src="https://oss.maxcdn.com/html5shiv/3.7.3/html5shiv.min.js"></script> +<script src="https://oss.maxcdn.com/respond/1.4.2/respond.min.js"></script> +<![endif]--> + + + + </head> + + <body> + <div class="container template-reference-topic"> + <header> + <div class="navbar navbar-default navbar-fixed-top" role="navigation"> + <div class="container"> + <div class="navbar-header"> + <button type="button" class="navbar-toggle collapsed" data-toggle="collapse" data-target="#navbar" aria-expanded="false"> + <span class="sr-only">Toggle navigation</span> + <span class="icon-bar"></span> + <span class="icon-bar"></span> + <span class="icon-bar"></span> + </button> + <span class="navbar-brand"> + <a class="navbar-link" href="../index.html">mkin</a> + <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Released version">0.9.49.6</span> + </span> + </div> + + <div id="navbar" class="navbar-collapse collapse"> + <ul class="nav navbar-nav"> + <li> + <a href="../reference/index.html">Functions and data</a> +</li> +<li class="dropdown"> + <a href="#" class="dropdown-toggle" data-toggle="dropdown" role="button" aria-expanded="false"> + Articles + + <span class="caret"></span> + </a> + <ul class="dropdown-menu" role="menu"> + <li> + <a href="../articles/mkin.html">Introduction to mkin</a> + </li> + <li> + <a href="../articles/FOCUS_D.html">Example evaluation of FOCUS Example Dataset D</a> + </li> + <li> + <a href="../articles/FOCUS_L.html">Example evaluation of FOCUS Laboratory Data L1 to L3</a> + </li> + <li> + <a href="../articles/web_only/FOCUS_Z.html">Example evaluation of FOCUS Example Dataset Z</a> + </li> + <li> + <a href="../articles/web_only/compiled_models.html">Performance benefit by using compiled model definitions in mkin</a> + </li> + <li> + <a href="../articles/twa.html">Calculation of time weighted average concentrations with mkin</a> + </li> + <li> + <a href="../articles/web_only/NAFTA_examples.html">Example evaluation of NAFTA SOP Attachment examples</a> + </li> + </ul> +</li> +<li> + <a href="../news/index.html">News</a> +</li> + </ul> + <ul class="nav navbar-nav navbar-right"> + + </ul> + + </div><!--/.nav-collapse --> + </div><!--/.container --> +</div><!--/.navbar --> + + + + </header> + +<div class="row"> + <div class="col-md-9 contents"> + <div class="page-header"> + <h1>Update an mkinfit model with different arguments</h1> + + <div class="hidden name"><code>update.mkinfit.Rd</code></div> + </div> + + <div class="ref-description"> + <p>This function will return an updated mkinfit object. The fitted degradation +model parameters from the old fit are used as starting values for the +updated fit. Values specified as 'parms.ini' and/or 'state.ini' will +override these starting values.</p> + </div> + + <pre class="usage"><span class='co'># S3 method for mkinfit</span> +<span class='fu'><a href='https://rdrr.io/r/stats/update.html'>update</a></span>(<span class='no'>object</span>, <span class='no'>...</span>, <span class='kw'>evaluate</span> <span class='kw'>=</span> <span class='fl'>TRUE</span>)</pre> + + <h2 class="hasAnchor" id="arguments"><a class="anchor" href="#arguments"></a>Arguments</h2> + <table class="ref-arguments"> + <colgroup><col class="name" /><col class="desc" /></colgroup> + <tr> + <th>object</th> + <td><p>An mkinfit object to be updated</p></td> + </tr> + <tr> + <th>...</th> + <td><p>Arguments to <code><a href='mkinfit.html'>mkinfit</a></code> that should replace +the arguments from the original call. Arguments set to NULL will +remove arguments given in the original call</p></td> + </tr> + <tr> + <th>evaluate</th> + <td><p>Should the call be evaluated or returned as a call</p></td> + </tr> + </table> + + + <h2 class="hasAnchor" id="examples"><a class="anchor" href="#examples"></a>Examples</h2> + <pre class="examples"><div class='input'><span class='co'># \dontrun{</span> +<span class='no'>fit</span> <span class='kw'><-</span> <span class='fu'><a href='mkinfit.html'>mkinfit</a></span>(<span class='st'>"DFOP"</span>, <span class='fu'><a href='https://rdrr.io/r/base/subset.html'>subset</a></span>(<span class='no'>FOCUS_2006_D</span>, <span class='no'>value</span> <span class='kw'>!=</span> <span class='fl'>0</span>), <span class='kw'>quiet</span> <span class='kw'>=</span> <span class='fl'>TRUE</span>) +<span class='fu'><a href='https://rdrr.io/r/stats/update.html'>update</a></span>(<span class='no'>fit</span>, <span class='kw'>error_model</span> <span class='kw'>=</span> <span class='st'>"tc"</span>)</div><div class='output co'>#> $par +#> parent_0 log_k1 log_k2 g_ilr sigma_low rsd_high +#> 100.85489822 8.84468217 -2.29693632 -14.95263998 0.00375222 0.06763435 +#> +#> $objective +#> [1] 19.40656 +#> +#> $convergence +#> [1] 0 +#> +#> $iterations +#> [1] 120 +#> +#> $evaluations +#> function gradient +#> 144 847 +#> +#> $message +#> [1] "relative convergence (4)" +#> +#> $logLik +#> [1] -19.40656 +#> +#> $d_3_message +#> threestep +#> "Three-step fitting yielded a higher likelihood than direct fitting" +#> +#> $hessian +#> parent_0 log_k1 log_k2 g_ilr sigma_low +#> parent_0 3.662473e-01 -2.914408e-16 -7.241561e+01 -3.021629e-08 1.923504e+01 +#> log_k1 -2.914408e-16 0.000000e+00 -2.215935e-13 -7.291307e-25 3.416474e-15 +#> log_k2 -7.241561e+01 -2.215935e-13 3.127457e+04 6.766544e-06 -1.495826e+04 +#> g_ilr -3.021629e-08 -7.291307e-25 6.766544e-06 3.122099e-09 -1.797429e-06 +#> sigma_low 1.923504e+01 3.416474e-15 -1.495826e+04 -1.797429e-06 7.759299e+04 +#> rsd_high 3.902119e+00 -1.801019e-16 -1.685343e+02 -3.750713e-07 3.984179e+03 +#> rsd_high +#> parent_0 3.902119e+00 +#> log_k1 -1.801019e-16 +#> log_k2 -1.685343e+02 +#> g_ilr -3.750713e-07 +#> sigma_low 3.984179e+03 +#> rsd_high 7.188991e+03 +#> +#> $hessian_notrans +#> parent_0 k1 k2 g sigma_low +#> parent_0 3.662473e-01 -3.714445e-19 -7.201669e+02 -3.261485e+01 1.923504e+01 +#> k1 -3.714445e-19 0.000000e+00 -4.258512e-15 7.218123e-21 4.355854e-18 +#> k2 -7.201669e+02 -4.258512e-15 3.092510e+06 7.263235e+04 -1.456870e+05 +#> g -3.261485e+01 7.218123e-21 7.263235e+04 3.291750e+03 -1.939948e+03 +#> sigma_low 1.923504e+01 4.355854e-18 -1.456870e+05 -1.939948e+03 7.759299e+04 +#> rsd_high 3.902119e+00 -2.259812e-19 -1.779680e+03 -4.048658e+02 3.984179e+03 +#> rsd_high +#> parent_0 3.902119e+00 +#> k1 -2.259812e-19 +#> k2 -1.779680e+03 +#> g -4.048658e+02 +#> sigma_low 3.984179e+03 +#> rsd_high 7.188991e+03 +#> +#> $call +#> mkinfit(mkinmod = "DFOP", observed = subset(FOCUS_2006_D, value != +#> 0), parms.ini = c(k1 = 0.699298911979803, k2 = 0.0899931270871125, +#> g = 0.0923391681138686), state.ini = c(parent = 101.948852047129), +#> quiet = TRUE, error_model = "tc") +#> +#> $error_model_algorithm +#> [1] "d_3" +#> +#> $solution_type +#> [1] "analytical" +#> +#> $transform_rates +#> [1] TRUE +#> +#> $transform_fractions +#> [1] TRUE +#> +#> $reweight.tol +#> [1] 1e-08 +#> +#> $reweight.max.iter +#> [1] 10 +#> +#> $control +#> $control$eval.max +#> [1] 300 +#> +#> $control$iter.max +#> [1] 200 +#> +#> +#> $calls +#> [1] 3105 +#> +#> $time +#> User System verstrichen +#> 10.314 0.000 10.320 +#> +#> $mkinmod +#> <mkinmod> model generated with +#> Use of formation fractions $use_of_ff: min +#> Specification $spec: +#> $parent +#> $type: DFOP; $sink: TRUE +#> Differential equations: +#> d_parent/dt = - ((k1 * g * exp(-k1 * time) + k2 * (1 - g) * exp(-k2 * +#> time)) / (g * exp(-k1 * time) + (1 - g) * exp(-k2 * time))) +#> * parent +#> +#> $observed +#> name time value +#> 1 parent 0 99.46 +#> 2 parent 0 102.04 +#> 3 parent 1 93.50 +#> 4 parent 1 92.50 +#> 5 parent 3 63.23 +#> 6 parent 3 68.99 +#> 7 parent 7 52.32 +#> 8 parent 7 55.13 +#> 9 parent 14 27.27 +#> 10 parent 14 26.64 +#> 11 parent 21 11.50 +#> 12 parent 21 11.64 +#> 13 parent 35 2.85 +#> 14 parent 35 2.91 +#> 15 parent 50 0.69 +#> 16 parent 50 0.63 +#> 17 parent 75 0.05 +#> 18 parent 75 0.06 +#> +#> $obs_vars +#> [1] "parent" +#> +#> $predicted +#> name time value +#> 1 parent 0.0000000 100.85489822 +#> 2 parent 0.7575758 93.45650191 +#> 3 parent 1.0000000 91.20560523 +#> 4 parent 1.5151515 86.60082860 +#> 5 parent 2.2727273 80.24806580 +#> 6 parent 3.0000000 74.58828105 +#> 7 parent 3.0303030 74.36132158 +#> 8 parent 3.7878788 68.90641029 +#> 9 parent 4.5454545 63.85165403 +#> 10 parent 5.3030303 59.16769870 +#> 11 parent 6.0606061 54.82734352 +#> 12 parent 6.8181818 50.80538306 +#> 13 parent 7.0000000 49.88485755 +#> 14 parent 7.5757576 47.07846089 +#> 15 parent 8.3333333 43.62493394 +#> 16 parent 9.0909091 40.42474681 +#> 17 parent 9.8484848 37.45931528 +#> 18 parent 10.6060606 34.71141842 +#> 19 parent 11.3636364 32.16509858 +#> 20 parent 12.1212121 29.80556871 +#> 21 parent 12.8787879 27.61912649 +#> 22 parent 13.6363636 25.59307475 +#> 23 parent 14.0000000 24.67405211 +#> 24 parent 14.3939394 23.71564776 +#> 25 parent 15.1515152 21.97594287 +#> 26 parent 15.9090909 20.36385722 +#> 27 parent 16.6666667 18.87002909 +#> 28 parent 17.4242424 17.48578345 +#> 29 parent 18.1818182 16.20308170 +#> 30 parent 18.9393939 15.01447489 +#> 31 parent 19.6969697 13.91306051 +#> 32 parent 20.4545455 12.89244241 +#> 33 parent 21.0000000 12.20428157 +#> 34 parent 21.2121212 11.94669362 +#> 35 parent 21.9696970 11.07032198 +#> 36 parent 22.7272727 10.25823818 +#> 37 parent 23.4848485 9.50572628 +#> 38 parent 24.2424242 8.80841627 +#> 39 parent 25.0000000 8.16225872 +#> 40 parent 25.7575758 7.56350125 +#> 41 parent 26.5151515 7.00866672 +#> 42 parent 27.2727273 6.49453311 +#> 43 parent 28.0303030 6.01811471 +#> 44 parent 28.7878788 5.57664485 +#> 45 parent 29.5454545 5.16755983 +#> 46 parent 30.3030303 4.78848399 +#> 47 parent 31.0606061 4.43721595 +#> 48 parent 31.8181818 4.11171583 +#> 49 parent 32.5757576 3.81009336 +#> 50 parent 33.3333333 3.53059697 +#> 51 parent 34.0909091 3.27160354 +#> 52 parent 34.8484848 3.03160906 +#> 53 parent 35.0000000 2.98576554 +#> 54 parent 35.6060606 2.80921981 +#> 55 parent 36.3636364 2.60314433 +#> 56 parent 37.1212121 2.41218590 +#> 57 parent 37.8787879 2.23523557 +#> 58 parent 38.6363636 2.07126576 +#> 59 parent 39.3939394 1.91932426 +#> 60 parent 40.1515152 1.77852870 +#> 61 parent 40.9090909 1.64806147 +#> 62 parent 41.6666667 1.52716489 +#> 63 parent 42.4242424 1.41513691 +#> 64 parent 43.1818182 1.31132694 +#> 65 parent 43.9393939 1.21513214 +#> 66 parent 44.6969697 1.12599389 +#> 67 parent 45.4545455 1.04339454 +#> 68 parent 46.2121212 0.96685442 +#> 69 parent 46.9696970 0.89592904 +#> 70 parent 47.7272727 0.83020652 +#> 71 parent 48.4848485 0.76930520 +#> 72 parent 49.2424242 0.71287140 +#> 73 parent 50.0000000 0.66057741 +#> 74 parent 50.7575758 0.61211954 +#> 75 parent 51.5151515 0.56721639 +#> 76 parent 52.2727273 0.52560719 +#> 77 parent 53.0303030 0.48705031 +#> 78 parent 53.7878788 0.45132184 +#> 79 parent 54.5454545 0.41821430 +#> 80 parent 55.3030303 0.38753542 +#> 81 parent 56.0606061 0.35910705 +#> 82 parent 56.8181818 0.33276409 +#> 83 parent 57.5757576 0.30835357 +#> 84 parent 58.3333333 0.28573373 +#> 85 parent 59.0909091 0.26477320 +#> 86 parent 59.8484848 0.24535028 +#> 87 parent 60.6060606 0.22735216 +#> 88 parent 61.3636364 0.21067432 +#> 89 parent 62.1212121 0.19521992 +#> 90 parent 62.8787879 0.18089921 +#> 91 parent 63.6363636 0.16762901 +#> 92 parent 64.3939394 0.15533228 +#> 93 parent 65.1515152 0.14393759 +#> 94 parent 65.9090909 0.13337879 +#> 95 parent 66.6666667 0.12359454 +#> 96 parent 67.4242424 0.11452804 +#> 97 parent 68.1818182 0.10612662 +#> 98 parent 68.9393939 0.09834151 +#> 99 parent 69.6969697 0.09112749 +#> 100 parent 70.4545455 0.08444266 +#> 101 parent 71.2121212 0.07824822 +#> 102 parent 71.9696970 0.07250818 +#> 103 parent 72.7272727 0.06718920 +#> 104 parent 73.4848485 0.06226042 +#> 105 parent 74.2424242 0.05769319 +#> 106 parent 75.0000000 0.05346100 +#> +#> $rss +#> function (P) +#> cost_function(P, OLS = TRUE, update_data = FALSE) +#> <bytecode: 0x555557c557c8> +#> <environment: 0x55555bb0e330> +#> +#> $ll +#> function (P, fixed_degparms = FALSE, fixed_errparms = FALSE) +#> { +#> -cost_function(P, trans = FALSE, fixed_degparms = fixed_degparms, +#> fixed_errparms = fixed_errparms, OLS = FALSE, update_data = FALSE) +#> } +#> <bytecode: 0x555557c55bf0> +#> <environment: 0x55555bb0e330> +#> +#> $start +#> value type +#> parent_0 101.94885205 state +#> k1 0.69929891 deparm +#> k2 0.08999313 deparm +#> g 0.09233917 deparm +#> sigma_low 0.10000000 error +#> rsd_high 0.10000000 error +#> +#> $start_transformed +#> value lower upper +#> parent_0 101.948852 -Inf Inf +#> log_k1 -0.357677 -Inf Inf +#> log_k2 -2.408022 -Inf Inf +#> g_ilr -1.616024 -Inf Inf +#> sigma_low 0.100000 0 Inf +#> rsd_high 0.100000 0 Inf +#> +#> $fixed +#> [1] value type +#> <0 Zeilen> (oder row.names mit Länge 0) +#> +#> $data +#> time variable observed predicted residual +#> 1 0 parent 99.46 100.8548982 -1.39489822 +#> 2 0 parent 102.04 100.8548982 1.18510178 +#> 3 1 parent 93.50 91.2056052 2.29439477 +#> 4 1 parent 92.50 91.2056052 1.29439477 +#> 5 3 parent 63.23 74.5882810 -11.35828105 +#> 6 3 parent 68.99 74.5882810 -5.59828105 +#> 7 7 parent 52.32 49.8848576 2.43514245 +#> 8 7 parent 55.13 49.8848576 5.24514245 +#> 9 14 parent 27.27 24.6740521 2.59594789 +#> 10 14 parent 26.64 24.6740521 1.96594789 +#> 11 21 parent 11.50 12.2042816 -0.70428157 +#> 12 21 parent 11.64 12.2042816 -0.56428157 +#> 13 35 parent 2.85 2.9857655 -0.13576554 +#> 14 35 parent 2.91 2.9857655 -0.07576554 +#> 15 50 parent 0.69 0.6605774 0.02942259 +#> 16 50 parent 0.63 0.6605774 -0.03057741 +#> 17 75 parent 0.05 0.0534610 -0.00346100 +#> 18 75 parent 0.06 0.0534610 0.00653900 +#> +#> $atol +#> [1] 1e-08 +#> +#> $rtol +#> [1] 1e-10 +#> +#> $err_mod +#> [1] "tc" +#> +#> $bparms.optim +#> parent_0 k1 k2 g +#> 1.008549e+02 6.937399e+03 1.005665e-01 6.551046e-10 +#> +#> $bparms.fixed +#> numeric(0) +#> +#> $bparms.ode +#> k1 k2 g +#> 6.937399e+03 1.005665e-01 6.551046e-10 +#> +#> $bparms.state +#> parent +#> 100.8549 +#> +#> $errparms +#> sigma_low rsd_high +#> 0.00375222 0.06763435 +#> +#> $df.residual +#> [1] 12 +#> +#> $date +#> [1] "Thu Oct 31 01:49:09 2019" +#> +#> $version +#> [1] "0.9.49.6" +#> +#> $Rversion +#> [1] "3.6.1" +#> +#> attr(,"class") +#> [1] "mkinfit" "modFit" </div><div class='input'># } +</div></pre> + </div> + <div class="col-md-3 hidden-xs hidden-sm" id="sidebar"> + <h2>Contents</h2> + <ul class="nav nav-pills nav-stacked"> + <li><a href="#arguments">Arguments</a></li> + <li><a href="#examples">Examples</a></li> + </ul> + + </div> +</div> + + + <footer> + <div class="copyright"> + <p>Developed by Johannes Ranke.</p> +</div> + +<div class="pkgdown"> + <p>Site built with <a href="https://pkgdown.r-lib.org/">pkgdown</a> 1.4.1.</p> +</div> + + </footer> + </div> + + + + + </body> +</html> + + diff --git a/docs/sitemap.xml b/docs/sitemap.xml index 9e3363ba..3767bdda 100644 --- a/docs/sitemap.xml +++ b/docs/sitemap.xml @@ -73,6 +73,9 @@ <loc>https://pkgdown.jrwb.de/mkin/reference/logistic.solution.html</loc> </url> <url> + <loc>https://pkgdown.jrwb.de/mkin/reference/lrtest.mkinfit.html</loc> + </url> + <url> <loc>https://pkgdown.jrwb.de/mkin/reference/max_twa_parent.html</loc> </url> <url> @@ -139,6 +142,12 @@ <loc>https://pkgdown.jrwb.de/mkin/reference/print.mkinmod.html</loc> </url> <url> + <loc>https://pkgdown.jrwb.de/mkin/reference/reexports.html</loc> + </url> + <url> + <loc>https://pkgdown.jrwb.de/mkin/reference/residuals.mkinfit.html</loc> + </url> + <url> <loc>https://pkgdown.jrwb.de/mkin/reference/schaefer07_complex_case.html</loc> </url> <url> @@ -157,6 +166,9 @@ <loc>https://pkgdown.jrwb.de/mkin/reference/transform_odeparms.html</loc> </url> <url> + <loc>https://pkgdown.jrwb.de/mkin/reference/update.mkinfit.html</loc> + </url> + <url> <loc>https://pkgdown.jrwb.de/mkin/articles/FOCUS_D.html</loc> </url> <url> diff --git a/man/confint.mkinfit.Rd b/man/confint.mkinfit.Rd index bad73407..ee07c9c1 100644 --- a/man/confint.mkinfit.Rd +++ b/man/confint.mkinfit.Rd @@ -71,7 +71,8 @@ system.time(ci_profile <- confint(f_d_1, cores = 1, quiet = TRUE)) # c("k_parent_sink", "k_parent_m1", "k_m1_sink", "sigma"), cores = 1)) # If we exclude parent_0 (the confidence of which is often of minor interest), we get a nice # performance improvement from about 30 seconds to about 12 seconds -# system.time(ci_profile_no_parent_0 <- confint(f_d_1, c("k_parent_sink", "k_parent_m1", "k_m1_sink", "sigma"), cores = 4)) +# system.time(ci_profile_no_parent_0 <- confint(f_d_1, +# c("k_parent_sink", "k_parent_m1", "k_m1_sink", "sigma"), cores = 4)) ci_profile ci_quadratic_transformed <- confint(f_d_1, method = "quadratic") ci_quadratic_transformed diff --git a/man/logLik.mkinfit.Rd b/man/logLik.mkinfit.Rd index bb2c2957..502fb4d7 100644 --- a/man/logLik.mkinfit.Rd +++ b/man/logLik.mkinfit.Rd @@ -17,10 +17,11 @@ An object of class \code{\link{logLik}} with the number of estimated as attribute. } \description{ -This function simply calculates the product of the likelihood densities -calculated using \code{\link{dnorm}}, i.e. assuming normal distribution, -with of the mean predicted by the degradation model, and the standard -deviation predicted by the error model. +This function returns the product of the likelihood densities of each +observed value, as calculated as part of the fitting procedure using +\code{\link{dnorm}}, i.e. assuming normal distribution, and with the means +predicted by the degradation model, and the standard deviations predicted by +the error model. } \details{ The total number of estimated parameters returned with the value of the diff --git a/man/lrtest.mkinfit.Rd b/man/lrtest.mkinfit.Rd new file mode 100644 index 00000000..b38732b4 --- /dev/null +++ b/man/lrtest.mkinfit.Rd @@ -0,0 +1,43 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/lrtest.mkinfit.R +\name{lrtest.mkinfit} +\alias{lrtest.mkinfit} +\title{Likelihood ratio test for mkinfit models} +\usage{ +\method{lrtest}{mkinfit}(object, object_2 = NULL, ...) +} +\arguments{ +\item{object}{An \code{\link{mkinfit}} object} + +\item{object_2}{Optionally, another mkinfit object fitted to the same data.} + +\item{\dots}{Argument to \code{\link{mkinfit}}, passed to +\code{\link{update.mkinfit}} for creating the alternative fitted object.} +} +\description{ +Compare two mkinfit models based on their likelihood. If two fitted +mkinfit objects are given as arguments, it is checked if they have been +fitted to the same data. It is the responsibility of the user to make sure +that the models are nested, i.e. one of them has less degrees of freedom +and can be expressed by fixing the parameters of the other. +} +\details{ +Alternatively, an argument to mkinfit can be given which is then passed +to \code{\link{update.mkinfit}} to obtain the alternative model. + +The comparison is then made by the \code{\link[lmtest]{lrtest.default}} +method from the lmtest package. The model with the higher number of fitted +parameters (alternative hypothesis) is listed first, then the model with the +lower number of fitted parameters (null hypothesis). +} +\examples{ +\dontrun{ +test_data <- subset(synthetic_data_for_UBA_2014[[12]]$data, name == "parent") +sfo_fit <- mkinfit("SFO", test_data, quiet = TRUE) +dfop_fit <- mkinfit("DFOP", test_data, quiet = TRUE) +lrtest(dfop_fit, sfo_fit) +lrtest(sfo_fit, dfop_fit) +lrtest(dfop_fit, error_model = "tc") +lrtest(dfop_fit, fixed_parms = c(k2 = 0)) +} +} diff --git a/man/mkinfit.Rd b/man/mkinfit.Rd index d9afb753..e58e61e2 100644 --- a/man/mkinfit.Rd +++ b/man/mkinfit.Rd @@ -65,7 +65,9 @@ default values. Otherwise, inital values for all error model parameters must be given.} \item{fixed_parms}{The names of parameters that should not be optimised but -rather kept at the values specified in \code{parms.ini}.} +rather kept at the values specified in \code{parms.ini}. Alternatively, +a named numeric vector of parameters to be fixed, regardless of the values +in parms.ini.} \item{fixed_initials}{The names of model variables for which the initial state at time 0 should be excluded from the optimisation. Defaults to all diff --git a/man/reexports.Rd b/man/reexports.Rd new file mode 100644 index 00000000..bb77acc5 --- /dev/null +++ b/man/reexports.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/lrtest.mkinfit.R +\docType{import} +\name{reexports} +\alias{reexports} +\alias{lrtest} +\title{Objects exported from other packages} +\keyword{internal} +\description{ +These objects are imported from other packages. Follow the links +below to see their documentation. + +\describe{ + \item{lmtest}{\code{\link[lmtest]{lrtest}}} +}} + diff --git a/man/residuals.mkinfit.Rd b/man/residuals.mkinfit.Rd new file mode 100644 index 00000000..407b89b9 --- /dev/null +++ b/man/residuals.mkinfit.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/residuals.mkinfit.R +\name{residuals.mkinfit} +\alias{residuals.mkinfit} +\title{Extract residuals from an mkinfit model} +\usage{ +\method{residuals}{mkinfit}(object, standardized = FALSE, ...) +} +\arguments{ +\item{object}{An \code{\link{mkinfit}} object} + +\item{standardized}{Should the residuals be standardized by dividing by the +standard deviation obtained from the fitted error model?} + +\item{\dots}{Not used} +} +\description{ +Extract residuals from an mkinfit model +} +\examples{ +f <- mkinfit("DFOP", FOCUS_2006_C, quiet = TRUE) +residuals(f) +residuals(f, standardized = TRUE) +} diff --git a/man/update.mkinfit.Rd b/man/update.mkinfit.Rd new file mode 100644 index 00000000..aae1fbb4 --- /dev/null +++ b/man/update.mkinfit.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/update.mkinfit.R +\name{update.mkinfit} +\alias{update.mkinfit} +\title{Update an mkinfit model with different arguments} +\usage{ +\method{update}{mkinfit}(object, ..., evaluate = TRUE) +} +\arguments{ +\item{object}{An mkinfit object to be updated} + +\item{\dots}{Arguments to \code{\link{mkinfit}} that should replace +the arguments from the original call. Arguments set to NULL will +remove arguments given in the original call} + +\item{evaluate}{Should the call be evaluated or returned as a call} +} +\description{ +This function will return an updated mkinfit object. The fitted degradation +model parameters from the old fit are used as starting values for the +updated fit. Values specified as 'parms.ini' and/or 'state.ini' will +override these starting values. +} +\examples{ +\dontrun{ +fit <- mkinfit("DFOP", subset(FOCUS_2006_D, value != 0), quiet = TRUE) +update(fit, error_model = "tc") +} +} @@ -1,31 +1,34 @@ Loading mkin Testing mkin +Successfully compiled differential equation model from auto-generated C code. ✔ | OK F W S | Context ✔ | 2 | Export dataset for reading into CAKE -✔ | 10 | Confidence intervals and p-values [12.8 s] -✔ | 10 | Error model fitting [37.1 s] +✔ | 10 | Confidence intervals and p-values [10.2 s] +✔ | 10 | Error model fitting [38.3 s] ✔ | 5 | Calculation of FOCUS chi2 error levels [3.5 s] -✔ | 13 | Results for FOCUS D established in expertise for UBA (Ranke 2014) [3.4 s] +✔ | 13 | Results for FOCUS D established in expertise for UBA (Ranke 2014) [3.3 s] ✔ | 6 | Test fitting the decline of metabolites from their maximum [0.9 s] ✔ | 1 | Fitting the logistic model [0.9 s] ✔ | 1 | Test dataset class mkinds used in gmkin ✔ | 12 | Special cases of mkinfit calls [2.7 s] ✔ | 9 | mkinmod model generation and printing [0.2 s] ✔ | 3 | Model predictions with mkinpredict [0.3 s] -✔ | 16 | Evaluations according to 2015 NAFTA guidance [4.0 s] -✔ | 4 | Calculation of maximum time weighted average concentrations (TWAs) [2.2 s] +✔ | 16 | Evaluations according to 2015 NAFTA guidance [4.1 s] +✔ | 4 | Calculation of maximum time weighted average concentrations (TWAs) [2.3 s] ✔ | 3 | Summary ✔ | 11 | Plotting [0.6 s] ✔ | 3 | AIC calculation +✔ | 2 | Residuals extracted from mkinfit models ✔ | 2 | Complex test case from Schaefer et al. (2007) Piacenza paper [5.3 s] ✔ | 4 | Fitting the SFORB model [1.7 s] ✔ | 1 | Summaries of old mkinfit objects ✔ | 4 | Results for synthetic data established in expertise for UBA (Ranke 2014) [7.2 s] +✔ | 5 | Hypothesis tests [9.9 s] ══ Results ═════════════════════════════════════════════════════════════════════ -Duration: 84.5 s +Duration: 91.5 s -OK: 120 +OK: 127 Failed: 0 Warnings: 0 Skipped: 0 diff --git a/tests/testthat/FOCUS_2006_D.csf b/tests/testthat/FOCUS_2006_D.csf index c9da7d61..942d56e1 100644 --- a/tests/testthat/FOCUS_2006_D.csf +++ b/tests/testthat/FOCUS_2006_D.csf @@ -5,7 +5,7 @@ Description: MeasurementUnits: % AR TimeUnits: days Comments: Created using mkin::CAKE_export -Date: 2019-10-28 +Date: 2019-10-31 Optimiser: IRLS [Data] diff --git a/tests/testthat/setup_script.R b/tests/testthat/setup_script.R index cfa978fc..fc972a3d 100644 --- a/tests/testthat/setup_script.R +++ b/tests/testthat/setup_script.R @@ -14,6 +14,27 @@ if (Sys.getenv("TRAVIS") != "") n_cores = 1 # On Windows we would need to make a cluster first if (Sys.info()["sysname"] == "Windows") n_cores = 1 +# We set up some models and fits with nls for comparisons +SFO_trans <- function(t, parent_0, log_k_parent_sink) { + parent_0 * exp(- exp(log_k_parent_sink) * t) +} +SFO_notrans <- function(t, parent_0, k_parent_sink) { + parent_0 * exp(- k_parent_sink * t) +} +f_1_nls_trans <- nls(value ~ SFO_trans(time, parent_0, log_k_parent_sink), + data = FOCUS_2006_A, + start = list(parent_0 = 100, log_k_parent_sink = log(0.1))) +f_1_nls_notrans <- nls(value ~ SFO_notrans(time, parent_0, k_parent_sink), + data = FOCUS_2006_A, + start = list(parent_0 = 100, k_parent_sink = 0.1)) + +f_1_mkin_trans <- mkinfit("SFO", FOCUS_2006_A, quiet = TRUE) +f_1_mkin_notrans <- mkinfit("SFO", FOCUS_2006_A, quiet = TRUE, + transform_rates = FALSE) + +f_2_mkin <- mkinfit("DFOP", FOCUS_2006_C, quiet = TRUE) +f_2_nls <- nls(value ~ SSbiexp(time, A1, lrc1, A2, lrc2), data = FOCUS_2006_C) + # mmkin object of parent fits for tests models <- c("SFO", "FOMC", "DFOP", "HS") fits <- mmkin(models, @@ -54,8 +75,8 @@ m_synth_DFOP_par <- mkinmod(parent = mkinsub("DFOP", c("M1", "M2")), M2 = mkinsub("SFO"), use_of_ff = "max", quiet = TRUE) -f_SFO_lin_mkin_OLS <- mkinfit(m_synth_SFO_lin, SFO_lin_a, quiet = TRUE) -f_SFO_lin_mkin_ML <- mkinfit(m_synth_SFO_lin, SFO_lin_a, quiet = TRUE, +fit_nw_1 <- mkinfit(m_synth_SFO_lin, SFO_lin_a, quiet = TRUE) +fit_nw_1_ML <- mkinfit(m_synth_SFO_lin, SFO_lin_a, quiet = TRUE, error_model = "const", error_model_algorithm = "direct") # We know direct optimization is OK and direct needs 4 sec versus 5.5 for threestep and 6 for IRLS @@ -69,5 +90,14 @@ fit_tc_1 <- mkinfit(m_synth_SFO_lin, SFO_lin_a, error_model = "tc", quiet = TRUE f_tc_2 <- mkinfit(m_synth_DFOP_par, DFOP_par_c, error_model = "tc", error_model_algorithm = "direct", quiet = TRUE) -#f_tc_2_ntf <- mkinfit(m_synth_DFOP_par, DFOP_par_c, error_model = "tc", -# transform_fractions = FALSE, error_model_algorithm = "direct", quiet = TRUE) +# Experimental data for UBA +dfop_sfo_sfo <- mkinmod( + parent = mkinsub("DFOP", to = "A1"), + A1 = mkinsub("SFO", to = "A2"), + A2 = mkinsub("SFO"), + use_of_ff = "max" +) + +f_soil_1_tc <- mkinfit(dfop_sfo_sfo, + experimental_data_for_UBA_2019[[1]]$data, + error_model = "tc", quiet = TRUE) diff --git a/tests/testthat/test_confidence.R b/tests/testthat/test_confidence.R index 5f76c344..2443fa66 100644 --- a/tests/testthat/test_confidence.R +++ b/tests/testthat/test_confidence.R @@ -1,44 +1,21 @@ -# We set up some models and fits with nls for comparisons -SFO_trans <- function(t, parent_0, log_k_parent_sink) { - parent_0 * exp(- exp(log_k_parent_sink) * t) -} -SFO_notrans <- function(t, parent_0, k_parent_sink) { - parent_0 * exp(- k_parent_sink * t) -} -f_1_nls_trans <- nls(value ~ SFO_trans(time, parent_0, log_k_parent_sink), - data = FOCUS_2006_A, - start = list(parent_0 = 100, log_k_parent_sink = log(0.1))) -f_1_nls_notrans <- nls(value ~ SFO_notrans(time, parent_0, k_parent_sink), - data = FOCUS_2006_A, - start = list(parent_0 = 100, k_parent_sink = 0.1)) - -f_1_mkin_OLS <- mkinfit("SFO", FOCUS_2006_A, quiet = TRUE) -f_1_mkin_OLS_notrans <- mkinfit("SFO", FOCUS_2006_A, quiet = TRUE, - transform_rates = FALSE) - - -f_2_mkin <- mkinfit("DFOP", FOCUS_2006_C, quiet = TRUE) -f_2_nls <- nls(value ~ SSbiexp(time, A1, lrc1, A2, lrc2), data = FOCUS_2006_C) - context("Confidence intervals and p-values") test_that("The confint method 'quadratic' is consistent with the summary", { expect_equivalent( - confint(f_SFO_lin_mkin_ML, method = "quadratic"), - summary(f_SFO_lin_mkin_ML)$bpar[, c("Lower", "Upper")]) + confint(fit_nw_1, method = "quadratic"), + summary(fit_nw_1)$bpar[, c("Lower", "Upper")]) expect_equivalent( - confint(f_SFO_lin_mkin_ML, method = "quadratic", backtransform = FALSE), - summary(f_SFO_lin_mkin_ML)$par[, c("Lower", "Upper")]) + confint(fit_nw_1, method = "quadratic", backtransform = FALSE), + summary(fit_nw_1)$par[, c("Lower", "Upper")]) - f_notrans <- mkinfit("SFO", FOCUS_2006_C, quiet = TRUE, transform_rates = FALSE) expect_equivalent( - confint(f_notrans, method = "quadratic", transformed = FALSE), - summary(f_notrans)$par[, c("Lower", "Upper")]) + confint(f_1_mkin_notrans, method = "quadratic", transformed = FALSE), + summary(f_1_mkin_notrans)$par[, c("Lower", "Upper")]) expect_equivalent( - confint(f_notrans, method = "quadratic", transformed = FALSE), - summary(f_notrans)$bpar[, c("Lower", "Upper")]) + confint(f_1_mkin_notrans, method = "quadratic", transformed = FALSE), + summary(f_1_mkin_notrans)$bpar[, c("Lower", "Upper")]) }) @@ -46,20 +23,20 @@ test_that("Quadratic confidence intervals for rate constants are comparable to v # Check fitted parameter values expect_equivalent( - (f_1_mkin_OLS$bparms.optim -coef(f_1_nls_notrans))/f_1_mkin_OLS$bparms.optim, + (f_1_mkin_trans$bparms.optim -coef(f_1_nls_notrans))/f_1_mkin_trans$bparms.optim, rep(0, 2), tolerance = 1e-6) expect_equivalent( - (f_1_mkin_OLS$par[1:2] - coef(f_1_nls_trans))/f_1_mkin_OLS$par[1:2], + (f_1_mkin_trans$par[1:2] - coef(f_1_nls_trans))/f_1_mkin_trans$par[1:2], rep(0, 2), tolerance = 1e-6) # Check the standard error for the transformed parameters se_nls <- summary(f_1_nls_trans)$coefficients[, "Std. Error"] # This is of similar magnitude as the standard error obtained with the mkin - se_mkin <- summary(f_1_mkin_OLS)$par[1:2, "Std. Error"] + se_mkin <- summary(f_1_mkin_trans)$par[1:2, "Std. Error"] se_nls_notrans <- summary(f_1_nls_notrans)$coefficients[, "Std. Error"] # This is also of similar magnitude as the standard error obtained with the mkin - se_mkin_notrans <- summary(f_1_mkin_OLS_notrans)$par[1:2, "Std. Error"] + se_mkin_notrans <- summary(f_1_mkin_notrans)$par[1:2, "Std. Error"] # The difference can partly be explained by the ratio between # the maximum likelihood estimate of the standard error sqrt(rss/n) diff --git a/tests/testthat/test_residuals.R b/tests/testthat/test_residuals.R new file mode 100644 index 00000000..0fe05b4f --- /dev/null +++ b/tests/testthat/test_residuals.R @@ -0,0 +1,8 @@ +context("Residuals extracted from mkinfit models") + +test_that("Residuals are correctly returned", { + f <- fits[["FOMC", "FOCUS_C"]] + expect_equal(residuals(f)[1:3], c(-0.7748906, 2.7090589, -1.9451989)) + + expect_equivalent(residuals(f_tc_2, standardized = TRUE)[1:3], c(0.52579103, 0.40714911, 1.66394233)) +}) diff --git a/tests/testthat/test_tests.R b/tests/testthat/test_tests.R new file mode 100644 index 00000000..523edc4a --- /dev/null +++ b/tests/testthat/test_tests.R @@ -0,0 +1,27 @@ +context("Hypothesis tests") + +test_that("The likelihood ratio test works", { + + expect_error(lrtest(fit_tc_1, f_tc_2), "not been fitted to the same data") + + res <- lrtest(fit_nw_1, fit_tc_1) + expect_equal(res[["2", "Pr(>Chisq)"]], 0.9999998) + +}) + +test_that("We can conveniently fix parameters using 'fixed_parms'", { + f_k2_fixed <- mkinfit("DFOP", FOCUS_2006_C, fixed_parms = c(k2 = 0.05), quiet = TRUE) + expect_equivalent(f_k2_fixed$bparms.ode["k2"], 0.05) +}) + +test_that("Updating fitted models works", { + f_dfop_const <- mkinfit("DFOP", FOCUS_2006_C, quiet = TRUE) + f_dfop_tc <- update(f_dfop_const, error_model = "tc") + + f_soil_1_nw <- update(f_soil_1_tc, error_model = "const") + f_soil_1_nw_A2 <- update(f_soil_1_nw, fixed_parms = c(k_A2 = 0)) + test_nw_tc <- lrtest(f_soil_1_nw, f_soil_1_tc) + expect_equivalent(test_nw_tc[["2", "Pr(>Chisq)"]], 2.113e-6) + test_nw_A2 <- lrtest(f_soil_1_nw, f_soil_1_nw_A2) + expect_equivalent(test_nw_A2[["2", "Pr(>Chisq)"]], 0.9999468) +}) |