diff options
| author | Johannes Ranke <johannes.ranke@jrwb.de> | 2024-07-29 08:15:30 +0200 |
|---|---|---|
| committer | Johannes Ranke <johannes.ranke@jrwb.de> | 2024-07-29 08:16:19 +0200 |
| commit | ba3eaa0d61d4980a61ebbcd105f07d21dd2aabb6 (patch) | |
| tree | 329430e6ec17482c222eb73a3feb6351fd607e38 /docs/coverage/coverage.html | |
| parent | bad2f70c18cd9f57c0d382914327613bcfc9298f (diff) | |
Add coverage report for pkgdown pagemain
Diffstat (limited to 'docs/coverage/coverage.html')
| -rw-r--r-- | docs/coverage/coverage.html | 69858 |
1 files changed, 69858 insertions, 0 deletions
diff --git a/docs/coverage/coverage.html b/docs/coverage/coverage.html new file mode 100644 index 00000000..749ccdd0 --- /dev/null +++ b/docs/coverage/coverage.html @@ -0,0 +1,69858 @@ +<!DOCTYPE html> +<html lang="en"> +<head> +<meta charset="utf-8"/> +<style>body{background-color:white;}</style> +<link href="lib/htmltools-fill-0.5.8.1/fill.css" rel="stylesheet" /> +<script src="lib/htmlwidgets-1.6.4/htmlwidgets.js"></script> +<link href="lib/datatables-css-0.0.0/datatables-crosstalk.css" rel="stylesheet" /> +<script src="lib/datatables-binding-0.33/datatables.js"></script> +<script src="lib/jquery-3.6.0/jquery-3.6.0.min.js"></script> +<link href="lib/dt-core-1.13.6/css/jquery.dataTables.min.css" rel="stylesheet" /> +<link href="lib/dt-core-1.13.6/css/jquery.dataTables.extra.css" rel="stylesheet" /> +<script src="lib/dt-core-1.13.6/js/jquery.dataTables.min.js"></script> +<link href="lib/crosstalk-1.2.1/css/crosstalk.min.css" rel="stylesheet" /> +<script src="lib/crosstalk-1.2.1/js/crosstalk.min.js"></script> +<link href="lib/highlight.js-6.2/rstudio.css" rel="stylesheet" /> +<script src="lib/highlight.js-6.2/highlight.pack.js"></script> +<meta name="viewport" content="width=device-width, initial-scale=1" /> +<link href="lib/bootstrap-3.3.5/css/bootstrap.min.css" rel="stylesheet" /> +<link href="lib/bootstrap-3.3.5/css/bootstrap-theme.min.css" rel="stylesheet" /> +<script src="lib/bootstrap-3.3.5/js/bootstrap.min.js"></script> +<script src="lib/bootstrap-3.3.5/shim/html5shiv.min.js"></script> +<script src="lib/bootstrap-3.3.5/shim/respond.min.js"></script> + +</head> +<body> +<div class="container-fluid"> + <style type="text/css">table tr:hover td { + font-weight:bold;text-decoration:none +} +table tr.covered td{ + background-color:rgba(95,151,68,0.3) +} + +table tr:hover.covered .num{ + background-color:rgba(95,151,68,0.7) +} +table tr.missed td{ + background-color:rgba(185,73,71,0.3) +} +table tr:hover.missed .num{ + background-color:rgba(185,73,71,0.7) +} + +table tr.missed:hover td{ + -webkit-box-shadow:0 -2px 0 0 #b94947 inset; + -moz-box-shadow:0 -2px 0 0 #b94947 inset; + box-shadow:0 -2px 0 0 #b94947 inset +} +table tr.covered:hover td{ + -webkit-box-shadow:0 -2px 0 0 #5f9744 inset; + -moz-box-shadow:0 -2px 0 0 #5f9744 inset; + box-shadow:0 -2px 0 0 #5f9744 inset +} + +table tr.never td{ + background-color:transparent +} + +table tbody { + border-style: solid; + border: 1px solid rgba(0,0,0,0.1) +} + +table .num { + border-right: 1px solid rgba(0,0,0,0.1) +} + +td.coverage em { + opacity: 0.5; +} + +table td.coverage { + border-right: 1px solid rgba(0,0,0,0.1); + font-weight: bold; + text-align: center; +} +table.table-condensed pre { + background-color: transparent; + margin: 0; + padding: 0; + border: 0; + font-size: 11px; +} +div#files td { + padding: 0; + padding-left: 5px; +} + +div#files td.num { + padding-right: 5px; +} + +table.table-condensed { + font-size: 11px; +}</style> + <div class="col-md-8 col-md-offset-2"> + <h2>mkin coverage - 89.32%</h2> + <div class="tabbable"> + <ul class="nav nav-tabs" data-tabsetid="covr"> + <li class="active"> + <a href="#tab-covr-1" data-toggle="tab" data-value="Files">Files</a> + </li> + <li> + <a href="#tab-covr-2" data-toggle="tab" data-value="Source">Source</a> + </li> + </ul> + <div class="tab-content" data-tabsetid="covr"> + <div class="tab-pane active" title="Files" data-value="Files" id="tab-covr-1"> + <div class="datatables html-widget html-fill-item" id="htmlwidget-df8b8ed832d104ae69ed" style="width:100%;height:500px;"></div> + <script type="application/json" data-for="htmlwidget-df8b8ed832d104ae69ed">{"x":{"filter":"none","vertical":false,"fillContainer":false,"data":[["<a href=\"#\">R/summary_listing.R<\/a>","<a href=\"#\">R/hierarchical_kinetics.R<\/a>","<a href=\"#\">R/aw.R<\/a>","<a href=\"#\">R/multistart.R<\/a>","<a href=\"#\">R/status.R<\/a>","<a href=\"#\">R/parms.R<\/a>","<a href=\"#\">R/lrtest.mkinfit.R<\/a>","<a href=\"#\">R/mkinresplot.R<\/a>","<a href=\"#\">R/mkinds.R<\/a>","<a href=\"#\">R/f_time_norm_focus.R<\/a>","<a href=\"#\">R/loftest.R<\/a>","<a href=\"#\">R/read_spreadsheet.R<\/a>","<a href=\"#\">R/mhmkin.R<\/a>","<a href=\"#\">R/plot.mixed.mmkin.R<\/a>","<a href=\"#\">R/plot.mkinfit.R<\/a>","<a href=\"#\">R/mkinpredict.R<\/a>","<a href=\"#\">R/update.mkinfit.R<\/a>","<a href=\"#\">R/anova.saem.mmkin.R<\/a>","<a href=\"#\">R/plot.mmkin.R<\/a>","<a href=\"#\">R/max_twa_parent.R<\/a>","<a href=\"#\">R/nafta.R<\/a>","<a href=\"#\">R/saem.R<\/a>","<a href=\"#\">R/llhist.R<\/a>","<a href=\"#\">R/illparms.R<\/a>","<a href=\"#\">R/mkin_wide_to_long.R<\/a>","<a href=\"#\">R/summary.saem.mmkin.R<\/a>","<a href=\"#\">R/summary.nlme.mmkin.R<\/a>","<a href=\"#\">R/summary.mkinfit.R<\/a>","<a href=\"#\">R/mean_degparms.R<\/a>","<a href=\"#\">R/transform_odeparms.R<\/a>","<a href=\"#\">R/mkinmod.R<\/a>","<a href=\"#\">R/mkinfit.R<\/a>","<a href=\"#\">R/endpoints.R<\/a>","<a href=\"#\">R/intervals.R<\/a>","<a href=\"#\">R/ilr.R<\/a>","<a href=\"#\">R/set_nd_nq.R<\/a>","<a href=\"#\">R/parplot.R<\/a>","<a href=\"#\">R/mkinparplot.R<\/a>","<a href=\"#\">R/nlme.R<\/a>","<a href=\"#\">R/mixed.mmkin.R<\/a>","<a href=\"#\">R/mkinerrplot.R<\/a>","<a href=\"#\">R/nlme.mmkin.R<\/a>","<a href=\"#\">R/mmkin.R<\/a>","<a href=\"#\">R/confint.mkinfit.R<\/a>","<a href=\"#\">R/create_deg_func.R<\/a>","<a href=\"#\">R/mkinerrmin.R<\/a>","<a href=\"#\">R/CAKE_export.R<\/a>","<a href=\"#\">R/summary.mmkin.R<\/a>","<a href=\"#\">R/AIC.mmkin.R<\/a>","<a href=\"#\">R/parent_solutions.R<\/a>","<a href=\"#\">R/residuals.mkinfit.R<\/a>","<a href=\"#\">R/add_err.R<\/a>","<a href=\"#\">R/mkin_long_to_wide.R<\/a>","<a href=\"#\">R/logLik.mkinfit.R<\/a>","<a href=\"#\">R/nobs.mkinfit.R<\/a>","<a href=\"#\">R/sigma_twocomp.R<\/a>","<a href=\"#\">R/mkinsub.R<\/a>"],[59,59,84,224,117,82,80,94,178,112,112,120,300,380,336,271,61,114,157,125,153,867,43,168,35,317,240,291,68,278,513,985,255,102,89,164,124,75,145,103,107,267,199,238,159,120,95,56,68,238,31,104,29,43,8,54,17],[28,14,27,76,59,22,20,26,44,39,28,46,110,183,109,87,23,62,47,48,58,466,18,66,11,149,116,167,28,88,225,452,159,53,18,56,64,47,62,31,37,83,51,69,95,43,41,20,17,15,13,12,6,5,1,1,1],[0,0,17,49,39,16,15,21,36,32,23,38,91,152,91,74,20,54,41,42,51,411,16,60,10,136,106,155,26,82,211,425,150,50,17,53,61,45,60,30,36,81,50,68,95,43,41,20,17,15,13,12,6,5,1,1,1],[28,14,10,27,20,6,5,5,8,7,5,8,19,31,18,13,3,8,6,6,7,55,2,6,1,13,10,12,2,6,14,27,9,3,1,3,3,2,2,1,1,2,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0],["0","0","403","168","482","20261","5","976","102","290","1","305","305","634","738","19867308","4","509","523","2","179","2273233","225","867","1025","500","323","44586","6538","30119107","4421","292559","29490","3125","529091","18","160","104","1217374","149","206","3258","1963","773","4031","72485","337","1","247","426770","1607","1285","535","166798","166810","4250","9864"],["0.00%","0.00%","62.96%","64.47%","66.10%","72.73%","75.00%","80.77%","81.82%","82.05%","82.14%","82.61%","82.73%","83.06%","83.49%","85.06%","86.96%","87.10%","87.23%","87.50%","87.93%","88.20%","88.89%","90.91%","90.91%","91.28%","91.38%","92.81%","92.86%","93.18%","93.78%","94.03%","94.34%","94.34%","94.44%","94.64%","95.31%","95.74%","96.77%","96.77%","97.30%","97.59%","98.04%","98.55%","100.00%","100.00%","100.00%","100.00%","100.00%","100.00%","100.00%","100.00%","100.00%","100.00%","100.00%","100.00%","100.00%"]],"container":"<table class=\"row-border\">\n <thead>\n <tr>\n <th>File<\/th>\n <th>Lines<\/th>\n <th>Relevant<\/th>\n <th>Covered<\/th>\n <th>Missed<\/th>\n <th>Hits / Line<\/th>\n <th>Coverage<\/th>\n <\/tr>\n <\/thead>\n<\/table>","options":{"searching":false,"dom":"t","paging":false,"columnDefs":[{"targets":6,"createdCell":"function(td, cellData, rowData, row, col) {\n var percent = cellData.replace(\"%\", \"\");\n if (percent > 90) {\n var grad = \"linear-gradient(90deg, #edfde7 \" + cellData + \", white \" + cellData + \")\";\n } else if (percent > 75) {\n var grad = \"linear-gradient(90deg, #f9ffe5 \" + cellData + \", white \" + cellData + \")\";\n } else {\n var grad = \"linear-gradient(90deg, #fcece9 \" + cellData + \", white \" + cellData + \")\";\n }\n $(td).css(\"background\", grad);\n}\n"},{"className":"dt-right","targets":[1,2,3,4]},{"name":"File","targets":0},{"name":"Lines","targets":1},{"name":"Relevant","targets":2},{"name":"Covered","targets":3},{"name":"Missed","targets":4},{"name":"Hits / Line","targets":5},{"name":"Coverage","targets":6}],"order":[],"autoWidth":false,"orderClasses":false},"callback":"function(table) {\ntable.on('click.dt', 'a', function() {\n files = $('div#files div');\n files.not('div.hidden').addClass('hidden');\n id = $(this).text();\n files.filter('div[id=\\'' + id + '\\']').removeClass('hidden');\n $('ul.nav a[data-value=Source]').text(id).tab('show');\n});\n}"},"evals":["options.columnDefs.0.createdCell","callback"],"jsHooks":[]}</script> + </div> + <div class="tab-pane" title="Source" data-value="Source" id="tab-covr-2"> + <div id="files"> + <div id="R/saem.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">utils::globalVariables(c("predicted", "std"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Fit nonlinear mixed models with SAEM</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' This function uses [saemix::saemix()] as a backend for fitting nonlinear mixed</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' effects models created from [mmkin] row objects using the Stochastic Approximation</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Expectation Maximisation algorithm (SAEM).</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' An mmkin row object is essentially a list of mkinfit objects that have been</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' obtained by fitting the same model to a list of datasets using [mkinfit].</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Starting values for the fixed effects (population mean parameters, argument</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' psi0 of [saemix::saemixModel()] are the mean values of the parameters found</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' using [mmkin].</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom utils packageVersion</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom saemix saemix</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param object An [mmkin] row object containing several fits of the same</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' [mkinmod] model to different datasets</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param verbose Should we print information about created objects of</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' type [saemix::SaemixModel] and [saemix::SaemixData]?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param transformations Per default, all parameter transformations are done</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' in mkin. If this argument is set to 'saemix', parameter transformations</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' are done in 'saemix' for the supported cases, i.e. (as of version 1.1.2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' SFO, FOMC, DFOP and HS without fixing `parent_0`, and SFO or DFOP with</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' one SFO metabolite.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param error_model Possibility to override the error model used in the mmkin object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param degparms_start Parameter values given as a named numeric vector will</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' be used to override the starting values obtained from the 'mmkin' object.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param test_log_parms If TRUE, an attempt is made to use more robust starting</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' values for population parameters fitted as log parameters in mkin (like</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' rate constants) by only considering rate constants that pass the t-test</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' when calculating mean degradation parameters using [mean_degparms].</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param conf.level Possibility to adjust the required confidence level</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' for parameter that are tested if requested by 'test_log_parms'.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param solution_type Possibility to specify the solution type in case the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' automatic choice is not desired</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param no_random_effect Character vector of degradation parameters for</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' which there should be no variability over the groups. Only used</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' if the covariance model is not explicitly specified.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param covariance.model Will be passed to [saemix::saemixModel()]. Per</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' default, uncorrelated random effects are specified for all degradation</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parameters.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param omega.init Will be passed to [saemix::saemixModel()]. If using</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' mkin transformations and the default covariance model with optionally</pre> + </td> + </tr> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' excluded random effects, the variances of the degradation parameters</pre> + </td> + </tr> + <tr class="never"> + <td class="num">47</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' are estimated using [mean_degparms], with testing of untransformed</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' log parameters for significant difference from zero. If not using</pre> + </td> + </tr> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' mkin transformations or a custom covariance model, the default</pre> + </td> + </tr> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' initialisation of [saemix::saemixModel] is used for omega.init.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param covariates A data frame with covariate data for use in</pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' 'covariate_models', with dataset names as row names.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param covariate_models A list containing linear model formulas with one explanatory</pre> + </td> + </tr> + <tr class="never"> + <td class="num">54</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' variable, i.e. of the type 'parameter ~ covariate'. Covariates must be available</pre> + </td> + </tr> + <tr class="never"> + <td class="num">55</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' in the 'covariates' data frame.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param error.init Will be passed to [saemix::saemixModel()].</pre> + </td> + </tr> + <tr class="never"> + <td class="num">57</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param quiet Should we suppress the messages saemix prints at the beginning</pre> + </td> + </tr> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' and the end of the optimisation process?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param nbiter.saemix Convenience option to increase the number of</pre> + </td> + </tr> + <tr class="never"> + <td class="num">60</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' iterations</pre> + </td> + </tr> + <tr class="never"> + <td class="num">61</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param control Passed to [saemix::saemix].</pre> + </td> + </tr> + <tr class="never"> + <td class="num">62</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots Further parameters passed to [saemix::saemixModel].</pre> + </td> + </tr> + <tr class="never"> + <td class="num">63</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return An S3 object of class 'saem.mmkin', containing the fitted</pre> + </td> + </tr> + <tr class="never"> + <td class="num">64</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' [saemix::SaemixObject] as a list component named 'so'. The</pre> + </td> + </tr> + <tr class="never"> + <td class="num">65</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' object also inherits from 'mixed.mmkin'.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">66</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @seealso [summary.saem.mmkin] [plot.mixed.mmkin]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">67</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">68</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">69</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ds <- lapply(experimental_data_for_UBA_2019[6:10],</pre> + </td> + </tr> + <tr class="never"> + <td class="num">70</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' function(x) subset(x$data[c("name", "time", "value")]))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">71</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' names(ds) <- paste("Dataset", 6:10)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">72</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_mmkin_parent_p0_fixed <- mmkin("FOMC", ds,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">73</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' state.ini = c(parent = 100), fixed_initials = "parent", quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">74</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_saem_p0_fixed <- saem(f_mmkin_parent_p0_fixed)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">75</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">76</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_mmkin_parent <- mmkin(c("SFO", "FOMC", "DFOP"), ds, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">77</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_saem_sfo <- saem(f_mmkin_parent["SFO", ])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">78</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_saem_fomc <- saem(f_mmkin_parent["FOMC", ])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">79</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_saem_dfop <- saem(f_mmkin_parent["DFOP", ])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">80</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' anova(f_saem_sfo, f_saem_fomc, f_saem_dfop)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">81</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' anova(f_saem_sfo, f_saem_dfop, test = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">82</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' illparms(f_saem_dfop)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">83</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_saem_dfop_red <- update(f_saem_dfop, no_random_effect = "g_qlogis")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">84</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' anova(f_saem_dfop, f_saem_dfop_red, test = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">85</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">86</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' anova(f_saem_sfo, f_saem_fomc, f_saem_dfop)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">87</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # The returned saem.mmkin object contains an SaemixObject, therefore we can use</pre> + </td> + </tr> + <tr class="never"> + <td class="num">88</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # functions from saemix</pre> + </td> + </tr> + <tr class="never"> + <td class="num">89</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' library(saemix)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">90</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' compare.saemix(f_saem_sfo$so, f_saem_fomc$so, f_saem_dfop$so)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">91</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(f_saem_fomc$so, plot.type = "convergence")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">92</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(f_saem_fomc$so, plot.type = "individual.fit")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">93</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(f_saem_fomc$so, plot.type = "npde")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">94</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(f_saem_fomc$so, plot.type = "vpc")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">95</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">96</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_mmkin_parent_tc <- update(f_mmkin_parent, error_model = "tc")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">97</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_saem_fomc_tc <- saem(f_mmkin_parent_tc["FOMC", ])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">98</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' anova(f_saem_fomc, f_saem_fomc_tc, test = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">99</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">100</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' sfo_sfo <- mkinmod(parent = mkinsub("SFO", "A1"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">101</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' A1 = mkinsub("SFO"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">102</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fomc_sfo <- mkinmod(parent = mkinsub("FOMC", "A1"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">103</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' A1 = mkinsub("SFO"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">104</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' dfop_sfo <- mkinmod(parent = mkinsub("DFOP", "A1"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">105</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' A1 = mkinsub("SFO"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">106</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # The following fit uses analytical solutions for SFO-SFO and DFOP-SFO,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">107</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # and compiled ODEs for FOMC that are much slower</pre> + </td> + </tr> + <tr class="never"> + <td class="num">108</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_mmkin <- mmkin(list(</pre> + </td> + </tr> + <tr class="never"> + <td class="num">109</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' "SFO-SFO" = sfo_sfo, "FOMC-SFO" = fomc_sfo, "DFOP-SFO" = dfop_sfo),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">110</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ds, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">111</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # saem fits of SFO-SFO and DFOP-SFO to these data take about five seconds</pre> + </td> + </tr> + <tr class="never"> + <td class="num">112</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # each on this system, as we use analytical solutions written for saemix.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">113</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # When using the analytical solutions written for mkin this took around</pre> + </td> + </tr> + <tr class="never"> + <td class="num">114</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # four minutes</pre> + </td> + </tr> + <tr class="never"> + <td class="num">115</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_saem_sfo_sfo <- saem(f_mmkin["SFO-SFO", ])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">116</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_saem_dfop_sfo <- saem(f_mmkin["DFOP-SFO", ])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">117</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # We can use print, plot and summary methods to check the results</pre> + </td> + </tr> + <tr class="never"> + <td class="num">118</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' print(f_saem_dfop_sfo)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">119</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(f_saem_dfop_sfo)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">120</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' summary(f_saem_dfop_sfo, data = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">121</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">122</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # The following takes about 6 minutes</pre> + </td> + </tr> + <tr class="never"> + <td class="num">123</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_saem_dfop_sfo_deSolve <- saem(f_mmkin["DFOP-SFO", ], solution_type = "deSolve",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">124</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' nbiter.saemix = c(200, 80))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">125</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">126</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' #anova(</pre> + </td> + </tr> + <tr class="never"> + <td class="num">127</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # f_saem_dfop_sfo,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">128</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # f_saem_dfop_sfo_deSolve))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">129</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">130</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # If the model supports it, we can also use eigenvalue based solutions, which</pre> + </td> + </tr> + <tr class="never"> + <td class="num">131</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # take a similar amount of time</pre> + </td> + </tr> + <tr class="never"> + <td class="num">132</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' #f_saem_sfo_sfo_eigen <- saem(f_mmkin["SFO-SFO", ], solution_type = "eigen",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">133</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # control = list(nbiter.saemix = c(200, 80), nbdisplay = 10))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">134</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">135</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">136</td> + <td class="coverage">2411<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r">saem <- function(object, ...) UseMethod("saem")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">137</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">138</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname saem</pre> + </td> + </tr> + <tr class="never"> + <td class="num">139</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">140</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">saem.mmkin <- function(object,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">141</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> transformations = c("mkin", "saemix"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">142</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> error_model = "auto",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">143</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms_start = numeric(),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">144</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> test_log_parms = TRUE,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">145</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> conf.level = 0.6,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">146</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> solution_type = "auto",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">147</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> covariance.model = "auto",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">148</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> omega.init = "auto",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">149</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> covariates = NULL,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">150</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> covariate_models = NULL,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">151</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> no_random_effect = NULL,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">152</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> error.init = c(1, 1),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">153</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> nbiter.saemix = c(300, 100),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">154</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> control = list(displayProgress = FALSE, print = FALSE,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">155</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> nbiter.saemix = nbiter.saemix,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">156</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> save = FALSE, save.graphs = FALSE),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">157</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> verbose = FALSE, quiet = FALSE, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">158</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">159</td> + <td class="coverage">2411<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> call <- match.call()</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">160</td> + <td class="coverage">2411<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transformations <- match.arg(transformations)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">161</td> + <td class="coverage">2411<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> m_saemix <- saemix_model(object, verbose = verbose,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">162</td> + <td class="coverage">2411<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> error_model = error_model,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">163</td> + <td class="coverage">2411<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms_start = degparms_start,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">164</td> + <td class="coverage">2411<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> test_log_parms = test_log_parms, conf.level = conf.level,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">165</td> + <td class="coverage">2411<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> solution_type = solution_type,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">166</td> + <td class="coverage">2411<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transformations = transformations,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">167</td> + <td class="coverage">2411<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covariance.model = covariance.model,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">168</td> + <td class="coverage">2411<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> omega.init = omega.init,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">169</td> + <td class="coverage">2411<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covariates = covariates,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">170</td> + <td class="coverage">2411<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covariate_models = covariate_models,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">171</td> + <td class="coverage">2411<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> error.init = error.init,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">172</td> + <td class="coverage">2411<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> no_random_effect = no_random_effect,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">173</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> ...)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">174</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> d_saemix <- saemix_data(object, covariates = covariates, verbose = verbose)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">175</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">176</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit_failed <- FALSE</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">177</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> FIM_failed <- NULL</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">178</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit_time <- system.time({</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">179</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> utils::capture.output(f_saemix <- try(saemix(m_saemix, d_saemix, control)), split = !quiet)</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">180</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (inherits(f_saemix, "try-error")) fit_failed <- TRUE</pre> + </td> + </tr> + <tr class="never"> + <td class="num">181</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> })</pre> + </td> + </tr> + <tr class="never"> + <td class="num">182</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">183</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return_data <- nlme_data(object)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">184</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">185</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!fit_failed) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">186</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (any(is.na(f_saemix@results@se.fixed))) FIM_failed <- c(FIM_failed, "fixed effects")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">187</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (any(is.na(c(f_saemix@results@se.omega, f_saemix@results@se.respar)))) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">188</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> FIM_failed <- c(FIM_failed, "random effects and error model parameters")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">189</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">190</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">191</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transparms_optim <- f_saemix@results@fixed.effects</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">192</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(transparms_optim) <- f_saemix@results@name.fixed</pre> + </td> + </tr> + <tr class="never"> + <td class="num">193</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">194</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (transformations == "mkin") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">195</td> + <td class="coverage">1413<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> bparms_optim <- backtransform_odeparms(transparms_optim,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">196</td> + <td class="coverage">1413<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object[[1]]$mkinmod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">197</td> + <td class="coverage">1413<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object[[1]]$transform_rates,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">198</td> + <td class="coverage">1413<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object[[1]]$transform_fractions)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">199</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">200</td> + <td class="coverage">774<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> bparms_optim <- transparms_optim</pre> + </td> + </tr> + <tr class="never"> + <td class="num">201</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">202</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">203</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> saemix_data_ds <- f_saemix@data@data$ds</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">204</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mkin_ds_order <- as.character(unique(return_data$ds))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">205</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> saemix_ds_order <- unique(saemix_data_ds)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">206</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">207</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> psi <- saemix::psi(f_saemix)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">208</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rownames(psi) <- saemix_ds_order</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">209</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return_data$predicted <- f_saemix@model@model(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">210</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> psi = psi[mkin_ds_order, ],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">211</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> id = as.numeric(return_data$ds),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">212</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> xidep = return_data[c("time", "name")])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">213</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">214</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return_data <- transform(return_data,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">215</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> residual = value - predicted,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">216</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> std = sigma_twocomp(predicted,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">217</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f_saemix@results@respar[1], f_saemix@results@respar[2]))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">218</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return_data <- transform(return_data,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">219</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> standardized = residual / std)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">220</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">221</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">222</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> result <- list(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">223</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mkinmod = object[[1]]$mkinmod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">224</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mmkin = object,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">225</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> solution_type = object[[1]]$solution_type,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">226</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transformations = transformations,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">227</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_rates = object[[1]]$transform_rates,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">228</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_fractions = object[[1]]$transform_fractions,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">229</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covariates = covariates,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">230</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covariate_models = covariate_models,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">231</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> sm = m_saemix,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">232</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> so = f_saemix,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">233</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> call = call,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">234</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> time = fit_time,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">235</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> FIM_failed = FIM_failed,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">236</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mean_dp_start = attr(m_saemix, "mean_dp_start"),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">237</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> bparms.fixed = object[[1]]$bparms.fixed,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">238</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> data = return_data,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">239</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> err_mod = object[[1]]$err_mod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">240</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> date.fit = date(),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">241</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> saemixversion = as.character(utils::packageVersion("saemix")),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">242</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mkinversion = as.character(utils::packageVersion("mkin")),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">243</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> Rversion = paste(R.version$major, R.version$minor, sep=".")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">244</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> )</pre> + </td> + </tr> + <tr class="never"> + <td class="num">245</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">246</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!fit_failed) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">247</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> result$mkin_ds_order <- mkin_ds_order</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">248</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> result$saemix_ds_order <- saemix_ds_order</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">249</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> result$bparms.optim <- bparms_optim</pre> + </td> + </tr> + <tr class="never"> + <td class="num">250</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">251</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">252</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(result) <- c("saem.mmkin", "mixed.mmkin")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">253</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(result)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">254</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">255</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">256</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">257</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname saem</pre> + </td> + </tr> + <tr class="never"> + <td class="num">258</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param x An saem.mmkin object to print</pre> + </td> + </tr> + <tr class="never"> + <td class="num">259</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param digits Number of digits to use for printing</pre> + </td> + </tr> + <tr class="never"> + <td class="num">260</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">print.saem.mmkin <- function(x, digits = max(3, getOption("digits") - 3), ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">261</td> + <td class="coverage">234<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat( "Kinetic nonlinear mixed-effects model fit by SAEM" )</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">262</td> + <td class="coverage">234<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nStructural model:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">263</td> + <td class="coverage">234<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> diffs <- x$mmkin[[1]]$mkinmod$diffs</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">264</td> + <td class="coverage">234<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> nice_diffs <- gsub("^(d.*) =", "\\1/dt =", diffs)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">265</td> + <td class="coverage">234<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> writeLines(strwrap(nice_diffs, exdent = 11))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">266</td> + <td class="coverage">234<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nData:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">267</td> + <td class="coverage">234<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat(nrow(x$data), "observations of",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">268</td> + <td class="coverage">234<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> length(unique(x$data$name)), "variable(s) grouped in",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">269</td> + <td class="coverage">234<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> length(unique(x$data$ds)), "datasets\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">270</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">271</td> + <td class="coverage">234<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (inherits(x$so, "try-error")) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">272</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nFit did not terminate successfully\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">273</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">274</td> + <td class="coverage">234<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nLikelihood computed by importance sampling\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">275</td> + <td class="coverage">234<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ll <- try(logLik(x$so, type = "is"), silent = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">276</td> + <td class="coverage">234<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (inherits(ll, "try-error")) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">277</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("Not available\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">278</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">279</td> + <td class="coverage">234<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(data.frame(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">280</td> + <td class="coverage">234<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> AIC = AIC(x$so, type = "is"),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">281</td> + <td class="coverage">234<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> BIC = BIC(x$so, type = "is"),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">282</td> + <td class="coverage">234<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> logLik = logLik(x$so, type = "is"),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">283</td> + <td class="coverage">234<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> row.names = " "), digits = digits)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">284</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">285</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">286</td> + <td class="coverage">234<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nFitted parameters:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">287</td> + <td class="coverage">234<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> conf.int <- parms(x, ci = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">288</td> + <td class="coverage">234<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(conf.int, digits = digits)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">289</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">290</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">291</td> + <td class="coverage">234<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> invisible(x)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">292</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">293</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">294</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname saem</pre> + </td> + </tr> + <tr class="never"> + <td class="num">295</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return An [saemix::SaemixModel] object.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">296</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">297</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">saemix_model <- function(object, solution_type = "auto",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">298</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> transformations = c("mkin", "saemix"), error_model = "auto",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">299</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms_start = numeric(),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">300</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> covariance.model = "auto", no_random_effect = NULL,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">301</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> omega.init = "auto",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">302</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> covariates = NULL, covariate_models = NULL,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">303</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> error.init = numeric(),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">304</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> test_log_parms = FALSE, conf.level = 0.6, verbose = FALSE, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">305</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">306</td> + <td class="coverage">65<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (nrow(object) > 1) stop("Only row objects allowed")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">307</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">308</td> + <td class="coverage">2346<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mkin_model <- object[[1]]$mkinmod</pre> + </td> + </tr> + <tr class="never"> + <td class="num">309</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">310</td> + <td class="coverage">2346<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(mkin_model$spec) > 1 & solution_type[1] == "analytical") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">311</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> stop("mkin analytical solutions not supported for more thane one observed variable")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">312</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">313</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">314</td> + <td class="coverage">2242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms_optim <- mean_degparms(object, test_log_parms = test_log_parms)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">315</td> + <td class="coverage">2242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> na_degparms <- names(which(is.na(degparms_optim)))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">316</td> + <td class="coverage">2242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(na_degparms) > 0) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">317</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> message("Did not find valid starting values for ", paste(na_degparms, collapse = ", "), "\n",</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">318</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> "Now trying with test_log_parms = FALSE")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">319</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> degparms_optim <- mean_degparms(object, test_log_parms = FALSE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">320</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">321</td> + <td class="coverage">2242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (transformations == "saemix") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">322</td> + <td class="coverage">779<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms_optim <- backtransform_odeparms(degparms_optim,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">323</td> + <td class="coverage">779<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object[[1]]$mkinmod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">324</td> + <td class="coverage">779<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object[[1]]$transform_rates,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">325</td> + <td class="coverage">779<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object[[1]]$transform_fractions)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">326</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">327</td> + <td class="coverage">2242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms_fixed <- object[[1]]$bparms.fixed</pre> + </td> + </tr> + <tr class="never"> + <td class="num">328</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">329</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Transformations are done in the degradation function by default</pre> + </td> + </tr> + <tr class="never"> + <td class="num">330</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # (transformations = "mkin")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">331</td> + <td class="coverage">2242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform.par = rep(0, length(degparms_optim))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">332</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">333</td> + <td class="coverage">2242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeini_optim_parm_names <- grep('_0$', names(degparms_optim), value = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">334</td> + <td class="coverage">2242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeini_fixed_parm_names <- grep('_0$', names(degparms_fixed), value = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">335</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">336</td> + <td class="coverage">2242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeparms_fixed_names <- setdiff(names(degparms_fixed), odeini_fixed_parm_names)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">337</td> + <td class="coverage">2242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeparms_fixed <- degparms_fixed[odeparms_fixed_names]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">338</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">339</td> + <td class="coverage">2242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeini_fixed <- degparms_fixed[odeini_fixed_parm_names]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">340</td> + <td class="coverage">2242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(odeini_fixed) <- gsub('_0$', '', odeini_fixed_parm_names)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">341</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">342</td> + <td class="coverage">2242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> model_function <- FALSE</pre> + </td> + </tr> + <tr class="never"> + <td class="num">343</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">344</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Model functions with analytical solutions</pre> + </td> + </tr> + <tr class="never"> + <td class="num">345</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Fixed parameters, use_of_ff = "min" and turning off sinks currently not supported here</pre> + </td> + </tr> + <tr class="never"> + <td class="num">346</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # In general, we need to consider exactly how the parameters in mkinfit were specified,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">347</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # as the parameters are currently mapped by position in these solutions</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">348</td> + <td class="coverage">2242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> sinks <- sapply(mkin_model$spec, function(x) x$sink)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">349</td> + <td class="coverage">2242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(odeparms_fixed) == 0 & mkin_model$use_of_ff == "max" & all(sinks)) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">350</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Parent only</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">351</td> + <td class="coverage">2242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(mkin_model$spec) == 1) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">352</td> + <td class="coverage">1748<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parent_type <- mkin_model$spec[[1]]$type</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">353</td> + <td class="coverage">1748<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(odeini_fixed) == 1 && !grepl("_bound$", names(odeini_fixed))) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">354</td> + <td class="coverage">50<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (transformations == "saemix") {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">355</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> stop("saemix transformations are not supported for parent fits with fixed initial parent value")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">356</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">357</td> + <td class="coverage">50<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (parent_type == "SFO") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">358</td> + <td class="coverage">50<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> stop("saemix needs at least two parameters to work on.")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">359</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">360</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (parent_type == "FOMC") {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">361</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> model_function <- function(psi, id, xidep) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">362</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> odeini_fixed / (xidep[, "time"]/exp(psi[id, 2]) + 1)^exp(psi[id, 1])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">363</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">364</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">365</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (parent_type == "DFOP") {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">366</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> model_function <- function(psi, id, xidep) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">367</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> g <- plogis(psi[id, 3])</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">368</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> t <- xidep[, "time"]</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">369</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> odeini_fixed * (g * exp(- exp(psi[id, 1]) * t) +</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">370</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> (1 - g) * exp(- exp(psi[id, 2]) * t))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">371</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">372</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">373</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (parent_type == "HS") {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">374</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> model_function <- function(psi, id, xidep) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">375</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> tb <- exp(psi[id, 3])</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">376</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> t <- xidep[, "time"]</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">377</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> k1 = exp(psi[id, 1])</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">378</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> odeini_fixed * ifelse(t <= tb,</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">379</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> exp(- k1 * t),</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">380</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> exp(- k1 * tb) * exp(- exp(psi[id, 2]) * (t - tb)))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">381</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">382</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">383</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">384</td> + <td class="coverage">1698<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(odeini_fixed) == 2) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">385</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> stop("SFORB with fixed initial parent value is not supported")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">386</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">387</td> + <td class="coverage">1698<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (parent_type == "SFO") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">388</td> + <td class="coverage">785<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (transformations == "mkin") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">389</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> model_function <- function(psi, id, xidep) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">390</td> + <td class="coverage">2628025<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> psi[id, 1] * exp( - exp(psi[id, 2]) * xidep[, "time"])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">391</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">392</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">393</td> + <td class="coverage">502<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> model_function <- function(psi, id, xidep) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">394</td> + <td class="coverage">4054103<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> psi[id, 1] * exp( - psi[id, 2] * xidep[, "time"])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">395</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">396</td> + <td class="coverage">502<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform.par = c(0, 1)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">397</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">398</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">399</td> + <td class="coverage">1698<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (parent_type == "FOMC") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">400</td> + <td class="coverage">76<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (transformations == "mkin") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">401</td> + <td class="coverage">41<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> model_function <- function(psi, id, xidep) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">402</td> + <td class="coverage">510269<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> psi[id, 1] / (xidep[, "time"]/exp(psi[id, 3]) + 1)^exp(psi[id, 2])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">403</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">404</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">405</td> + <td class="coverage">35<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> model_function <- function(psi, id, xidep) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">406</td> + <td class="coverage">432565<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> psi[id, 1] / (xidep[, "time"]/psi[id, 3] + 1)^psi[id, 2]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">407</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">408</td> + <td class="coverage">35<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform.par = c(0, 1, 1)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">409</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">410</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">411</td> + <td class="coverage">1698<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (parent_type == "DFOP") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">412</td> + <td class="coverage">677<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (transformations == "mkin") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">413</td> + <td class="coverage">637<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> model_function <- function(psi, id, xidep) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">414</td> + <td class="coverage">8785439<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> g <- plogis(psi[id, 4])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">415</td> + <td class="coverage">8785439<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> t <- xidep[, "time"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">416</td> + <td class="coverage">8785439<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> psi[id, 1] * (g * exp(- exp(psi[id, 2]) * t) +</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">417</td> + <td class="coverage">8785439<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> (1 - g) * exp(- exp(psi[id, 3]) * t))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">418</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">419</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">420</td> + <td class="coverage">40<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> model_function <- function(psi, id, xidep) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">421</td> + <td class="coverage">507885<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> g <- psi[id, 4]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">422</td> + <td class="coverage">507885<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> t <- xidep[, "time"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">423</td> + <td class="coverage">507885<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> psi[id, 1] * (g * exp(- psi[id, 2] * t) +</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">424</td> + <td class="coverage">507885<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> (1 - g) * exp(- psi[id, 3] * t))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">425</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">426</td> + <td class="coverage">40<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform.par = c(0, 1, 1, 3)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">427</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">428</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">429</td> + <td class="coverage">1698<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (parent_type == "SFORB") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">430</td> + <td class="coverage">150<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (transformations == "mkin") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">431</td> + <td class="coverage">130<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> model_function <- function(psi, id, xidep) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">432</td> + <td class="coverage">1240580<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k_12 <- exp(psi[id, 3])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">433</td> + <td class="coverage">1240580<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k_21 <- exp(psi[id, 4])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">434</td> + <td class="coverage">1240580<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k_1output <- exp(psi[id, 2])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">435</td> + <td class="coverage">1240580<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> t <- xidep[, "time"]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">436</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">437</td> + <td class="coverage">1240580<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> sqrt_exp = sqrt(1/4 * (k_12 + k_21 + k_1output)^2 - k_1output * k_21)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">438</td> + <td class="coverage">1240580<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> b1 = 0.5 * (k_12 + k_21 + k_1output) + sqrt_exp</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">439</td> + <td class="coverage">1240580<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> b2 = 0.5 * (k_12 + k_21 + k_1output) - sqrt_exp</pre> + </td> + </tr> + <tr class="never"> + <td class="num">440</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">441</td> + <td class="coverage">1240580<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> psi[id, 1] * (((k_12 + k_21 - b1)/(b2 - b1)) * exp(-b1 * t) +</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">442</td> + <td class="coverage">1240580<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ((k_12 + k_21 - b2)/(b1 - b2)) * exp(-b2 * t))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">443</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">444</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">445</td> + <td class="coverage">20<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> model_function <- function(psi, id, xidep) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">446</td> + <td class="coverage">290980<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k_12 <- psi[id, 3]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">447</td> + <td class="coverage">290980<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k_21 <- psi[id, 4]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">448</td> + <td class="coverage">290980<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k_1output <- psi[id, 2]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">449</td> + <td class="coverage">290980<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> t <- xidep[, "time"]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">450</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">451</td> + <td class="coverage">290980<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> sqrt_exp = sqrt(1/4 * (k_12 + k_21 + k_1output)^2 - k_1output * k_21)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">452</td> + <td class="coverage">290980<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> b1 = 0.5 * (k_12 + k_21 + k_1output) + sqrt_exp</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">453</td> + <td class="coverage">290980<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> b2 = 0.5 * (k_12 + k_21 + k_1output) - sqrt_exp</pre> + </td> + </tr> + <tr class="never"> + <td class="num">454</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">455</td> + <td class="coverage">290980<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> psi[id, 1] * (((k_12 + k_21 - b1)/(b2 - b1)) * exp(-b1 * t) +</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">456</td> + <td class="coverage">290980<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ((k_12 + k_21 - b2)/(b1 - b2)) * exp(-b2 * t))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">457</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">458</td> + <td class="coverage">20<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform.par = c(0, 1, 1, 1)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">459</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">460</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">461</td> + <td class="coverage">1698<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (parent_type == "HS") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">462</td> + <td class="coverage">10<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (transformations == "mkin") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">463</td> + <td class="coverage">10<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> model_function <- function(psi, id, xidep) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">464</td> + <td class="coverage">150610<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> tb <- exp(psi[id, 4])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">465</td> + <td class="coverage">150610<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> t <- xidep[, "time"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">466</td> + <td class="coverage">150610<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k1 <- exp(psi[id, 2])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">467</td> + <td class="coverage">150610<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> psi[id, 1] * ifelse(t <= tb,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">468</td> + <td class="coverage">150610<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> exp(- k1 * t),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">469</td> + <td class="coverage">150610<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> exp(- k1 * tb) * exp(- exp(psi[id, 3]) * (t - tb)))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">470</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">471</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">472</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> model_function <- function(psi, id, xidep) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">473</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> tb <- psi[id, 4]</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">474</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> t <- xidep[, "time"]</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">475</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> psi[id, 1] * ifelse(t <= tb,</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">476</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> exp(- psi[id, 2] * t),</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">477</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> exp(- psi[id, 2] * tb) * exp(- psi[id, 3] * (t - tb)))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">478</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">479</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> transform.par = c(0, 1, 1, 1)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">480</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">481</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">482</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">483</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">484</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">485</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Parent with one metabolite</pre> + </td> + </tr> + <tr class="never"> + <td class="num">486</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Parameter names used in the model functions are as in</pre> + </td> + </tr> + <tr class="never"> + <td class="num">487</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # https://nbviewer.jupyter.org/urls/jrwb.de/nb/Symbolic%20ODE%20solutions%20for%20mkin.ipynb</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">488</td> + <td class="coverage">2192<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> types <- unname(sapply(mkin_model$spec, function(x) x$type))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">489</td> + <td class="coverage">2192<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(mkin_model$spec) == 2 &! "SFORB" %in% types ) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">490</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Initial value for the metabolite (n20) must be fixed</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">491</td> + <td class="coverage">494<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (names(odeini_fixed) == names(mkin_model$spec)[2]) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">492</td> + <td class="coverage">494<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n20 <- odeini_fixed</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">493</td> + <td class="coverage">494<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parent_name <- names(mkin_model$spec)[1]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">494</td> + <td class="coverage">494<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (identical(types, c("SFO", "SFO"))) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">495</td> + <td class="coverage">208<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (transformations == "mkin") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">496</td> + <td class="coverage">208<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> model_function <- function(psi, id, xidep) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">497</td> + <td class="coverage">873912<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> t <- xidep[, "time"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">498</td> + <td class="coverage">873912<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n10 <- psi[id, 1]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">499</td> + <td class="coverage">873912<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k1 <- exp(psi[id, 2])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">500</td> + <td class="coverage">873912<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k2 <- exp(psi[id, 3])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">501</td> + <td class="coverage">873912<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f12 <- plogis(psi[id, 4])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">502</td> + <td class="coverage">873912<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ifelse(xidep[, "name"] == parent_name,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">503</td> + <td class="coverage">873912<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n10 * exp(- k1 * t),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">504</td> + <td class="coverage">873912<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> (((k2 - k1) * n20 - f12 * k1 * n10) * exp(- k2 * t)) / (k2 - k1) +</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">505</td> + <td class="coverage">873912<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> (f12 * k1 * n10 * exp(- k1 * t)) / (k2 - k1)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">506</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> )</pre> + </td> + </tr> + <tr class="never"> + <td class="num">507</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">508</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">509</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> model_function <- function(psi, id, xidep) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">510</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> t <- xidep[, "time"]</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">511</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> n10 <- psi[id, 1]</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">512</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> k1 <- psi[id, 2]</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">513</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> k2 <- psi[id, 3]</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">514</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> f12 <- psi[id, 4]</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">515</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> ifelse(xidep[, "name"] == parent_name,</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">516</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> n10 * exp(- k1 * t),</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">517</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> (((k2 - k1) * n20 - f12 * k1 * n10) * exp(- k2 * t)) / (k2 - k1) +</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">518</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> (f12 * k1 * n10 * exp(- k1 * t)) / (k2 - k1)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">519</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> )</pre> + </td> + </tr> + <tr class="never"> + <td class="num">520</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">521</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> transform.par = c(0, 1, 1, 3)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">522</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">523</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">524</td> + <td class="coverage">494<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (identical(types, c("DFOP", "SFO"))) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">525</td> + <td class="coverage">286<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (transformations == "mkin") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">526</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> model_function <- function(psi, id, xidep) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">527</td> + <td class="coverage">1821022<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> t <- xidep[, "time"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">528</td> + <td class="coverage">1821022<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n10 <- psi[id, 1]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">529</td> + <td class="coverage">1821022<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k2 <- exp(psi[id, 2])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">530</td> + <td class="coverage">1821022<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f12 <- plogis(psi[id, 3])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">531</td> + <td class="coverage">1821022<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> l1 <- exp(psi[id, 4])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">532</td> + <td class="coverage">1821022<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> l2 <- exp(psi[id, 5])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">533</td> + <td class="coverage">1821022<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> g <- plogis(psi[id, 6])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">534</td> + <td class="coverage">1821022<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ifelse(xidep[, "name"] == parent_name,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">535</td> + <td class="coverage">1821022<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n10 * (g * exp(- l1 * t) + (1 - g) * exp(- l2 * t)),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">536</td> + <td class="coverage">1821022<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ((f12 * g - f12) * l2 * n10 * exp(- l2 * t)) / (l2 - k2) -</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">537</td> + <td class="coverage">1821022<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> (f12 * g * l1 * n10 * exp(- l1 * t)) / (l1 - k2) +</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">538</td> + <td class="coverage">1821022<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ((((l1 - k2) * l2 - k2 * l1 + k2^2) * n20 +</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">539</td> + <td class="coverage">1821022<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ((f12 * l1 + (f12 * g - f12) * k2) * l2 -</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">540</td> + <td class="coverage">1821022<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f12 * g * k2 * l1) * n10) * exp( - k2 * t)) /</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">541</td> + <td class="coverage">1821022<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ((l1 - k2) * l2 - k2 * l1 + k2^2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">542</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> )</pre> + </td> + </tr> + <tr class="never"> + <td class="num">543</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">544</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">545</td> + <td class="coverage">182<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> model_function <- function(psi, id, xidep) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">546</td> + <td class="coverage">2908620<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> t <- xidep[, "time"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">547</td> + <td class="coverage">2908620<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n10 <- psi[id, 1]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">548</td> + <td class="coverage">2908620<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k2 <- psi[id, 2]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">549</td> + <td class="coverage">2908620<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f12 <- psi[id, 3]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">550</td> + <td class="coverage">2908620<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> l1 <- psi[id, 4]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">551</td> + <td class="coverage">2908620<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> l2 <- psi[id, 5]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">552</td> + <td class="coverage">2908620<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> g <- psi[id, 6]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">553</td> + <td class="coverage">2908620<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ifelse(xidep[, "name"] == parent_name,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">554</td> + <td class="coverage">2908620<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n10 * (g * exp(- l1 * t) + (1 - g) * exp(- l2 * t)),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">555</td> + <td class="coverage">2908620<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ((f12 * g - f12) * l2 * n10 * exp(- l2 * t)) / (l2 - k2) -</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">556</td> + <td class="coverage">2908620<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> (f12 * g * l1 * n10 * exp(- l1 * t)) / (l1 - k2) +</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">557</td> + <td class="coverage">2908620<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ((((l1 - k2) * l2 - k2 * l1 + k2^2) * n20 +</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">558</td> + <td class="coverage">2908620<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ((f12 * l1 + (f12 * g - f12) * k2) * l2 -</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">559</td> + <td class="coverage">2908620<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f12 * g * k2 * l1) * n10) * exp( - k2 * t)) /</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">560</td> + <td class="coverage">2908620<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ((l1 - k2) * l2 - k2 * l1 + k2^2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">561</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> )</pre> + </td> + </tr> + <tr class="never"> + <td class="num">562</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">563</td> + <td class="coverage">182<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform.par = c(0, 1, 3, 1, 1, 3)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">564</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">565</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">566</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">567</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">568</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">569</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">570</td> + <td class="coverage">2192<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.function(model_function) & solution_type == "auto") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">571</td> + <td class="coverage">2083<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> solution_type = "analytical saemix"</pre> + </td> + </tr> + <tr class="never"> + <td class="num">572</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">573</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">574</td> + <td class="coverage">109<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (transformations == "saemix") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">575</td> + <td class="coverage">5<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> stop("Using saemix transformations is only supported if an analytical solution is implemented for saemix")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">576</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">577</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">578</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (solution_type == "auto")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">579</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> solution_type <- object[[1]]$solution_type</pre> + </td> + </tr> + <tr class="never"> + <td class="num">580</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">581</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Define some variables to avoid function calls in model function</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">582</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transparms_optim_names <- names(degparms_optim)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">583</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeini_optim_names <- gsub('_0$', '', odeini_optim_parm_names)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">584</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> diff_names <- names(mkin_model$diffs)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">585</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ode_transparms_optim_names <- setdiff(transparms_optim_names, odeini_optim_parm_names)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">586</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_rates <- object[[1]]$transform_rates</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">587</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_fractions <- object[[1]]$transform_fractions</pre> + </td> + </tr> + <tr class="never"> + <td class="num">588</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">589</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Get native symbol info for speed</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">590</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> use_symbols = FALSE</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">591</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (solution_type == "deSolve" & !is.null(mkin_model$cf)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">592</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mkin_model$symbols <- try(deSolve::checkDLL(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">593</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dllname = mkin_model$dll_info[["name"]],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">594</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> func = "diffs", initfunc = "initpar",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">595</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> jacfunc = NULL, nout = 0, outnames = NULL))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">596</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!inherits(mkin_model$symbols, "try-error")) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">597</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> use_symbols = TRUE</pre> + </td> + </tr> + <tr class="never"> + <td class="num">598</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">599</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">600</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">601</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Define the model function</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">602</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> model_function <- function(psi, id, xidep) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">603</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">604</td> + <td class="coverage">873912<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> uid <- unique(id)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">605</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">606</td> + <td class="coverage">873912<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res_list <- lapply(uid, function(i) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">607</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">608</td> + <td class="coverage">43671888<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transparms_optim <- as.numeric(psi[i, ]) # psi[i, ] is a dataframe when called in saemix.predict</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">609</td> + <td class="coverage">43671888<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(transparms_optim) <- transparms_optim_names</pre> + </td> + </tr> + <tr class="never"> + <td class="num">610</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">611</td> + <td class="coverage">43671888<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeini_optim <- transparms_optim[odeini_optim_parm_names]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">612</td> + <td class="coverage">43671888<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(odeini_optim) <- odeini_optim_names</pre> + </td> + </tr> + <tr class="never"> + <td class="num">613</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">614</td> + <td class="coverage">43671888<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeini <- c(odeini_optim, odeini_fixed)[diff_names]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">615</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">616</td> + <td class="coverage">43671888<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeparms_optim <- backtransform_odeparms(transparms_optim[ode_transparms_optim_names], mkin_model,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">617</td> + <td class="coverage">43671888<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_rates = transform_rates,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">618</td> + <td class="coverage">43671888<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_fractions = transform_fractions)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">619</td> + <td class="coverage">43671888<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeparms <- c(odeparms_optim, odeparms_fixed)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">620</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">621</td> + <td class="coverage">43671888<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> xidep_i <- xidep[which(id == i), ]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">622</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">623</td> + <td class="coverage">43671888<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (solution_type[1] == "analytical") {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">624</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> out_values <- mkin_model$deg_func(xidep_i, odeini, odeparms)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">625</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">626</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">627</td> + <td class="coverage">43671888<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> i_time <- xidep_i$time</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">628</td> + <td class="coverage">43671888<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> i_name <- xidep_i$name</pre> + </td> + </tr> + <tr class="never"> + <td class="num">629</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">630</td> + <td class="coverage">43671888<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> out_wide <- mkinpredict(mkin_model,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">631</td> + <td class="coverage">43671888<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeparms = odeparms, odeini = odeini,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">632</td> + <td class="coverage">43671888<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> solution_type = solution_type,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">633</td> + <td class="coverage">43671888<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> outtimes = sort(unique(i_time)),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">634</td> + <td class="coverage">43671888<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> na_stop = FALSE</pre> + </td> + </tr> + <tr class="never"> + <td class="num">635</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> )</pre> + </td> + </tr> + <tr class="never"> + <td class="num">636</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">637</td> + <td class="coverage">43671888<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> out_index <- cbind(as.character(i_time), as.character(i_name))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">638</td> + <td class="coverage">43671888<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> out_values <- out_wide[out_index]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">639</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">640</td> + <td class="coverage">43671888<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(out_values)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">641</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> })</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">642</td> + <td class="coverage">873912<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res <- unlist(res_list)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">643</td> + <td class="coverage">873912<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(res)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">644</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">645</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">646</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">647</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (identical(error_model, "auto")) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">648</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> error_model = object[[1]]$err_mod</pre> + </td> + </tr> + <tr class="never"> + <td class="num">649</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">650</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> error.model <- switch(error_model,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">651</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> const = "constant",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">652</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> tc = "combined",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">653</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> obs = "constant")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">654</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">655</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (error_model == "obs") {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">656</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> warning("The error model 'obs' (variance by variable) can currently not be transferred to an saemix model")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">657</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">658</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">659</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms_psi0 <- degparms_optim</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">660</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms_psi0[names(degparms_start)] <- degparms_start</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">661</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> psi0_matrix <- matrix(degparms_psi0, nrow = 1,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">662</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dimnames = list("(Intercept)", names(degparms_psi0)))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">663</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">664</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (covariance.model[1] == "auto") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">665</td> + <td class="coverage">2062<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covariance_diagonal <- rep(1, length(degparms_optim))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">666</td> + <td class="coverage">2062<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.null(no_random_effect)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">667</td> + <td class="coverage">766<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms_no_random <- which(names(degparms_psi0) %in% no_random_effect)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">668</td> + <td class="coverage">766<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covariance_diagonal[degparms_no_random] <- 0</pre> + </td> + </tr> + <tr class="never"> + <td class="num">669</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">670</td> + <td class="coverage">2062<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covariance.model = diag(covariance_diagonal)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">671</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">672</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">673</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (omega.init[1] == "auto") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">674</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (transformations == "mkin") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">675</td> + <td class="coverage">1413<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms_eta_ini <- as.numeric( # remove names</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">676</td> + <td class="coverage">1413<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mean_degparms(object,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">677</td> + <td class="coverage">1413<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> random = TRUE, test_log_parms = TRUE)$eta)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">678</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">679</td> + <td class="coverage">1413<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> omega.init <- 2 * diag(degparms_eta_ini^2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">680</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">681</td> + <td class="coverage">774<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> omega.init <- matrix(nrow = 0, ncol = 0)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">682</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">683</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">684</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">685</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.null(covariate_models)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">686</td> + <td class="coverage">2027<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covariate.model <- matrix(nrow = 0, ncol = 0) # default in saemixModel()</pre> + </td> + </tr> + <tr class="never"> + <td class="num">687</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">688</td> + <td class="coverage">160<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms_dependent <- sapply(covariate_models, function(x) as.character(x[[2]]))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">689</td> + <td class="coverage">160<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covariates_in_models = unique(unlist(lapply(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">690</td> + <td class="coverage">160<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covariate_models, function(x)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">691</td> + <td class="coverage">160<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> colnames(attr(terms(x), "factors"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">692</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> )))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">693</td> + <td class="coverage">160<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covariates_not_available <- setdiff(covariates_in_models, names(covariates))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">694</td> + <td class="coverage">160<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(covariates_not_available) > 0) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">695</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> stop("Covariate(s) ", paste(covariates_not_available, collapse = ", "),</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">696</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> " used in the covariate models not available in the covariate data")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">697</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">698</td> + <td class="coverage">160<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> psi0_matrix <- rbind(psi0_matrix,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">699</td> + <td class="coverage">160<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> matrix(0, nrow = length(covariates), ncol = ncol(psi0_matrix),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">700</td> + <td class="coverage">160<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dimnames = list(names(covariates), colnames(psi0_matrix))))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">701</td> + <td class="coverage">160<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covariate.model <- matrix(0, nrow = length(covariates),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">702</td> + <td class="coverage">160<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ncol = ncol(psi0_matrix),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">703</td> + <td class="coverage">160<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dimnames = list(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">704</td> + <td class="coverage">160<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covariates = names(covariates),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">705</td> + <td class="coverage">160<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms = colnames(psi0_matrix)))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">706</td> + <td class="coverage">160<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (transformations == "saemix") {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">707</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> stop("Covariate models with saemix transformations currently not supported")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">708</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">709</td> + <td class="coverage">160<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms_trans <- as.data.frame(t(sapply(object, parms, transformed = TRUE)))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">710</td> + <td class="coverage">160<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (covariate_model in covariate_models) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">711</td> + <td class="coverage">160<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covariate_name <- as.character(covariate_model[[2]])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">712</td> + <td class="coverage">160<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> model_data <- cbind(parms_trans, covariates)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">713</td> + <td class="coverage">160<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ini_model <- lm(covariate_model, data = model_data)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">714</td> + <td class="coverage">160<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ini_coef <- coef(ini_model)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">715</td> + <td class="coverage">160<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> psi0_matrix[names(ini_coef), covariate_name] <- ini_coef</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">716</td> + <td class="coverage">160<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covariate.model[names(ini_coef)[-1], covariate_name] <- as.numeric(as.logical(ini_coef[-1]))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">717</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">718</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">719</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">720</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res <- saemix::saemixModel(model_function,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">721</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> psi0 = psi0_matrix,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">722</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "Mixed model generated from mmkin object",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">723</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform.par = transform.par,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">724</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> error.model = error.model,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">725</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> verbose = verbose,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">726</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covariance.model = covariance.model,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">727</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covariate.model = covariate.model,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">728</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> omega.init = omega.init,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">729</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> error.init = error.init,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">730</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> ...</pre> + </td> + </tr> + <tr class="never"> + <td class="num">731</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> )</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">732</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> attr(res, "mean_dp_start") <- degparms_optim</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">733</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(res)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">734</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">735</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">736</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname saem</pre> + </td> + </tr> + <tr class="never"> + <td class="num">737</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom rlang !!!</pre> + </td> + </tr> + <tr class="never"> + <td class="num">738</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return An [saemix::SaemixData] object.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">739</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">740</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">saemix_data <- function(object, covariates = NULL, verbose = FALSE, ...) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">741</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (nrow(object) > 1) stop("Only row objects allowed")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">742</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ds_names <- colnames(object)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">743</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">744</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ds_list <- lapply(object, function(x) x$data[c("time", "variable", "observed")])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">745</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(ds_list) <- ds_names</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">746</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ds_saemix_all <- vctrs::vec_rbind(!!!ds_list, .names_to = "ds")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">747</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ds_saemix <- data.frame(ds = ds_saemix_all$ds,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">748</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> name = as.character(ds_saemix_all$variable),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">749</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> time = ds_saemix_all$time,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">750</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> value = ds_saemix_all$observed,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">751</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> stringsAsFactors = FALSE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">752</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.null(covariates)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">753</td> + <td class="coverage">160<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> name.covariates <- names(covariates)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">754</td> + <td class="coverage">160<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covariates$ds <- rownames(covariates)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">755</td> + <td class="coverage">160<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ds_saemix <- merge(ds_saemix, covariates, sort = FALSE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">756</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">757</td> + <td class="coverage">2027<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> name.covariates <- character(0)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">758</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">759</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">760</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res <- saemix::saemixData(ds_saemix,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">761</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> name.group = "ds",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">762</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> name.predictors = c("time", "name"),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">763</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> name.response = "value",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">764</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> name.covariates = name.covariates,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">765</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> verbose = verbose,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">766</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> ...)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">767</td> + <td class="coverage">2187<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(res)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">768</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">769</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">770</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' logLik method for saem.mmkin objects</pre> + </td> + </tr> + <tr class="never"> + <td class="num">771</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">772</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param object The fitted [saem.mmkin] object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">773</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots Passed to [saemix::logLik.SaemixObject]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">774</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param method Passed to [saemix::logLik.SaemixObject]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">775</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">776</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">logLik.saem.mmkin <- function(object, ..., method = c("is", "lin", "gq")) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">777</td> + <td class="coverage">4404<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> method <- match.arg(method)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">778</td> + <td class="coverage">4404<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(logLik(object$so, method = method))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">779</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">780</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">781</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">782</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">update.saem.mmkin <- function(object, ..., evaluate = TRUE) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">783</td> + <td class="coverage">507<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> call <- object$call</pre> + </td> + </tr> + <tr class="never"> + <td class="num">784</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # For some reason we get saem.mmkin in the call when using mhmkin</pre> + </td> + </tr> + <tr class="never"> + <td class="num">785</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # so we need to fix this so we do not have to export saem.mmkin in</pre> + </td> + </tr> + <tr class="never"> + <td class="num">786</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # addition to the S3 method</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">787</td> + <td class="coverage">507<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> call[[1]] <- saem</pre> + </td> + </tr> + <tr class="never"> + <td class="num">788</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">789</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # We also need to provide the mmkin object in the call, so it</pre> + </td> + </tr> + <tr class="never"> + <td class="num">790</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # will also be found when called by testthat or pkgdown</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">791</td> + <td class="coverage">507<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> call[[2]] <- object$mmkin</pre> + </td> + </tr> + <tr class="never"> + <td class="num">792</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">793</td> + <td class="coverage">507<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> update_arguments <- match.call(expand.dots = FALSE)$...</pre> + </td> + </tr> + <tr class="never"> + <td class="num">794</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">795</td> + <td class="coverage">507<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(update_arguments) > 0) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">796</td> + <td class="coverage">507<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> update_arguments_in_call <- !is.na(match(names(update_arguments), names(call)))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">797</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">798</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">799</td> + <td class="coverage">507<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (a in names(update_arguments)[update_arguments_in_call]) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">800</td> + <td class="coverage">35<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> call[[a]] <- update_arguments[[a]]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">801</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">802</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">803</td> + <td class="coverage">507<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> update_arguments_not_in_call <- !update_arguments_in_call</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">804</td> + <td class="coverage">507<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(any(update_arguments_not_in_call)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">805</td> + <td class="coverage">472<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> call <- c(as.list(call), update_arguments[update_arguments_not_in_call])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">806</td> + <td class="coverage">472<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> call <- as.call(call)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">807</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">808</td> + <td class="coverage">507<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(evaluate) eval(call, parent.frame())</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">809</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> else call</pre> + </td> + </tr> + <tr class="never"> + <td class="num">810</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">811</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">812</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">813</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname parms</pre> + </td> + </tr> + <tr class="never"> + <td class="num">814</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param ci Should a matrix with estimates and confidence interval boundaries</pre> + </td> + </tr> + <tr class="never"> + <td class="num">815</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' be returned? If FALSE (default), a vector of estimates is returned if no</pre> + </td> + </tr> + <tr class="never"> + <td class="num">816</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' covariates are given, otherwise a matrix of estimates is returned, with</pre> + </td> + </tr> + <tr class="never"> + <td class="num">817</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' each column corresponding to a row of the data frame holding the covariates</pre> + </td> + </tr> + <tr class="never"> + <td class="num">818</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param covariates A data frame holding covariate values for which to</pre> + </td> + </tr> + <tr class="never"> + <td class="num">819</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' return parameter values. Only has an effect if 'ci' is FALSE.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">820</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">parms.saem.mmkin <- function(object, ci = FALSE, covariates = NULL, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">821</td> + <td class="coverage">2904<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cov.mod <- object$sm@covariance.model</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">822</td> + <td class="coverage">2904<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n_cov_mod_parms <- sum(cov.mod[upper.tri(cov.mod, diag = TRUE)])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">823</td> + <td class="coverage">2904<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n_parms <- length(object$sm@name.modpar) +</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">824</td> + <td class="coverage">2904<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n_cov_mod_parms +</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">825</td> + <td class="coverage">2904<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> length(object$sm@name.sigma)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">826</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">827</td> + <td class="coverage">2904<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (inherits(object$so, "try-error")) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">828</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> conf.int <- matrix(rep(NA, 3 * n_parms), ncol = 3)</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">829</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> colnames(conf.int) <- c("estimate", "lower", "upper")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">830</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">831</td> + <td class="coverage">2904<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> conf.int <- object$so@results@conf.int[c("estimate", "lower", "upper")]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">832</td> + <td class="coverage">2904<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rownames(conf.int) <- object$so@results@conf.int[["name"]]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">833</td> + <td class="coverage">2904<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> conf.int.var <- grepl("^Var\\.", rownames(conf.int))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">834</td> + <td class="coverage">2904<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> conf.int <- conf.int[!conf.int.var, ]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">835</td> + <td class="coverage">2904<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> conf.int.cov <- grepl("^Cov\\.", rownames(conf.int))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">836</td> + <td class="coverage">2904<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> conf.int <- conf.int[!conf.int.cov, ]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">837</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">838</td> + <td class="coverage">2904<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> estimate <- conf.int[, "estimate"]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">839</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">840</td> + <td class="coverage">2904<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(estimate) <- rownames(conf.int)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">841</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">842</td> + <td class="coverage">2904<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (ci) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">843</td> + <td class="coverage">1034<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(conf.int)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">844</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">845</td> + <td class="coverage">1870<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.null(covariates)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">846</td> + <td class="coverage">1760<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(estimate)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">847</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">848</td> + <td class="coverage">110<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> est_for_cov <- matrix(NA,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">849</td> + <td class="coverage">110<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> nrow = length(object$sm@name.modpar), ncol = nrow(covariates),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">850</td> + <td class="coverage">110<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dimnames = (list(object$sm@name.modpar, rownames(covariates))))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">851</td> + <td class="coverage">110<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covmods <- object$covariate_models</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">852</td> + <td class="coverage">110<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(covmods) <- sapply(covmods, function(x) as.character(x[[2]]))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">853</td> + <td class="coverage">110<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (deg_parm_name in rownames(est_for_cov)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">854</td> + <td class="coverage">440<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (deg_parm_name %in% names(covmods)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">855</td> + <td class="coverage">110<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covariate <- covmods[[deg_parm_name]][[3]]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">856</td> + <td class="coverage">110<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> beta_degparm_name <- paste0("beta_", covariate,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">857</td> + <td class="coverage">110<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "(", deg_parm_name, ")")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">858</td> + <td class="coverage">110<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> est_for_cov[deg_parm_name, ] <- estimate[deg_parm_name] +</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">859</td> + <td class="coverage">110<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covariates[[covariate]] * estimate[beta_degparm_name]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">860</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">861</td> + <td class="coverage">330<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> est_for_cov[deg_parm_name, ] <- estimate[deg_parm_name]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">862</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">863</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">864</td> + <td class="coverage">110<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(est_for_cov)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">865</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">866</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">867</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/status.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Method to get status information for fit array objects</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param object The object to investigate</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param x The object to be printed</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots For potential future extensions</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return An object with the same dimensions as the fit array</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' suitable printing method.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">status <- function(object, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">11</td> + <td class="coverage">589<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> UseMethod("status", object)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname status</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fits <- mmkin(</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' c("SFO", "FOMC"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' list("FOCUS A" = FOCUS_2006_A,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' "FOCUS B" = FOCUS_2006_C),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' status(fits)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">status.mmkin <- function(object, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">26</td> + <td class="coverage">376<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> all_summary_warnings <- character()</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">27</td> + <td class="coverage">376<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> sww <- 0 # Counter for Shapiro-Wilks warnings</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">29</td> + <td class="coverage">376<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> result <- lapply(object,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">30</td> + <td class="coverage">376<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> function(fit) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">31</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (inherits(fit, "try-error")) return("E")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">32</td> + <td class="coverage">4391<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> sw <- fit$summary_warnings</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">33</td> + <td class="coverage">4391<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> swn <- names(sw)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">34</td> + <td class="coverage">4391<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(sw) > 0) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">35</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (any(grepl("S", swn))) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">36</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> sww <<- sww + 1</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">37</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> swn <- gsub("S", paste0("S", sww), swn)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">39</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> warnstring <- paste(swn, collapse = ", ")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">40</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> names(sw) <- swn</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">41</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> all_summary_warnings <<- c(all_summary_warnings, sw)</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">42</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> return(warnstring)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">44</td> + <td class="coverage">4391<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return("OK")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> })</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">47</td> + <td class="coverage">376<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> result <- unlist(result)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">48</td> + <td class="coverage">376<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dim(result) <- dim(object)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">49</td> + <td class="coverage">376<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dimnames(result) <- dimnames(object)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">51</td> + <td class="coverage">376<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> u_swn <- unique(names(all_summary_warnings))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">52</td> + <td class="coverage">376<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> attr(result, "unique_warnings") <- all_summary_warnings[u_swn]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">53</td> + <td class="coverage">376<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(result) <- "status.mmkin"</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">54</td> + <td class="coverage">376<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(result)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">55</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">57</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname status</pre> + </td> + </tr> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">print.status.mmkin <- function(x, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">60</td> + <td class="coverage">376<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> u_w <- attr(x, "unique_warnings")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">61</td> + <td class="coverage">376<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> attr(x, "unique_warnings") <- NULL</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">62</td> + <td class="coverage">376<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(x) <- NULL</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">63</td> + <td class="coverage">376<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(x, quote = FALSE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">64</td> + <td class="coverage">376<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">65</td> + <td class="coverage">376<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (i in seq_along(u_w)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">66</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat(names(u_w)[i], ": ", u_w[i], "\n", sep = "")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">67</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">68</td> + <td class="coverage">376<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (any(x == "OK")) cat("OK: No warnings\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">69</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (any(x == "E")) cat("E: Error\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">70</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">71</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">72</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname status</pre> + </td> + </tr> + <tr class="never"> + <td class="num">73</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">74</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">status.mhmkin <- function(object, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">75</td> + <td class="coverage">125<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (inherits(object[[1]], "saem.mmkin")) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">76</td> + <td class="coverage">125<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> test_func <- function(fit) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">77</td> + <td class="coverage">500<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (inherits(fit, "try-error")) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">78</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> return("E")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">79</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">80</td> + <td class="coverage">500<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (inherits(fit$so, "try-error")) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">81</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> return("E")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">82</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">83</td> + <td class="coverage">500<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.null(fit$FIM_failed)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">84</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> return_values <- c("fixed effects" = "Fth",</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">85</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> "random effects and error model parameters" = "FO")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">86</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> return(paste(return_values[fit$FIM_failed], collapse = ", "))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">87</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">88</td> + <td class="coverage">500<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return("OK")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">89</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">90</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">91</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">92</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">93</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">94</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> stop("Only mhmkin objects containing saem.mmkin objects currently supported")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">95</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">96</td> + <td class="coverage">125<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> result <- lapply(object, test_func)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">97</td> + <td class="coverage">125<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> result <- unlist(result)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">98</td> + <td class="coverage">125<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dim(result) <- dim(object)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">99</td> + <td class="coverage">125<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dimnames(result) <- dimnames(object)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">100</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">101</td> + <td class="coverage">125<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(result) <- "status.mhmkin"</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">102</td> + <td class="coverage">125<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(result)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">103</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">104</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">105</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname status</pre> + </td> + </tr> + <tr class="never"> + <td class="num">106</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">107</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">print.status.mhmkin <- function(x, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">108</td> + <td class="coverage">125<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(x) <- NULL</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">109</td> + <td class="coverage">125<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(x, quote = FALSE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">110</td> + <td class="coverage">125<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">111</td> + <td class="coverage">125<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (any(x == "OK")) cat("OK: Fit terminated successfully\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">112</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (any(x == "Fth")) cat("Fth: Could not invert FIM for fixed effects\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">113</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (any(x == "FO")) cat("FO: Could not invert FIM for random effects and error model parameters\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">114</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (any(x == "Fth, FO")) cat("Fth, FO: Could not invert FIM for fixed effects, nor for random effects and error model parameters\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">115</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (any(x == "E")) cat("E: Error\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">116</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">117</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/endpoints.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Function to calculate endpoints for further use from kinetic models fitted</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' with mkinfit</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' This function calculates DT50 and DT90 values as well as formation fractions</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' from kinetic models fitted with mkinfit. If the SFORB model was specified</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' for one of the parents or metabolites, the Eigenvalues are returned. These</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' are equivalent to the rate constants of the DFOP model, but with the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' advantage that the SFORB model can also be used for metabolites.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Additional DT50 values are calculated from the FOMC DT90 and k1 and k2 from</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' HS and DFOP, as well as from Eigenvalues b1 and b2 of any SFORB models</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param fit An object of class [mkinfit], [nlme.mmkin] or [saem.mmkin], or</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' another object that has list components mkinmod containing an [mkinmod]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' degradation model, and two numeric vectors, bparms.optim and bparms.fixed,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' that contain parameter values for that model.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param covariates Numeric vector with covariate values for all variables in</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' any covariate models in the object. If given, it overrides 'covariate_quantile'.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param covariate_quantile This argument only has an effect if the fitted</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' object has covariate models. If so, the default is to show endpoints</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' for the median of the covariate values (50th percentile).</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom stats optimize</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return A list with a matrix of dissipation times named distimes, and, if</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' applicable, a vector of formation fractions named ff and, if the SFORB model</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' was in use, a vector of eigenvalues of these SFORB models, equivalent to</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' DFOP rate constants</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @note The function is used internally by [summary.mkinfit],</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' [summary.nlme.mmkin] and [summary.saem.mmkin].</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @author Johannes Ranke</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit <- mkinfit("FOMC", FOCUS_2006_C, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' endpoints(fit)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit_2 <- mkinfit("DFOP", FOCUS_2006_C, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' endpoints(fit_2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit_3 <- mkinfit("SFORB", FOCUS_2006_C, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' endpoints(fit_3)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">endpoints <- function(fit, covariates = NULL, covariate_quantile = 0.5) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">43</td> + <td class="coverage">56208<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mkinmod <- fit$mkinmod</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">44</td> + <td class="coverage">56208<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> obs_vars <- names(mkinmod$spec)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">46</td> + <td class="coverage">56208<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.null(fit$covariate_models)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">47</td> + <td class="coverage">110<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.null(covariates)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">48</td> + <td class="coverage">110<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covariates = as.data.frame(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">49</td> + <td class="coverage">110<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> apply(fit$covariates, 2, quantile,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">50</td> + <td class="coverage">110<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covariate_quantile, simplify = FALSE))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">52</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> covariate_m <- matrix(covariates, byrow = TRUE)</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">53</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> colnames(covariate_m) <- names(covariates)</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">54</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> rownames(covariate_m) <- "User"</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">55</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> covariates <- as.data.frame(covariate_m)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">57</td> + <td class="coverage">110<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms_trans <- parms(fit, covariates = covariates)[, 1]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">58</td> + <td class="coverage">110<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (inherits(fit, "saem.mmkin") & (fit$transformations == "saemix")) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">59</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> degparms <- degparms_trans</pre> + </td> + </tr> + <tr class="never"> + <td class="num">60</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">61</td> + <td class="coverage">110<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms <- backtransform_odeparms(degparms_trans,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">62</td> + <td class="coverage">110<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$mkinmod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">63</td> + <td class="coverage">110<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_rates = fit$transform_rates,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">64</td> + <td class="coverage">110<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_fractions = fit$transform_fractions)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">65</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">66</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">67</td> + <td class="coverage">56098<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms <- c(fit$bparms.optim, fit$bparms.fixed)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">68</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">69</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">70</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Set up object to return</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">71</td> + <td class="coverage">56208<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ep <- list()</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">72</td> + <td class="coverage">56208<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ep$covariates <- covariates</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">73</td> + <td class="coverage">56208<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ep$ff <- vector()</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">74</td> + <td class="coverage">56208<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ep$SFORB <- vector()</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">75</td> + <td class="coverage">56208<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ep$distimes <- data.frame(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">76</td> + <td class="coverage">56208<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DT50 = rep(NA, length(obs_vars)),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">77</td> + <td class="coverage">56208<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DT90 = rep(NA, length(obs_vars)),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">78</td> + <td class="coverage">56208<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> row.names = obs_vars)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">79</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">80</td> + <td class="coverage">56208<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (obs_var in obs_vars) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">81</td> + <td class="coverage">73858<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> type = names(mkinmod$map[[obs_var]])[1]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">82</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">83</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Get formation fractions if directly fitted, and calculate remaining fraction to sink</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">84</td> + <td class="coverage">73858<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f_names = grep(paste("^f", obs_var, sep = "_"), names(degparms), value=TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">85</td> + <td class="coverage">73858<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(f_names) > 0) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">86</td> + <td class="coverage">15068<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f_values = degparms[f_names]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">87</td> + <td class="coverage">15068<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f_to_sink = 1 - sum(f_values)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">88</td> + <td class="coverage">15068<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(f_to_sink) = ifelse(type == "SFORB",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">89</td> + <td class="coverage">15068<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> paste(obs_var, "free", "sink", sep = "_"),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">90</td> + <td class="coverage">15068<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> paste(obs_var, "sink", sep = "_"))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">91</td> + <td class="coverage">15068<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (f_name in f_names) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">92</td> + <td class="coverage">17338<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ep$ff[[sub("f_", "", sub("_to_", "_", f_name))]] = f_values[[f_name]]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">93</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">94</td> + <td class="coverage">15068<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ep$ff = append(ep$ff, f_to_sink)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">95</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">96</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">97</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Get the rest</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">98</td> + <td class="coverage">73858<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (type == "SFO") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">99</td> + <td class="coverage">40900<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k_names = grep(paste("^k", obs_var, sep="_"), names(degparms), value=TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">100</td> + <td class="coverage">40900<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k_tot = sum(degparms[k_names])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">101</td> + <td class="coverage">40900<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DT50 = log(2)/k_tot</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">102</td> + <td class="coverage">40900<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DT90 = log(10)/k_tot</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">103</td> + <td class="coverage">40900<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (mkinmod$use_of_ff == "min" && length(obs_vars) > 1) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">104</td> + <td class="coverage">622<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (k_name in k_names)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">105</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">106</td> + <td class="coverage">932<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ep$ff[[sub("k_", "", k_name)]] = degparms[[k_name]] / k_tot</pre> + </td> + </tr> + <tr class="never"> + <td class="num">107</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">108</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">109</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">110</td> + <td class="coverage">73858<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (type == "FOMC") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">111</td> + <td class="coverage">1790<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> alpha = degparms["alpha"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">112</td> + <td class="coverage">1790<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> beta = degparms["beta"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">113</td> + <td class="coverage">1790<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DT50 = beta * (2^(1/alpha) - 1)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">114</td> + <td class="coverage">1790<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DT90 = beta * (10^(1/alpha) - 1)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">115</td> + <td class="coverage">1790<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DT50_back = DT90 / (log(10)/log(2)) # Backcalculated DT50 as recommended in FOCUS 2011</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">116</td> + <td class="coverage">1790<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ep$distimes[obs_var, c("DT50back")] = DT50_back</pre> + </td> + </tr> + <tr class="never"> + <td class="num">117</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">118</td> + <td class="coverage">73858<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (type == "IORE") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">119</td> + <td class="coverage">352<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k_names = grep(paste("^k__iore", obs_var, sep="_"), names(degparms), value=TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">120</td> + <td class="coverage">352<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k_tot = sum(degparms[k_names])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">121</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # From the NAFTA kinetics guidance, p. 5</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">122</td> + <td class="coverage">352<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n = degparms[paste("N", obs_var, sep = "_")]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">123</td> + <td class="coverage">352<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k = k_tot</pre> + </td> + </tr> + <tr class="never"> + <td class="num">124</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Use the initial concentration of the parent compound</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">125</td> + <td class="coverage">352<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> source_name = mkinmod$map[[1]][[1]]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">126</td> + <td class="coverage">352<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> c0 = degparms[paste(source_name, "0", sep = "_")]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">127</td> + <td class="coverage">352<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> alpha = 1 / (n - 1)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">128</td> + <td class="coverage">352<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> beta = (c0^(1 - n))/(k * (n - 1))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">129</td> + <td class="coverage">352<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DT50 = beta * (2^(1/alpha) - 1)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">130</td> + <td class="coverage">352<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DT90 = beta * (10^(1/alpha) - 1)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">131</td> + <td class="coverage">352<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DT50_back = DT90 / (log(10)/log(2)) # Backcalculated DT50 as recommended in FOCUS 2011</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">132</td> + <td class="coverage">352<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ep$distimes[obs_var, c("DT50back")] = DT50_back</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">133</td> + <td class="coverage">352<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (mkinmod$use_of_ff == "min") {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">134</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> for (k_name in k_names)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">135</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">136</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> ep$ff[[sub("k_", "", k_name)]] = degparms[[k_name]] / k_tot</pre> + </td> + </tr> + <tr class="never"> + <td class="num">137</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">138</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">139</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">140</td> + <td class="coverage">73858<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (type == "DFOP") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">141</td> + <td class="coverage">27729<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k1 = degparms["k1"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">142</td> + <td class="coverage">27729<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k2 = degparms["k2"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">143</td> + <td class="coverage">27729<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> g = degparms["g"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">144</td> + <td class="coverage">27729<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f <- function(log_t, x) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">145</td> + <td class="coverage">684705<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> t <- exp(log_t)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">146</td> + <td class="coverage">684705<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fraction <- g * exp( - k1 * t) + (1 - g) * exp( - k2 * t)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">147</td> + <td class="coverage">684705<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> (fraction - (1 - x/100))^2</pre> + </td> + </tr> + <tr class="never"> + <td class="num">148</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">149</td> + <td class="coverage">27729<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DT50_k1 = log(2)/k1</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">150</td> + <td class="coverage">27729<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DT50_k2 = log(2)/k2</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">151</td> + <td class="coverage">27729<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DT90_k1 = log(10)/k1</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">152</td> + <td class="coverage">27729<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DT90_k2 = log(10)/k2</pre> + </td> + </tr> + <tr class="never"> + <td class="num">153</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">154</td> + <td class="coverage">27729<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DT50 <- try(exp(optimize(f, c(log(DT50_k1), log(DT50_k2)), x=50)$minimum),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">155</td> + <td class="coverage">27729<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> silent = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">156</td> + <td class="coverage">27729<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DT90 <- try(exp(optimize(f, c(log(DT90_k1), log(DT90_k2)), x=90)$minimum),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">157</td> + <td class="coverage">27729<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> silent = TRUE)</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">158</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (inherits(DT50, "try-error")) DT50 = NA</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">159</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (inherits(DT90, "try-error")) DT90 = NA</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">160</td> + <td class="coverage">27729<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DT50_back = DT90 / (log(10)/log(2)) # Backcalculated DT50 as recommended in FOCUS 2011</pre> + </td> + </tr> + <tr class="never"> + <td class="num">161</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">162</td> + <td class="coverage">27729<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ep$distimes[obs_var, c("DT50back")] = DT50_back</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">163</td> + <td class="coverage">27729<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ep$distimes[obs_var, c("DT50_k1")] = DT50_k1</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">164</td> + <td class="coverage">27729<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ep$distimes[obs_var, c("DT50_k2")] = DT50_k2</pre> + </td> + </tr> + <tr class="never"> + <td class="num">165</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">166</td> + <td class="coverage">73858<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (type == "HS") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">167</td> + <td class="coverage">318<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k1 = degparms["k1"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">168</td> + <td class="coverage">318<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k2 = degparms["k2"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">169</td> + <td class="coverage">318<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> tb = degparms["tb"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">170</td> + <td class="coverage">318<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DTx <- function(x) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">171</td> + <td class="coverage">636<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DTx.a <- (log(100/(100 - x)))/k1</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">172</td> + <td class="coverage">636<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DTx.b <- tb + (log(100/(100 - x)) - k1 * tb)/k2</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">173</td> + <td class="coverage">339<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (DTx.a < tb) DTx <- DTx.a</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">174</td> + <td class="coverage">297<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> else DTx <- DTx.b</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">175</td> + <td class="coverage">636<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(DTx)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">176</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">177</td> + <td class="coverage">318<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DT50 <- DTx(50)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">178</td> + <td class="coverage">318<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DT90 <- DTx(90)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">179</td> + <td class="coverage">318<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DT50_back = DT90 / (log(10)/log(2)) # Backcalculated DT50 as recommended in FOCUS 2011</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">180</td> + <td class="coverage">318<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DT50_k1 = log(2)/k1</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">181</td> + <td class="coverage">318<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DT50_k2 = log(2)/k2</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">182</td> + <td class="coverage">318<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ep$distimes[obs_var, c("DT50back")] = DT50_back</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">183</td> + <td class="coverage">318<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ep$distimes[obs_var, c("DT50_k1")] = DT50_k1</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">184</td> + <td class="coverage">318<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ep$distimes[obs_var, c("DT50_k2")] = DT50_k2</pre> + </td> + </tr> + <tr class="never"> + <td class="num">185</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">186</td> + <td class="coverage">73858<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (type == "SFORB") {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">187</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # FOCUS kinetics (2006), p. 60 f</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">188</td> + <td class="coverage">2616<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k_out_names = grep(paste("^k", obs_var, "free", sep="_"), names(degparms), value=TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">189</td> + <td class="coverage">2616<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k_out_names = setdiff(k_out_names, paste("k", obs_var, "free", "bound", sep="_"))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">190</td> + <td class="coverage">2616<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k_1output = sum(degparms[k_out_names])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">191</td> + <td class="coverage">2616<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k_12 = degparms[paste("k", obs_var, "free", "bound", sep="_")]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">192</td> + <td class="coverage">2616<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k_21 = degparms[paste("k", obs_var, "bound", "free", sep="_")]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">193</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">194</td> + <td class="coverage">2616<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> sqrt_exp = sqrt(1/4 * (k_12 + k_21 + k_1output)^2 - k_1output * k_21)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">195</td> + <td class="coverage">2616<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> b1 = 0.5 * (k_12 + k_21 + k_1output) + sqrt_exp</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">196</td> + <td class="coverage">2616<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> b2 = 0.5 * (k_12 + k_21 + k_1output) - sqrt_exp</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">197</td> + <td class="coverage">2616<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> g = (k_12 + k_21 - b1)/(b2 - b1)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">198</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">199</td> + <td class="coverage">2616<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DT50_b1 = log(2)/b1</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">200</td> + <td class="coverage">2616<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DT50_b2 = log(2)/b2</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">201</td> + <td class="coverage">2616<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DT90_b1 = log(10)/b1</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">202</td> + <td class="coverage">2616<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DT90_b2 = log(10)/b2</pre> + </td> + </tr> + <tr class="never"> + <td class="num">203</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">204</td> + <td class="coverage">2616<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> SFORB_fraction = function(t) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">205</td> + <td class="coverage">60096<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> g * exp(-b1 * t) + (1 - g) * exp(-b2 * t)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">206</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">207</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">208</td> + <td class="coverage">2616<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f_50 <- function(log_t) (SFORB_fraction(exp(log_t)) - 0.5)^2</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">209</td> + <td class="coverage">2616<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> log_DT50 <- try(optimize(f_50, c(log(DT50_b1), log(DT50_b2)))$minimum,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">210</td> + <td class="coverage">2616<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> silent = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">211</td> + <td class="coverage">2616<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f_90 <- function(log_t) (SFORB_fraction(exp(log_t)) - 0.1)^2</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">212</td> + <td class="coverage">2616<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> log_DT90 <- try(optimize(f_90, c(log(DT90_b1), log(DT90_b2)))$minimum,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">213</td> + <td class="coverage">2616<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> silent = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">214</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">215</td> + <td class="coverage">2616<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DT50 = if (inherits(log_DT50, "try-error")) NA</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">216</td> + <td class="coverage">2616<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> else exp(log_DT50)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">217</td> + <td class="coverage">2616<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DT90 = if (inherits(log_DT90, "try-error")) NA</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">218</td> + <td class="coverage">2616<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> else exp(log_DT90)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">219</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">220</td> + <td class="coverage">2616<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DT50_back = DT90 / (log(10)/log(2)) # Backcalculated DT50 as recommended in FOCUS 2011</pre> + </td> + </tr> + <tr class="never"> + <td class="num">221</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">222</td> + <td class="coverage">2616<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (k_out_name in k_out_names)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">223</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">224</td> + <td class="coverage">2618<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ep$ff[[sub("k_", "", k_out_name)]] = degparms[[k_out_name]] / k_1output</pre> + </td> + </tr> + <tr class="never"> + <td class="num">225</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">226</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">227</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Return the eigenvalues for comparison with DFOP rate constants</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">228</td> + <td class="coverage">2616<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ep$SFORB[[paste(obs_var, "b1", sep="_")]] = b1</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">229</td> + <td class="coverage">2616<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ep$SFORB[[paste(obs_var, "b2", sep="_")]] = b2</pre> + </td> + </tr> + <tr class="never"> + <td class="num">230</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Return g for comparison with DFOP</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">231</td> + <td class="coverage">2616<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ep$SFORB[[paste(obs_var, "g", sep="_")]] = g</pre> + </td> + </tr> + <tr class="never"> + <td class="num">232</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">233</td> + <td class="coverage">2616<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ep$distimes[obs_var, c("DT50back")] = DT50_back</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">234</td> + <td class="coverage">2616<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ep$distimes[obs_var, c(paste("DT50", obs_var, "b1", sep = "_"))] = DT50_b1</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">235</td> + <td class="coverage">2616<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ep$distimes[obs_var, c(paste("DT50", obs_var, "b2", sep = "_"))] = DT50_b2</pre> + </td> + </tr> + <tr class="never"> + <td class="num">236</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">237</td> + <td class="coverage">73858<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (type == "logistic") {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">238</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # FOCUS kinetics (2014) p. 67</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">239</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> kmax = degparms["kmax"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">240</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k0 = degparms["k0"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">241</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> r = degparms["r"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">242</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DT50 = (1/r) * log(1 - ((kmax/k0) * (1 - 2^(r/kmax))))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">243</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DT90 = (1/r) * log(1 - ((kmax/k0) * (1 - 10^(r/kmax))))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">244</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">245</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DT50_k0 = log(2)/k0</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">246</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DT50_kmax = log(2)/kmax</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">247</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ep$distimes[obs_var, c("DT50_k0")] = DT50_k0</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">248</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ep$distimes[obs_var, c("DT50_kmax")] = DT50_kmax</pre> + </td> + </tr> + <tr class="never"> + <td class="num">249</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">250</td> + <td class="coverage">73858<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ep$distimes[obs_var, c("DT50", "DT90")] = c(DT50, DT90)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">251</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">252</td> + <td class="coverage">38846<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(ep$ff) == 0) ep$ff <- NULL</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">253</td> + <td class="coverage">53592<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(ep$SFORB) == 0) ep$SFORB <- NULL</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">254</td> + <td class="coverage">56208<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(ep)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">255</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/mkinmod.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Function to set up a kinetic model with one or more state variables</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' This function is usually called using a call to [mkinsub()] for each observed</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' variable, specifying the corresponding submodel as well as outgoing pathways</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' (see examples).</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' For the definition of model types and their parameters, the equations given</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' in the FOCUS and NAFTA guidance documents are used.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' For kinetic models with more than one observed variable, a symbolic solution</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' of the system of differential equations is included in the resulting</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' mkinmod object in some cases, speeding up the solution.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' If a C compiler is found by [pkgbuild::has_compiler()] and there</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' is more than one observed variable in the specification, C code is generated</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' for evaluating the differential equations, compiled using</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' [inline::cfunction()] and added to the resulting mkinmod object.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param ... For each observed variable, a list as obtained by [mkinsub()]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' has to be specified as an argument (see examples). Currently, single</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' first order kinetics "SFO", indeterminate order rate equation kinetics</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' "IORE", or single first order with reversible binding "SFORB" are</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' implemented for all variables, while "FOMC", "DFOP", "HS" and "logistic"</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' can additionally be chosen for the first variable which is assumed to be</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the source compartment.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Additionally, [mkinsub()] has an argument \code{to}, specifying names of</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' variables to which a transfer is to be assumed in the model.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' If the argument \code{use_of_ff} is set to "min"</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' and the model for the compartment is "SFO" or "SFORB", an</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' additional [mkinsub()] argument can be \code{sink = FALSE}, effectively</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fixing the flux to sink to zero.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' In print.mkinmod, this argument is currently not used.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param use_of_ff Specification of the use of formation fractions in the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' model equations and, if applicable, the coefficient matrix. If "max",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' formation fractions are always used (default). If "min", a minimum use of</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' formation fractions is made, i.e. each first-order pathway to a metabolite</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' has its own rate constant.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param speclist The specification of the observed variables and their</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' submodel types and pathways can be given as a single list using this</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' argument. Default is NULL.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param quiet Should messages be suppressed?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param verbose If \code{TRUE}, passed to [inline::cfunction()] if</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' applicable to give detailed information about the C function being built.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param name A name for the model. Should be a valid R object name.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param dll_dir Directory where an DLL object, if generated internally by</pre> + </td> + </tr> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' [inline::cfunction()], should be saved. The DLL will only be stored in a</pre> + </td> + </tr> + <tr class="never"> + <td class="num">47</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' permanent location for use in future sessions, if 'dll_dir' and 'name'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' are specified. This is helpful if fit objects are cached e.g. by knitr,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' as the cache remains functional across sessions if the DLL is stored in</pre> + </td> + </tr> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' a user defined location.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param unload If a DLL from the target location in 'dll_dir' is already</pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' loaded, should that be unloaded first?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param overwrite If a file exists at the target DLL location in 'dll_dir',</pre> + </td> + </tr> + <tr class="never"> + <td class="num">54</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' should this be overwritten?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">55</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom methods signature</pre> + </td> + </tr> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return A list of class \code{mkinmod} for use with [mkinfit()],</pre> + </td> + </tr> + <tr class="never"> + <td class="num">57</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' containing, among others,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{diffs}{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' A vector of string representations of differential equations, one for</pre> + </td> + </tr> + <tr class="never"> + <td class="num">60</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' each modelling variable.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">61</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">62</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{map}{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">63</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' A list containing named character vectors for each observed variable,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">64</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' specifying the modelling variables by which it is represented.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">65</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">66</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{use_of_ff}{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">67</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' The content of \code{use_of_ff} is passed on in this list component.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">68</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">69</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{deg_func}{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">70</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' If generated, a function containing the solution of the degradation</pre> + </td> + </tr> + <tr class="never"> + <td class="num">71</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' model.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">72</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">73</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{coefmat}{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">74</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' The coefficient matrix, if the system of differential equations can be</pre> + </td> + </tr> + <tr class="never"> + <td class="num">75</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' represented by one.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">76</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">77</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{cf}{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">78</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' If generated, a compiled function calculating the derivatives as</pre> + </td> + </tr> + <tr class="never"> + <td class="num">79</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' returned by cfunction.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">80</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">81</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @note The IORE submodel is not well tested for metabolites. When using this</pre> + </td> + </tr> + <tr class="never"> + <td class="num">82</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' model for metabolites, you may want to read the note in the help</pre> + </td> + </tr> + <tr class="never"> + <td class="num">83</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' page to [mkinfit].</pre> + </td> + </tr> + <tr class="never"> + <td class="num">84</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @author Johannes Ranke</pre> + </td> + </tr> + <tr class="never"> + <td class="num">85</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @references FOCUS (2006) \dQuote{Guidance Document on Estimating Persistence</pre> + </td> + </tr> + <tr class="never"> + <td class="num">86</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' and Degradation Kinetics from Environmental Fate Studies on Pesticides in</pre> + </td> + </tr> + <tr class="never"> + <td class="num">87</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' EU Registration} Report of the FOCUS Work Group on Degradation Kinetics,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">88</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' EC Document Reference Sanco/10058/2005 version 2.0, 434 pp,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">89</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \url{http://esdac.jrc.ec.europa.eu/projects/degradation-kinetics}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">90</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">91</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' NAFTA Technical Working Group on Pesticides (not dated) Guidance for</pre> + </td> + </tr> + <tr class="never"> + <td class="num">92</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Evaluating and Calculating Degradation Kinetics in Environmental Media</pre> + </td> + </tr> + <tr class="never"> + <td class="num">93</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">94</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">95</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Specify the SFO model (this is not needed any more, as we can now mkinfit("SFO", ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">96</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' SFO <- mkinmod(parent = mkinsub("SFO"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">97</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">98</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # One parent compound, one metabolite, both single first order</pre> + </td> + </tr> + <tr class="never"> + <td class="num">99</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' SFO_SFO <- mkinmod(</pre> + </td> + </tr> + <tr class="never"> + <td class="num">100</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parent = mkinsub("SFO", "m1"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">101</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' m1 = mkinsub("SFO"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">102</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' print(SFO_SFO)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">103</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">104</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">105</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit_sfo_sfo <- mkinfit(SFO_SFO, FOCUS_2006_D, quiet = TRUE, solution_type = "deSolve")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">106</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">107</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Now supplying compound names used for plotting, and write to user defined location</pre> + </td> + </tr> + <tr class="never"> + <td class="num">108</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # We need to choose a path outside the session tempdir because this gets removed</pre> + </td> + </tr> + <tr class="never"> + <td class="num">109</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' DLL_dir <- "~/.local/share/mkin"</pre> + </td> + </tr> + <tr class="never"> + <td class="num">110</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' if (!dir.exists(DLL_dir)) dir.create(DLL_dir)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">111</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' SFO_SFO.2 <- mkinmod(</pre> + </td> + </tr> + <tr class="never"> + <td class="num">112</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parent = mkinsub("SFO", "m1", full_name = "Test compound"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">113</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' m1 = mkinsub("SFO", full_name = "Metabolite M1"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">114</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' name = "SFO_SFO", dll_dir = DLL_dir, unload = TRUE, overwrite = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">115</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Now we can save the model and restore it in a new session</pre> + </td> + </tr> + <tr class="never"> + <td class="num">116</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' saveRDS(SFO_SFO.2, file = "~/SFO_SFO.rds")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">117</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Terminate the R session here if you would like to check, and then do</pre> + </td> + </tr> + <tr class="never"> + <td class="num">118</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' library(mkin)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">119</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' SFO_SFO.3 <- readRDS("~/SFO_SFO.rds")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">120</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit_sfo_sfo <- mkinfit(SFO_SFO.3, FOCUS_2006_D, quiet = TRUE, solution_type = "deSolve")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">121</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">122</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Show details of creating the C function</pre> + </td> + </tr> + <tr class="never"> + <td class="num">123</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' SFO_SFO <- mkinmod(</pre> + </td> + </tr> + <tr class="never"> + <td class="num">124</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parent = mkinsub("SFO", "m1"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">125</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' m1 = mkinsub("SFO"), verbose = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">126</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">127</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # The symbolic solution which is available in this case is not</pre> + </td> + </tr> + <tr class="never"> + <td class="num">128</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # made for human reading but for speed of computation</pre> + </td> + </tr> + <tr class="never"> + <td class="num">129</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' SFO_SFO$deg_func</pre> + </td> + </tr> + <tr class="never"> + <td class="num">130</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">131</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # If we have several parallel metabolites</pre> + </td> + </tr> + <tr class="never"> + <td class="num">132</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # (compare tests/testthat/test_synthetic_data_for_UBA_2014.R)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">133</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' m_synth_DFOP_par <- mkinmod(</pre> + </td> + </tr> + <tr class="never"> + <td class="num">134</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parent = mkinsub("DFOP", c("M1", "M2")),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">135</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' M1 = mkinsub("SFO"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">136</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' M2 = mkinsub("SFO"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">137</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">138</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">139</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit_DFOP_par_c <- mkinfit(m_synth_DFOP_par,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">140</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' synthetic_data_for_UBA_2014[[12]]$data,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">141</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">142</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">143</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">144</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export mkinmod</pre> + </td> + </tr> + <tr class="never"> + <td class="num">145</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">mkinmod <- function(..., use_of_ff = "max", name = NULL,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">146</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> speclist = NULL, quiet = FALSE, verbose = FALSE, dll_dir = NULL,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">147</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> unload = FALSE, overwrite = FALSE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">148</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">149</td> + <td class="coverage">4940<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.null(speclist)) spec <- list(...)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">150</td> + <td class="coverage">3905<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> else spec <- speclist</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">151</td> + <td class="coverage">8845<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> obs_vars <- names(spec)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">152</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">153</td> + <td class="coverage">8845<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> save_msg <- "You need to specify both 'name' and 'dll_dir' to save a model DLL"</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">154</td> + <td class="coverage">8845<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.null(dll_dir)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">155</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (!dir.exists(dll_dir)) stop(dll_dir, " does not exist")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">156</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.null(name)) stop(save_msg)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">157</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">158</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">159</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Check if any of the names of the observed variables contains any other</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">160</td> + <td class="coverage">8845<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (obs_var in obs_vars) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">161</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(grep(obs_var, obs_vars)) > 1) stop("Sorry, variable names can not contain each other")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">162</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (grepl("_to_", obs_var)) stop("Sorry, names of observed variables can not contain _to_")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">163</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (obs_var == "sink") stop("Naming a compound 'sink' is not supported")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">164</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">165</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">166</td> + <td class="coverage">8533<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!use_of_ff %in% c("min", "max"))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">167</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> stop("The use of formation fractions 'use_of_ff' can only be 'min' or 'max'")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">168</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">169</td> + <td class="coverage">8429<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms <- vector()</pre> + </td> + </tr> + <tr class="never"> + <td class="num">170</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # }}}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">171</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">172</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Do not return a coefficient matrix mat when FOMC, IORE, DFOP, HS or logistic is used for the parent {{{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">173</td> + <td class="coverage">8429<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(spec[[1]]$type %in% c("FOMC", "IORE", "DFOP", "HS", "logistic")) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">174</td> + <td class="coverage">2280<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mat = FALSE</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">175</td> + <td class="coverage">6149<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> } else mat = TRUE</pre> + </td> + </tr> + <tr class="never"> + <td class="num">176</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> #}}}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">177</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">178</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Establish a list of differential equations as well as a map from observed {{{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">179</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # compartments to differential equations</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">180</td> + <td class="coverage">8429<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> diffs <- vector()</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">181</td> + <td class="coverage">8429<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> map <- list()</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">182</td> + <td class="coverage">8429<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (varname in obs_vars)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">183</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">184</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Check the type component of the compartment specification {{{</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">185</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if(is.null(spec[[varname]]$type)) stop(</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">186</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> "Every part of the model specification must be a list containing a type component")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">187</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(!spec[[varname]]$type %in% c("SFO", "FOMC", "IORE", "DFOP", "HS", "SFORB", "logistic")) stop(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">188</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "Available types are SFO, FOMC, IORE, DFOP, HS, SFORB and logistic only")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">189</td> + <td class="coverage">13150<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(spec[[varname]]$type %in% c("FOMC", "DFOP", "HS", "logistic") & match(varname, obs_vars) != 1) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">190</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> stop(paste("Types FOMC, DFOP, HS and logistic are only implemented for the first compartment,",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">191</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "which is assumed to be the source compartment"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">192</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">193</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> #}}}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">194</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # New (sub)compartments (boxes) needed for the model type {{{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">195</td> + <td class="coverage">13046<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> new_boxes <- switch(spec[[varname]]$type,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">196</td> + <td class="coverage">13046<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> SFO = varname,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">197</td> + <td class="coverage">13046<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> FOMC = varname,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">198</td> + <td class="coverage">13046<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> IORE = varname,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">199</td> + <td class="coverage">13046<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DFOP = varname,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">200</td> + <td class="coverage">13046<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> HS = varname,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">201</td> + <td class="coverage">13046<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> logistic = varname,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">202</td> + <td class="coverage">13046<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> SFORB = paste(varname, c("free", "bound"), sep = "_")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">203</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> )</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">204</td> + <td class="coverage">13046<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> map[[varname]] <- new_boxes</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">205</td> + <td class="coverage">13046<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(map[[varname]]) <- rep(spec[[varname]]$type, length(new_boxes)) #}}}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">206</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Start a new differential equation for each new box {{{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">207</td> + <td class="coverage">13046<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> new_diffs <- paste("d_", new_boxes, " =", sep = "")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">208</td> + <td class="coverage">13046<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(new_diffs) <- new_boxes</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">209</td> + <td class="coverage">13046<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> diffs <- c(diffs, new_diffs) #}}}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">210</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } #}}}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">211</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">212</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Create content of differential equations and build parameter list {{{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">213</td> + <td class="coverage">8221<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (varname in obs_vars)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">214</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">215</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Get the name of the box(es) we are working on for the decline term(s)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">216</td> + <td class="coverage">12838<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> box_1 = map[[varname]][[1]] # This is the only box unless type is SFORB</pre> + </td> + </tr> + <tr class="never"> + <td class="num">217</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Turn on sink if this is not explicitly excluded by the user by</pre> + </td> + </tr> + <tr class="never"> + <td class="num">218</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # specifying sink=FALSE</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">219</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(is.null(spec[[varname]]$sink)) spec[[varname]]$sink <- TRUE</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">220</td> + <td class="coverage">12838<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(spec[[varname]]$type %in% c("SFO", "IORE", "SFORB")) { # {{{ Add decline term</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">221</td> + <td class="coverage">10838<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (use_of_ff == "min") { # Minimum use of formation fractions</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">222</td> + <td class="coverage">1304<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(spec[[varname]]$type == "IORE" && length(spec[[varname]]$to) > 0) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">223</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> stop("Transformation reactions from compounds modelled with IORE\n",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">224</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "are only supported with formation fractions (use_of_ff = 'max')")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">225</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">226</td> + <td class="coverage">1200<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(spec[[varname]]$sink) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">227</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # If sink is requested, add first-order/IORE sink term</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">228</td> + <td class="coverage">952<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k_compound_sink <- paste("k", box_1, "sink", sep = "_")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">229</td> + <td class="coverage">952<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(spec[[varname]]$type == "IORE") {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">230</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> k_compound_sink <- paste("k__iore", box_1, "sink", sep = "_")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">231</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">232</td> + <td class="coverage">952<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms <- c(parms, k_compound_sink)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">233</td> + <td class="coverage">952<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> decline_term <- paste(k_compound_sink, "*", box_1)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">234</td> + <td class="coverage">952<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(spec[[varname]]$type == "IORE") {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">235</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> N <- paste("N", box_1, sep = "_")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">236</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> parms <- c(parms, N)</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">237</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> decline_term <- paste0(decline_term, "^", N)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">238</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">239</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else { # otherwise no decline term needed here</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">240</td> + <td class="coverage">248<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> decline_term = "0"</pre> + </td> + </tr> + <tr class="never"> + <td class="num">241</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">242</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else { # Maximum use of formation fractions</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">243</td> + <td class="coverage">9534<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k_compound <- paste("k", box_1, sep = "_")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">244</td> + <td class="coverage">9534<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(spec[[varname]]$type == "IORE") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">245</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k_compound <- paste("k__iore", box_1, sep = "_")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">246</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">247</td> + <td class="coverage">9534<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms <- c(parms, k_compound)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">248</td> + <td class="coverage">9534<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> decline_term <- paste(k_compound, "*", box_1)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">249</td> + <td class="coverage">9534<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(spec[[varname]]$type == "IORE") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">250</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> N <- paste("N", box_1, sep = "_")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">251</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms <- c(parms, N)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">252</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> decline_term <- paste0(decline_term, "^", N)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">253</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">254</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">255</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } #}}}</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">256</td> + <td class="coverage">12734<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(spec[[varname]]$type == "FOMC") { # {{{ Add FOMC decline term</pre> + </td> + </tr> + <tr class="never"> + <td class="num">257</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # From p. 53 of the FOCUS kinetics report, without the power function so it works in C</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">258</td> + <td class="coverage">381<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> decline_term <- paste("(alpha/beta) * 1/((time/beta) + 1) *", box_1)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">259</td> + <td class="coverage">381<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms <- c(parms, "alpha", "beta")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">260</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } #}}}</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">261</td> + <td class="coverage">12734<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(spec[[varname]]$type == "DFOP") { # {{{ Add DFOP decline term</pre> + </td> + </tr> + <tr class="never"> + <td class="num">262</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # From p. 57 of the FOCUS kinetics report</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">263</td> + <td class="coverage">1283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> decline_term <- paste("((k1 * g * exp(-k1 * time) + k2 * (1 - g) * exp(-k2 * time)) / (g * exp(-k1 * time) + (1 - g) * exp(-k2 * time))) *", box_1)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">264</td> + <td class="coverage">1283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms <- c(parms, "k1", "k2", "g")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">265</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } #}}}</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">266</td> + <td class="coverage">12734<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> HS_decline <- "ifelse(time <= tb, k1, k2)" # Used below for automatic translation to C</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">267</td> + <td class="coverage">12734<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(spec[[varname]]$type == "HS") { # {{{ Add HS decline term</pre> + </td> + </tr> + <tr class="never"> + <td class="num">268</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # From p. 55 of the FOCUS kinetics report</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">269</td> + <td class="coverage">30<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> decline_term <- paste(HS_decline, "*", box_1)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">270</td> + <td class="coverage">30<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms <- c(parms, "k1", "k2", "tb")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">271</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } #}}}</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">272</td> + <td class="coverage">12734<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(spec[[varname]]$type == "logistic") { # {{{ Add logistic decline term</pre> + </td> + </tr> + <tr class="never"> + <td class="num">273</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # From p. 67 of the FOCUS kinetics report (2014)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">274</td> + <td class="coverage">306<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> decline_term <- paste("(k0 * kmax)/(k0 + (kmax - k0) * exp(-r * time)) *", box_1)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">275</td> + <td class="coverage">306<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms <- c(parms, "kmax", "k0", "r")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">276</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } #}}}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">277</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Add origin decline term to box 1 (usually the only box, unless type is SFORB)#{{{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">278</td> + <td class="coverage">12734<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> diffs[[box_1]] <- paste(diffs[[box_1]], "-", decline_term)#}}}</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">279</td> + <td class="coverage">12734<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(spec[[varname]]$type == "SFORB") { # {{{ Add SFORB reversible binding terms</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">280</td> + <td class="coverage">25<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> box_2 = map[[varname]][[2]]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">281</td> + <td class="coverage">25<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k_free_bound <- paste("k", varname, "free", "bound", sep = "_")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">282</td> + <td class="coverage">25<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k_bound_free <- paste("k", varname, "bound", "free", sep = "_")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">283</td> + <td class="coverage">25<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms <- c(parms, k_free_bound, k_bound_free)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">284</td> + <td class="coverage">25<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> reversible_binding_term_1 <- paste("-", k_free_bound, "*", box_1, "+",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">285</td> + <td class="coverage">25<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k_bound_free, "*", box_2)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">286</td> + <td class="coverage">25<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> reversible_binding_term_2 <- paste("+", k_free_bound, "*", box_1, "-",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">287</td> + <td class="coverage">25<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k_bound_free, "*", box_2)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">288</td> + <td class="coverage">25<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> diffs[[box_1]] <- paste(diffs[[box_1]], reversible_binding_term_1)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">289</td> + <td class="coverage">25<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> diffs[[box_2]] <- paste(diffs[[box_2]], reversible_binding_term_2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">290</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } #}}}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">291</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">292</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Transfer between compartments#{{{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">293</td> + <td class="coverage">12734<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> to <- spec[[varname]]$to</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">294</td> + <td class="coverage">12734<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(!is.null(to)) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">295</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Name of box from which transfer takes place</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">296</td> + <td class="coverage">4174<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> origin_box <- box_1</pre> + </td> + </tr> + <tr class="never"> + <td class="num">297</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">298</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Number of targets</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">299</td> + <td class="coverage">4174<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n_targets = length(to)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">300</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">301</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Add transfer terms to listed compartments</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">302</td> + <td class="coverage">4174<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (target in to) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">303</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (!target %in% obs_vars) stop("You did not specify a submodel for target variable ", target)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">304</td> + <td class="coverage">4813<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> target_box <- switch(spec[[target]]$type,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">305</td> + <td class="coverage">4813<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> SFO = target,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">306</td> + <td class="coverage">4813<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> IORE = target,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">307</td> + <td class="coverage">4813<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> SFORB = paste(target, "free", sep = "_"))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">308</td> + <td class="coverage">4813<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (use_of_ff == "min" && spec[[varname]]$type %in% c("SFO", "SFORB"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">309</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">310</td> + <td class="coverage">601<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k_from_to <- paste("k", origin_box, target_box, sep = "_")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">311</td> + <td class="coverage">601<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms <- c(parms, k_from_to)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">312</td> + <td class="coverage">601<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> diffs[[origin_box]] <- paste(diffs[[origin_box]], "-",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">313</td> + <td class="coverage">601<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k_from_to, "*", origin_box)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">314</td> + <td class="coverage">601<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> diffs[[target_box]] <- paste(diffs[[target_box]], "+",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">315</td> + <td class="coverage">601<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k_from_to, "*", origin_box)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">316</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">317</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Do not introduce a formation fraction if this is the only target</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">318</td> + <td class="coverage">4212<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (spec[[varname]]$sink == FALSE && n_targets == 1) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">319</td> + <td class="coverage">689<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> diffs[[target_box]] <- paste(diffs[[target_box]], "+",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">320</td> + <td class="coverage">689<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> decline_term)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">321</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">322</td> + <td class="coverage">3523<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fraction_to_target = paste("f", origin_box, "to", target, sep = "_")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">323</td> + <td class="coverage">3523<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms <- c(parms, fraction_to_target)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">324</td> + <td class="coverage">3523<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> diffs[[target_box]] <- paste(diffs[[target_box]], "+",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">325</td> + <td class="coverage">3523<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fraction_to_target, "*", decline_term)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">326</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">327</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">328</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">329</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } #}}}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">330</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } #}}}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">331</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">332</td> + <td class="coverage">8117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> model <- list(diffs = diffs, parms = parms, map = map, spec = spec, use_of_ff = use_of_ff, name = name)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">333</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">334</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Create coefficient matrix if possible #{{{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">335</td> + <td class="coverage">8117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (mat) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">336</td> + <td class="coverage">5941<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> boxes <- names(diffs)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">337</td> + <td class="coverage">5941<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n <- length(boxes)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">338</td> + <td class="coverage">5941<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> m <- matrix(nrow=n, ncol=n, dimnames=list(boxes, boxes))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">339</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">340</td> + <td class="coverage">5941<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (use_of_ff == "min") { # {{{ Minimum use of formation fractions</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">341</td> + <td class="coverage">600<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (from in boxes) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">342</td> + <td class="coverage">1201<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (to in boxes) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">343</td> + <td class="coverage">2405<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (from == to) { # diagonal elements</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">344</td> + <td class="coverage">1201<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k.candidate = paste("k", from, c(boxes, "sink"), sep = "_")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">345</td> + <td class="coverage">1201<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k.candidate = sub("free.*bound", "free_bound", k.candidate)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">346</td> + <td class="coverage">1201<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k.candidate = sub("bound.*free", "bound_free", k.candidate)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">347</td> + <td class="coverage">1201<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k.effective = intersect(model$parms, k.candidate)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">348</td> + <td class="coverage">1201<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> m[from,to] = ifelse(length(k.effective) > 0,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">349</td> + <td class="coverage">1201<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> paste("-", k.effective, collapse = " "), "0")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">350</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">351</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else { # off-diagonal elements</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">352</td> + <td class="coverage">1204<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k.candidate = paste("k", from, to, sep = "_")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">353</td> + <td class="coverage">1204<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (sub("_free$", "", from) == sub("_bound$", "", to)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">354</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k.candidate = paste("k", sub("_free$", "_free_bound", from), sep = "_")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">355</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">356</td> + <td class="coverage">1204<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (sub("_bound$", "", from) == sub("_free$", "", to)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">357</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k.candidate = paste("k", sub("_bound$", "_bound_free", from), sep = "_")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">358</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">359</td> + <td class="coverage">1204<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k.effective = intersect(model$parms, k.candidate)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">360</td> + <td class="coverage">1204<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> m[to, from] = ifelse(length(k.effective) > 0,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">361</td> + <td class="coverage">1204<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k.effective, "0")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">362</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">363</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">364</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } # }}}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">365</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else { # {{{ Use formation fractions where possible</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">366</td> + <td class="coverage">5341<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (from in boxes) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">367</td> + <td class="coverage">8074<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (to in boxes) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">368</td> + <td class="coverage">15220<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (from == to) { # diagonal elements</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">369</td> + <td class="coverage">8074<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k.candidate = paste("k", from, sep = "_")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">370</td> + <td class="coverage">8074<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> m[from,to] = ifelse(k.candidate %in% model$parms,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">371</td> + <td class="coverage">8074<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> paste("-", k.candidate), "0")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">372</td> + <td class="coverage">8074<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(grepl("_free", from)) { # add transfer to bound compartment for SFORB</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">373</td> + <td class="coverage">24<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> m[from,to] = paste(m[from,to], "-", paste("k", from, "bound", sep = "_"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">374</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">375</td> + <td class="coverage">8074<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(grepl("_bound", from)) { # add backtransfer to free compartment for SFORB</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">376</td> + <td class="coverage">24<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> m[from,to] = paste("- k", from, "free", sep = "_")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">377</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">378</td> + <td class="coverage">8074<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> m[from,to] = m[from,to]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">379</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else { # off-diagonal elements</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">380</td> + <td class="coverage">7146<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f.candidate = paste("f", from, "to", to, sep = "_")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">381</td> + <td class="coverage">7146<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k.candidate = paste("k", from, to, sep = "_")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">382</td> + <td class="coverage">7146<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k.candidate = sub("free.*bound", "free_bound", k.candidate)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">383</td> + <td class="coverage">7146<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k.candidate = sub("bound.*free", "bound_free", k.candidate)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">384</td> + <td class="coverage">7146<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> m[to, from] = ifelse(f.candidate %in% model$parms,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">385</td> + <td class="coverage">7146<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> paste(f.candidate, " * k_", from, sep = ""),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">386</td> + <td class="coverage">7146<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ifelse(k.candidate %in% model$parms, k.candidate, "0"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">387</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Special case: singular pathway and no sink</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">388</td> + <td class="coverage">7146<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (spec[[from]]$sink == FALSE && length(spec[[from]]$to) == 1 && to %in% spec[[from]]$to) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">389</td> + <td class="coverage">689<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> m[to, from] = paste("k", from, sep = "_")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">390</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">391</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">392</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">393</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">394</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } # }}}</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">395</td> + <td class="coverage">5941<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> model$coefmat <- m</pre> + </td> + </tr> + <tr class="never"> + <td class="num">396</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }#}}}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">397</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">398</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Try to create a function compiled from C code if there is more than one observed variable {{{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">399</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # and a compiler is available</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">400</td> + <td class="coverage">8117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(obs_vars) > 1 & pkgbuild::has_compiler()) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">401</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">402</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Translate the R code for the derivatives to C code</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">403</td> + <td class="coverage">3728<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> diffs.C <- paste(diffs, collapse = ";\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">404</td> + <td class="coverage">3728<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> diffs.C <- paste0(diffs.C, ";")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">405</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">406</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # HS</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">407</td> + <td class="coverage">3728<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> diffs.C <- gsub(HS_decline, "(time <= tb ? k1 : k2)", diffs.C, fixed = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">408</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">409</td> + <td class="coverage">3728<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (i in seq_along(diffs)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">410</td> + <td class="coverage">8347<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> state_var <- names(diffs)[i]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">411</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">412</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # IORE</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">413</td> + <td class="coverage">8347<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (state_var %in% obs_vars) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">414</td> + <td class="coverage">8343<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (spec[[state_var]]$type == "IORE") {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">415</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> diffs.C <- gsub(paste0(state_var, "^N_", state_var),</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">416</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> paste0("pow(y[", i - 1, "], N_", state_var, ")"),</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">417</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> diffs.C, fixed = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">418</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">419</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">420</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">421</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Replace d_... terms by f[i-1]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">422</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # First line</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">423</td> + <td class="coverage">8347<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> pattern <- paste0("^d_", state_var)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">424</td> + <td class="coverage">8347<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> replacement <- paste0("\nf[", i - 1, "]")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">425</td> + <td class="coverage">8347<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> diffs.C <- gsub(pattern, replacement, diffs.C)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">426</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Other lines</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">427</td> + <td class="coverage">8347<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> pattern <- paste0("\\nd_", state_var)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">428</td> + <td class="coverage">8347<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> replacement <- paste0("\nf[", i - 1, "]")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">429</td> + <td class="coverage">8347<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> diffs.C <- gsub(pattern, replacement, diffs.C)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">430</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">431</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Replace names of observed variables by y[i],</pre> + </td> + </tr> + <tr class="never"> + <td class="num">432</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # making the implicit assumption that the observed variables only occur after "* "</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">433</td> + <td class="coverage">8347<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> pattern <- paste0("\\* ", state_var)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">434</td> + <td class="coverage">8347<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> replacement <- paste0("* y[", i - 1, "]")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">435</td> + <td class="coverage">8347<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> diffs.C <- gsub(pattern, replacement, diffs.C)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">436</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">437</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">438</td> + <td class="coverage">3728<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> derivs_sig <- signature(n = "integer", t = "numeric", y = "numeric",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">439</td> + <td class="coverage">3728<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f = "numeric", rpar = "numeric", ipar = "integer")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">440</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">441</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Declare the time variable in the body of the function if it is used</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">442</td> + <td class="coverage">3728<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> derivs_code <- if (spec[[1]]$type %in% c("FOMC", "DFOP", "HS")) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">443</td> + <td class="coverage">1060<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> paste0("double time = *t;\n", diffs.C)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">444</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">445</td> + <td class="coverage">2668<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> diffs.C</pre> + </td> + </tr> + <tr class="never"> + <td class="num">446</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">447</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">448</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Define the function initializing the parameters</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">449</td> + <td class="coverage">3728<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> npar <- length(parms)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">450</td> + <td class="coverage">3728<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> initpar_code <- paste0(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">451</td> + <td class="coverage">3728<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "static double parms [", npar, "];\n",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">452</td> + <td class="coverage">3728<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> paste0("#define ", parms, " parms[", 0:(npar - 1), "]\n", collapse = ""),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">453</td> + <td class="coverage">3728<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "\n",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">454</td> + <td class="coverage">3728<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "void initpar(void (* odeparms)(int *, double *)) {\n",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">455</td> + <td class="coverage">3728<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> " int N = ", npar, ";\n",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">456</td> + <td class="coverage">3728<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> " odeparms(&N, parms);\n",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">457</td> + <td class="coverage">3728<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "}\n\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">458</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">459</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Try to build a shared library</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">460</td> + <td class="coverage">3728<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> model$cf <- try(inline::cfunction(derivs_sig, derivs_code,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">461</td> + <td class="coverage">3728<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> otherdefs = initpar_code,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">462</td> + <td class="coverage">3728<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> verbose = verbose, name = "diffs",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">463</td> + <td class="coverage">3728<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> convention = ".C", language = "C"),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">464</td> + <td class="coverage">3728<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> silent = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">465</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">466</td> + <td class="coverage">3728<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!inherits(model$cf, "try-error")) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">467</td> + <td class="coverage">495<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!quiet) message("Temporary DLL for differentials generated and loaded")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">468</td> + <td class="coverage">3728<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.null(dll_dir)) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">469</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # We suppress warnings, as we get a warning about a path "(embedding)" </pre> + </td> + </tr> + <tr class="never"> + <td class="num">470</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # under Windows, at least when using RStudio</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">471</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> suppressWarnings(inline::moveDLL(model$cf, name, dll_dir,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">472</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> unload = unload, overwrite = overwrite, verbose = !quiet))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">473</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">474</td> + <td class="coverage">3728<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> model$dll_info <- inline::getDynLib(model$cf)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">475</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">476</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">477</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # }}}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">478</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">479</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Attach a degradation function if an analytical solution is available</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">480</td> + <td class="coverage">8117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> model$deg_func <- create_deg_func(spec, use_of_ff)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">481</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">482</td> + <td class="coverage">8117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(model) <- "mkinmod"</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">483</td> + <td class="coverage">8117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(model)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">484</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">485</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">486</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Print mkinmod objects</pre> + </td> + </tr> + <tr class="never"> + <td class="num">487</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">488</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Print mkinmod objects in a way that the user finds his way to get to its</pre> + </td> + </tr> + <tr class="never"> + <td class="num">489</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' components.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">490</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">491</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname mkinmod</pre> + </td> + </tr> + <tr class="never"> + <td class="num">492</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param x An \code{\link{mkinmod}} object.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">493</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">494</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">print.mkinmod <- function(x, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">495</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("<mkinmod> model generated with\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">496</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("Use of formation fractions $use_of_ff:", x$use_of_ff, "\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">497</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("Specification $spec:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">498</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (obs in names(x$spec)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">499</td> + <td class="coverage">208<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("$", obs, "\n", sep = "")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">500</td> + <td class="coverage">208<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> spl <- x$spec[[obs]]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">501</td> + <td class="coverage">208<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("$type:", spl$type)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">502</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.null(spl$to) && length(spl$to)) cat("; $to: ", paste(spl$to, collapse = ", "), sep = "")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">503</td> + <td class="coverage">208<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("; $sink: ", spl$sink, sep = "")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">504</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.null(spl$full_name)) if (!is.na(spl$full_name)) cat("; $full_name:", spl$full_name)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">505</td> + <td class="coverage">208<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">506</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">507</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.matrix(x$coefmat)) cat("Coefficient matrix $coefmat available\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">508</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.null(x$cf)) cat("Compiled model $cf available\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">509</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("Differential equations:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">510</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> nice_diffs <- gsub("^(d.*) =", "\\1/dt =", x[["diffs"]])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">511</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> writeLines(strwrap(nice_diffs, exdent = 11))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">512</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">513</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"># vim: set foldmethod=marker ts=2 sw=2 expandtab:</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/mhmkin.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Fit nonlinear mixed-effects models built from one or more kinetic</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' degradation models and one or more error models</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' The name of the methods expresses that (**m**ultiple) **h**ierarchichal</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' (also known as multilevel) **m**ulticompartment **kin**etic models are</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fitted. Our kinetic models are nonlinear, so we can use various nonlinear</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' mixed-effects model fitting functions.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param objects A list of [mmkin] objects containing fits of the same</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' degradation models to the same data, but using different error models.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Alternatively, a single [mmkin] object containing fits of several</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' degradation models to the same data</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param backend The backend to be used for fitting. Currently, only saemix is</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' supported</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param no_random_effect Default is NULL and will be passed to [saem]. If a</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' character vector is supplied, it will be passed to all calls to [saem],</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' which will exclude random effects for all matching parameters. Alternatively,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' a list of character vectors or an object of class [illparms.mhmkin] can be</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' specified. They have to have the same dimensions that the return object of</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the current call will have, i.e. the number of rows must match the number</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' of degradation models in the mmkin object(s), and the number of columns must</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' match the number of error models used in the mmkin object(s).</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param algorithm The algorithm to be used for fitting (currently not used)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots Further arguments that will be passed to the nonlinear mixed-effects</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' model fitting function.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param cores The number of cores to be used for multicore processing. This</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' is only used when the \code{cluster} argument is \code{NULL}. On Windows</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' machines, cores > 1 is not supported, you need to use the \code{cluster}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' argument to use multiple logical processors. Per default, all cores detected</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' by [parallel::detectCores()] are used, except on Windows where the default</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' is 1.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param cluster A cluster as returned by [makeCluster] to be used for</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parallel execution.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom parallel mclapply parLapply detectCores</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return A two-dimensional [array] of fit objects and/or try-errors that can</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' be indexed using the degradation model names for the first index (row index)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' and the error model names for the second index (column index), with class</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' attribute 'mhmkin'.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @author Johannes Ranke</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @seealso \code{\link{[.mhmkin}} for subsetting [mhmkin] objects</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">mhmkin <- function(objects, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">43</td> + <td class="coverage">375<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> UseMethod("mhmkin")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">47</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname mhmkin</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">mhmkin.mmkin <- function(objects, ...) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">49</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> mhmkin(list(objects), ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname mhmkin</pre> + </td> + </tr> + <tr class="never"> + <td class="num">54</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">55</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # We start with separate evaluations of all the first six datasets with two</pre> + </td> + </tr> + <tr class="never"> + <td class="num">57</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # degradation models and two error models</pre> + </td> + </tr> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_sep_const <- mmkin(c("SFO", "FOMC"), ds_fomc[1:6], cores = 2, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_sep_tc <- update(f_sep_const, error_model = "tc")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">60</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # The mhmkin function sets up hierarchical degradation models aka</pre> + </td> + </tr> + <tr class="never"> + <td class="num">61</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # nonlinear mixed-effects models for all four combinations, specifying</pre> + </td> + </tr> + <tr class="never"> + <td class="num">62</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # uncorrelated random effects for all degradation parameters</pre> + </td> + </tr> + <tr class="never"> + <td class="num">63</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_saem_1 <- mhmkin(list(f_sep_const, f_sep_tc), cores = 2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">64</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' status(f_saem_1)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">65</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # The 'illparms' function shows that in all hierarchical fits, at least</pre> + </td> + </tr> + <tr class="never"> + <td class="num">66</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # one random effect is ill-defined (the confidence interval for the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">67</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # random effect expressed as standard deviation includes zero)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">68</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' illparms(f_saem_1)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">69</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Therefore we repeat the fits, excluding the ill-defined random effects</pre> + </td> + </tr> + <tr class="never"> + <td class="num">70</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_saem_2 <- update(f_saem_1, no_random_effect = illparms(f_saem_1))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">71</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' status(f_saem_2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">72</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' illparms(f_saem_2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">73</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Model comparisons show that FOMC with two-component error is preferable,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">74</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # and confirms our reduction of the default parameter model</pre> + </td> + </tr> + <tr class="never"> + <td class="num">75</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' anova(f_saem_1)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">76</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' anova(f_saem_2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">77</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # The convergence plot for the selected model looks fine</pre> + </td> + </tr> + <tr class="never"> + <td class="num">78</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' saemix::plot(f_saem_2[["FOMC", "tc"]]$so, plot.type = "convergence")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">79</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # The plot of predictions versus data shows that we have a pretty data-rich</pre> + </td> + </tr> + <tr class="never"> + <td class="num">80</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # situation with homogeneous distribution of residuals, because we used the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">81</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # same degradation model, error model and parameter distribution model that</pre> + </td> + </tr> + <tr class="never"> + <td class="num">82</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # was used in the data generation.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">83</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(f_saem_2[["FOMC", "tc"]])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">84</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # We can specify the same parameter model reductions manually</pre> + </td> + </tr> + <tr class="never"> + <td class="num">85</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' no_ranef <- list("parent_0", "log_beta", "parent_0", c("parent_0", "log_beta"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">86</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' dim(no_ranef) <- c(2, 2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">87</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_saem_2m <- update(f_saem_1, no_random_effect = no_ranef)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">88</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' anova(f_saem_2m)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">89</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">90</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">mhmkin.list <- function(objects, backend = "saemix", algorithm = "saem",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">91</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> no_random_effect = NULL,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">92</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> ...,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">93</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> cores = if (Sys.info()["sysname"] == "Windows") 1 else parallel::detectCores(), cluster = NULL)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">94</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">95</td> + <td class="coverage">375<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> call <- match.call()</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">96</td> + <td class="coverage">375<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dot_args <- list(...)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">97</td> + <td class="coverage">375<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> backend_function <- switch(backend,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">98</td> + <td class="coverage">375<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> saemix = "saem"</pre> + </td> + </tr> + <tr class="never"> + <td class="num">99</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> )</pre> + </td> + </tr> + <tr class="never"> + <td class="num">100</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">101</td> + <td class="coverage">375<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> deg_models <- lapply(objects[[1]][, 1], function(x) x$mkinmod)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">102</td> + <td class="coverage">375<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(deg_models) <- dimnames(objects[[1]])$model</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">103</td> + <td class="coverage">375<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n.deg <- length(deg_models)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">104</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">105</td> + <td class="coverage">375<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ds <- lapply(objects[[1]][1, ], function(x) x$data)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">106</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">107</td> + <td class="coverage">375<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (other in objects[-1]) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">108</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Check if the degradation models in all objects are the same</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">109</td> + <td class="coverage">375<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (deg_model_name in names(deg_models)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">110</td> + <td class="coverage">750<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!all.equal(other[[deg_model_name, 1]]$mkinmod$spec,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">111</td> + <td class="coverage">750<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> deg_models[[deg_model_name]]$spec))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">112</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">113</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> stop("The mmkin objects have to be based on the same degradation models")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">114</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">115</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">116</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Check if they have been fitted to the same dataset</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">117</td> + <td class="coverage">375<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> other_object_ds <- lapply(other[1, ], function(x) x$data)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">118</td> + <td class="coverage">375<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (i in 1:length(ds)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">119</td> + <td class="coverage">2250<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!all.equal(ds[[i]][c("time", "variable", "observed")],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">120</td> + <td class="coverage">2250<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> other_object_ds[[i]][c("time", "variable", "observed")]))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">121</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">122</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> stop("The mmkin objects have to be fitted to the same datasets")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">123</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">124</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">125</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">126</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">127</td> + <td class="coverage">375<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n.o <- length(objects)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">128</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">129</td> + <td class="coverage">375<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> error_models = sapply(objects, function(x) x[[1]]$err_mod)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">130</td> + <td class="coverage">375<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n.e <- length(error_models)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">131</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">132</td> + <td class="coverage">375<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n.fits <- n.deg * n.e</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">133</td> + <td class="coverage">375<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit_indices <- matrix(1:n.fits, ncol = n.e)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">134</td> + <td class="coverage">375<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dimnames(fit_indices) <- list(degradation = names(deg_models),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">135</td> + <td class="coverage">375<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> error = error_models)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">136</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">137</td> + <td class="coverage">375<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.null(no_random_effect) || is.null(dim(no_random_effect))) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">138</td> + <td class="coverage">129<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> no_ranef <- rep(list(no_random_effect), n.fits)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">139</td> + <td class="coverage">129<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dim(no_ranef) <- dim(fit_indices)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">140</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">141</td> + <td class="coverage">246<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!identical(dim(no_random_effect), dim(fit_indices))) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">142</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> stop("Dimensions of argument 'no_random_effect' are not suitable")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">143</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">144</td> + <td class="coverage">246<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (is(no_random_effect, "illparms.mhmkin")) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">145</td> + <td class="coverage">125<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> no_ranef_dim <- dim(no_random_effect)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">146</td> + <td class="coverage">125<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> no_ranef <- lapply(no_random_effect, function(x) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">147</td> + <td class="coverage">500<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> no_ranef_split <- strsplit(x, ", ")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">148</td> + <td class="coverage">500<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ret <- sapply(no_ranef_split, function(y) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">149</td> + <td class="coverage">500<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> gsub("sd\\((.*)\\)", "\\1", y)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">150</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> })</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">151</td> + <td class="coverage">500<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(ret)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">152</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> })</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">153</td> + <td class="coverage">125<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dim(no_ranef) <- no_ranef_dim</pre> + </td> + </tr> + <tr class="never"> + <td class="num">154</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">155</td> + <td class="coverage">121<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> no_ranef <- no_random_effect</pre> + </td> + </tr> + <tr class="never"> + <td class="num">156</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">157</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">158</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">159</td> + <td class="coverage">375<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit_function <- function(fit_index) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">160</td> + <td class="coverage">12<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> w <- which(fit_indices == fit_index, arr.ind = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">161</td> + <td class="coverage">12<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> deg_index <- w[1]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">162</td> + <td class="coverage">12<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> error_index <- w[2]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">163</td> + <td class="coverage">12<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mmkin_row <- objects[[error_index]][deg_index, ]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">164</td> + <td class="coverage">12<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res <- try(do.call(backend_function,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">165</td> + <td class="coverage">12<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> args = c(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">166</td> + <td class="coverage">12<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> list(mmkin_row),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">167</td> + <td class="coverage">12<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dot_args,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">168</td> + <td class="coverage">12<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> list(no_random_effect = no_ranef[[deg_index, error_index]]))))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">169</td> + <td class="coverage">12<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(res)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">170</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">171</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">172</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">173</td> + <td class="coverage">375<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit_time <- system.time({</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">174</td> + <td class="coverage">375<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.null(cluster)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">175</td> + <td class="coverage">375<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> results <- parallel::mclapply(as.list(1:n.fits), fit_function,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">176</td> + <td class="coverage">375<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mc.cores = cores, mc.preschedule = FALSE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">177</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">178</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> results <- parallel::parLapply(cluster, as.list(1:n.fits), fit_function)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">179</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">180</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> })</pre> + </td> + </tr> + <tr class="never"> + <td class="num">181</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">182</td> + <td class="coverage">363<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> attributes(results) <- attributes(fit_indices)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">183</td> + <td class="coverage">363<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> attr(results, "call") <- call</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">184</td> + <td class="coverage">363<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> attr(results, "time") <- fit_time</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">185</td> + <td class="coverage">363<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(results) <- switch(backend,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">186</td> + <td class="coverage">363<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> saemix = c("mhmkin.saem.mmkin", "mhmkin")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">187</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> )</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">188</td> + <td class="coverage">363<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(results)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">189</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">190</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">191</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Subsetting method for mhmkin objects</pre> + </td> + </tr> + <tr class="never"> + <td class="num">192</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">193</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param x An [mhmkin] object.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">194</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param i Row index selecting the fits for specific models</pre> + </td> + </tr> + <tr class="never"> + <td class="num">195</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param j Column index selecting the fits to specific datasets</pre> + </td> + </tr> + <tr class="never"> + <td class="num">196</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param drop If FALSE, the method always returns an mhmkin object, otherwise</pre> + </td> + </tr> + <tr class="never"> + <td class="num">197</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' either a list of fit objects or a single fit object.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">198</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return An object inheriting from \code{\link{mhmkin}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">199</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname mhmkin</pre> + </td> + </tr> + <tr class="never"> + <td class="num">200</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">201</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">`[.mhmkin` <- function(x, i, j, ..., drop = FALSE) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">202</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> original_class <- class(x)</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">203</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> class(x) <- NULL</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">204</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> x_sub <- x[i, j, drop = drop]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">205</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="missed"> + <td class="num">206</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (!drop) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">207</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> class(x_sub) <- original_class</pre> + </td> + </tr> + <tr class="never"> + <td class="num">208</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">209</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> return(x_sub)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">210</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">211</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">212</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Print method for mhmkin objects</pre> + </td> + </tr> + <tr class="never"> + <td class="num">213</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">214</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname mhmkin</pre> + </td> + </tr> + <tr class="never"> + <td class="num">215</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">216</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">print.mhmkin <- function(x, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">217</td> + <td class="coverage">125<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("<mhmkin> object\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">218</td> + <td class="coverage">125<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("Status of individual fits:\n\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">219</td> + <td class="coverage">125<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(status(x))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">220</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">221</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">222</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Check if fit within an mhmkin object failed</pre> + </td> + </tr> + <tr class="never"> + <td class="num">223</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param x The object to be checked</pre> + </td> + </tr> + <tr class="never"> + <td class="num">224</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">check_failed <- function(x) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">225</td> + <td class="coverage">1936<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (inherits(x, "try-error")) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">226</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> return(TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">227</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">228</td> + <td class="coverage">1936<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (inherits(x$so, "try-error")) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">229</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> return(TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">230</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">231</td> + <td class="coverage">1936<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(FALSE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">232</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">233</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">234</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">235</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">236</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">237</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">AIC.mhmkin <- function(object, ..., k = 2) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">238</td> + <td class="coverage">125<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res <- sapply(object, function(x) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">239</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (check_failed(x)) return(NA)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">240</td> + <td class="coverage">500<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> else return(AIC(x$so, k = k))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">241</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> })</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">242</td> + <td class="coverage">125<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dim(res) <- dim(object)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">243</td> + <td class="coverage">125<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dimnames(res) <- dimnames(object)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">244</td> + <td class="coverage">125<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(res)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">245</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">246</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">247</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">248</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">BIC.mhmkin <- function(object, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">249</td> + <td class="coverage">125<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res <- sapply(object, function(x) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">250</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (check_failed(x)) return(NA)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">251</td> + <td class="coverage">500<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> else return(BIC(x$so))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">252</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> })</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">253</td> + <td class="coverage">125<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dim(res) <- dim(object)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">254</td> + <td class="coverage">125<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dimnames(res) <- dimnames(object)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">255</td> + <td class="coverage">125<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(res)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">256</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">257</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">258</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">259</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">update.mhmkin <- function(object, ..., evaluate = TRUE) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">260</td> + <td class="coverage">246<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> call <- attr(object, "call")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">261</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # For some reason we get mhkin.list in call[[1]] when using mhmkin from the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">262</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # loaded package so we need to fix this so we do not have to export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">263</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # mhmkin.list in addition to the S3 method mhmkin</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">264</td> + <td class="coverage">246<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> call[[1]] <- mhmkin</pre> + </td> + </tr> + <tr class="never"> + <td class="num">265</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">266</td> + <td class="coverage">246<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> update_arguments <- match.call(expand.dots = FALSE)$...</pre> + </td> + </tr> + <tr class="never"> + <td class="num">267</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">268</td> + <td class="coverage">246<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(update_arguments) > 0) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">269</td> + <td class="coverage">246<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> update_arguments_in_call <- !is.na(match(names(update_arguments), names(call)))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">270</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">271</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">272</td> + <td class="coverage">246<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (a in names(update_arguments)[update_arguments_in_call]) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">273</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> call[[a]] <- update_arguments[[a]]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">274</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">275</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">276</td> + <td class="coverage">246<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> update_arguments_not_in_call <- !update_arguments_in_call</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">277</td> + <td class="coverage">246<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(any(update_arguments_not_in_call)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">278</td> + <td class="coverage">246<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> call <- c(as.list(call), update_arguments[update_arguments_not_in_call])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">279</td> + <td class="coverage">246<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> call <- as.call(call)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">280</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">281</td> + <td class="coverage">246<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(evaluate) eval(call, parent.frame())</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">282</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> else call</pre> + </td> + </tr> + <tr class="never"> + <td class="num">283</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">284</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">285</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">286</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">anova.mhmkin <- function(object, ...,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">287</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> method = c("is", "lin", "gq"), test = FALSE, model.names = "auto") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">288</td> + <td class="coverage">234<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (identical(model.names, "auto")) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">289</td> + <td class="coverage">234<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> model.names <- outer(rownames(object), colnames(object), paste)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">290</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">291</td> + <td class="coverage">234<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> failed_index <- which(sapply(object, check_failed), arr.ind = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">292</td> + <td class="coverage">234<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(failed_index > 0)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">293</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> rlang::inject(anova(!!!(object[-failed_index]), method = method, test = test,</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">294</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> model.names = model.names[-failed_index]))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">295</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">296</td> + <td class="coverage">234<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rlang::inject(anova(!!!(object), method = method, test = test,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">297</td> + <td class="coverage">234<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> model.names = model.names))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">298</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">299</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">300</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/nafta.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Evaluate parent kinetics using the NAFTA guidance</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' The function fits the SFO, IORE and DFOP models using \code{\link{mmkin}}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' and returns an object of class \code{nafta} that has methods for printing</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' and plotting.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param ds A dataframe that must contain one variable called "time" with the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' time values specified by the \code{time} argument, one column called</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' "name" with the grouping of the observed values, and finally one column of</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' observed values called "value".</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param title Optional title of the dataset</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param quiet Should the evaluation text be shown?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots Further arguments passed to \code{\link{mmkin}} (not for the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' printing method).</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom stats qf</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return An list of class \code{nafta}. The list element named "mmkin" is the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \code{\link{mmkin}} object containing the fits of the three models. The</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' list element named "title" contains the title of the dataset used. The</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' list element "data" contains the dataset used in the fits.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @author Johannes Ranke</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @source NAFTA (2011) Guidance for evaluating and calculating degradation</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' kinetics in environmental media. NAFTA Technical Working Group on</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Pesticides</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \url{https://www.epa.gov/pesticide-science-and-assessing-pesticide-risks/guidance-evaluating-and-calculating-degradation}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' accessed 2019-02-22</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' US EPA (2015) Standard Operating Procedure for Using the NAFTA Guidance to</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Calculate Representative Half-life Values and Characterizing Pesticide</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Degradation</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \url{https://www.epa.gov/pesticide-science-and-assessing-pesticide-risks/standard-operating-procedure-using-nafta-guidance}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' nafta_evaluation <- nafta(NAFTA_SOP_Appendix_D, cores = 1)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' print(nafta_evaluation)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(nafta_evaluation)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">nafta <- function(ds, title = NA, quiet = FALSE, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">39</td> + <td class="coverage">264<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(levels(ds$name)) > 1) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">40</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> stop("The NAFTA procedure is only defined for decline data for a single compound")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">42</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n <- nrow(subset(ds, !is.na(value)))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">43</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> models <- c("SFO", "IORE", "DFOP")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">45</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> result <- list(title = title, data = ds)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">46</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> result$mmkin <- mmkin(models, list(ds), quiet = TRUE, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">47</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">48</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> distimes <- lapply(result$mmkin, function(x) as.numeric(endpoints(x)$distimes["parent", ]))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">50</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> result$distimes <- matrix(NA, nrow = 3, ncol = 3,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">51</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dimnames = list(models, c("DT50", "DT90", "DT50_rep")))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">52</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> result$distimes["SFO", ] <- distimes[[1]][c(1, 2, 1)]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">53</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> result$distimes["IORE", ] <- distimes[[2]][c(1, 2, 3)]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">54</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> result$distimes["DFOP", ] <- distimes[[3]][c(1, 2, 5)]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">55</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Get parameters with statistics</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">57</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> result$parameters <- lapply(result$mmkin, function(x) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">58</td> + <td class="coverage">528<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> summary(x)$bpar[, c(1, 4:6)]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> })</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">60</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(result$parameters) <- models</pre> + </td> + </tr> + <tr class="never"> + <td class="num">61</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">62</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Compare the sum of squared residuals (SSR) to the upper bound of the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">63</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # confidence region of the SSR for the IORE model</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">64</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> result$S <- sapply(result$mmkin, function(x) sum(x$data$residual^2))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">65</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(result$S) <- c("SFO", "IORE", "DFOP")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">66</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Equation (3) on p. 3</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">67</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> p <- 3</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">68</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> result$S["IORE"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">69</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> result$S_c <- result$S[["IORE"]] * (1 + p/(n - p) * qf(0.5, p, n - p))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">70</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">71</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> result$t_rep <- .evaluate_nafta_results(result$S, result$S_c,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">72</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> result$distimes, quiet = quiet)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">73</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">74</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(result) <- "nafta"</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">75</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(result)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">76</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">77</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">78</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Plot the results of the three models used in the NAFTA scheme.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">79</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">80</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' The plots are ordered with increasing complexity of the model in this</pre> + </td> + </tr> + <tr class="never"> + <td class="num">81</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' function (SFO, then IORE, then DFOP).</pre> + </td> + </tr> + <tr class="never"> + <td class="num">82</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">83</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Calls \code{\link{plot.mmkin}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">84</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">85</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param x An object of class \code{\link{nafta}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">86</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param legend Should a legend be added?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">87</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param main Possibility to override the main title of the plot.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">88</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots Further arguments passed to \code{\link{plot.mmkin}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">89</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return The function is called for its side effect.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">90</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @author Johannes Ranke</pre> + </td> + </tr> + <tr class="never"> + <td class="num">91</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">92</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">plot.nafta <- function(x, legend = FALSE, main = "auto", ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">93</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (main == "auto") {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">94</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.na(x$title)) main = ""</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">95</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> else main = x$title</pre> + </td> + </tr> + <tr class="never"> + <td class="num">96</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">97</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> plot(x$mmkin, ..., legend = legend, main = main)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">98</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">99</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">100</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Print nafta objects</pre> + </td> + </tr> + <tr class="never"> + <td class="num">101</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">102</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Print nafta objects. The results for the three models are printed in the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">103</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' order of increasing model complexity, i.e. SFO, then IORE, and finally DFOP.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">104</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">105</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param x An \code{\link{nafta}} object.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">106</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param digits Number of digits to be used for printing parameters and</pre> + </td> + </tr> + <tr class="never"> + <td class="num">107</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' dissipation times.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">108</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname nafta</pre> + </td> + </tr> + <tr class="never"> + <td class="num">109</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">110</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">print.nafta <- function(x, quiet = TRUE, digits = 3, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">111</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("Sums of squares:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">112</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(x$S)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">113</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nCritical sum of squares for checking the SFO model:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">114</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(x$S_c)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">115</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nParameters:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">116</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(x$parameters, digits = digits)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">117</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> t_rep <- .evaluate_nafta_results(x$S, x$S_c, x$distimes, quiet = quiet)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">118</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nDTx values:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">119</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(signif(x$distimes, digits = digits))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">120</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nRepresentative half-life:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">121</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(round(t_rep, 2))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">122</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">123</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">124</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">.evaluate_nafta_results <- function(S, S_c, distimes, quiet = FALSE) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">125</td> + <td class="coverage">352<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> t_SFO <- distimes["IORE", "DT50"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">126</td> + <td class="coverage">352<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> t_IORE <- distimes["IORE", "DT50_rep"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">127</td> + <td class="coverage">352<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> t_DFOP2 <- distimes["DFOP", "DT50_rep"]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">128</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">129</td> + <td class="coverage">352<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (S["SFO"] < S_c) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">130</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (!quiet) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">131</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> message("S_SFO is lower than the critical value S_c, use the SFO model")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">132</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">133</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> t_rep <- t_SFO</pre> + </td> + </tr> + <tr class="never"> + <td class="num">134</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">135</td> + <td class="coverage">352<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!quiet) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">136</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> message("The SFO model is rejected as S_SFO is equal or higher than the critical value S_c")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">137</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">138</td> + <td class="coverage">352<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (t_IORE < t_DFOP2) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">139</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!quiet) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">140</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> message("The half-life obtained from the IORE model may be used")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">141</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">142</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> t_rep <- t_IORE</pre> + </td> + </tr> + <tr class="never"> + <td class="num">143</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">144</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!quiet) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">145</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> message("The representative half-life of the IORE model is longer than the one corresponding")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">146</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> message("to the terminal degradation rate found with the DFOP model.")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">147</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> message("The representative half-life obtained from the DFOP model may be used")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">148</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">149</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> t_rep <- t_DFOP2</pre> + </td> + </tr> + <tr class="never"> + <td class="num">150</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">151</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">152</td> + <td class="coverage">352<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(t_rep)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">153</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/summary.nlme.mmkin.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Summary method for class "nlme.mmkin"</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Lists model equations, initial parameter values, optimised parameters</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' for fixed effects (population), random effects (deviations from the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' population mean) and residual error model, as well as the resulting</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' endpoints such as formation fractions and DT50 values. Optionally</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' (default is FALSE), the data are listed in full.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param object an object of class [nlme.mmkin]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param x an object of class [summary.nlme.mmkin]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param data logical, indicating whether the full data should be included in</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the summary.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param verbose Should the summary be verbose?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param distimes logical, indicating whether DT50 and DT90 values should be</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' included.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param alpha error level for confidence interval estimation from the t</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' distribution</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param digits Number of digits to use for printing</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots optional arguments passed to methods like \code{print}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return The summary function returns a list based on the [nlme] object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' obtained in the fit, with at least the following additional components</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{nlmeversion, mkinversion, Rversion}{The nlme, mkin and R versions used}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{date.fit, date.summary}{The dates where the fit and the summary were</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' produced}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{diffs}{The differential equations used in the degradation model}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{use_of_ff}{Was maximum or minimum use made of formation fractions}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{data}{The data}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{confint_trans}{Transformed parameters as used in the optimisation, with confidence intervals}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{confint_back}{Backtransformed parameters, with confidence intervals if available}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{ff}{The estimated formation fractions derived from the fitted</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' model.}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{distimes}{The DT50 and DT90 values for each observed variable.}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{SFORB}{If applicable, eigenvalues of SFORB components of the model.}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' The print method is called for its side effect, i.e. printing the summary.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom stats predict</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @author Johannes Ranke for the mkin specific parts</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' José Pinheiro and Douglas Bates for the components inherited from nlme</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Generate five datasets following SFO kinetics</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' sampling_times = c(0, 1, 3, 7, 14, 28, 60, 90, 120)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' dt50_sfo_in_pop <- 50</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' k_in_pop <- log(2) / dt50_sfo_in_pop</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' set.seed(1234)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' k_in <- rlnorm(5, log(k_in_pop), 0.5)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' SFO <- mkinmod(parent = mkinsub("SFO"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">47</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' pred_sfo <- function(k) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' mkinpredict(SFO,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' c(k_parent = k),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' c(parent = 100),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' sampling_times)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">54</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">55</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ds_sfo_mean <- lapply(k_in, pred_sfo)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' names(ds_sfo_mean) <- paste("ds", 1:5)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">57</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' set.seed(12345)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ds_sfo_syn <- lapply(ds_sfo_mean, function(ds) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">60</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' add_err(ds,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">61</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' sdfunc = function(value) sqrt(1^2 + value^2 * 0.07^2),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">62</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' n = 1)[[1]]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">63</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' })</pre> + </td> + </tr> + <tr class="never"> + <td class="num">64</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">65</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">66</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Evaluate using mmkin and nlme</pre> + </td> + </tr> + <tr class="never"> + <td class="num">67</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' library(nlme)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">68</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_mmkin <- mmkin("SFO", ds_sfo_syn, quiet = TRUE, error_model = "tc", cores = 1)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">69</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_nlme <- nlme(f_mmkin)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">70</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' summary(f_nlme, data = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">71</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">72</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">73</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">74</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">summary.nlme.mmkin <- function(object, data = FALSE, verbose = FALSE, distimes = TRUE, alpha = 0.05, ...) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">75</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">76</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mod_vars <- names(object$mkinmod$diffs)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">77</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">78</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> confint_trans <- intervals(object, which = "fixed", level = 1 - alpha)$fixed</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">79</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> attr(confint_trans, "label") <- NULL</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">80</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> pnames <- rownames(confint_trans)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">81</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">82</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> bp <- backtransform_odeparms(confint_trans[, "est."], object$mkinmod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">83</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$transform_rates, object$transform_fractions)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">84</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> bpnames <- names(bp)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">85</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">86</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # variance-covariance estimates for fixed effects (from summary.lme)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">87</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fixed <- fixef(object)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">88</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> stdFixed <- sqrt(diag(as.matrix(object$varFix)))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">89</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$corFixed <- array(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">90</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> t(object$varFix/stdFixed)/stdFixed,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">91</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dim(object$varFix),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">92</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> list(names(fixed), names(fixed)))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">93</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">94</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Transform boundaries of CI for one parameter at a time,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">95</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # with the exception of sets of formation fractions (single fractions are OK).</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">96</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f_names_skip <- character(0)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">97</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (box in mod_vars) { # Figure out sets of fractions to skip</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">98</td> + <td class="coverage">436<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f_names <- grep(paste("^f", box, sep = "_"), pnames, value = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">99</td> + <td class="coverage">436<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n_paths <- length(f_names)</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">100</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (n_paths > 1) f_names_skip <- c(f_names_skip, f_names)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">101</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">102</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">103</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> confint_back <- matrix(NA, nrow = length(bp), ncol = 3,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">104</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dimnames = list(bpnames, colnames(confint_trans)))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">105</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> confint_back[, "est."] <- bp</pre> + </td> + </tr> + <tr class="never"> + <td class="num">106</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">107</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (pname in pnames) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">108</td> + <td class="coverage">1410<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!pname %in% f_names_skip) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">109</td> + <td class="coverage">1410<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> par.lower <- confint_trans[pname, "lower"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">110</td> + <td class="coverage">1410<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> par.upper <- confint_trans[pname, "upper"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">111</td> + <td class="coverage">1410<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(par.lower) <- names(par.upper) <- pname</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">112</td> + <td class="coverage">1410<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> bpl <- backtransform_odeparms(par.lower, object$mkinmod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">113</td> + <td class="coverage">1410<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$transform_rates,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">114</td> + <td class="coverage">1410<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$transform_fractions)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">115</td> + <td class="coverage">1410<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> bpu <- backtransform_odeparms(par.upper, object$mkinmod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">116</td> + <td class="coverage">1410<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$transform_rates,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">117</td> + <td class="coverage">1410<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$transform_fractions)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">118</td> + <td class="coverage">1410<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> confint_back[names(bpl), "lower"] <- bpl</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">119</td> + <td class="coverage">1410<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> confint_back[names(bpu), "upper"] <- bpu</pre> + </td> + </tr> + <tr class="never"> + <td class="num">120</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">121</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">122</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">123</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$confint_trans <- confint_trans</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">124</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$confint_back <- confint_back</pre> + </td> + </tr> + <tr class="never"> + <td class="num">125</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">126</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$date.summary = date()</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">127</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$use_of_ff = object$mkinmod$use_of_ff</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">128</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$error_model_algorithm = object$mmkin[[1]]$error_model_algorithm</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">129</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> err_mod = object$mmkin[[1]]$err_mod</pre> + </td> + </tr> + <tr class="never"> + <td class="num">130</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">131</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$diffs <- object$mkinmod$diffs</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">132</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$print_data <- data</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">133</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$data[["observed"]] <- object$data[["value"]]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">134</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$data[["value"]] <- NULL</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">135</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$data[["predicted"]] <- predict(object)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">136</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$data[["residual"]] <- residuals(object, type = "response")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">137</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.null(object$modelStruct$varStruct)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">138</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> object$data[["std"]] <- object$sigma</pre> + </td> + </tr> + <tr class="never"> + <td class="num">139</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">140</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$data[["std"]] <- 1/attr(object$modelStruct$varStruct, "weights")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">141</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">142</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$data[["standardized"]] <- residuals(object, type = "pearson")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">143</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$verbose <- verbose</pre> + </td> + </tr> + <tr class="never"> + <td class="num">144</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">145</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$fixed <- object$mmkin[[1]]$fixed</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">146</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$AIC = AIC(object)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">147</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$BIC = BIC(object)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">148</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$logLik = logLik(object)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">149</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">150</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ep <- endpoints(object)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">151</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(ep$ff) != 0)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">152</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$ff <- ep$ff</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">153</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (distimes) object$distimes <- ep$distimes</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">154</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(ep$SFORB) != 0) object$SFORB <- ep$SFORB</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">155</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(object) <- c("summary.nlme.mmkin", "nlme.mmkin", "nlme", "lme")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">156</td> + <td class="coverage">319<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(object)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">157</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">158</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">159</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname summary.nlme.mmkin</pre> + </td> + </tr> + <tr class="never"> + <td class="num">160</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">161</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">print.summary.nlme.mmkin <- function(x, digits = max(3, getOption("digits") - 3), verbose = x$verbose, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">162</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("nlme version used for fitting: ", x$nlmeversion, "\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">163</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("mkin version used for pre-fitting: ", x$mkinversion, "\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">164</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("R version used for fitting: ", x$Rversion, "\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">165</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">166</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("Date of fit: ", x$date.fit, "\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">167</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("Date of summary:", x$date.summary, "\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">168</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">169</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nEquations:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">170</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> nice_diffs <- gsub("^(d.*) =", "\\1/dt =", x[["diffs"]])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">171</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> writeLines(strwrap(nice_diffs, exdent = 11))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">172</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">173</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nData:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">174</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat(nrow(x$data), "observations of",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">175</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> length(unique(x$data$name)), "variable(s) grouped in",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">176</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> length(unique(x$data$ds)), "datasets\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">177</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">178</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nModel predictions using solution type", x$solution_type, "\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">179</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">180</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nFitted in", x$time[["elapsed"]], "s using", x$numIter, "iterations\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">181</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">182</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nVariance model: ")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">183</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat(switch(x$err_mod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">184</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> const = "Constant variance",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">185</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> obs = "Variance unique to each observed variable",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">186</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> tc = "Two-component variance function"), "\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">187</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">188</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nMean of starting values for individual parameters:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">189</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(x$mean_dp_start, digits = digits)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">190</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">191</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nFixed degradation parameter values:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">192</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(length(x$fixed$value) == 0) cat("None\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">193</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> else print(x$fixed, digits = digits)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">194</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">195</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nResults:\n\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">196</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(data.frame(AIC = x$AIC, BIC = x$BIC, logLik = x$logLik,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">197</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> row.names = " "), digits = digits, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">198</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">199</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nOptimised, transformed parameters with symmetric confidence intervals:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">200</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(x$confint_trans, digits = digits, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">201</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">202</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (nrow(x$confint_trans) > 1) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">203</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> corr <- x$corFixed</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">204</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(corr) <- "correlation"</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">205</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(corr, title = "\nCorrelation:", rdig = digits, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">206</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">207</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">208</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\n") # Random effects</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">209</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(summary(x$modelStruct), sigma = x$sigma,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">210</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> reEstimates = x$coef$random, digits = digits, verbose = verbose, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">211</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">212</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nBacktransformed parameters with asymmetric confidence intervals:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">213</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(x$confint_back, digits = digits, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">214</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">215</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">216</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> printSFORB <- !is.null(x$SFORB)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">217</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(printSFORB){</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">218</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nEstimated Eigenvalues of SFORB model(s):\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">219</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> print(x$SFORB, digits = digits,...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">220</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">221</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">222</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> printff <- !is.null(x$ff)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">223</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(printff){</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">224</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nResulting formation fractions:\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">225</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> print(data.frame(ff = x$ff), digits = digits, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">226</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">227</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">228</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> printdistimes <- !is.null(x$distimes)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">229</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(printdistimes){</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">230</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nEstimated disappearance times:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">231</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(x$distimes, digits = digits, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">232</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">233</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">234</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (x$print_data){</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">235</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nData:\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">236</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> print(format(x$data, digits = digits, ...), row.names = FALSE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">237</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">238</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">239</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> invisible(x)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">240</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/mkinerrplot.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">utils::globalVariables(c("variable", "residual"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Function to plot squared residuals and the error model for an mkin object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' This function plots the squared residuals for the specified subset of the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' observed variables from an mkinfit object. In addition, one or more dashed</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' line(s) show the fitted error model. A combined plot of the fitted model</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' and this error model plot can be obtained with \code{\link{plot.mkinfit}}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' using the argument \code{show_errplot = TRUE}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param object A fit represented in an \code{\link{mkinfit}} object.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param obs_vars A character vector of names of the observed variables for</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' which residuals should be plotted. Defaults to all observed variables in</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the model</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param xlim plot range in x direction.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param xlab Label for the x axis.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param ylab Label for the y axis.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param maxy Maximum value of the residuals. This is used for the scaling of</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the y axis and defaults to "auto".</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param legend Should a legend be plotted?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param lpos Where should the legend be placed? Default is "topright". Will</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' be passed on to \code{\link{legend}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param col_obs Colors for the observed variables.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param pch_obs Symbols to be used for the observed variables.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param frame Should a frame be drawn around the plots?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots further arguments passed to \code{\link{plot}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return Nothing is returned by this function, as it is called for its side</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' effect, namely to produce a plot.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @author Johannes Ranke</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @seealso \code{\link{mkinplot}}, for a way to plot the data and the fitted</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' lines of the mkinfit object.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @keywords hplot</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' model <- mkinmod(parent = mkinsub("SFO", "m1"), m1 = mkinsub("SFO"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit <- mkinfit(model, FOCUS_2006_D, error_model = "tc", quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' mkinerrplot(fit)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">mkinerrplot <- function (object,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> obs_vars = names(object$mkinmod$map),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> xlim = c(0, 1.1 * max(object$data$predicted)),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> xlab = "Predicted", ylab = "Squared residual",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> maxy = "auto", legend= TRUE, lpos = "topright",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">47</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> col_obs = "auto", pch_obs = "auto",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> frame = TRUE,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">51</td> + <td class="coverage">275<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> obs_vars_all <- as.character(unique(object$data$variable))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">53</td> + <td class="coverage">275<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(obs_vars) > 0){</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">54</td> + <td class="coverage">275<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> obs_vars <- intersect(obs_vars_all, obs_vars)</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">55</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> } else obs_vars <- obs_vars_all</pre> + </td> + </tr> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">57</td> + <td class="coverage">275<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> residuals <- subset(object$data, variable %in% obs_vars, residual)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">59</td> + <td class="coverage">275<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (maxy == "auto") maxy = max(residuals^2, na.rm = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">60</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">61</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Set colors and symbols</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">62</td> + <td class="coverage">275<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (col_obs[1] == "auto") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">63</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> col_obs <- 1:length(obs_vars)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">64</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">65</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">66</td> + <td class="coverage">275<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (pch_obs[1] == "auto") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">67</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> pch_obs <- 1:length(obs_vars)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">68</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">69</td> + <td class="coverage">275<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(col_obs) <- names(pch_obs) <- obs_vars</pre> + </td> + </tr> + <tr class="never"> + <td class="num">70</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">71</td> + <td class="coverage">275<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> plot(0, type = "n",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">72</td> + <td class="coverage">275<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> xlab = xlab, ylab = ylab,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">73</td> + <td class="coverage">275<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> xlim = xlim,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">74</td> + <td class="coverage">275<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ylim = c(0, 1.2 * maxy), frame = frame, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">75</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">76</td> + <td class="coverage">275<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for(obs_var in obs_vars){</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">77</td> + <td class="coverage">410<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> residuals_plot <- subset(object$data, variable == obs_var, c("predicted", "residual"))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">78</td> + <td class="coverage">410<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> points(residuals_plot[["predicted"]],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">79</td> + <td class="coverage">410<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> residuals_plot[["residual"]]^2,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">80</td> + <td class="coverage">410<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> pch = pch_obs[obs_var], col = col_obs[obs_var])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">81</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">82</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">83</td> + <td class="coverage">275<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (object$err_mod == "const") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">84</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> abline(h = object$errparms^2, lty = 2, col = 1)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">85</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">86</td> + <td class="coverage">275<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (object$err_mod == "obs") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">87</td> + <td class="coverage">65<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (obs_var in obs_vars) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">88</td> + <td class="coverage">130<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> sigma_name = paste0("sigma_", obs_var)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">89</td> + <td class="coverage">130<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> abline(h = object$errparms[sigma_name]^2, lty = 2,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">90</td> + <td class="coverage">130<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> col = col_obs[obs_var])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">91</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">92</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">93</td> + <td class="coverage">275<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (object$err_mod == "tc") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">94</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> sigma_plot <- function(predicted) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">95</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> sigma_twocomp(predicted,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">96</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> sigma_low = object$errparms[1],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">97</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rsd_high = object$errparms[2])^2</pre> + </td> + </tr> + <tr class="never"> + <td class="num">98</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">99</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> plot(sigma_plot, from = 0, to = max(object$data$predicted),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">100</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> add = TRUE, lty = 2, col = 1)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">101</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">102</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">103</td> + <td class="coverage">275<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (legend == TRUE) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">104</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> legend(lpos, inset = c(0.05, 0.05), legend = obs_vars,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">105</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> col = col_obs[obs_vars], pch = pch_obs[obs_vars])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">106</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">107</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/parplot.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Plot parameter variability of multistart objects</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Produces a boxplot with all parameters from the multiple runs, scaled</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' either by the parameters of the run with the highest likelihood,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' or by their medians as proposed in the paper by Duchesne et al. (2021).</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Starting values of degradation model parameters and error model parameters</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' are shown as green circles. The results obtained in the original run</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' are shown as red circles.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param object The [multistart] object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param llmin The minimum likelihood of objects to be shown</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param llquant Fractional value for selecting only the fits with higher</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' likelihoods. Overrides 'llmin'.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param scale By default, scale parameters using the best</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' available fit.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' If 'median', parameters are scaled using the median parameters from all fits.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param main Title of the plot</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param lpos Positioning of the legend.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots Passed to [boxplot]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @references Duchesne R, Guillemin A, Gandrillon O, Crauste F. Practical</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' identifiability in the frame of nonlinear mixed effects models: the example</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' of the in vitro erythropoiesis. BMC Bioinformatics. 2021 Oct 4;22(1):478.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' doi: 10.1186/s12859-021-04373-4.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @seealso [multistart]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom stats median quantile</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">parplot <- function(object, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">29</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> UseMethod("parplot")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname parplot</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">parplot.multistart.saem.mmkin <- function(object, llmin = -Inf, llquant = NA,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> scale = c("best", "median"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> lpos = "bottomleft", main = "", ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">38</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> oldpar <- par(no.readonly = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">39</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> on.exit(par(oldpar, no.readonly = TRUE))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">41</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> orig <- attr(object, "orig")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">42</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> orig_parms <- parms(orig)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">43</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> start_degparms <- orig$mean_dp_start</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">44</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> all_parms <- parms(object, exclude_failed = FALSE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">46</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (inherits(object, "multistart.saem.mmkin")) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">47</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> llfunc <- function(object) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">48</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (inherits(object$so, "try-error")) return(NA)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">49</td> + <td class="coverage">1408<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> else return(logLik(object$so))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">52</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> stop("parplot is only implemented for multistart.saem.mmkin objects")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">54</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ll <- sapply(object, llfunc)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">55</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.na(llquant[1])) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">56</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (llmin != -Inf) warning("Overriding 'llmin' because 'llquant' was specified")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">57</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> llmin <- quantile(ll, 1 - llquant)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">59</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> selected <- which(ll > llmin)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">60</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> selected_parms <- all_parms[selected, ]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">61</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">62</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> par(las = 1)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">63</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (orig$transformations == "mkin") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">64</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparm_names_transformed <- names(start_degparms)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">65</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparm_index <- which(names(orig_parms) %in% degparm_names_transformed)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">66</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> orig_parms[degparm_names_transformed] <- backtransform_odeparms(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">67</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> orig_parms[degparm_names_transformed],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">68</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> orig$mmkin[[1]]$mkinmod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">69</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_rates = orig$mmkin[[1]]$transform_rates,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">70</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_fractions = orig$mmkin[[1]]$transform_fractions)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">71</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> start_degparms <- backtransform_odeparms(start_degparms,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">72</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> orig$mmkin[[1]]$mkinmod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">73</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_rates = orig$mmkin[[1]]$transform_rates,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">74</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_fractions = orig$mmkin[[1]]$transform_fractions)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">75</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparm_names <- names(start_degparms)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">76</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">77</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(orig_parms) <- c(degparm_names, names(orig_parms[-degparm_index]))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">78</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">79</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> selected_parms[, degparm_names_transformed] <-</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">80</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> t(apply(selected_parms[, degparm_names_transformed], 1, backtransform_odeparms,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">81</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> orig$mmkin[[1]]$mkinmod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">82</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_rates = orig$mmkin[[1]]$transform_rates,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">83</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_fractions = orig$mmkin[[1]]$transform_fractions))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">84</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> colnames(selected_parms)[1:length(degparm_names)] <- degparm_names</pre> + </td> + </tr> + <tr class="never"> + <td class="num">85</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">86</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">87</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> start_errparms <- orig$so@model@error.init</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">88</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(start_errparms) <- orig$so@model@name.sigma</pre> + </td> + </tr> + <tr class="never"> + <td class="num">89</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">90</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> start_omegaparms <- orig$so@model@omega.init</pre> + </td> + </tr> + <tr class="never"> + <td class="num">91</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">92</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> start_parms <- c(start_degparms, start_errparms)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">93</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">94</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> scale <- match.arg(scale)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">95</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parm_scale <- switch(scale,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">96</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> best = selected_parms[which.best(object[selected]), ],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">97</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> median = apply(selected_parms, 2, median)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">98</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> )</pre> + </td> + </tr> + <tr class="never"> + <td class="num">99</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">100</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Boxplots of all scaled parameters</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">101</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> selected_scaled_parms <- t(apply(selected_parms, 1, function(x) x / parm_scale))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">102</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> boxplot(selected_scaled_parms, log = "y", main = main, ,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">103</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ylab = "Normalised parameters", ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">104</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">105</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Show starting parameters</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">106</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> start_scaled_parms <- rep(NA_real_, length(orig_parms))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">107</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(start_scaled_parms) <- names(orig_parms)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">108</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> start_scaled_parms[names(start_parms)] <-</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">109</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> start_parms / parm_scale[names(start_parms)]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">110</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> points(start_scaled_parms, col = 3, cex = 3)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">111</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">112</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Show parameters of original run</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">113</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> orig_scaled_parms <- orig_parms / parm_scale</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">114</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> points(orig_scaled_parms, col = 2, cex = 2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">115</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">116</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> abline(h = 1, lty = 2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">117</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">118</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> legend(lpos, inset = c(0.05, 0.05), bty = "n",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">119</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> pch = 1, col = 3:1, lty = c(NA, NA, 1),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">120</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> legend = c(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">121</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "Original start",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">122</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "Original results",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">123</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "Multistart runs"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">124</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/plot.mixed.mmkin.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">utils::globalVariables("ds")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Plot predictions from a fitted nonlinear mixed model obtained via an mmkin row object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param x An object of class [mixed.mmkin], [saem.mmkin] or [nlme.mmkin]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param i A numeric index to select datasets for which to plot the individual predictions,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' in case plots get too large</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @inheritParams plot.mkinfit</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param standardized Should the residuals be standardized? Only takes effect if</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' `resplot = "time"`.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param pop_curves Per default, one population curve is drawn in case</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' population parameters are fitted by the model, e.g. for saem objects.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' In case there is a covariate model, the behaviour depends on the value</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' of 'covariates'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param covariates Data frame with covariate values for all variables in</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' any covariate models in the object. If given, it overrides 'covariate_quantiles'.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Each line in the data frame will result in a line drawn for the population.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Rownames are used in the legend to label the lines.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param covariate_quantiles This argument only has an effect if the fitted</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' object has covariate models. If so, the default is to show three population</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' curves, for the 5th percentile, the 50th percentile and the 95th percentile</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' of the covariate values used for fitting the model.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @note Covariate models are currently only supported for saem.mmkin objects.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param pred_over Named list of alternative predictions as obtained</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' from [mkinpredict] with a compatible [mkinmod].</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param test_log_parms Passed to [mean_degparms] in the case of an</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' [mixed.mmkin] object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param conf.level Passed to [mean_degparms] in the case of an</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' [mixed.mmkin] object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param default_log_parms Passed to [mean_degparms] in the case of an</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' [mixed.mmkin] object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param rel.height.legend The relative height of the legend shown on top</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param rel.height.bottom The relative height of the bottom plot row</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param ymax Vector of maximum y axis values</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param ncol.legend Number of columns to use in the legend</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param nrow.legend Number of rows to use in the legend</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param resplot Should the residuals plotted against time or against</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' predicted values?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param col_ds Colors used for plotting the observed data and the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' corresponding model prediction lines for the different datasets.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param pch_ds Symbols to be used for plotting the data.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param lty_ds Line types to be used for the model predictions.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom stats coefficients</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return The function is called for its side effect.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @author Johannes Ranke</pre> + </td> + </tr> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">47</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ds <- lapply(experimental_data_for_UBA_2019[6:10],</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' function(x) x$data[c("name", "time", "value")])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' names(ds) <- paste0("ds ", 6:10)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' dfop_sfo <- mkinmod(parent = mkinsub("DFOP", "A1"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' A1 = mkinsub("SFO"), quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f <- mmkin(list("DFOP-SFO" = dfop_sfo), ds, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">54</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(f[, 3:4], standardized = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">55</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # For this fit we need to increase pnlsMaxiter, and we increase the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">57</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # tolerance in order to speed up the fit for this example evaluation</pre> + </td> + </tr> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # It still takes 20 seconds to run</pre> + </td> + </tr> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_nlme <- nlme(f, control = list(pnlsMaxIter = 120, tolerance = 1e-3))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">60</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(f_nlme)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">61</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">62</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_saem <- saem(f, transformations = "saemix")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">63</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(f_saem)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">64</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">65</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_obs <- mmkin(list("DFOP-SFO" = dfop_sfo), ds, quiet = TRUE, error_model = "obs")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">66</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_nlmix <- nlmix(f_obs)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">67</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(f_nlmix)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">68</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">69</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # We can overlay the two variants if we generate predictions</pre> + </td> + </tr> + <tr class="never"> + <td class="num">70</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' pred_nlme <- mkinpredict(dfop_sfo,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">71</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_nlme$bparms.optim[-1],</pre> + </td> + </tr> + <tr class="never"> + <td class="num">72</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' c(parent = f_nlme$bparms.optim[[1]], A1 = 0),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">73</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' seq(0, 180, by = 0.2))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">74</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(f_saem, pred_over = list(nlme = pred_nlme))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">75</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">76</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">77</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">plot.mixed.mmkin <- function(x,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">78</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> i = 1:ncol(x$mmkin),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">79</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> obs_vars = names(x$mkinmod$map),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">80</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> standardized = TRUE,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">81</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> covariates = NULL,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">82</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> covariate_quantiles = c(0.5, 0.05, 0.95),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">83</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> xlab = "Time",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">84</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> xlim = range(x$data$time),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">85</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> resplot = c("predicted", "time"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">86</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> pop_curves = "auto",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">87</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> pred_over = NULL,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">88</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> test_log_parms = FALSE,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">89</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> conf.level = 0.6,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">90</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> default_log_parms = NA,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">91</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> ymax = "auto", maxabs = "auto",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">92</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> ncol.legend = ifelse(length(i) <= 3, length(i) + 1, ifelse(length(i) <= 8, 3, 4)),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">93</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> nrow.legend = ceiling((length(i) + 1) / ncol.legend),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">94</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> rel.height.legend = 0.02 + 0.07 * nrow.legend,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">95</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> rel.height.bottom = 1.1,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">96</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> pch_ds = 1:length(i),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">97</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> col_ds = pch_ds + 1,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">98</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> lty_ds = col_ds,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">99</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> frame = TRUE, ...</pre> + </td> + </tr> + <tr class="never"> + <td class="num">100</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">101</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">102</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Prepare parameters and data</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">103</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit_1 <- x$mmkin[[1]]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">104</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ds_names <- colnames(x$mmkin)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">105</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">106</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> backtransform = TRUE</pre> + </td> + </tr> + <tr class="never"> + <td class="num">107</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">108</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (identical(class(x), "mixed.mmkin")) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">109</td> + <td class="coverage">65<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (identical(pop_curves, "auto")) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">110</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> pop_curves <- FALSE</pre> + </td> + </tr> + <tr class="never"> + <td class="num">111</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">112</td> + <td class="coverage">65<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> pop_curves <- TRUE</pre> + </td> + </tr> + <tr class="never"> + <td class="num">113</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">114</td> + <td class="coverage">65<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (pop_curves) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">115</td> + <td class="coverage">65<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms_pop <- mean_degparms(x$mmkin, test_log_parms = test_log_parms,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">116</td> + <td class="coverage">65<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> conf.level = conf.level, default_log_parms = default_log_parms)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">117</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">118</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">119</td> + <td class="coverage">65<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms_tmp <- parms(x$mmkin, transformed = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">120</td> + <td class="coverage">65<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms_i <- as.data.frame(t(degparms_tmp[setdiff(rownames(degparms_tmp), names(fit_1$errparms)), ]))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">121</td> + <td class="coverage">65<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> residual_type = ifelse(standardized, "standardized", "residual")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">122</td> + <td class="coverage">65<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> residuals <- x$data[[residual_type]]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">123</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">124</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">125</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (inherits(x, "nlme.mmkin")) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">126</td> + <td class="coverage">65<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (identical(pop_curves, "auto")) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">127</td> + <td class="coverage">65<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> pop_curves <- TRUE</pre> + </td> + </tr> + <tr class="never"> + <td class="num">128</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">129</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> pop_curves <- FALSE</pre> + </td> + </tr> + <tr class="never"> + <td class="num">130</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">131</td> + <td class="coverage">65<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms_i <- coefficients(x)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">132</td> + <td class="coverage">65<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms_pop <- nlme::fixef(x)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">133</td> + <td class="coverage">65<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> residuals <- residuals(x,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">134</td> + <td class="coverage">65<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> type = ifelse(standardized, "pearson", "response"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">135</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">136</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">137</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (inherits(x, "saem.mmkin")) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">138</td> + <td class="coverage">65<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (x$transformations == "saemix") backtransform = FALSE</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">139</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> psi <- saemix::psi(x$so)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">140</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rownames(psi) <- x$saemix_ds_order</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">141</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms_i <- psi[ds_names, ]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">142</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms_i_names <- colnames(degparms_i)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">143</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> residual_type = ifelse(standardized, "standardized", "residual")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">144</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> residuals <- x$data[[residual_type]]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">145</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">146</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (identical(pop_curves, "auto")) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">147</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(x$covariate_models) == 0) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">148</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms_pop <- x$so@results@fixed.effects</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">149</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(degparms_pop) <- degparms_i_names</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">150</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> pop_curves <- TRUE</pre> + </td> + </tr> + <tr class="never"> + <td class="num">151</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">152</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.null(covariates)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">153</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> covariates = as.data.frame(</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">154</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> apply(x$covariates, 2, quantile,</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">155</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> covariate_quantiles, simplify = FALSE))</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">156</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> rownames(covariates) <- paste(</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">157</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> ifelse(length(x$covariate_models) == 1,</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">158</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> "Covariate", "Covariates"),</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">159</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> rownames(covariates))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">160</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">161</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> degparms_pop <- parms(x, covariates = covariates)</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">162</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> pop_curves <- TRUE</pre> + </td> + </tr> + <tr class="never"> + <td class="num">163</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">164</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">165</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> pop_curves <- FALSE</pre> + </td> + </tr> + <tr class="never"> + <td class="num">166</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">167</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">168</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">169</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (pop_curves) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">170</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Make sure degparms_pop is a matrix, columns corresponding to population curve(s)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">171</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.null(dim(degparms_pop))) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">172</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms_pop <- matrix(degparms_pop, ncol = 1,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">173</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dimnames = list(names(degparms_pop), "Population"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">174</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">175</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">176</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">177</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms_fixed <- fit_1$fixed$value</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">178</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(degparms_fixed) <- rownames(fit_1$fixed)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">179</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms_all <- cbind(as.matrix(degparms_i),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">180</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> matrix(rep(degparms_fixed, nrow(degparms_i)),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">181</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ncol = length(degparms_fixed),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">182</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> nrow = nrow(degparms_i), byrow = TRUE))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">183</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms_all_names <- c(names(degparms_i), names(degparms_fixed))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">184</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> colnames(degparms_all) <- degparms_all_names</pre> + </td> + </tr> + <tr class="never"> + <td class="num">185</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">186</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeini_names <- grep("_0$", degparms_all_names, value = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">187</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeparms_names <- setdiff(degparms_all_names, odeini_names)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">188</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">189</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> observed <- cbind(x$data[c("ds", "name", "time", "value")],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">190</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> residual = residuals)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">191</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">192</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> solution_type = fit_1$solution_type</pre> + </td> + </tr> + <tr class="never"> + <td class="num">193</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">194</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> outtimes <- sort(unique(c(x$data$time,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">195</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> seq(xlim[1], xlim[2], length.out = 50))))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">196</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">197</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> pred_list <- lapply(i, function(ds_i) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">198</td> + <td class="coverage">2945<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeparms_trans <- degparms_all[ds_i, odeparms_names]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">199</td> + <td class="coverage">2945<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(odeparms_trans) <- odeparms_names # needed if only one odeparm</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">200</td> + <td class="coverage">2945<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (backtransform) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">201</td> + <td class="coverage">2620<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeparms <- backtransform_odeparms(odeparms_trans,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">202</td> + <td class="coverage">2620<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> x$mkinmod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">203</td> + <td class="coverage">2620<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_rates = fit_1$transform_rates,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">204</td> + <td class="coverage">2620<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_fractions = fit_1$transform_fractions)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">205</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">206</td> + <td class="coverage">325<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeparms <- odeparms_trans</pre> + </td> + </tr> + <tr class="never"> + <td class="num">207</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">208</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">209</td> + <td class="coverage">2945<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeini <- degparms_all[ds_i, odeini_names]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">210</td> + <td class="coverage">2945<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(odeini) <- gsub("_0", "", odeini_names)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">211</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">212</td> + <td class="coverage">2945<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> out <- mkinpredict(x$mkinmod, odeparms, odeini,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">213</td> + <td class="coverage">2945<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> outtimes, solution_type = solution_type,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">214</td> + <td class="coverage">2945<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> atol = fit_1$atol, rtol = fit_1$rtol)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">215</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> })</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">216</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(pred_list) <- ds_names[i]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">217</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> pred_ds <- vctrs::vec_rbind(!!!pred_list, .names_to = "ds")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">218</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">219</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (pop_curves) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">220</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> pred_list_pop <- lapply(1:ncol(degparms_pop), function(cov_i) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">221</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms_all_pop_i <- c(degparms_pop[, cov_i], degparms_fixed)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">222</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeparms_pop_trans_i <- degparms_all_pop_i[odeparms_names]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">223</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(odeparms_pop_trans_i) <- odeparms_names # needed if only one odeparm</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">224</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (backtransform) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">225</td> + <td class="coverage">218<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeparms_pop_i <- backtransform_odeparms(odeparms_pop_trans_i,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">226</td> + <td class="coverage">218<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> x$mkinmod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">227</td> + <td class="coverage">218<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_rates = fit_1$transform_rates,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">228</td> + <td class="coverage">218<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_fractions = fit_1$transform_fractions)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">229</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">230</td> + <td class="coverage">65<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeparms_pop_i <- odeparms_pop_trans_i</pre> + </td> + </tr> + <tr class="never"> + <td class="num">231</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">232</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">233</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeini <- degparms_all_pop_i[odeini_names]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">234</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(odeini) <- gsub("_0", "", odeini_names)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">235</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">236</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> out <- mkinpredict(x$mkinmod, odeparms_pop_i, odeini,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">237</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> outtimes, solution_type = solution_type,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">238</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> atol = fit_1$atol, rtol = fit_1$rtol)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">239</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> })</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">240</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(pred_list_pop) <- colnames(degparms_pop)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">241</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">242</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">243</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> pred_list_pop <- NULL</pre> + </td> + </tr> + <tr class="never"> + <td class="num">244</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">245</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">246</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Start of graphical section</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">247</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> oldpar <- par(no.readonly = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">248</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> on.exit(par(oldpar, no.readonly = TRUE))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">249</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">250</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n_plot_rows = length(obs_vars)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">251</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n_plots = n_plot_rows * 2</pre> + </td> + </tr> + <tr class="never"> + <td class="num">252</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">253</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Set relative plot heights, so the first plot row is the norm</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">254</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rel.heights <- if (n_plot_rows > 1) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">255</td> + <td class="coverage">218<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> c(rel.height.legend, c(rep(1, n_plot_rows - 1), rel.height.bottom))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">256</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">257</td> + <td class="coverage">65<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> c(rel.height.legend, 1)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">258</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">259</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">260</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> layout_matrix = matrix(c(1, 1, 2:(n_plots + 1)),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">261</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n_plot_rows + 1, 2, byrow = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">262</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> layout(layout_matrix, heights = rel.heights)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">263</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">264</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> par(mar = c(0.1, 2.1, 0.1, 2.1))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">265</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">266</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Empty plot with legend</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">267</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.null(pred_over)) lty_over <- seq(2, length.out = length(pred_over))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">268</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> else lty_over <- NULL</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">269</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (pop_curves) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">270</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.null(covariates)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">271</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lty_pop <- 1</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">272</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(lty_pop) <- "Population"</pre> + </td> + </tr> + <tr class="never"> + <td class="num">273</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">274</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> lty_pop <- 1:nrow(covariates)</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">275</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> names(lty_pop) <- rownames(covariates)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">276</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">277</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">278</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> lty_pop <- NULL</pre> + </td> + </tr> + <tr class="never"> + <td class="num">279</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">280</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n_pop_over <- length(lty_pop) + length(lty_over)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">281</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">282</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> plot(0, type = "n", axes = FALSE, ann = FALSE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">283</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> legend("center", bty = "n", ncol = ncol.legend,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">284</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> legend = c(names(lty_pop), names(pred_over), ds_names[i]),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">285</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lty = c(lty_pop, lty_over, lty_ds),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">286</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lwd = c(rep(2, n_pop_over), rep(1, length(i))),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">287</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> col = c(rep(1, n_pop_over), col_ds),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">288</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> pch = c(rep(NA, n_pop_over), pch_ds))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">289</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">290</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> resplot <- match.arg(resplot)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">291</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">292</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Loop plot rows</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">293</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (plot_row in 1:n_plot_rows) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">294</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">295</td> + <td class="coverage">501<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> obs_var <- obs_vars[plot_row]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">296</td> + <td class="coverage">501<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> observed_row <- subset(observed, name == obs_var)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">297</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">298</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Set ylim to sensible default, or use ymax</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">299</td> + <td class="coverage">501<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (identical(ymax, "auto")) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">300</td> + <td class="coverage">501<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ylim_row = c(0,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">301</td> + <td class="coverage">501<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> max(c(observed_row$value, pred_ds[[obs_var]]), na.rm = TRUE))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">302</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">303</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> ylim_row = c(0, ymax[plot_row])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">304</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">305</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">306</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Margins for bottom row of plots when we have more than one row</pre> + </td> + </tr> + <tr class="never"> + <td class="num">307</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # This is the only row that needs to show the x axis legend</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">308</td> + <td class="coverage">501<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (plot_row == n_plot_rows) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">309</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> par(mar = c(5.1, 4.1, 1.1, 2.1))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">310</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">311</td> + <td class="coverage">218<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> par(mar = c(3.0, 4.1, 1.1, 2.1))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">312</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">313</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">314</td> + <td class="coverage">501<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> plot(0, type = "n",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">315</td> + <td class="coverage">501<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> xlim = xlim, ylim = ylim_row,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">316</td> + <td class="coverage">501<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> xlab = xlab, ylab = paste("Residues", obs_var), frame = frame)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">317</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">318</td> + <td class="coverage">501<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.null(pred_over)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">319</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> for (i_over in seq_along(pred_over)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">320</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> pred_frame <- as.data.frame(pred_over[[i_over]])</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">321</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> lines(pred_frame$time, pred_frame[[obs_var]],</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">322</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> lwd = 2, lty = lty_over[i_over])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">323</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">324</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">325</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">326</td> + <td class="coverage">501<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (ds_i in seq_along(i)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">327</td> + <td class="coverage">4915<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> points(subset(observed_row, ds == ds_names[ds_i], c("time", "value")),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">328</td> + <td class="coverage">4915<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> col = col_ds[ds_i], pch = pch_ds[ds_i])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">329</td> + <td class="coverage">4915<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lines(subset(pred_ds, ds == ds_names[ds_i], c("time", obs_var)),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">330</td> + <td class="coverage">4915<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> col = col_ds[ds_i], lty = lty_ds[ds_i])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">331</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">332</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">333</td> + <td class="coverage">501<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (pop_curves) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">334</td> + <td class="coverage">501<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (cov_i in seq_along(pred_list_pop)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">335</td> + <td class="coverage">501<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cov_name <- names(pred_list_pop)[cov_i]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">336</td> + <td class="coverage">501<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lines(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">337</td> + <td class="coverage">501<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> pred_list_pop[[cov_i]][, "time"],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">338</td> + <td class="coverage">501<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> pred_list_pop[[cov_i]][, obs_var],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">339</td> + <td class="coverage">501<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> type = "l", lwd = 2, lty = lty_pop[cov_i])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">340</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">341</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">342</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">343</td> + <td class="coverage">501<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (identical(maxabs, "auto")) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">344</td> + <td class="coverage">283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> maxabs = max(abs(observed_row$residual), na.rm = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">345</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">346</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">347</td> + <td class="coverage">501<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (identical(resplot, "time")) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">348</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> plot(0, type = "n", xlim = xlim, xlab = "Time",</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">349</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> ylim = c(-1.2 * maxabs, 1.2 * maxabs),</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">350</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> ylab = if (standardized) "Standardized residual" else "Residual",</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">351</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> frame = frame)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">352</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="missed"> + <td class="num">353</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> abline(h = 0, lty = 2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">354</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="missed"> + <td class="num">355</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> for (ds_i in seq_along(i)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">356</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> points(subset(observed_row, ds == ds_names[ds_i], c("time", "residual")),</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">357</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> col = col_ds[ds_i], pch = pch_ds[ds_i])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">358</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">359</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">360</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">361</td> + <td class="coverage">501<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (identical(resplot, "predicted")) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">362</td> + <td class="coverage">501<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> plot(0, type = "n",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">363</td> + <td class="coverage">501<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> xlim = c(0, max(pred_ds[[obs_var]])),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">364</td> + <td class="coverage">501<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> xlab = "Predicted",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">365</td> + <td class="coverage">501<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ylim = c(-1.2 * maxabs, 1.2 * maxabs),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">366</td> + <td class="coverage">501<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ylab = if (standardized) "Standardized residual" else "Residual",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">367</td> + <td class="coverage">501<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> frame = frame)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">368</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">369</td> + <td class="coverage">501<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> abline(h = 0, lty = 2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">370</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">371</td> + <td class="coverage">501<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (ds_i in seq_along(i)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">372</td> + <td class="coverage">4915<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> observed_row_ds <- merge(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">373</td> + <td class="coverage">4915<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> subset(observed_row, ds == ds_names[ds_i], c("time", "residual")),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">374</td> + <td class="coverage">4915<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> subset(pred_ds, ds == ds_names[ds_i], c("time", obs_var)))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">375</td> + <td class="coverage">4915<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> points(observed_row_ds[c(3, 2)],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">376</td> + <td class="coverage">4915<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> col = col_ds[ds_i], pch = pch_ds[ds_i])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">377</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">378</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">379</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">380</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/summary.mkinfit.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Summary method for class "mkinfit"</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Lists model equations, initial parameter values, optimised parameters with</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' some uncertainty statistics, the chi2 error levels calculated according to</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' FOCUS guidance (2006) as defined therein, formation fractions, DT50 values</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' and optionally the data, consisting of observed, predicted and residual</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' values.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param object an object of class [mkinfit].</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param x an object of class \code{summary.mkinfit}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param data logical, indicating whether the data should be included in the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' summary.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param distimes logical, indicating whether DT50 and DT90 values should be</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' included.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param alpha error level for confidence interval estimation from t</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' distribution</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param digits Number of digits to use for printing</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots optional arguments passed to methods like \code{print}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom stats qt pt cov2cor</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return The summary function returns a list with components, among others</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{version, Rversion}{The mkin and R versions used}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{date.fit, date.summary}{The dates where the fit and the summary were</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' produced}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{diffs}{The differential equations used in the model}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{use_of_ff}{Was maximum or minimum use made of formation fractions}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{bpar}{Optimised and backtransformed</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parameters}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{data}{The data (see Description above).}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{start}{The starting values and bounds, if applicable, for optimised</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parameters.}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{fixed}{The values of fixed parameters.}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{errmin }{The chi2 error levels for</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' each observed variable.}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{bparms.ode}{All backtransformed ODE</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parameters, for use as starting parameters for related models.}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{errparms}{Error model parameters.}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{ff}{The estimated formation fractions derived from the fitted</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' model.}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{distimes}{The DT50 and DT90 values for each observed variable.}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{SFORB}{If applicable, eigenvalues and fractional eigenvector component</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' g of SFORB systems in the model.}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' The print method is called for its side effect, i.e. printing the summary.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @author Johannes Ranke</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @references FOCUS (2006) \dQuote{Guidance Document on Estimating Persistence</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' and Degradation Kinetics from Environmental Fate Studies on Pesticides in</pre> + </td> + </tr> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' EU Registration} Report of the FOCUS Work Group on Degradation Kinetics,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">47</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' EC Document Reference Sanco/10058/2005 version 2.0, 434 pp,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \url{http://esdac.jrc.ec.europa.eu/projects/degradation-kinetics}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' summary(mkinfit("SFO", FOCUS_2006_A, quiet = TRUE))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">54</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">summary.mkinfit <- function(object, data = TRUE, distimes = TRUE, alpha = 0.05, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">55</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> param <- object$par</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">56</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> pnames <- names(param)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">57</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> bpnames <- names(object$bparms.optim)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">58</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> epnames <- names(object$errparms)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">59</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> p <- length(param)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">60</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mod_vars <- names(object$mkinmod$diffs)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">61</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covar <- try(solve(object$hessian), silent = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">62</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covar_notrans <- try(solve(object$hessian_notrans), silent = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">63</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rdf <- object$df.residual</pre> + </td> + </tr> + <tr class="never"> + <td class="num">64</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">65</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.numeric(covar) | is.na(covar[1])) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">66</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> covar <- NULL</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">67</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> se <- lci <- uci <- rep(NA, p)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">68</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">69</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rownames(covar) <- colnames(covar) <- pnames</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">70</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> se <- sqrt(diag(covar))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">71</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lci <- param + qt(alpha/2, rdf) * se</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">72</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> uci <- param + qt(1-alpha/2, rdf) * se</pre> + </td> + </tr> + <tr class="never"> + <td class="num">73</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">74</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">75</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> beparms.optim <- c(object$bparms.optim, object$par[epnames])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">76</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.numeric(covar_notrans) | is.na(covar_notrans[1])) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">77</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covar_notrans <- NULL</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">78</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> se_notrans <- tval <- pval <- rep(NA, p)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">79</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">80</td> + <td class="coverage">52070<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rownames(covar_notrans) <- colnames(covar_notrans) <- c(bpnames, epnames)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">81</td> + <td class="coverage">52070<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> se_notrans <- sqrt(diag(covar_notrans))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">82</td> + <td class="coverage">52070<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> tval <- beparms.optim / se_notrans</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">83</td> + <td class="coverage">52070<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> pval <- pt(abs(tval), rdf, lower.tail = FALSE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">84</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">85</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">86</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(se) <- pnames</pre> + </td> + </tr> + <tr class="never"> + <td class="num">87</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">88</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> param <- cbind(param, se, lci, uci)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">89</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dimnames(param) <- list(pnames, c("Estimate", "Std. Error", "Lower", "Upper"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">90</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">91</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> bparam <- cbind(Estimate = beparms.optim, se_notrans,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">92</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "t value" = tval, "Pr(>t)" = pval, Lower = NA, Upper = NA)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">93</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">94</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Transform boundaries of CI for one parameter at a time,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">95</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # with the exception of sets of formation fractions (single fractions are OK).</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">96</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f_names_skip <- character(0)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">97</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (box in mod_vars) { # Figure out sets of fractions to skip</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">98</td> + <td class="coverage">70671<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f_names <- grep(paste("^f", box, sep = "_"), pnames, value = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">99</td> + <td class="coverage">70671<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n_paths <- length(f_names)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">100</td> + <td class="coverage">1135<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (n_paths > 1) f_names_skip <- c(f_names_skip, f_names)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">101</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">102</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">103</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (pname in pnames) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">104</td> + <td class="coverage">293621<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!pname %in% f_names_skip) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">105</td> + <td class="coverage">290217<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> par.lower <- param[pname, "Lower"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">106</td> + <td class="coverage">290217<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> par.upper <- param[pname, "Upper"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">107</td> + <td class="coverage">290217<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(par.lower) <- names(par.upper) <- pname</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">108</td> + <td class="coverage">290217<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> bpl <- backtransform_odeparms(par.lower, object$mkinmod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">109</td> + <td class="coverage">290217<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$transform_rates,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">110</td> + <td class="coverage">290217<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$transform_fractions)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">111</td> + <td class="coverage">290217<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> bpu <- backtransform_odeparms(par.upper, object$mkinmod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">112</td> + <td class="coverage">290217<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$transform_rates,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">113</td> + <td class="coverage">290217<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$transform_fractions)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">114</td> + <td class="coverage">290217<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> bparam[names(bpl), "Lower"] <- bpl</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">115</td> + <td class="coverage">290217<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> bparam[names(bpu), "Upper"] <- bpu</pre> + </td> + </tr> + <tr class="never"> + <td class="num">116</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">117</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">118</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> bparam[epnames, c("Lower", "Upper")] <- param[epnames, c("Lower", "Upper")]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">119</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">120</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ans <- list(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">121</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> version = as.character(utils::packageVersion("mkin")),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">122</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> Rversion = paste(R.version$major, R.version$minor, sep="."),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">123</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> date.fit = object$date,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">124</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> date.summary = date(),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">125</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> solution_type = object$solution_type,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">126</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> warnings = object$summary_warnings,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">127</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> use_of_ff = object$mkinmod$use_of_ff,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">128</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> error_model_algorithm = object$error_model_algorithm,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">129</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> df = c(p, rdf),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">130</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covar = covar,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">131</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covar_notrans = covar_notrans,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">132</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> err_mod = object$err_mod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">133</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> niter = object$iterations,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">134</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> calls = object$calls,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">135</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> time = object$time,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">136</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> par = param,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">137</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> bpar = bparam)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">138</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">139</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.null(object$version)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">140</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ans$fit_version <- object$version</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">141</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ans$fit_Rversion <- object$Rversion</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">142</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (ans$fit_version >= "0.9.49.6") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">143</td> + <td class="coverage">52156<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ans$AIC = AIC(object)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">144</td> + <td class="coverage">52156<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ans$BIC = BIC(object)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">145</td> + <td class="coverage">52156<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ans$logLik = logLik(object)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">146</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">147</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">148</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">149</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ans$diffs <- object$mkinmod$diffs</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">150</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(data) ans$data <- object$data</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">151</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ans$start <- object$start</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">152</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ans$start_transformed <- object$start_transformed</pre> + </td> + </tr> + <tr class="never"> + <td class="num">153</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">154</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ans$fixed <- object$fixed</pre> + </td> + </tr> + <tr class="never"> + <td class="num">155</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">156</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ans$errmin <- mkinerrmin(object, alpha = 0.05)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">157</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">158</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (object$calls > 0) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">159</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.null(ans$covar)){</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">160</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> Corr <- cov2cor(ans$covar)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">161</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rownames(Corr) <- colnames(Corr) <- rownames(ans$par)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">162</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ans$Corr <- Corr</pre> + </td> + </tr> + <tr class="never"> + <td class="num">163</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">164</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> warning("Could not calculate correlation; no covariance matrix")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">165</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">166</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">167</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">168</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ans$bparms.ode <- object$bparms.ode</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">169</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ans$shapiro.p <- object$shapiro.p</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">170</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ep <- endpoints(object)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">171</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(ep$ff) != 0)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">172</td> + <td class="coverage">15612<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ans$ff <- ep$ff</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">173</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (distimes) ans$distimes <- ep$distimes</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">174</td> + <td class="coverage">2442<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(ep$SFORB) != 0) ans$SFORB <- ep$SFORB</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">175</td> + <td class="coverage">43972<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.null(object$d_3_message)) ans$d_3_message <- object$d_3_message</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">176</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(ans) <- "summary.mkinfit"</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">177</td> + <td class="coverage">52158<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(ans)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">178</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">179</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">180</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname summary.mkinfit</pre> + </td> + </tr> + <tr class="never"> + <td class="num">181</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">182</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">print.summary.mkinfit <- function(x, digits = max(3, getOption("digits") - 3), ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">183</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.null(x$fit_version)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">184</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("mkin version: ", x$version, "\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">185</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("R version: ", x$Rversion, "\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">186</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">187</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("mkin version used for fitting: ", x$fit_version, "\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">188</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("R version used for fitting: ", x$fit_Rversion, "\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">189</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">190</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">191</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("Date of fit: ", x$date.fit, "\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">192</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("Date of summary:", x$date.summary, "\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">193</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">194</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nEquations:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">195</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> nice_diffs <- gsub("^(d.*) =", "\\1/dt =", x[["diffs"]])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">196</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> writeLines(strwrap(nice_diffs, exdent = 11))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">197</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> df <- x$df</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">198</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rdf <- df[2]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">199</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">200</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nModel predictions using solution type", x$solution_type, "\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">201</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">202</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nFitted using", x$calls, "model solutions performed in", x$time[["elapsed"]], "s\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">203</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">204</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.null(x$err_mod)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">205</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nError model: ")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">206</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat(switch(x$err_mod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">207</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> const = "Constant variance",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">208</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> obs = "Variance unique to each observed variable",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">209</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> tc = "Two-component variance function"), "\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">210</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">211</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nError model algorithm:", x$error_model_algorithm, "\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">212</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.null(x$d_3_message)) cat(x$d_3_message, "\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">213</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">214</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">215</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nStarting values for parameters to be optimised:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">216</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(x$start)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">217</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">218</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nStarting values for the transformed parameters actually optimised:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">219</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(x$start_transformed)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">220</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">221</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nFixed parameter values:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">222</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(length(x$fixed$value) == 0) cat("None\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">223</td> + <td class="coverage">3<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> else print(x$fixed)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">224</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">225</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # We used to only have one warning - show this for summarising old objects</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">226</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.null(x[["warning"]])) cat("\n\nWarning:", x$warning, "\n\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">227</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">228</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(x$warnings) > 0) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">229</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\n\nWarning(s):", "\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">230</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat(x$warnings, sep = "\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">231</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">232</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">233</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.null(x$AIC)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">234</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nResults:\n\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">235</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(data.frame(AIC = x$AIC, BIC = x$BIC, logLik = x$logLik,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">236</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> row.names = " "))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">237</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">238</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">239</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nOptimised, transformed parameters with symmetric confidence intervals:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">240</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(signif(x$par, digits = digits))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">241</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">242</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (x$calls > 0) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">243</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nParameter correlation:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">244</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.null(x$covar)){</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">245</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(x$Corr, digits = digits, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">246</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">247</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("No covariance matrix")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">248</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">249</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">250</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">251</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nBacktransformed parameters:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">252</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("Confidence intervals for internally transformed parameters are asymmetric.\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">253</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if ((x$version) < "0.9-36") {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">254</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("To get the usual (questionable) t-test, upgrade mkin and repeat the fit.\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">255</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> print(signif(x$bpar, digits = digits))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">256</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">257</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("t-test (unrealistically) based on the assumption of normal distribution\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">258</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("for estimators of untransformed parameters.\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">259</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(signif(x$bpar[, c(1, 3, 4, 5, 6)], digits = digits))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">260</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">261</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">262</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nFOCUS Chi2 error levels in percent:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">263</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> x$errmin$err.min <- 100 * x$errmin$err.min</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">264</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(x$errmin, digits=digits,...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">265</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">266</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> printSFORB <- !is.null(x$SFORB)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">267</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(printSFORB){</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">268</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nEstimated Eigenvalues and DFOP g parameter of SFORB model(s):\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">269</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(x$SFORB, digits=digits,...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">270</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">271</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">272</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> printff <- !is.null(x$ff)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">273</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(printff){</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">274</td> + <td class="coverage">3<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nResulting formation fractions:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">275</td> + <td class="coverage">3<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(data.frame(ff = x$ff), digits=digits,...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">276</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">277</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">278</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> printdistimes <- !is.null(x$distimes)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">279</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(printdistimes){</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">280</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nEstimated disappearance times:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">281</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(x$distimes, digits=digits,...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">282</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">283</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">284</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> printdata <- !is.null(x$data)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">285</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (printdata){</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">286</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nData:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">287</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(format(x$data, digits = digits, ...), row.names = FALSE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">288</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">289</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">290</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> invisible(x)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">291</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/mkinfit.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">utils::globalVariables(c("name", "time", "value"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Fit a kinetic model to data with one or more state variables</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' This function maximises the likelihood of the observed data using the Port</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' algorithm [stats::nlminb()], and the specified initial or fixed</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parameters and starting values. In each step of the optimisation, the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' kinetic model is solved using the function [mkinpredict()], except</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' if an analytical solution is implemented, in which case the model is solved</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' using the degradation function in the [mkinmod] object. The</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parameters of the selected error model are fitted simultaneously with the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' degradation model parameters, as both of them are arguments of the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' likelihood function.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Per default, parameters in the kinetic models are internally transformed in</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' order to better satisfy the assumption of a normal distribution of their</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' estimators.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param mkinmod A list of class [mkinmod], containing the kinetic</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' model to be fitted to the data, or one of the shorthand names ("SFO",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' "FOMC", "DFOP", "HS", "SFORB", "IORE"). If a shorthand name is given, a</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parent only degradation model is generated for the variable with the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' highest value in \code{observed}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param observed A dataframe with the observed data. The first column called</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' "name" must contain the name of the observed variable for each data point.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' The second column must contain the times of observation, named "time".</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' The third column must be named "value" and contain the observed values.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Zero values in the "value" column will be removed, with a warning, in</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' order to avoid problems with fitting the two-component error model. This</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' is not expected to be a problem, because in general, values of zero are</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' not observed in degradation data, because there is a lower limit of</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' detection.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param parms.ini A named vector of initial values for the parameters,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' including parameters to be optimised and potentially also fixed parameters</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' as indicated by \code{fixed_parms}. If set to "auto", initial values for</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' rate constants are set to default values. Using parameter names that are</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' not in the model gives an error.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' It is possible to only specify a subset of the parameters that the model</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' needs. You can use the parameter lists "bparms.ode" from a previously</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fitted model, which contains the differential equation parameters from</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' this model. This works nicely if the models are nested. An example is</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' given below.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param state.ini A named vector of initial values for the state variables of</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the model. In case the observed variables are represented by more than one</pre> + </td> + </tr> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' model variable, the names will differ from the names of the observed</pre> + </td> + </tr> + <tr class="never"> + <td class="num">47</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' variables (see \code{map} component of [mkinmod]). The default</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' is to set the initial value of the first model variable to the mean of the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' time zero values for the variable with the maximum observed value, and all</pre> + </td> + </tr> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' others to 0. If this variable has no time zero observations, its initial</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' value is set to 100.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param err.ini A named vector of initial values for the error model</pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parameters to be optimised. If set to "auto", initial values are set to</pre> + </td> + </tr> + <tr class="never"> + <td class="num">54</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' default values. Otherwise, inital values for all error model parameters</pre> + </td> + </tr> + <tr class="never"> + <td class="num">55</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' must be given.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param fixed_parms The names of parameters that should not be optimised but</pre> + </td> + </tr> + <tr class="never"> + <td class="num">57</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' rather kept at the values specified in \code{parms.ini}. Alternatively,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' a named numeric vector of parameters to be fixed, regardless of the values</pre> + </td> + </tr> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' in parms.ini.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">60</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param fixed_initials The names of model variables for which the initial</pre> + </td> + </tr> + <tr class="never"> + <td class="num">61</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' state at time 0 should be excluded from the optimisation. Defaults to all</pre> + </td> + </tr> + <tr class="never"> + <td class="num">62</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' state variables except for the first one.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">63</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param from_max_mean If this is set to TRUE, and the model has only one</pre> + </td> + </tr> + <tr class="never"> + <td class="num">64</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' observed variable, then data before the time of the maximum observed value</pre> + </td> + </tr> + <tr class="never"> + <td class="num">65</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' (after averaging for each sampling time) are discarded, and this time is</pre> + </td> + </tr> + <tr class="never"> + <td class="num">66</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' subtracted from all remaining time values, so the time of the maximum</pre> + </td> + </tr> + <tr class="never"> + <td class="num">67</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' observed mean value is the new time zero.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">68</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param solution_type If set to "eigen", the solution of the system of</pre> + </td> + </tr> + <tr class="never"> + <td class="num">69</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' differential equations is based on the spectral decomposition of the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">70</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' coefficient matrix in cases that this is possible. If set to "deSolve", a</pre> + </td> + </tr> + <tr class="never"> + <td class="num">71</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' numerical [ode solver from package deSolve][deSolve::ode()] is used. If</pre> + </td> + </tr> + <tr class="never"> + <td class="num">72</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' set to "analytical", an analytical solution of the model is used. This is</pre> + </td> + </tr> + <tr class="never"> + <td class="num">73</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' only implemented for relatively simple degradation models. The default is</pre> + </td> + </tr> + <tr class="never"> + <td class="num">74</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' "auto", which uses "analytical" if possible, otherwise "deSolve" if a</pre> + </td> + </tr> + <tr class="never"> + <td class="num">75</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' compiler is present, and "eigen" if no compiler is present and the model</pre> + </td> + </tr> + <tr class="never"> + <td class="num">76</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' can be expressed using eigenvalues and eigenvectors.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">77</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param method.ode The solution method passed via [mkinpredict()]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">78</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' to [deSolve::ode()] in case the solution type is "deSolve". The default</pre> + </td> + </tr> + <tr class="never"> + <td class="num">79</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' "lsoda" is performant, but sometimes fails to converge.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">80</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param use_compiled If set to \code{FALSE}, no compiled version of the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">81</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' [mkinmod] model is used in the calls to [mkinpredict()] even if a compiled</pre> + </td> + </tr> + <tr class="never"> + <td class="num">82</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' version is present.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">83</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param control A list of control arguments passed to [stats::nlminb()].</pre> + </td> + </tr> + <tr class="never"> + <td class="num">84</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param transform_rates Boolean specifying if kinetic rate constants should</pre> + </td> + </tr> + <tr class="never"> + <td class="num">85</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' be transformed in the model specification used in the fitting for better</pre> + </td> + </tr> + <tr class="never"> + <td class="num">86</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' compliance with the assumption of normal distribution of the estimator. If</pre> + </td> + </tr> + <tr class="never"> + <td class="num">87</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' TRUE, also alpha and beta parameters of the FOMC model are</pre> + </td> + </tr> + <tr class="never"> + <td class="num">88</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' log-transformed, as well as k1 and k2 rate constants for the DFOP and HS</pre> + </td> + </tr> + <tr class="never"> + <td class="num">89</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' models and the break point tb of the HS model. If FALSE, zero is used as</pre> + </td> + </tr> + <tr class="never"> + <td class="num">90</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' a lower bound for the rates in the optimisation.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">91</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param transform_fractions Boolean specifying if formation fractions</pre> + </td> + </tr> + <tr class="never"> + <td class="num">92</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' should be transformed in the model specification used in the fitting for</pre> + </td> + </tr> + <tr class="never"> + <td class="num">93</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' better compliance with the assumption of normal distribution of the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">94</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' estimator. The default (TRUE) is to do transformations. If TRUE,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">95</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the g parameter of the DFOP model is also transformed. Transformations</pre> + </td> + </tr> + <tr class="never"> + <td class="num">96</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' are described in [transform_odeparms].</pre> + </td> + </tr> + <tr class="never"> + <td class="num">97</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param quiet Suppress printing out the current value of the negative</pre> + </td> + </tr> + <tr class="never"> + <td class="num">98</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' log-likelihood after each improvement?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">99</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param atol Absolute error tolerance, passed to [deSolve::ode()]. Default</pre> + </td> + </tr> + <tr class="never"> + <td class="num">100</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' is 1e-8, which is lower than the default in the [deSolve::lsoda()]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">101</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' function which is used per default.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">102</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param rtol Absolute error tolerance, passed to [deSolve::ode()]. Default</pre> + </td> + </tr> + <tr class="never"> + <td class="num">103</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' is 1e-10, much lower than in [deSolve::lsoda()].</pre> + </td> + </tr> + <tr class="never"> + <td class="num">104</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param error_model If the error model is "const", a constant standard</pre> + </td> + </tr> + <tr class="never"> + <td class="num">105</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' deviation is assumed.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">106</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">107</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' If the error model is "obs", each observed variable is assumed to have its</pre> + </td> + </tr> + <tr class="never"> + <td class="num">108</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' own variance.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">109</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">110</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' If the error model is "tc" (two-component error model), a two component</pre> + </td> + </tr> + <tr class="never"> + <td class="num">111</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' error model similar to the one described by Rocke and Lorenzato (1995) is</pre> + </td> + </tr> + <tr class="never"> + <td class="num">112</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' used for setting up the likelihood function. Note that this model</pre> + </td> + </tr> + <tr class="never"> + <td class="num">113</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' deviates from the model by Rocke and Lorenzato, as their model implies</pre> + </td> + </tr> + <tr class="never"> + <td class="num">114</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' that the errors follow a lognormal distribution for large values, not a</pre> + </td> + </tr> + <tr class="never"> + <td class="num">115</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' normal distribution as assumed by this method.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">116</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param error_model_algorithm If "auto", the selected algorithm depends on</pre> + </td> + </tr> + <tr class="never"> + <td class="num">117</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the error model. If the error model is "const", unweighted nonlinear</pre> + </td> + </tr> + <tr class="never"> + <td class="num">118</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' least squares fitting ("OLS") is selected. If the error model is "obs", or</pre> + </td> + </tr> + <tr class="never"> + <td class="num">119</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' "tc", the "d_3" algorithm is selected.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">120</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">121</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' The algorithm "d_3" will directly minimize the negative log-likelihood</pre> + </td> + </tr> + <tr class="never"> + <td class="num">122</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' and independently also use the three step algorithm described below.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">123</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' The fit with the higher likelihood is returned.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">124</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">125</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' The algorithm "direct" will directly minimize the negative log-likelihood.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">126</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">127</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' The algorithm "twostep" will minimize the negative log-likelihood after an</pre> + </td> + </tr> + <tr class="never"> + <td class="num">128</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' initial unweighted least squares optimisation step.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">129</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">130</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' The algorithm "threestep" starts with unweighted least squares, then</pre> + </td> + </tr> + <tr class="never"> + <td class="num">131</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' optimizes only the error model using the degradation model parameters</pre> + </td> + </tr> + <tr class="never"> + <td class="num">132</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' found, and then minimizes the negative log-likelihood with free</pre> + </td> + </tr> + <tr class="never"> + <td class="num">133</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' degradation and error model parameters.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">134</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">135</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' The algorithm "fourstep" starts with unweighted least squares, then</pre> + </td> + </tr> + <tr class="never"> + <td class="num">136</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' optimizes only the error model using the degradation model parameters</pre> + </td> + </tr> + <tr class="never"> + <td class="num">137</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' found, then optimizes the degradation model again with fixed error model</pre> + </td> + </tr> + <tr class="never"> + <td class="num">138</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parameters, and finally minimizes the negative log-likelihood with free</pre> + </td> + </tr> + <tr class="never"> + <td class="num">139</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' degradation and error model parameters.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">140</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">141</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' The algorithm "IRLS" (Iteratively Reweighted Least Squares) starts with</pre> + </td> + </tr> + <tr class="never"> + <td class="num">142</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' unweighted least squares, and then iterates optimization of the error</pre> + </td> + </tr> + <tr class="never"> + <td class="num">143</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' model parameters and subsequent optimization of the degradation model</pre> + </td> + </tr> + <tr class="never"> + <td class="num">144</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' using those error model parameters, until the error model parameters</pre> + </td> + </tr> + <tr class="never"> + <td class="num">145</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' converge.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">146</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param reweight.tol Tolerance for the convergence criterion calculated from</pre> + </td> + </tr> + <tr class="never"> + <td class="num">147</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the error model parameters in IRLS fits.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">148</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param reweight.max.iter Maximum number of iterations in IRLS fits.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">149</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param trace_parms Should a trace of the parameter values be listed?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">150</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param test_residuals Should the residuals be tested for normal distribution?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">151</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots Further arguments that will be passed on to</pre> + </td> + </tr> + <tr class="never"> + <td class="num">152</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' [deSolve::ode()].</pre> + </td> + </tr> + <tr class="never"> + <td class="num">153</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom stats nlminb aggregate dist shapiro.test</pre> + </td> + </tr> + <tr class="never"> + <td class="num">154</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return A list with "mkinfit" in the class attribute.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">155</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @note When using the "IORE" submodel for metabolites, fitting with</pre> + </td> + </tr> + <tr class="never"> + <td class="num">156</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' "transform_rates = TRUE" (the default) often leads to failures of the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">157</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' numerical ODE solver. In this situation it may help to switch off the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">158</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' internal rate transformation.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">159</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @author Johannes Ranke</pre> + </td> + </tr> + <tr class="never"> + <td class="num">160</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @seealso [summary.mkinfit], [plot.mkinfit], [parms] and [lrtest].</pre> + </td> + </tr> + <tr class="never"> + <td class="num">161</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">162</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Comparisons of models fitted to the same data can be made using</pre> + </td> + </tr> + <tr class="never"> + <td class="num">163</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \code{\link{AIC}} by virtue of the method \code{\link{logLik.mkinfit}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">164</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">165</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Fitting of several models to several datasets in a single call to</pre> + </td> + </tr> + <tr class="never"> + <td class="num">166</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \code{\link{mmkin}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">167</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @references Rocke DM and Lorenzato S (1995) A two-component model</pre> + </td> + </tr> + <tr class="never"> + <td class="num">168</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' for measurement error in analytical chemistry. *Technometrics* 37(2), 176-184.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">169</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">170</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Ranke J and Meinecke S (2019) Error Models for the Kinetic Evaluation of Chemical</pre> + </td> + </tr> + <tr class="never"> + <td class="num">171</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Degradation Data. *Environments* 6(12) 124</pre> + </td> + </tr> + <tr class="never"> + <td class="num">172</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \doi{10.3390/environments6120124}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">173</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">174</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">175</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Use shorthand notation for parent only degradation</pre> + </td> + </tr> + <tr class="never"> + <td class="num">176</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit <- mkinfit("FOMC", FOCUS_2006_C, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">177</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' summary(fit)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">178</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">179</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # One parent compound, one metabolite, both single first order.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">180</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # We remove zero values from FOCUS dataset D in order to avoid warnings</pre> + </td> + </tr> + <tr class="never"> + <td class="num">181</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' FOCUS_D <- subset(FOCUS_2006_D, value != 0)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">182</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Use mkinsub for convenience in model formulation. Pathway to sink included per default.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">183</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' SFO_SFO <- mkinmod(</pre> + </td> + </tr> + <tr class="never"> + <td class="num">184</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parent = mkinsub("SFO", "m1"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">185</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' m1 = mkinsub("SFO"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">186</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">187</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Fit the model quietly to the FOCUS example dataset D using defaults</pre> + </td> + </tr> + <tr class="never"> + <td class="num">188</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit <- mkinfit(SFO_SFO, FOCUS_D, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">189</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot_sep(fit)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">190</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # As lower parent values appear to have lower variance, we try an alternative error model</pre> + </td> + </tr> + <tr class="never"> + <td class="num">191</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit.tc <- mkinfit(SFO_SFO, FOCUS_D, quiet = TRUE, error_model = "tc")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">192</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # This avoids the warning, and the likelihood ratio test confirms it is preferable</pre> + </td> + </tr> + <tr class="never"> + <td class="num">193</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' lrtest(fit.tc, fit)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">194</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # We can also allow for different variances of parent and metabolite as error model</pre> + </td> + </tr> + <tr class="never"> + <td class="num">195</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit.obs <- mkinfit(SFO_SFO, FOCUS_D, quiet = TRUE, error_model = "obs")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">196</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # The two-component error model has significantly higher likelihood</pre> + </td> + </tr> + <tr class="never"> + <td class="num">197</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' lrtest(fit.obs, fit.tc)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">198</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parms(fit.tc)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">199</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' endpoints(fit.tc)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">200</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">201</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # We can show a quick (only one replication) benchmark for this case, as we</pre> + </td> + </tr> + <tr class="never"> + <td class="num">202</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # have several alternative solution methods for the model. We skip</pre> + </td> + </tr> + <tr class="never"> + <td class="num">203</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # uncompiled deSolve, as it is so slow. More benchmarks are found in the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">204</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # benchmark vignette</pre> + </td> + </tr> + <tr class="never"> + <td class="num">205</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">206</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' if(require(rbenchmark)) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">207</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' benchmark(replications = 1, order = "relative", columns = c("test", "relative", "elapsed"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">208</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' deSolve_compiled = mkinfit(SFO_SFO, FOCUS_D, quiet = TRUE, error_model = "tc",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">209</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' solution_type = "deSolve", use_compiled = TRUE),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">210</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' eigen = mkinfit(SFO_SFO, FOCUS_D, quiet = TRUE, error_model = "tc",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">211</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' solution_type = "eigen"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">212</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' analytical = mkinfit(SFO_SFO, FOCUS_D, quiet = TRUE, error_model = "tc",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">213</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' solution_type = "analytical"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">214</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">215</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">216</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">217</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Use stepwise fitting, using optimised parameters from parent only fit, FOMC-SFO</pre> + </td> + </tr> + <tr class="never"> + <td class="num">218</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">219</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' FOMC_SFO <- mkinmod(</pre> + </td> + </tr> + <tr class="never"> + <td class="num">220</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parent = mkinsub("FOMC", "m1"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">221</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' m1 = mkinsub("SFO"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">222</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit.FOMC_SFO <- mkinfit(FOMC_SFO, FOCUS_D, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">223</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Again, we get a warning and try a more sophisticated error model</pre> + </td> + </tr> + <tr class="never"> + <td class="num">224</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit.FOMC_SFO.tc <- mkinfit(FOMC_SFO, FOCUS_D, quiet = TRUE, error_model = "tc")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">225</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # This model has a higher likelihood, but not significantly so</pre> + </td> + </tr> + <tr class="never"> + <td class="num">226</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' lrtest(fit.tc, fit.FOMC_SFO.tc)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">227</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Also, the missing standard error for log_beta and the t-tests for alpha</pre> + </td> + </tr> + <tr class="never"> + <td class="num">228</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # and beta indicate overparameterisation</pre> + </td> + </tr> + <tr class="never"> + <td class="num">229</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' summary(fit.FOMC_SFO.tc, data = FALSE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">230</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">231</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # We can easily use starting parameters from the parent only fit (only for illustration)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">232</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit.FOMC = mkinfit("FOMC", FOCUS_2006_D, quiet = TRUE, error_model = "tc")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">233</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit.FOMC_SFO <- mkinfit(FOMC_SFO, FOCUS_D, quiet = TRUE,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">234</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parms.ini = fit.FOMC$bparms.ode, error_model = "tc")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">235</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">236</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">237</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">mkinfit <- function(mkinmod, observed,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">238</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> parms.ini = "auto",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">239</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> state.ini = "auto",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">240</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> err.ini = "auto",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">241</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> fixed_parms = NULL,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">242</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> fixed_initials = names(mkinmod$diffs)[-1],</pre> + </td> + </tr> + <tr class="never"> + <td class="num">243</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> from_max_mean = FALSE,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">244</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> solution_type = c("auto", "analytical", "eigen", "deSolve"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">245</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> method.ode = "lsoda",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">246</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> use_compiled = "auto",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">247</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> control = list(eval.max = 300, iter.max = 200),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">248</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_rates = TRUE,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">249</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_fractions = TRUE,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">250</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> quiet = FALSE,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">251</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> atol = 1e-8, rtol = 1e-10,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">252</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> error_model = c("const", "obs", "tc"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">253</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> error_model_algorithm = c("auto", "d_3", "direct", "twostep", "threestep", "fourstep", "IRLS", "OLS"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">254</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> reweight.tol = 1e-8, reweight.max.iter = 10,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">255</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> trace_parms = FALSE,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">256</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> test_residuals = FALSE,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">257</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">258</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">259</td> + <td class="coverage">9202<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> call <- match.call()</pre> + </td> + </tr> + <tr class="never"> + <td class="num">260</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">261</td> + <td class="coverage">9202<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> summary_warnings <- character()</pre> + </td> + </tr> + <tr class="never"> + <td class="num">262</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">263</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Derive the name used for the model</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">264</td> + <td class="coverage">9202<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.character(mkinmod)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">265</td> + <td class="coverage">4009<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mkinmod_name <- mkinmod</pre> + </td> + </tr> + <tr class="never"> + <td class="num">266</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">267</td> + <td class="coverage">5193<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.null(mkinmod$name)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">268</td> + <td class="coverage">5071<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mkinmod_name <- deparse(substitute(mkinmod))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">269</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">270</td> + <td class="coverage">18<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mkinmod_name <- mkinmod$name</pre> + </td> + </tr> + <tr class="never"> + <td class="num">271</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">272</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">273</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">274</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Check mkinmod and generate a model for the variable whith the highest value</pre> + </td> + </tr> + <tr class="never"> + <td class="num">275</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # if a suitable string is given</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">276</td> + <td class="coverage">9098<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parent_models_available = c("SFO", "FOMC", "DFOP", "HS", "SFORB", "IORE", "logistic")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">277</td> + <td class="coverage">9098<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!inherits(mkinmod, "mkinmod")) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">278</td> + <td class="coverage">4009<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> presumed_parent_name = observed[which.max(observed$value), "name"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">279</td> + <td class="coverage">4009<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (mkinmod[[1]] %in% parent_models_available) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">280</td> + <td class="coverage">3905<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> speclist <- list(list(type = mkinmod, sink = TRUE))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">281</td> + <td class="coverage">3905<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(speclist) <- presumed_parent_name</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">282</td> + <td class="coverage">3905<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mkinmod <- mkinmod(speclist = speclist, use_of_ff = "max")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">283</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">284</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> stop("Argument mkinmod must be of class mkinmod or a string containing one of\n ",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">285</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> paste(parent_models_available, collapse = ", "))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">286</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">287</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">288</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">289</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Get the names of the state variables in the model</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">290</td> + <td class="coverage">8994<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mod_vars <- names(mkinmod$diffs)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">291</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">292</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Get the names of observed variables</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">293</td> + <td class="coverage">8994<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> obs_vars <- names(mkinmod$spec)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">294</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">295</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Subset observed data with names of observed data in the model and remove NA values</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">296</td> + <td class="coverage">8994<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> observed <- subset(observed, name %in% obs_vars)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">297</td> + <td class="coverage">8994<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> observed <- subset(observed, !is.na(value))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">298</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">299</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Also remove zero values to avoid instabilities (e.g. of the 'tc' error model)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">300</td> + <td class="coverage">8994<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (any(observed$value == 0)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">301</td> + <td class="coverage">529<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> zero_warning <- "Observations with value of zero were removed from the data"</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">302</td> + <td class="coverage">529<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> summary_warnings <- c(summary_warnings, Z = zero_warning)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">303</td> + <td class="coverage">529<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> warning(zero_warning)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">304</td> + <td class="coverage">529<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> observed <- subset(observed, value != 0)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">305</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">306</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">307</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Sort observed values for efficient analytical predictions</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">308</td> + <td class="coverage">8994<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> observed$name <- ordered(observed$name, levels = obs_vars)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">309</td> + <td class="coverage">8994<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> observed <- observed[order(observed$name, observed$time), ]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">310</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">311</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Obtain data for decline from maximum mean value if requested</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">312</td> + <td class="coverage">8994<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (from_max_mean) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">313</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # This is only used for simple decline models</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">314</td> + <td class="coverage">459<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(obs_vars) > 1)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">315</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> stop("Decline from maximum is only implemented for models with a single observed variable")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">316</td> + <td class="coverage">306<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> observed$name <- as.character(observed$name)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">317</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">318</td> + <td class="coverage">306<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> means <- aggregate(value ~ time, data = observed, mean, na.rm=TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">319</td> + <td class="coverage">306<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> t_of_max <- means[which.max(means$value), "time"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">320</td> + <td class="coverage">306<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> observed <- subset(observed, time >= t_of_max)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">321</td> + <td class="coverage">306<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> observed$time <- observed$time - t_of_max</pre> + </td> + </tr> + <tr class="never"> + <td class="num">322</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">323</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">324</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Number observations used for fitting</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">325</td> + <td class="coverage">8841<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n_observed <- nrow(observed)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">326</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">327</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Define starting values for parameters where not specified by the user</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">328</td> + <td class="coverage">8371<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (parms.ini[[1]] == "auto") parms.ini = vector()</pre> + </td> + </tr> + <tr class="never"> + <td class="num">329</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">330</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Override parms.ini for parameters given as a numeric vector in</pre> + </td> + </tr> + <tr class="never"> + <td class="num">331</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # fixed_parms</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">332</td> + <td class="coverage">8841<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.numeric(fixed_parms)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">333</td> + <td class="coverage">3<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fixed_parm_names <- names(fixed_parms)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">334</td> + <td class="coverage">3<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms.ini[fixed_parm_names] <- fixed_parms</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">335</td> + <td class="coverage">3<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fixed_parms <- fixed_parm_names</pre> + </td> + </tr> + <tr class="never"> + <td class="num">336</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">337</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">338</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Warn for inital parameter specifications that are not in the model</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">339</td> + <td class="coverage">8841<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> wrongpar.names <- setdiff(names(parms.ini), mkinmod$parms)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">340</td> + <td class="coverage">8841<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(wrongpar.names) > 0) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">341</td> + <td class="coverage">257<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> warning("Initial parameter(s) ", paste(wrongpar.names, collapse = ", "),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">342</td> + <td class="coverage">257<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> " not used in the model")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">343</td> + <td class="coverage">257<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms.ini <- parms.ini[setdiff(names(parms.ini), wrongpar.names)]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">344</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">345</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">346</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Warn that the sum of formation fractions may exceed one if they are not</pre> + </td> + </tr> + <tr class="never"> + <td class="num">347</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # fitted in the transformed way</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">348</td> + <td class="coverage">8841<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (mkinmod$use_of_ff == "max" & transform_fractions == FALSE) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">349</td> + <td class="coverage">410<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> warning("The sum of formation fractions may exceed one if you do not use ",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">350</td> + <td class="coverage">410<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "transform_fractions = TRUE." )</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">351</td> + <td class="coverage">410<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (box in mod_vars) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">352</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Stop if formation fractions are not transformed and we have no sink</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">353</td> + <td class="coverage">716<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (mkinmod$spec[[box]]$sink == FALSE) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">354</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> stop("If formation fractions are not transformed during the fitting, ",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">355</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "it is not supported to turn off pathways to sink.\n ",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">356</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "Consider turning on the transformation of formation fractions or ",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">357</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "setting up a model with use_of_ff = 'min'.\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">358</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">359</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">360</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">361</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">362</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Do not allow fixing formation fractions if we are using the ilr transformation,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">363</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # this is not supported</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">364</td> + <td class="coverage">8737<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (transform_fractions == TRUE && length(fixed_parms) > 0) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">365</td> + <td class="coverage">107<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (any(grepl("^f_", fixed_parms))) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">366</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> stop("Fixing formation fractions is not supported when using the ilr ",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">367</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "transformation.")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">368</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">369</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">370</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">371</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Set initial parameter values, including a small increment (salt)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">372</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # to avoid linear dependencies (singular matrix) in Eigenvalue based solutions</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">373</td> + <td class="coverage">8633<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k_salt = 0</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">374</td> + <td class="coverage">8633<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> defaultpar.names <- setdiff(mkinmod$parms, names(parms.ini))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">375</td> + <td class="coverage">8633<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (parmname in defaultpar.names) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">376</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Default values for rate constants, depending on the parameterisation</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">377</td> + <td class="coverage">20999<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (grepl("^k", parmname)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">378</td> + <td class="coverage">15908<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms.ini[parmname] = 0.1 + k_salt</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">379</td> + <td class="coverage">15908<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k_salt = k_salt + 1e-4</pre> + </td> + </tr> + <tr class="never"> + <td class="num">380</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">381</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Default values for rate constants for reversible binding</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">382</td> + <td class="coverage">26<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (grepl("free_bound$", parmname)) parms.ini[parmname] = 0.1</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">383</td> + <td class="coverage">26<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (grepl("bound_free$", parmname)) parms.ini[parmname] = 0.02</pre> + </td> + </tr> + <tr class="never"> + <td class="num">384</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Default values for IORE exponents</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">385</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (grepl("^N", parmname)) parms.ini[parmname] = 1.1</pre> + </td> + </tr> + <tr class="never"> + <td class="num">386</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Default values for the FOMC, DFOP and HS models</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">387</td> + <td class="coverage">238<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (parmname == "alpha") parms.ini[parmname] = 1</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">388</td> + <td class="coverage">238<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (parmname == "beta") parms.ini[parmname] = 10</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">389</td> + <td class="coverage">1014<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (parmname == "k1") parms.ini[parmname] = 0.1</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">390</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (parmname == "k2") parms.ini[parmname] = 0.01</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">391</td> + <td class="coverage">30<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (parmname == "tb") parms.ini[parmname] = 5</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">392</td> + <td class="coverage">984<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (parmname == "g") parms.ini[parmname] = 0.5</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">393</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (parmname == "kmax") parms.ini[parmname] = 0.1</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">394</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (parmname == "k0") parms.ini[parmname] = 0.0001</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">395</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (parmname == "r") parms.ini[parmname] = 0.2</pre> + </td> + </tr> + <tr class="never"> + <td class="num">396</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">397</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Default values for formation fractions in case they are present</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">398</td> + <td class="coverage">8633<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (obs_var in obs_vars) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">399</td> + <td class="coverage">13865<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> origin <- mkinmod$map[[obs_var]][[1]]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">400</td> + <td class="coverage">13865<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f_names <- mkinmod$parms[grep(paste0("^f_", origin), mkinmod$parms)]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">401</td> + <td class="coverage">13865<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(f_names) > 0) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">402</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # We need to differentiate between default and specified fractions</pre> + </td> + </tr> + <tr class="never"> + <td class="num">403</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # and set the unspecified to 1 - sum(specified)/n_unspecified</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">404</td> + <td class="coverage">3365<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f_default_names <- intersect(f_names, defaultpar.names)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">405</td> + <td class="coverage">3365<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f_specified_names <- setdiff(f_names, defaultpar.names)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">406</td> + <td class="coverage">3365<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> sum_f_specified = sum(parms.ini[f_specified_names])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">407</td> + <td class="coverage">3365<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (sum_f_specified > 1) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">408</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> stop("Starting values for the formation fractions originating from ",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">409</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> origin, " sum up to more than 1.")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">410</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">411</td> + <td class="coverage">3260<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (mkinmod$spec[[obs_var]]$sink) n_unspecified = length(f_default_names) + 1</pre> + </td> + </tr> + <tr class="never"> + <td class="num">412</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">413</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n_unspecified = length(f_default_names)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">414</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">415</td> + <td class="coverage">3261<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms.ini[f_default_names] <- (1 - sum_f_specified) / n_unspecified</pre> + </td> + </tr> + <tr class="never"> + <td class="num">416</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">417</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">418</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">419</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Set default for state.ini if appropriate</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">420</td> + <td class="coverage">8529<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parent_name = names(mkinmod$spec)[[1]]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">421</td> + <td class="coverage">8529<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parent_time_0 = subset(observed, time == 0 & name == parent_name)$value</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">422</td> + <td class="coverage">8529<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parent_time_0_mean = mean(parent_time_0, na.rm = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">423</td> + <td class="coverage">8529<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.na(parent_time_0_mean)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">424</td> + <td class="coverage">2<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> state.ini_auto = c(100, rep(0, length(mkinmod$diffs) - 1))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">425</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">426</td> + <td class="coverage">8527<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> state.ini_auto = c(parent_time_0_mean, rep(0, length(mkinmod$diffs) - 1))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">427</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">428</td> + <td class="coverage">8529<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(state.ini_auto) <- mod_vars</pre> + </td> + </tr> + <tr class="never"> + <td class="num">429</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">430</td> + <td class="coverage">8529<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (state.ini[1] == "auto") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">431</td> + <td class="coverage">8316<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> state.ini_used <- state.ini_auto</pre> + </td> + </tr> + <tr class="never"> + <td class="num">432</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">433</td> + <td class="coverage">213<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> state.ini_used <- state.ini_auto</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">434</td> + <td class="coverage">213<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> state.ini_good <- intersect(names(mkinmod$diffs), names(state.ini))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">435</td> + <td class="coverage">213<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> state.ini_used[state.ini_good] <- state.ini[state.ini_good]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">436</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">437</td> + <td class="coverage">8529<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> state.ini <- state.ini_used</pre> + </td> + </tr> + <tr class="never"> + <td class="num">438</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">439</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Name the inital state variable values if they are not named yet</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">440</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if(is.null(names(state.ini))) names(state.ini) <- mod_vars</pre> + </td> + </tr> + <tr class="never"> + <td class="num">441</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">442</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Transform initial parameter values for fitting</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">443</td> + <td class="coverage">8529<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transparms.ini <- transform_odeparms(parms.ini, mkinmod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">444</td> + <td class="coverage">8529<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_rates = transform_rates,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">445</td> + <td class="coverage">8529<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_fractions = transform_fractions)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">446</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">447</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Parameters to be optimised:</pre> + </td> + </tr> + <tr class="never"> + <td class="num">448</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Kinetic parameters in parms.ini whose names are not in fixed_parms</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">449</td> + <td class="coverage">8529<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms.fixed <- parms.ini[fixed_parms]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">450</td> + <td class="coverage">8529<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms.optim <- parms.ini[setdiff(names(parms.ini), fixed_parms)]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">451</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">452</td> + <td class="coverage">8529<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transparms.fixed <- transform_odeparms(parms.fixed, mkinmod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">453</td> + <td class="coverage">8529<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_rates = transform_rates,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">454</td> + <td class="coverage">8529<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_fractions = transform_fractions)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">455</td> + <td class="coverage">8529<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transparms.optim <- transform_odeparms(parms.optim, mkinmod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">456</td> + <td class="coverage">8529<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_rates = transform_rates,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">457</td> + <td class="coverage">8529<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_fractions = transform_fractions)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">458</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">459</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Inital state variables in state.ini whose names are not in fixed_initials</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">460</td> + <td class="coverage">8529<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> state.ini.fixed <- state.ini[fixed_initials]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">461</td> + <td class="coverage">8529<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> state.ini.optim <- state.ini[setdiff(names(state.ini), fixed_initials)]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">462</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">463</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Preserve names of state variables before renaming initial state variable</pre> + </td> + </tr> + <tr class="never"> + <td class="num">464</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # parameters</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">465</td> + <td class="coverage">8529<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> state.ini.optim.boxnames <- names(state.ini.optim)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">466</td> + <td class="coverage">8529<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> state.ini.fixed.boxnames <- names(state.ini.fixed)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">467</td> + <td class="coverage">8529<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(length(state.ini.optim) > 0) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">468</td> + <td class="coverage">8529<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(state.ini.optim) <- paste(names(state.ini.optim), "0", sep="_")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">469</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">470</td> + <td class="coverage">8529<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(length(state.ini.fixed) > 0) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">471</td> + <td class="coverage">4509<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(state.ini.fixed) <- paste(names(state.ini.fixed), "0", sep="_")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">472</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">473</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">474</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Decide if the solution of the model can be based on a simple analytical</pre> + </td> + </tr> + <tr class="never"> + <td class="num">475</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # formula, the spectral decomposition of the matrix (fundamental system)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">476</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # or a numeric ode solver from the deSolve package</pre> + </td> + </tr> + <tr class="never"> + <td class="num">477</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Prefer deSolve over eigen if a compiled model is present and use_compiled</pre> + </td> + </tr> + <tr class="never"> + <td class="num">478</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # is not set to FALSE</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">479</td> + <td class="coverage">8529<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> solution_type = match.arg(solution_type)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">480</td> + <td class="coverage">8529<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (solution_type == "analytical" && !is.function(mkinmod$deg_func))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">481</td> + <td class="coverage">105<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> stop("Analytical solution not implemented for this model.")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">482</td> + <td class="coverage">8424<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (solution_type == "eigen" && !is.matrix(mkinmod$coefmat))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">483</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> stop("Eigenvalue based solution not possible, coefficient matrix not present.")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">484</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (solution_type == "auto") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">485</td> + <td class="coverage">6190<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(mkinmod$spec) == 1 || is.function(mkinmod$deg_func)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">486</td> + <td class="coverage">5434<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> solution_type = "analytical"</pre> + </td> + </tr> + <tr class="never"> + <td class="num">487</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">488</td> + <td class="coverage">756<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.null(mkinmod$cf) & use_compiled[1] != FALSE) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">489</td> + <td class="coverage">756<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> solution_type = "deSolve"</pre> + </td> + </tr> + <tr class="never"> + <td class="num">490</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">491</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.matrix(mkinmod$coefmat)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">492</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> solution_type = "eigen"</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">493</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (max(observed$value, na.rm = TRUE) < 0.1) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">494</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> stop("The combination of small observed values (all < 0.1) and solution_type = eigen is error-prone")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">495</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">496</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">497</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> solution_type = "deSolve"</pre> + </td> + </tr> + <tr class="never"> + <td class="num">498</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">499</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">500</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">501</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">502</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">503</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Get native symbol before iterations info for speed</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">504</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> use_symbols = FALSE</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">505</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (solution_type == "deSolve" & use_compiled[1] != FALSE) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">506</td> + <td class="coverage">2144<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mkinmod[["symbols"]] <- try(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">507</td> + <td class="coverage">2144<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> deSolve::checkDLL(dllname = mkinmod$dll_info[["name"]],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">508</td> + <td class="coverage">2144<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> func = "diffs", initfunc = "initpar",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">509</td> + <td class="coverage">2144<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> jacfunc = NULL, nout = 0, outnames = NULL))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">510</td> + <td class="coverage">2144<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!inherits(mkinmod[["symbols"]], "try-error")) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">511</td> + <td class="coverage">2144<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> use_symbols = TRUE</pre> + </td> + </tr> + <tr class="never"> + <td class="num">512</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">513</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">514</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">515</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Get the error model and the algorithm for fitting</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">516</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> err_mod <- match.arg(error_model)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">517</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> error_model_algorithm = match.arg(error_model_algorithm)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">518</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (error_model_algorithm == "OLS") {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">519</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (err_mod != "const") stop("OLS is only appropriate for constant variance")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">520</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">521</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (error_model_algorithm == "auto") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">522</td> + <td class="coverage">6692<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> error_model_algorithm = switch(err_mod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">523</td> + <td class="coverage">6692<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> const = "OLS", obs = "d_3", tc = "d_3")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">524</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">525</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> errparm_names <- switch(err_mod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">526</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "const" = "sigma",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">527</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "obs" = paste0("sigma_", obs_vars),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">528</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "tc" = c("sigma_low", "rsd_high"))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">529</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> errparm_names_optim <- if (error_model_algorithm == "OLS") NULL else errparm_names</pre> + </td> + </tr> + <tr class="never"> + <td class="num">530</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">531</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Define starting values for the error model</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">532</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (err.ini[1] != "auto") {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">533</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (!identical(names(err.ini), errparm_names)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">534</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> stop("Please supply initial values for error model components ", paste(errparm_names, collapse = ", "))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">535</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">536</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> errparms = err.ini</pre> + </td> + </tr> + <tr class="never"> + <td class="num">537</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">538</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">539</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (err_mod == "const") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">540</td> + <td class="coverage">6410<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> errparms = 3</pre> + </td> + </tr> + <tr class="never"> + <td class="num">541</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">542</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (err_mod == "obs") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">543</td> + <td class="coverage">317<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> errparms = rep(3, length(obs_vars))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">544</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">545</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (err_mod == "tc") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">546</td> + <td class="coverage">1593<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> errparms <- c(sigma_low = 0.1, rsd_high = 0.1)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">547</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">548</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(errparms) <- errparm_names</pre> + </td> + </tr> + <tr class="never"> + <td class="num">549</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">550</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (error_model_algorithm == "OLS") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">551</td> + <td class="coverage">6410<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> errparms_optim <- NULL</pre> + </td> + </tr> + <tr class="never"> + <td class="num">552</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">553</td> + <td class="coverage">1910<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> errparms_optim <- errparms</pre> + </td> + </tr> + <tr class="never"> + <td class="num">554</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">555</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">556</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Unique outtimes for model solution.</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">557</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> outtimes <- sort(unique(observed$time))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">558</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">559</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Define the objective function for optimisation, including (back)transformations</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">560</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cost_function <- function(P, trans = TRUE, OLS = FALSE, fixed_degparms = FALSE, fixed_errparms = FALSE, update_data = TRUE, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">561</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">562</td> + <td class="coverage">4086568<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> assign("calls", calls + 1, inherits = TRUE) # Increase the model solution counter</pre> + </td> + </tr> + <tr class="never"> + <td class="num">563</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">564</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> #browser()</pre> + </td> + </tr> + <tr class="never"> + <td class="num">565</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">566</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Trace parameter values if requested and if we are actually optimising</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">567</td> + <td class="coverage">3224<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(trace_parms & update_data) cat(format(P, width = 10, digits = 6), "\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">568</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">569</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Determine local parameter values for the cost estimation</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">570</td> + <td class="coverage">4086568<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.numeric(fixed_degparms)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">571</td> + <td class="coverage">94746<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cost_degparms <- fixed_degparms</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">572</td> + <td class="coverage">94746<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cost_errparms <- P</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">573</td> + <td class="coverage">94746<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms_fixed = TRUE</pre> + </td> + </tr> + <tr class="never"> + <td class="num">574</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">575</td> + <td class="coverage">3991822<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms_fixed = FALSE</pre> + </td> + </tr> + <tr class="never"> + <td class="num">576</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">577</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">578</td> + <td class="coverage">4086568<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.numeric(fixed_errparms)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">579</td> + <td class="coverage">4725<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cost_degparms <- P</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">580</td> + <td class="coverage">4725<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cost_errparms <- fixed_errparms</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">581</td> + <td class="coverage">4725<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> errparms_fixed = TRUE</pre> + </td> + </tr> + <tr class="never"> + <td class="num">582</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">583</td> + <td class="coverage">4081843<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> errparms_fixed = FALSE</pre> + </td> + </tr> + <tr class="never"> + <td class="num">584</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">585</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">586</td> + <td class="coverage">4086568<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (OLS) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">587</td> + <td class="coverage">1063145<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cost_degparms <- P</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">588</td> + <td class="coverage">1063145<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cost_errparms <- numeric(0)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">589</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">590</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">591</td> + <td class="coverage">4086568<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!OLS & !degparms_fixed & !errparms_fixed) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">592</td> + <td class="coverage">2923952<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cost_degparms <- P[1:(length(P) - length(errparms))]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">593</td> + <td class="coverage">2923952<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cost_errparms <- P[(length(cost_degparms) + 1):length(P)]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">594</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">595</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">596</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Initial states for t0</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">597</td> + <td class="coverage">4086568<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(length(state.ini.optim) > 0) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">598</td> + <td class="coverage">4086568<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeini <- c(cost_degparms[1:length(state.ini.optim)], state.ini.fixed)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">599</td> + <td class="coverage">4086568<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(odeini) <- c(state.ini.optim.boxnames, state.ini.fixed.boxnames)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">600</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">601</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> odeini <- state.ini.fixed</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">602</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> names(odeini) <- state.ini.fixed.boxnames</pre> + </td> + </tr> + <tr class="never"> + <td class="num">603</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">604</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">605</td> + <td class="coverage">4086568<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeparms.optim <- cost_degparms[(length(state.ini.optim) + 1):length(cost_degparms)]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">606</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">607</td> + <td class="coverage">4086568<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (trans == TRUE) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">608</td> + <td class="coverage">2580794<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeparms <- c(odeparms.optim, transparms.fixed)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">609</td> + <td class="coverage">2580794<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms <- backtransform_odeparms(odeparms, mkinmod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">610</td> + <td class="coverage">2580794<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_rates = transform_rates,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">611</td> + <td class="coverage">2580794<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_fractions = transform_fractions)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">612</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">613</td> + <td class="coverage">1505774<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms <- c(odeparms.optim, parms.fixed)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">614</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">615</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">616</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Solve the system with current parameter values</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">617</td> + <td class="coverage">4086568<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (solution_type == "analytical") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">618</td> + <td class="coverage">2562380<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> observed$predicted <- mkinmod$deg_func(observed, odeini, parms)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">619</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">620</td> + <td class="coverage">1524188<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> out <- mkinpredict(mkinmod, parms,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">621</td> + <td class="coverage">1524188<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeini, outtimes,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">622</td> + <td class="coverage">1524188<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> solution_type = solution_type,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">623</td> + <td class="coverage">1524188<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> use_compiled = use_compiled,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">624</td> + <td class="coverage">1524188<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> use_symbols = use_symbols,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">625</td> + <td class="coverage">1524188<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> method.ode = method.ode,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">626</td> + <td class="coverage">1524188<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> atol = atol, rtol = rtol,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">627</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">628</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">629</td> + <td class="coverage">1524188<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> observed_index <- cbind(as.character(observed$time), as.character(observed$name))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">630</td> + <td class="coverage">1524188<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> observed$predicted <- out[observed_index]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">631</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">632</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">633</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Define standard deviation for each observation</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">634</td> + <td class="coverage">4086568<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (err_mod == "const") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">635</td> + <td class="coverage">2789021<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> observed$std <- if (OLS) NA else cost_errparms["sigma"]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">636</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">637</td> + <td class="coverage">4086568<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (err_mod == "obs") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">638</td> + <td class="coverage">366137<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> std_names <- paste0("sigma_", observed$name)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">639</td> + <td class="coverage">366137<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> observed$std <- cost_errparms[std_names]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">640</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">641</td> + <td class="coverage">4086568<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (err_mod == "tc") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">642</td> + <td class="coverage">931410<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> observed$std <- sqrt(cost_errparms["sigma_low"]^2 + observed$predicted^2 * cost_errparms["rsd_high"]^2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">643</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">644</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">645</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Calculate model cost</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">646</td> + <td class="coverage">4086568<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (OLS) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">647</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Cost is the sum of squared residuals</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">648</td> + <td class="coverage">1063145<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cost <- with(observed, sum((value - predicted)^2))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">649</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">650</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Cost is the negative log-likelihood</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">651</td> + <td class="coverage">3023423<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cost <- - with(observed,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">652</td> + <td class="coverage">3023423<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> sum(dnorm(x = value, mean = predicted, sd = std, log = TRUE)))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">653</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">654</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">655</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # We update the current cost and data during the optimisation, not</pre> + </td> + </tr> + <tr class="never"> + <td class="num">656</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # during hessian calculations</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">657</td> + <td class="coverage">4086568<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (update_data) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">658</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">659</td> + <td class="coverage">1622188<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> assign("current_data", observed, inherits = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">660</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">661</td> + <td class="coverage">1622188<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (cost < cost.current) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">662</td> + <td class="coverage">594930<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> assign("cost.current", cost, inherits = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">663</td> + <td class="coverage">1768<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!quiet) message(ifelse(OLS, "Sum of squared residuals", "Negative log-likelihood"),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">664</td> + <td class="coverage">1768<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> " at call ", calls, ": ", signif(cost.current, 6), "\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">665</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">666</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">667</td> + <td class="coverage">4086415<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(cost)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">668</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">669</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">670</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names_optim <- c(names(state.ini.optim),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">671</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(transparms.optim),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">672</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> errparm_names_optim)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">673</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n_optim <- length(names_optim)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">674</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">675</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Define lower and upper bounds other than -Inf and Inf for parameters</pre> + </td> + </tr> + <tr class="never"> + <td class="num">676</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # for which no internal transformation is requested in the call to mkinfit</pre> + </td> + </tr> + <tr class="never"> + <td class="num">677</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # and for optimised error model parameters</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">678</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lower <- rep(-Inf, n_optim)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">679</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> upper <- rep(Inf, n_optim)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">680</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(lower) <- names(upper) <- names_optim</pre> + </td> + </tr> + <tr class="never"> + <td class="num">681</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">682</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # IORE exponents are not transformed, but need a lower bound</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">683</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> index_N <- grep("^N", names(lower))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">684</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lower[index_N] <- 0</pre> + </td> + </tr> + <tr class="never"> + <td class="num">685</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">686</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!transform_rates) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">687</td> + <td class="coverage">553<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> index_k <- grep("^k_", names(lower))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">688</td> + <td class="coverage">553<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lower[index_k] <- 0</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">689</td> + <td class="coverage">553<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> index_k__iore <- grep("^k__iore_", names(lower))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">690</td> + <td class="coverage">553<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lower[index_k__iore] <- 0</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">691</td> + <td class="coverage">553<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> other_rate_parms <- intersect(c("alpha", "beta", "k1", "k2", "tb", "r"), names(lower))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">692</td> + <td class="coverage">553<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lower[other_rate_parms] <- 0</pre> + </td> + </tr> + <tr class="never"> + <td class="num">693</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">694</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">695</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!transform_fractions) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">696</td> + <td class="coverage">306<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> index_f <- grep("^f_", names(upper))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">697</td> + <td class="coverage">306<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lower[index_f] <- 0</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">698</td> + <td class="coverage">306<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> upper[index_f] <- 1</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">699</td> + <td class="coverage">306<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> other_fraction_parms <- intersect(c("g"), names(upper))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">700</td> + <td class="coverage">306<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lower[other_fraction_parms] <- 0</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">701</td> + <td class="coverage">306<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> upper[other_fraction_parms] <- 1</pre> + </td> + </tr> + <tr class="never"> + <td class="num">702</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">703</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">704</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (err_mod == "const") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">705</td> + <td class="coverage">6410<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (error_model_algorithm != "OLS") {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">706</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> lower["sigma"] <- 0</pre> + </td> + </tr> + <tr class="never"> + <td class="num">707</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">708</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">709</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (err_mod == "obs") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">710</td> + <td class="coverage">317<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> index_sigma <- grep("^sigma_", names(lower))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">711</td> + <td class="coverage">317<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lower[index_sigma] <- 0</pre> + </td> + </tr> + <tr class="never"> + <td class="num">712</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">713</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (err_mod == "tc") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">714</td> + <td class="coverage">1593<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lower["sigma_low"] <- 0</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">715</td> + <td class="coverage">1593<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lower["rsd_high"] <- 0</pre> + </td> + </tr> + <tr class="never"> + <td class="num">716</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">717</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">718</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Counter for cost function evaluations</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">719</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> calls = 0</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">720</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cost.current <- Inf</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">721</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> out_predicted <- NA</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">722</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> current_data <- NA</pre> + </td> + </tr> + <tr class="never"> + <td class="num">723</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">724</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Show parameter names if tracing is requested</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">725</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(trace_parms) cat(format(names_optim, width = 10), "\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">726</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">727</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> #browser()</pre> + </td> + </tr> + <tr class="never"> + <td class="num">728</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">729</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Do the fit and take the time until the hessians are calculated</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">730</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit_time <- system.time({</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">731</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms <- c(state.ini.optim, transparms.optim)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">732</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n_degparms <- length(degparms)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">733</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms_index <- seq(1, n_degparms)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">734</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> errparms_index <- seq(n_degparms + 1, length.out = length(errparms))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">735</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">736</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (error_model_algorithm == "d_3") {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">737</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (!quiet) message("Directly optimising the complete model")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">738</td> + <td class="coverage">471<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms.start <- c(degparms, errparms)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">739</td> + <td class="coverage">471<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit_direct <- try(nlminb(parms.start, cost_function,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">740</td> + <td class="coverage">471<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lower = lower[names(parms.start)],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">741</td> + <td class="coverage">471<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> upper = upper[names(parms.start)],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">742</td> + <td class="coverage">471<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> control = control, ...))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">743</td> + <td class="coverage">471<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!inherits(fit_direct, "try-error")) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">744</td> + <td class="coverage">471<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit_direct$logLik <- - cost.current</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">745</td> + <td class="coverage">471<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cost.current <- Inf # reset to avoid conflict with the OLS step</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">746</td> + <td class="coverage">471<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> data_direct <- current_data # We need this later if it was better</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">747</td> + <td class="coverage">471<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> direct_failed = FALSE</pre> + </td> + </tr> + <tr class="never"> + <td class="num">748</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">749</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> direct_failed = TRUE</pre> + </td> + </tr> + <tr class="never"> + <td class="num">750</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">751</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">752</td> + <td class="coverage">8320<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (error_model_algorithm != "direct") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">753</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!quiet) message("Ordinary least squares optimisation")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">754</td> + <td class="coverage">7884<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit <- nlminb(degparms, cost_function, control = control,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">755</td> + <td class="coverage">7884<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lower = lower[names(degparms)],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">756</td> + <td class="coverage">7884<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> upper = upper[names(degparms)], OLS = TRUE, ...)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">757</td> + <td class="coverage">7731<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms <- fit$par</pre> + </td> + </tr> + <tr class="never"> + <td class="num">758</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">759</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Get the maximum likelihood estimate for sigma at the optimum parameter values</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">760</td> + <td class="coverage">7731<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> current_data$residual <- current_data$value - current_data$predicted</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">761</td> + <td class="coverage">7731<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> sigma_mle <- sqrt(sum(current_data$residual^2)/nrow(current_data))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">762</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">763</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Use that estimate for the constant variance, or as first guess if err_mod = "obs"</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">764</td> + <td class="coverage">7731<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (err_mod != "tc") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">765</td> + <td class="coverage">6327<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> errparms[names(errparms)] <- sigma_mle</pre> + </td> + </tr> + <tr class="never"> + <td class="num">766</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">767</td> + <td class="coverage">7731<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$par <- c(fit$par, errparms)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">768</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">769</td> + <td class="coverage">7731<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cost.current <- cost_function(c(degparms, errparms), OLS = FALSE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">770</td> + <td class="coverage">7731<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$logLik <- - cost.current</pre> + </td> + </tr> + <tr class="never"> + <td class="num">771</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">772</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (error_model_algorithm %in% c("threestep", "fourstep", "d_3")) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">773</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (!quiet) message("Optimising the error model")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">774</td> + <td class="coverage">1096<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit <- nlminb(errparms, cost_function, control = control,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">775</td> + <td class="coverage">1096<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lower = lower[names(errparms)],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">776</td> + <td class="coverage">1096<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> upper = upper[names(errparms)],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">777</td> + <td class="coverage">1096<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fixed_degparms = degparms, ...)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">778</td> + <td class="coverage">1096<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> errparms <- fit$par</pre> + </td> + </tr> + <tr class="never"> + <td class="num">779</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">780</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (error_model_algorithm == "fourstep") {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">781</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (!quiet) message("Optimising the degradation model")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">782</td> + <td class="coverage">189<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit <- nlminb(degparms, cost_function, control = control,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">783</td> + <td class="coverage">189<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lower = lower[names(degparms)],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">784</td> + <td class="coverage">189<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> upper = upper[names(degparms)],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">785</td> + <td class="coverage">189<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fixed_errparms = errparms, ...)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">786</td> + <td class="coverage">189<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms <- fit$par</pre> + </td> + </tr> + <tr class="never"> + <td class="num">787</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">788</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (error_model_algorithm %in%</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">789</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> c("direct", "twostep", "threestep", "fourstep", "d_3")) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">790</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (!quiet) message("Optimising the complete model")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">791</td> + <td class="coverage">1721<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms.start <- c(degparms, errparms)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">792</td> + <td class="coverage">1721<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit <- nlminb(parms.start, cost_function,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">793</td> + <td class="coverage">1721<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lower = lower[names(parms.start)],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">794</td> + <td class="coverage">1721<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> upper = upper[names(parms.start)],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">795</td> + <td class="coverage">1721<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> control = control, ...)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">796</td> + <td class="coverage">1721<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms <- fit$par[degparms_index]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">797</td> + <td class="coverage">1721<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> errparms <- fit$par[errparms_index]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">798</td> + <td class="coverage">1721<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$logLik <- - cost.current</pre> + </td> + </tr> + <tr class="never"> + <td class="num">799</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">800</td> + <td class="coverage">1721<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (error_model_algorithm == "d_3") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">801</td> + <td class="coverage">471<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> d_3_messages = c(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">802</td> + <td class="coverage">471<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> direct_failed = "Direct fitting failed, results of three-step fitting are returned",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">803</td> + <td class="coverage">471<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> same = "Direct fitting and three-step fitting yield approximately the same likelihood",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">804</td> + <td class="coverage">471<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> threestep = "Three-step fitting yielded a higher likelihood than direct fitting",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">805</td> + <td class="coverage">471<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> direct = "Direct fitting yielded a higher likelihood than three-step fitting")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">806</td> + <td class="coverage">471<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (direct_failed) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">807</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (!quiet) message(d_3_messages["direct_failed"])</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">808</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> fit$d_3_message <- d_3_messages["direct_failed"]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">809</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">810</td> + <td class="coverage">471<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rel_diff <- abs((fit_direct$logLik - fit$logLik))/-mean(c(fit_direct$logLik, fit$logLik))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">811</td> + <td class="coverage">471<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (rel_diff < 0.0001) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">812</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (!quiet) message(d_3_messages["same"])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">813</td> + <td class="coverage">240<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$d_3_message <- d_3_messages["same"]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">814</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">815</td> + <td class="coverage">231<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (fit$logLik > fit_direct$logLik) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">816</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (!quiet) message(d_3_messages["threestep"])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">817</td> + <td class="coverage">15<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$d_3_message <- d_3_messages["threestep"]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">818</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">819</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (!quiet) message(d_3_messages["direct"])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">820</td> + <td class="coverage">216<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit <- fit_direct</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">821</td> + <td class="coverage">216<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$d_3_message <- d_3_messages["direct"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">822</td> + <td class="coverage">216<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms <- fit$par[degparms_index]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">823</td> + <td class="coverage">216<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> errparms <- fit$par[errparms_index]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">824</td> + <td class="coverage">216<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> current_data <- data_direct</pre> + </td> + </tr> + <tr class="never"> + <td class="num">825</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">826</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">827</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">828</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">829</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">830</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (err_mod != "const" & error_model_algorithm == "IRLS") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">831</td> + <td class="coverage">189<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> reweight.diff <- 1</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">832</td> + <td class="coverage">189<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n.iter <- 0</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">833</td> + <td class="coverage">189<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> errparms_last <- errparms</pre> + </td> + </tr> + <tr class="never"> + <td class="num">834</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">835</td> + <td class="coverage">189<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> while (reweight.diff > reweight.tol &</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">836</td> + <td class="coverage">189<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n.iter < reweight.max.iter) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">837</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="missed"> + <td class="num">838</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (!quiet) message("Optimising the error model")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">839</td> + <td class="coverage">756<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit <- nlminb(errparms, cost_function, control = control,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">840</td> + <td class="coverage">756<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lower = lower[names(errparms)],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">841</td> + <td class="coverage">756<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> upper = upper[names(errparms)],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">842</td> + <td class="coverage">756<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fixed_degparms = degparms, ...)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">843</td> + <td class="coverage">756<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> errparms <- fit$par</pre> + </td> + </tr> + <tr class="never"> + <td class="num">844</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="missed"> + <td class="num">845</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (!quiet) message("Optimising the degradation model")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">846</td> + <td class="coverage">756<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit <- nlminb(degparms, cost_function, control = control,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">847</td> + <td class="coverage">756<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lower = lower[names(degparms)],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">848</td> + <td class="coverage">756<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> upper = upper[names(degparms)],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">849</td> + <td class="coverage">756<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fixed_errparms = errparms, ...)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">850</td> + <td class="coverage">756<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparms <- fit$par</pre> + </td> + </tr> + <tr class="never"> + <td class="num">851</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">852</td> + <td class="coverage">756<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> reweight.diff <- dist(rbind(errparms, errparms_last))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">853</td> + <td class="coverage">756<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> errparms_last <- errparms</pre> + </td> + </tr> + <tr class="never"> + <td class="num">854</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">855</td> + <td class="coverage">756<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$par <- c(fit$par, errparms)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">856</td> + <td class="coverage">756<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cost.current <- cost_function(c(degparms, errparms), OLS = FALSE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">857</td> + <td class="coverage">756<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$logLik <- - cost.current</pre> + </td> + </tr> + <tr class="never"> + <td class="num">858</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">859</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">860</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">861</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dim_hessian <- length(c(degparms, errparms))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">862</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">863</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$hessian <- try(numDeriv::hessian(cost_function, c(degparms, errparms), OLS = FALSE,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">864</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> update_data = FALSE), silent = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">865</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (inherits(fit$hessian, "try-error")) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">866</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> fit$hessian <- matrix(NA, nrow = dim_hessian, ncol = dim_hessian)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">867</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">868</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dimnames(fit$hessian) <- list(names(c(degparms, errparms)),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">869</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(c(degparms, errparms)))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">870</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">871</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Backtransform parameters</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">872</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> bparms.optim = backtransform_odeparms(degparms, mkinmod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">873</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_rates = transform_rates,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">874</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_fractions = transform_fractions)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">875</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> bparms.fixed = c(state.ini.fixed, parms.fixed)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">876</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> bparms.all = c(bparms.optim, parms.fixed)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">877</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">878</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$hessian_notrans <- try(numDeriv::hessian(cost_function, c(bparms.optim, errparms),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">879</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> OLS = FALSE, trans = FALSE, update_data = FALSE), silent = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">880</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (inherits(fit$hessian_notrans, "try-error")) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">881</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> fit$hessian_notrans <- matrix(NA, nrow = dim_hessian, ncol = dim_hessian)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">882</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">883</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dimnames(fit$hessian_notrans) <- list(names(c(bparms.optim, errparms)),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">884</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(c(bparms.optim, errparms)))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">885</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> })</pre> + </td> + </tr> + <tr class="never"> + <td class="num">886</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">887</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$call <- call</pre> + </td> + </tr> + <tr class="never"> + <td class="num">888</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">889</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$error_model_algorithm <- error_model_algorithm</pre> + </td> + </tr> + <tr class="never"> + <td class="num">890</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">891</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (fit$convergence != 0) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">892</td> + <td class="coverage">108<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> convergence_warning = paste0("Optimisation did not converge:\n", fit$message)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">893</td> + <td class="coverage">108<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> summary_warnings <- c(summary_warnings, C = convergence_warning)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">894</td> + <td class="coverage">108<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> warning(convergence_warning)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">895</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">896</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(!quiet) message("Optimisation successfully terminated.\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">897</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">898</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">899</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # We need to return some more data for summary and plotting</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">900</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$solution_type <- solution_type</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">901</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$transform_rates <- transform_rates</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">902</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$transform_fractions <- transform_fractions</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">903</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$reweight.tol <- reweight.tol</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">904</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$reweight.max.iter <- reweight.max.iter</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">905</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$control <- control</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">906</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$calls <- calls</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">907</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$time <- fit_time</pre> + </td> + </tr> + <tr class="never"> + <td class="num">908</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">909</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # We also need the model and a model name for summary and plotting,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">910</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # but without symbols because they could become invalid</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">911</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$symbols <- NULL</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">912</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$mkinmod <- mkinmod</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">913</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$mkinmod$name <- mkinmod_name</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">914</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$obs_vars <- obs_vars</pre> + </td> + </tr> + <tr class="never"> + <td class="num">915</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">916</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Residual sum of squares as a function of the fitted parameters</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">917</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$rss <- function(P) cost_function(P, OLS = TRUE, update_data = FALSE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">918</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">919</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Log-likelihood with possibility to fix degparms or errparms</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">920</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$ll <- function(P, fixed_degparms = FALSE, fixed_errparms = FALSE, trans = FALSE) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">921</td> + <td class="coverage">547080<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> - cost_function(P, trans = trans, fixed_degparms = fixed_degparms,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">922</td> + <td class="coverage">547080<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fixed_errparms = fixed_errparms, OLS = FALSE, update_data = FALSE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">923</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">924</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">925</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Collect initial parameter values in three dataframes</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">926</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$start <- data.frame(value = c(state.ini.optim,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">927</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms.optim, errparms_optim))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">928</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$start$type = c(rep("state", length(state.ini.optim)),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">929</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rep("deparm", length(parms.optim)),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">930</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rep("error", length(errparms_optim)))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">931</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">932</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$start_transformed = data.frame(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">933</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> value = c(state.ini.optim, transparms.optim, errparms_optim),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">934</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lower = lower,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">935</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> upper = upper)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">936</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">937</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$fixed <- data.frame(value = c(state.ini.fixed, parms.fixed))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">938</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$fixed$type = c(rep("state", length(state.ini.fixed)),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">939</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rep("deparm", length(parms.fixed)))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">940</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">941</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$data <- data.frame(time = current_data$time,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">942</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> variable = current_data$name,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">943</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> observed = current_data$value,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">944</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> predicted = current_data$predicted)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">945</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">946</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$data$residual <- fit$data$observed - fit$data$predicted</pre> + </td> + </tr> + <tr class="never"> + <td class="num">947</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">948</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$atol <- atol</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">949</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$rtol <- rtol</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">950</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$err_mod <- err_mod</pre> + </td> + </tr> + <tr class="never"> + <td class="num">951</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">952</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Return different sets of backtransformed parameters for summary and plotting</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">953</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$bparms.optim <- bparms.optim</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">954</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$bparms.fixed <- bparms.fixed</pre> + </td> + </tr> + <tr class="never"> + <td class="num">955</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">956</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Return ode and state parameters for further fitting</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">957</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$bparms.ode <- bparms.all[mkinmod$parms]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">958</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$bparms.state <- c(bparms.all[setdiff(names(bparms.all), names(fit$bparms.ode))],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">959</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> state.ini.fixed)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">960</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(fit$bparms.state) <- gsub("_0$", "", names(fit$bparms.state))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">961</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">962</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$errparms <- errparms</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">963</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$df.residual <- n_observed - length(c(degparms, errparms))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">964</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">965</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Assign the class here so method dispatch works for residuals</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">966</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(fit) <- c("mkinfit")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">967</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">968</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (test_residuals) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">969</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Check for normal distribution of residuals</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">970</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$shapiro.p <- shapiro.test(residuals(fit, standardized = TRUE))$p.value</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">971</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (fit$shapiro.p < 0.05) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">972</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> shapiro_warning <- paste("Shapiro-Wilk test for standardized residuals: p = ", signif(fit$shapiro.p, 3))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">973</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> warning(shapiro_warning)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">974</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> summary_warnings <- c(summary_warnings, S = shapiro_warning)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">975</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">976</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">977</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">978</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$summary_warnings <- summary_warnings</pre> + </td> + </tr> + <tr class="never"> + <td class="num">979</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">980</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$date <- date()</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">981</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$version <- as.character(utils::packageVersion("mkin"))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">982</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$Rversion <- paste(R.version$major, R.version$minor, sep=".")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">983</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">984</td> + <td class="coverage">8167<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(fit)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">985</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/illparms.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Method to get the names of ill-defined parameters</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' The method for generalised nonlinear regression fits as obtained</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' with [mkinfit] and [mmkin] checks if the degradation parameters</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' pass the Wald test (in degradation kinetics often simply called t-test) for</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' significant difference from zero. For this test, the parameterisation</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' without parameter transformations is used.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' The method for hierarchical model fits, also known as nonlinear</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' mixed-effects model fits as obtained with [saem] and [mhmkin]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' checks if any of the confidence intervals for the random</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' effects expressed as standard deviations include zero, and if</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the confidence intervals for the error model parameters include</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' zero.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param object The object to investigate</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param x The object to be printed</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param conf.level The confidence level for checking p values</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots For potential future extensions</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param random For hierarchical fits, should random effects be tested?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param errmod For hierarchical fits, should error model parameters be</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' tested?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param slopes For hierarchical [saem] fits using saemix as backend,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' should slope parameters in the covariate model(starting with 'beta_') be</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' tested?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return For [mkinfit] or [saem] objects, a character vector of parameter</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' names. For [mmkin] or [mhmkin] objects, a matrix like object of class</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' 'illparms.mmkin' or 'illparms.mhmkin'.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @note All return objects have printing methods. For the single fits, printing</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' does not output anything in the case no ill-defined parameters are found.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">illparms <- function(object, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">34</td> + <td class="coverage">2471<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> UseMethod("illparms", object)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname illparms</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit <- mkinfit("FOMC", FOCUS_2006_A, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' illparms(fit)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">illparms.mkinfit <- function(object, conf.level = 0.95, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">43</td> + <td class="coverage">8<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> p_values <- suppressWarnings(summary(object)$bpar[, "Pr(>t)"])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">44</td> + <td class="coverage">8<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> na <- is.na(p_values)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">45</td> + <td class="coverage">8<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> failed <- p_values > 1 - conf.level</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">46</td> + <td class="coverage">8<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ret <- names(parms(object))[na | failed]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">47</td> + <td class="coverage">8<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(ret) <- "illparms.mkinfit"</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">48</td> + <td class="coverage">8<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(ret)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname illparms</pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">print.illparms.mkinfit <- function(x, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">54</td> + <td class="coverage">190<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(x) <- NULL</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">55</td> + <td class="coverage">190<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(x) > 0) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">56</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> print(as.character(x))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">57</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">60</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname illparms</pre> + </td> + </tr> + <tr class="never"> + <td class="num">61</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">62</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">63</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">64</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fits <- mmkin(</pre> + </td> + </tr> + <tr class="never"> + <td class="num">65</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' c("SFO", "FOMC"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">66</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' list("FOCUS A" = FOCUS_2006_A,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">67</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' "FOCUS C" = FOCUS_2006_C),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">68</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">69</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' illparms(fits)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">70</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">71</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">illparms.mmkin <- function(object, conf.level = 0.95, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">72</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> result <- lapply(object,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">73</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> function(fit) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">74</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (inherits(fit, "try-error")) return("E")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">75</td> + <td class="coverage">8<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ill <- illparms(fit, conf.level = conf.level)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">76</td> + <td class="coverage">8<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(ill) > 0) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">77</td> + <td class="coverage">3<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(paste(ill, collapse = ", "))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">78</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">79</td> + <td class="coverage">5<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return("")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">80</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">81</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> })</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">82</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> result <- unlist(result)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">83</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dim(result) <- dim(object)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">84</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dimnames(result) <- dimnames(object)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">85</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(result) <- "illparms.mmkin"</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">86</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(result)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">87</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">88</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">89</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname illparms</pre> + </td> + </tr> + <tr class="never"> + <td class="num">90</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">91</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">print.illparms.mmkin <- function(x, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">92</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(x) <- NULL</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">93</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(x, quote = FALSE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">94</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">95</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">96</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname illparms</pre> + </td> + </tr> + <tr class="never"> + <td class="num">97</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">98</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">illparms.saem.mmkin <- function(object, conf.level = 0.95, random = TRUE, errmod = TRUE, slopes = TRUE, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">99</td> + <td class="coverage">2091<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (inherits(object$so, "try-error")) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">100</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> ill_parms <- NA</pre> + </td> + </tr> + <tr class="never"> + <td class="num">101</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">102</td> + <td class="coverage">2091<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ints <- intervals(object, conf.level = conf.level)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">103</td> + <td class="coverage">2091<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ill_parms <- character(0)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">104</td> + <td class="coverage">2091<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (random) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">105</td> + <td class="coverage">2091<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ill_parms_random_i <- which(ints$random[, "lower"] < 0)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">106</td> + <td class="coverage">2091<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ill_parms_random <- rownames(ints$random)[ill_parms_random_i]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">107</td> + <td class="coverage">2091<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ill_parms <- c(ill_parms, ill_parms_random)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">108</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">109</td> + <td class="coverage">2091<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (errmod) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">110</td> + <td class="coverage">2091<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ill_parms_errmod_i <- which(ints$errmod[, "lower"] < 0 & ints$errmod[, "upper"] > 0)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">111</td> + <td class="coverage">2091<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ill_parms_errmod <- rownames(ints$errmod)[ill_parms_errmod_i]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">112</td> + <td class="coverage">2091<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ill_parms <- c(ill_parms, ill_parms_errmod)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">113</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">114</td> + <td class="coverage">2091<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (slopes) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">115</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.null(object$so)) stop("Slope testing is only implemented for the saemix backend")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">116</td> + <td class="coverage">2091<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> slope_names <- grep("^beta_", object$so@model@name.fixed, value = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">117</td> + <td class="coverage">2091<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ci <- object$so@results@conf.int</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">118</td> + <td class="coverage">2091<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rownames(ci) <- ci$name</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">119</td> + <td class="coverage">2091<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> slope_ci <- ci[slope_names, ]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">120</td> + <td class="coverage">2091<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ill_parms_slopes <- slope_ci[, "lower"] < 0 & slope_ci[, "upper"] > 0</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">121</td> + <td class="coverage">2091<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ill_parms <- c(ill_parms, slope_names[ill_parms_slopes])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">122</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">123</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">124</td> + <td class="coverage">2091<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(ill_parms) <- "illparms.saem.mmkin"</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">125</td> + <td class="coverage">2091<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(ill_parms)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">126</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">127</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">128</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname illparms</pre> + </td> + </tr> + <tr class="never"> + <td class="num">129</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">130</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">print.illparms.saem.mmkin <- print.illparms.mkinfit</pre> + </td> + </tr> + <tr class="never"> + <td class="num">131</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">132</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname illparms</pre> + </td> + </tr> + <tr class="never"> + <td class="num">133</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">134</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">illparms.mhmkin <- function(object, conf.level = 0.95, random = TRUE, errmod = TRUE, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">135</td> + <td class="coverage">371<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (inherits(object[[1]], "saem.mmkin")) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">136</td> + <td class="coverage">371<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> check_failed <- function(x) if (inherits(x$so, "try-error")) TRUE else FALSE</pre> + </td> + </tr> + <tr class="never"> + <td class="num">137</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">138</td> + <td class="coverage">371<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> result <- lapply(object,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">139</td> + <td class="coverage">371<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> function(fit) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">140</td> + <td class="coverage">1484<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (check_failed(fit)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">141</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> return("E")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">142</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">143</td> + <td class="coverage">1484<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.null(fit$FIM_failed) &&</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">144</td> + <td class="coverage">1484<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "random effects and error model parameters" %in% fit$FIM_failed) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">145</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> return("NA")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">146</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">147</td> + <td class="coverage">1484<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ill <- illparms(fit, conf.level = conf.level, random = random, errmod = errmod)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">148</td> + <td class="coverage">1484<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(ill) > 0) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">149</td> + <td class="coverage">1000<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(paste(ill, collapse = ", "))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">150</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">151</td> + <td class="coverage">484<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return("")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">152</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">153</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">154</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">155</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> })</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">156</td> + <td class="coverage">371<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> result <- unlist(result)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">157</td> + <td class="coverage">371<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dim(result) <- dim(object)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">158</td> + <td class="coverage">371<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dimnames(result) <- dimnames(object)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">159</td> + <td class="coverage">371<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(result) <- "illparms.mhmkin"</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">160</td> + <td class="coverage">371<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(result)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">161</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">162</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">163</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname illparms</pre> + </td> + </tr> + <tr class="never"> + <td class="num">164</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">165</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">print.illparms.mhmkin <- function(x, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">166</td> + <td class="coverage">125<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(x) <- NULL</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">167</td> + <td class="coverage">125<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(x, quote = FALSE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">168</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/plot.mkinfit.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">utils::globalVariables(c("type", "variable", "observed"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Plot the observed data and the fitted model of an mkinfit object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Solves the differential equations with the optimised and fixed parameters</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' from a previous successful call to \code{\link{mkinfit}} and plots the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' observed data together with the solution of the fitted model.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' If the current plot device is a \code{\link[tikzDevice]{tikz}} device, then</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' latex is being used for the formatting of the chi2 error level, if</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \code{show_errmin = TRUE}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @aliases plot.mkinfit plot_sep plot_res plot_err</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param x Alias for fit introduced for compatibility with the generic S3</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' method.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param fit An object of class \code{\link{mkinfit}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param obs_vars A character vector of names of the observed variables for</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' which the data and the model should be plotted. Defauls to all observed</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' variables in the model.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param xlab Label for the x axis.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param ylab Label for the y axis.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param xlim Plot range in x direction.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param ylim Plot range in y direction. If given as a list, plot ranges</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' for the different plot rows can be given for row layout.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param col_obs Colors used for plotting the observed data and the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' corresponding model prediction lines.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param pch_obs Symbols to be used for plotting the data.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param lty_obs Line types to be used for the model predictions.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param add Should the plot be added to an existing plot?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param legend Should a legend be added to the plot?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param show_residuals Should residuals be shown? If only one plot of the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fits is shown, the residual plot is in the lower third of the plot.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Otherwise, i.e. if "sep_obs" is given, the residual plots will be located</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' to the right of the plots of the fitted curves. If this is set to</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' 'standardized', a plot of the residuals divided by the standard deviation</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' given by the fitted error model will be shown.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param standardized When calling 'plot_res', should the residuals be</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' standardized in the residual plot?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param show_errplot Should squared residuals and the error model be shown?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' If only one plot of the fits is shown, this plot is in the lower third of</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the plot. Otherwise, i.e. if "sep_obs" is given, the residual plots will</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' be located to the right of the plots of the fitted curves.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param maxabs Maximum absolute value of the residuals. This is used for the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' scaling of the y axis and defaults to "auto".</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param sep_obs Should the observed variables be shown in separate subplots?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' If yes, residual plots requested by "show_residuals" will be shown next</pre> + </td> + </tr> + <tr class="never"> + <td class="num">47</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' to, not below the plot of the fits.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param rel.height.middle The relative height of the middle plot, if more</pre> + </td> + </tr> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' than two rows of plots are shown.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param row_layout Should we use a row layout where the residual plot or the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' error model plot is shown to the right?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param lpos Position(s) of the legend(s). Passed to \code{\link{legend}} as</pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the first argument. If not length one, this should be of the same length</pre> + </td> + </tr> + <tr class="never"> + <td class="num">54</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' as the obs_var argument.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">55</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param inset Passed to \code{\link{legend}} if applicable.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param show_errmin Should the FOCUS chi2 error value be shown in the upper</pre> + </td> + </tr> + <tr class="never"> + <td class="num">57</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' margin of the plot?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param errmin_digits The number of significant digits for rounding the FOCUS</pre> + </td> + </tr> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' chi2 error percentage.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">60</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param frame Should a frame be drawn around the plots?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">61</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots Further arguments passed to \code{\link{plot}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">62</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @import graphics</pre> + </td> + </tr> + <tr class="never"> + <td class="num">63</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom grDevices dev.cur</pre> + </td> + </tr> + <tr class="never"> + <td class="num">64</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return The function is called for its side effect.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">65</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @author Johannes Ranke</pre> + </td> + </tr> + <tr class="never"> + <td class="num">66</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">67</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">68</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # One parent compound, one metabolite, both single first order, path from</pre> + </td> + </tr> + <tr class="never"> + <td class="num">69</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # parent to sink included</pre> + </td> + </tr> + <tr class="never"> + <td class="num">70</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">71</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' SFO_SFO <- mkinmod(parent = mkinsub("SFO", "m1", full = "Parent"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">72</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' m1 = mkinsub("SFO", full = "Metabolite M1" ))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">73</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit <- mkinfit(SFO_SFO, FOCUS_2006_D, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">74</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit <- mkinfit(SFO_SFO, FOCUS_2006_D, quiet = TRUE, error_model = "tc")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">75</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(fit)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">76</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot_res(fit)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">77</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot_res(fit, standardized = FALSE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">78</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot_err(fit)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">79</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">80</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Show the observed variables separately, with residuals</pre> + </td> + </tr> + <tr class="never"> + <td class="num">81</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(fit, sep_obs = TRUE, show_residuals = TRUE, lpos = c("topright", "bottomright"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">82</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' show_errmin = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">83</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">84</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # The same can be obtained with less typing, using the convenience function plot_sep</pre> + </td> + </tr> + <tr class="never"> + <td class="num">85</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot_sep(fit, lpos = c("topright", "bottomright"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">86</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">87</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Show the observed variables separately, with the error model</pre> + </td> + </tr> + <tr class="never"> + <td class="num">88</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(fit, sep_obs = TRUE, show_errplot = TRUE, lpos = c("topright", "bottomright"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">89</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' show_errmin = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">90</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">91</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">92</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">93</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">plot.mkinfit <- function(x, fit = x,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">94</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> obs_vars = names(fit$mkinmod$map),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">95</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> xlab = "Time", ylab = "Residue",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">96</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> xlim = range(fit$data$time),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">97</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> ylim = "default",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">98</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> col_obs = 1:length(obs_vars),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">99</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> pch_obs = col_obs,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">100</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> lty_obs = rep(1, length(obs_vars)),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">101</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> add = FALSE, legend = !add,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">102</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> show_residuals = FALSE,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">103</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> show_errplot = FALSE,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">104</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> maxabs = "auto",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">105</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> sep_obs = FALSE, rel.height.middle = 0.9,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">106</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> row_layout = FALSE,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">107</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> lpos = "topright", inset = c(0.05, 0.05),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">108</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> show_errmin = FALSE, errmin_digits = 3,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">109</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> frame = TRUE, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">110</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">111</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (identical(show_residuals, "standardized")) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">112</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> show_residuals <- TRUE</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">113</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> standardized <- TRUE</pre> + </td> + </tr> + <tr class="never"> + <td class="num">114</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">115</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> standardized <- FALSE</pre> + </td> + </tr> + <tr class="never"> + <td class="num">116</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">117</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="missed"> + <td class="num">118</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (add && show_residuals) stop("If adding to an existing plot we can not show residuals")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">119</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (add && show_errplot) stop("If adding to an existing plot we can not show the error model plot")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">120</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (show_residuals && show_errplot) stop("We can either show residuals over time or the error model plot, not both")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">121</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (add && sep_obs) stop("If adding to an existing plot we can not show observed variables separately")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">122</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">123</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">124</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> solution_type = fit$solution_type</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">125</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms.all <- c(fit$bparms.optim, fit$bparms.fixed)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">126</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">127</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ininames <- c(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">128</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rownames(subset(fit$start, type == "state")),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">129</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rownames(subset(fit$fixed, type == "state")))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">130</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeini <- parms.all[ininames]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">131</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">132</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Order initial state variables</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">133</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(odeini) <- sub("_0", "", names(odeini))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">134</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeini <- odeini[names(fit$mkinmod$diffs)]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">135</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">136</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> outtimes <- seq(xlim[1], xlim[2], length.out=100)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">137</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">138</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odenames <- c(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">139</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rownames(subset(fit$start, type == "deparm")),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">140</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rownames(subset(fit$fixed, type == "deparm")))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">141</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeparms <- parms.all[odenames]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">142</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">143</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">144</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (solution_type == "deSolve" & !is.null(fit$mkinmod$cf)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">145</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit$mkinmod[["symbols"]] <- deSolve::checkDLL(dllname = fit$mkinmod$dll_info[["name"]],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">146</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> func = "diffs", initfunc = "initpar",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">147</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> jacfunc = NULL, nout = 0, outnames = NULL)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">148</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">149</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> out <- mkinpredict(fit$mkinmod, odeparms, odeini, outtimes,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">150</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> solution_type = solution_type, atol = fit$atol, rtol = fit$rtol)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">151</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">152</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> out <- as.data.frame(out)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">153</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">154</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(col_obs) <- names(pch_obs) <- names(lty_obs) <- obs_vars</pre> + </td> + </tr> + <tr class="never"> + <td class="num">155</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">156</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Create a plot layout only if not to be added to an existing plot</pre> + </td> + </tr> + <tr class="never"> + <td class="num">157</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # or only a single plot is requested (e.g. by plot.mmkin)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">158</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> do_layout = FALSE</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">159</td> + <td class="coverage">485<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (show_residuals | sep_obs | show_errplot) do_layout = TRUE</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">160</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n_plot_rows = if (sep_obs) length(obs_vars) else 1</pre> + </td> + </tr> + <tr class="never"> + <td class="num">161</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">162</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (do_layout) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">163</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Layout should be restored afterwards</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">164</td> + <td class="coverage">485<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> oldpar <- par(no.readonly = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">165</td> + <td class="coverage">485<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> on.exit(par(oldpar, no.readonly = TRUE))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">166</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">167</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # If the observed variables are shown separately, or if requested, do row layout</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">168</td> + <td class="coverage">485<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (sep_obs | row_layout) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">169</td> + <td class="coverage">415<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> row_layout <- TRUE</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">170</td> + <td class="coverage">415<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n_plot_cols = if (show_residuals | show_errplot) 2 else 1</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">171</td> + <td class="coverage">415<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n_plots = n_plot_rows * n_plot_cols</pre> + </td> + </tr> + <tr class="never"> + <td class="num">172</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">173</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Set relative plot heights, so the first and the last plot are the norm</pre> + </td> + </tr> + <tr class="never"> + <td class="num">174</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # and the middle plots (if n_plot_rows >2) are smaller by rel.height.middle</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">175</td> + <td class="coverage">415<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rel.heights <- if (n_plot_rows > 2) c(1, rep(rel.height.middle, n_plot_rows - 2), 1)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">176</td> + <td class="coverage">415<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> else rep(1, n_plot_rows)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">177</td> + <td class="coverage">415<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> layout_matrix = matrix(1:n_plots,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">178</td> + <td class="coverage">415<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n_plot_rows, n_plot_cols, byrow = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">179</td> + <td class="coverage">415<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> layout(layout_matrix, heights = rel.heights)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">180</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else { # else show residuals in the lower third to keep compatibility</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">181</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> layout(matrix(c(1, 2), 2, 1), heights = c(2, 1.3))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">182</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> par(mar = c(3, 4, 4, 2) + 0.1)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">183</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">184</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">185</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">186</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Replicate legend position argument if necessary</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">187</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(lpos) == 1) lpos = rep(lpos, n_plot_rows)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">188</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">189</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Loop over plot rows</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">190</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (plot_row in 1:n_plot_rows) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">191</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">192</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> row_obs_vars = if (sep_obs) obs_vars[plot_row] else obs_vars</pre> + </td> + </tr> + <tr class="never"> + <td class="num">193</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">194</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Set ylim to sensible default, or to the specified value</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">195</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.list(ylim)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">196</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> ylim_row <- ylim[[plot_row]]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">197</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">198</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (ylim[[1]] == "default") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">199</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ylim_row = c(0, max(c(subset(fit$data, variable %in% row_obs_vars)$observed,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">200</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> unlist(out[row_obs_vars])), na.rm = TRUE))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">201</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">202</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> ylim_row = ylim</pre> + </td> + </tr> + <tr class="never"> + <td class="num">203</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">204</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">205</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">206</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (row_layout) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">207</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Margins for top row of plots when we have more than one row</pre> + </td> + </tr> + <tr class="never"> + <td class="num">208</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Reduce bottom margin by 2.1 - hides x axis legend</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">209</td> + <td class="coverage">415<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (plot_row == 1 & n_plot_rows > 1) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">210</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> par(mar = c(3.0, 4.1, 4.1, 2.1))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">211</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">212</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">213</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Margins for middle rows of plots, if any</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">214</td> + <td class="coverage">415<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (plot_row > 1 & plot_row < n_plot_rows) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">215</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Reduce top margin by 2 after the first plot as we have no main title,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">216</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # reduced plot height, therefore we need rel.height.middle in the layout</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">217</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> par(mar = c(3.0, 4.1, 2.1, 2.1))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">218</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">219</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">220</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Margins for bottom row of plots when we have more than one row</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">221</td> + <td class="coverage">415<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (plot_row == n_plot_rows & n_plot_rows > 1) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">222</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Restore bottom margin for last plot to show x axis legend</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">223</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> par(mar = c(5.1, 4.1, 2.1, 2.1))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">224</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">225</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">226</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">227</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Set up the main plot if not to be added to an existing plot</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">228</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (add == FALSE) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">229</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> plot(0, type="n",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">230</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> xlim = xlim, ylim = ylim_row,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">231</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> xlab = xlab, ylab = ylab, frame = frame, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">232</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">233</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">234</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Plot the data</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">235</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (obs_var in row_obs_vars) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">236</td> + <td class="coverage">1708<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> points(subset(fit$data, variable == obs_var, c(time, observed)),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">237</td> + <td class="coverage">1708<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> pch = pch_obs[obs_var], col = col_obs[obs_var])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">238</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">239</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">240</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Plot the model output</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">241</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> matlines(out$time, out[row_obs_vars], col = col_obs[row_obs_vars], lty = lty_obs[row_obs_vars])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">242</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">243</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (legend == TRUE) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">244</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Get full names from model definition if they are available</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">245</td> + <td class="coverage">695<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> legend_names = lapply(row_obs_vars, function(x) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">246</td> + <td class="coverage">900<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.null(fit$mkinmod$spec[[x]]$full_name))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">247</td> + <td class="coverage">410<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.na(fit$mkinmod$spec[[x]]$full_name)) x</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">248</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> else fit$mkinmod$spec[[x]]$full_name</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">249</td> + <td class="coverage">490<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> else x</pre> + </td> + </tr> + <tr class="never"> + <td class="num">250</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> })</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">251</td> + <td class="coverage">695<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> legend(lpos[plot_row], inset= inset, legend = legend_names,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">252</td> + <td class="coverage">695<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> col = col_obs[row_obs_vars], pch = pch_obs[row_obs_vars], lty = lty_obs[row_obs_vars])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">253</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">254</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">255</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Show chi2 error value if requested</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">256</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (show_errmin) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">257</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(row_obs_vars) == 1) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">258</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> errmin_var = row_obs_vars</pre> + </td> + </tr> + <tr class="never"> + <td class="num">259</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">260</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> errmin_var = "All data"</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">261</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(row_obs_vars) != length(fit$mkinmod$map)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">262</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> warning("Showing chi2 error level for all data, but only ",</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">263</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> row_obs_vars, " were selected for plotting")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">264</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">265</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">266</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">267</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> chi2 <- signif(100 * mkinerrmin(fit)[errmin_var, "err.min"], errmin_digits)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">268</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Use LateX if the current plotting device is tikz</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">269</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (names(dev.cur()) == "tikz output") {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">270</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> chi2_text <- paste0("$\\chi^2$ error level = ", chi2, "\\%")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">271</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">272</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> chi2_perc <- paste0(chi2, "%")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">273</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> chi2_text <- bquote(chi^2 ~ "error level" == .(chi2_perc))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">274</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">275</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mtext(chi2_text, cex = 0.7, line = 0.4)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">276</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">277</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">278</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (do_layout & !row_layout) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">279</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> par(mar = c(5, 4, 0, 2) + 0.1)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">280</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">281</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">282</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Show residuals if requested</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">283</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (show_residuals) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">284</td> + <td class="coverage">280<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mkinresplot(fit, obs_vars = row_obs_vars, standardized = standardized,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">285</td> + <td class="coverage">280<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> pch_obs = pch_obs[row_obs_vars], col_obs = col_obs[row_obs_vars],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">286</td> + <td class="coverage">280<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> legend = FALSE, frame = frame, xlab = xlab, xlim = xlim, maxabs = maxabs)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">287</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">288</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">289</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Show error model plot if requested</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">290</td> + <td class="coverage">1503<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (show_errplot) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">291</td> + <td class="coverage">205<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mkinerrplot(fit, obs_vars = row_obs_vars,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">292</td> + <td class="coverage">205<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> pch_obs = pch_obs[row_obs_vars], col_obs = col_obs[row_obs_vars],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">293</td> + <td class="coverage">205<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> legend = FALSE, frame = frame)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">294</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">295</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">296</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">297</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">298</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname plot.mkinfit</pre> + </td> + </tr> + <tr class="never"> + <td class="num">299</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">300</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">plot_sep <- function(fit, show_errmin = TRUE,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">301</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> show_residuals = ifelse(identical(fit$err_mod, "const"), TRUE, "standardized"), ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">302</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> plot.mkinfit(fit, sep_obs = TRUE, show_residuals = show_residuals,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">303</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> show_errmin = show_errmin, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">304</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">305</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">306</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname plot.mkinfit</pre> + </td> + </tr> + <tr class="never"> + <td class="num">307</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">308</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">plot_res <- function(fit, sep_obs = FALSE, show_errmin = sep_obs,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">309</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> standardized = ifelse(identical(fit$err_mod, "const"), FALSE, TRUE), ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">310</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">311</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> plot.mkinfit(fit, sep_obs = sep_obs, show_errmin = show_errmin,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">312</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> show_residuals = ifelse(standardized, "standardized", TRUE),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">313</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> row_layout = TRUE, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">314</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">315</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">316</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname plot.mkinfit</pre> + </td> + </tr> + <tr class="never"> + <td class="num">317</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">318</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">plot_err <- function(fit, sep_obs = FALSE, show_errmin = sep_obs, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">319</td> + <td class="coverage">205<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> plot.mkinfit(fit, sep_obs = sep_obs, show_errmin = show_errmin,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">320</td> + <td class="coverage">205<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> show_errplot = TRUE, row_layout = TRUE, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">321</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">322</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">323</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Plot the observed data and the fitted model of an mkinfit object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">324</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">325</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Deprecated function. It now only calls the plot method</pre> + </td> + </tr> + <tr class="never"> + <td class="num">326</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \code{\link{plot.mkinfit}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">327</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">328</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param fit an object of class \code{\link{mkinfit}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">329</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots further arguments passed to \code{\link{plot.mkinfit}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">330</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return The function is called for its side effect.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">331</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @author Johannes Ranke</pre> + </td> + </tr> + <tr class="never"> + <td class="num">332</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">333</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">mkinplot <- function(fit, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">334</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">335</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> plot(fit, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">336</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/mixed.mmkin.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Create a mixed effects model from an mmkin row object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom rlang !!!</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param object An [mmkin] row object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param method The method to be used</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots Currently not used</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return An object of class 'mixed.mmkin' which has the observed data in a</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' single dataframe which is convenient for plotting</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' sampling_times = c(0, 1, 3, 7, 14, 28, 60, 90, 120)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' n_biphasic <- 8</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' err_1 = list(const = 1, prop = 0.07)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' DFOP_SFO <- mkinmod(</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parent = mkinsub("DFOP", "m1"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' m1 = mkinsub("SFO"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' set.seed(123456)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' log_sd <- 0.3</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' syn_biphasic_parms <- as.matrix(data.frame(</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' k1 = rlnorm(n_biphasic, log(0.05), log_sd),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' k2 = rlnorm(n_biphasic, log(0.01), log_sd),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' g = plogis(rnorm(n_biphasic, 0, log_sd)),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_parent_to_m1 = plogis(rnorm(n_biphasic, 0, log_sd)),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' k_m1 = rlnorm(n_biphasic, log(0.002), log_sd)))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ds_biphasic_mean <- lapply(1:n_biphasic,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' function(i) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' mkinpredict(DFOP_SFO, syn_biphasic_parms[i, ],</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' c(parent = 100, m1 = 0), sampling_times)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' )</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' set.seed(123456L)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ds_biphasic <- lapply(ds_biphasic_mean, function(ds) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' add_err(ds,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' sdfunc = function(value) sqrt(err_1$const^2 + value^2 * err_1$prop^2),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' n = 1, secondary = "m1")[[1]]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' })</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_mmkin <- mmkin(list("DFOP-SFO" = DFOP_SFO), ds_biphasic, error_model = "tc", quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_mixed <- mixed(f_mmkin)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' print(f_mixed)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">47</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(f_mixed)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">mixed <- function(object, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">51</td> + <td class="coverage">182<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> UseMethod("mixed")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">54</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">55</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname mixed</pre> + </td> + </tr> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">mixed.mmkin <- function(object, method = c("none"), ...) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">57</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (nrow(object) > 1) stop("Only row objects allowed")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">59</td> + <td class="coverage">182<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> method <- match.arg(method)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">60</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">61</td> + <td class="coverage">182<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ds_names <- colnames(object)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">62</td> + <td class="coverage">182<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res <- list(mmkin = object, mkinmod = object[[1]]$mkinmod)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">63</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">64</td> + <td class="coverage">182<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (method[1] == "none") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">65</td> + <td class="coverage">182<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ds_list <- lapply(object,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">66</td> + <td class="coverage">182<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> function(x) x$data[c("variable", "time", "observed", "predicted", "residual")])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">67</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">68</td> + <td class="coverage">182<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(ds_list) <- ds_names</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">69</td> + <td class="coverage">182<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res$data <- vctrs::vec_rbind(!!!ds_list, .names_to = "ds")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">70</td> + <td class="coverage">182<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(res$data)[1:4] <- c("ds", "name", "time", "value")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">71</td> + <td class="coverage">182<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res$data$name <- as.character(res$data$name)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">72</td> + <td class="coverage">182<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res$data$ds <- ordered(res$data$ds, levels = unique(res$data$ds))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">73</td> + <td class="coverage">182<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> standardized <- unlist(lapply(object, residuals, standardized = TRUE))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">74</td> + <td class="coverage">182<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res$data$std <- res$data$residual / standardized</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">75</td> + <td class="coverage">182<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res$data$standardized <- standardized</pre> + </td> + </tr> + <tr class="never"> + <td class="num">76</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">77</td> + <td class="coverage">182<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(res) <- c("mixed.mmkin")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">78</td> + <td class="coverage">182<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(res)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">79</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">80</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">81</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">82</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">83</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname mixed</pre> + </td> + </tr> + <tr class="never"> + <td class="num">84</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param x A mixed.mmkin object to print</pre> + </td> + </tr> + <tr class="never"> + <td class="num">85</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param digits Number of digits to use for printing.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">86</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">print.mixed.mmkin <- function(x, digits = max(3, getOption("digits") - 3), ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">87</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("Kinetic model fitted by nonlinear regression to each dataset" )</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">88</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nStructural model:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">89</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> diffs <- x$mmkin[[1]]$mkinmod$diffs</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">90</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> nice_diffs <- gsub("^(d.*) =", "\\1/dt =", diffs)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">91</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> writeLines(strwrap(nice_diffs, exdent = 11))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">92</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nData:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">93</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat(nrow(x$data), "observations of",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">94</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> length(unique(x$data$name)), "variable(s) grouped in",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">95</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> length(unique(x$data$ds)), "datasets\n\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">96</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">97</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(x$mmkin, digits = digits)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">98</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">99</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nMean fitted parameters:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">100</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(mean_degparms(x$mmkin), digits = digits)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">101</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">102</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> invisible(x)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">103</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/parms.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Extract model parameters</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' This function returns degradation model parameters as well as error</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' model parameters per default, in order to avoid working with a fitted model</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' without considering the error structure that was assumed for the fit.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param object A fitted model object.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots Not used</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return Depending on the object, a numeric vector of fitted model parameters,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' a matrix (e.g. for mmkin row objects), or a list of matrices (e.g. for</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' mmkin objects with more than one row).</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @seealso [saem], [multistart]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # mkinfit objects</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit <- mkinfit("SFO", FOCUS_2006_C, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parms(fit)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parms(fit, transformed = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # mmkin objects</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ds <- lapply(experimental_data_for_UBA_2019[6:10],</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' function(x) subset(x$data[c("name", "time", "value")]))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' names(ds) <- paste("Dataset", 6:10)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fits <- mmkin(c("SFO", "FOMC", "DFOP"), ds, quiet = TRUE, cores = 1)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parms(fits["SFO", ])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parms(fits[, 2])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parms(fits)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parms(fits, transformed = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">parms <- function(object, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">33</td> + <td class="coverage">91384<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> UseMethod("parms", object)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param transformed Should the parameters be returned as used internally</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' during the optimisation?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param errparms Should the error model parameters be returned</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' in addition to the degradation parameters?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname parms</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">parms.mkinfit <- function(object, transformed = FALSE, errparms = TRUE, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">44</td> + <td class="coverage">88039<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res <- if (transformed) object$par</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">45</td> + <td class="coverage">88039<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> else c(object$bparms.optim, object$errparms)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">46</td> + <td class="coverage">88039<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!errparms) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">47</td> + <td class="coverage">3000<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res[setdiff(names(res), names(object$errparms))]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">49</td> + <td class="coverage">85039<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> else return(res)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname parms</pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">54</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">parms.mmkin <- function(object, transformed = FALSE, errparms = TRUE, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">55</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">56</td> + <td class="coverage">265<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (nrow(object) == 1) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">57</td> + <td class="coverage">265<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res <- sapply(object, parms, transformed = transformed,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">58</td> + <td class="coverage">265<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> errparms = errparms, ...)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">59</td> + <td class="coverage">265<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> colnames(res) <- colnames(object)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">60</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">61</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> res <- list()</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">62</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> for (i in 1:nrow(object)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">63</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> res[[i]] <- parms(object[i, ], transformed = transformed,</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">64</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> errparms = errparms, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">65</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">66</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> names(res) <- rownames(object)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">67</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">68</td> + <td class="coverage">265<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(res)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">69</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">70</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">71</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param exclude_failed For [multistart] objects, should rows for failed fits</pre> + </td> + </tr> + <tr class="never"> + <td class="num">72</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' be removed from the returned parameter matrix?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">73</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname parms</pre> + </td> + </tr> + <tr class="never"> + <td class="num">74</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">75</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">parms.multistart <- function(object, exclude_failed = TRUE, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">76</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res <- t(sapply(object, parms))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">77</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> successful <- which(!is.na(res[, 1]))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">78</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> first_success <- successful[1]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">79</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> colnames(res) <- names(parms(object[[first_success]]))</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">80</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (exclude_failed[1]) res <- res[successful, ]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">81</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(res)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">82</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/mmkin.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Fit one or more kinetic models with one or more state variables to one or</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' more datasets</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' This function calls \code{\link{mkinfit}} on all combinations of models and</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' datasets specified in its first two arguments.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param models Either a character vector of shorthand names like</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \code{c("SFO", "FOMC", "DFOP", "HS", "SFORB")}, or an optionally named</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' list of \code{\link{mkinmod}} objects.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param datasets An optionally named list of datasets suitable as observed</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' data for \code{\link{mkinfit}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param cores The number of cores to be used for multicore processing. This</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' is only used when the \code{cluster} argument is \code{NULL}. On Windows</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' machines, cores > 1 is not supported, you need to use the \code{cluster}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' argument to use multiple logical processors. Per default, all cores</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' detected by [parallel::detectCores()] are used, except on Windows where</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the default is 1.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param cluster A cluster as returned by \code{\link{makeCluster}} to be used</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' for parallel execution.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots Further arguments that will be passed to \code{\link{mkinfit}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom parallel mclapply parLapply detectCores</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return A two-dimensional \code{\link{array}} of \code{\link{mkinfit}}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' objects and/or try-errors that can be indexed using the model names for the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' first index (row index) and the dataset names for the second index (column</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' index).</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @author Johannes Ranke</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @seealso \code{\link{[.mmkin}} for subsetting, \code{\link{plot.mmkin}} for</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plotting.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @keywords optimize</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' m_synth_SFO_lin <- mkinmod(parent = mkinsub("SFO", "M1"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' M1 = mkinsub("SFO", "M2"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' M2 = mkinsub("SFO"), use_of_ff = "max")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' m_synth_FOMC_lin <- mkinmod(parent = mkinsub("FOMC", "M1"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' M1 = mkinsub("SFO", "M2"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' M2 = mkinsub("SFO"), use_of_ff = "max")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' models <- list(SFO_lin = m_synth_SFO_lin, FOMC_lin = m_synth_FOMC_lin)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' datasets <- lapply(synthetic_data_for_UBA_2014[1:3], function(x) x$data)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' names(datasets) <- paste("Dataset", 1:3)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' time_default <- system.time(fits.0 <- mmkin(models, datasets, quiet = TRUE))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' time_1 <- system.time(fits.4 <- mmkin(models, datasets, cores = 1, quiet = TRUE))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">47</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' time_default</pre> + </td> + </tr> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' time_1</pre> + </td> + </tr> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' endpoints(fits.0[["SFO_lin", 2]])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # plot.mkinfit handles rows or columns of mmkin result objects</pre> + </td> + </tr> + <tr class="never"> + <td class="num">54</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(fits.0[1, ])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">55</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(fits.0[1, ], obs_var = c("M1", "M2"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(fits.0[, 1])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">57</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Use double brackets to extract a single mkinfit object, which will be plotted</pre> + </td> + </tr> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # by plot.mkinfit and can be plotted using plot_sep</pre> + </td> + </tr> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(fits.0[[1, 1]], sep_obs = TRUE, show_residuals = TRUE, show_errmin = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">60</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot_sep(fits.0[[1, 1]])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">61</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Plotting with mmkin (single brackets, extracting an mmkin object) does not</pre> + </td> + </tr> + <tr class="never"> + <td class="num">62</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # allow to plot the observed variables separately</pre> + </td> + </tr> + <tr class="never"> + <td class="num">63</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(fits.0[1, 1])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">64</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">65</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # On Windows, we can use multiple cores by making a cluster first</pre> + </td> + </tr> + <tr class="never"> + <td class="num">66</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' cl <- parallel::makePSOCKcluster(12)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">67</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f <- mmkin(c("SFO", "FOMC", "DFOP"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">68</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' list(A = FOCUS_2006_A, B = FOCUS_2006_B, C = FOCUS_2006_C, D = FOCUS_2006_D),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">69</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' cluster = cl, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">70</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' print(f)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">71</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # We get false convergence for the FOMC fit to FOCUS_2006_A because this</pre> + </td> + </tr> + <tr class="never"> + <td class="num">72</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # dataset is really SFO, and the FOMC fit is overparameterised</pre> + </td> + </tr> + <tr class="never"> + <td class="num">73</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parallel::stopCluster(cl)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">74</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">75</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">76</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export mmkin</pre> + </td> + </tr> + <tr class="never"> + <td class="num">77</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">mmkin <- function(models = c("SFO", "FOMC", "DFOP"), datasets,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">78</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> cores = if (Sys.info()["sysname"] == "Windows") 1 else parallel::detectCores(), cluster = NULL, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">79</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">80</td> + <td class="coverage">4032<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> call <- match.call()</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">81</td> + <td class="coverage">4032<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parent_models_available = c("SFO", "FOMC", "DFOP", "HS", "SFORB", "IORE", "logistic")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">82</td> + <td class="coverage">4032<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n.m <- length(models)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">83</td> + <td class="coverage">4032<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n.d <- length(datasets)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">84</td> + <td class="coverage">4032<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n.fits <- n.m * n.d</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">85</td> + <td class="coverage">4032<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit_indices <- matrix(1:n.fits, ncol = n.d)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">86</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">87</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Check models and define their names</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">88</td> + <td class="coverage">4032<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!all(sapply(models, function(x) inherits(x, "mkinmod")))) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">89</td> + <td class="coverage">2323<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!all(models %in% parent_models_available)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">90</td> + <td class="coverage">50<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> stop("Please supply models as a list of mkinmod objects or a vector combined of\n ",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">91</td> + <td class="coverage">50<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> paste(parent_models_available, collapse = ", "))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">92</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">93</td> + <td class="coverage">2273<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(models) <- models</pre> + </td> + </tr> + <tr class="never"> + <td class="num">94</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">95</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">96</td> + <td class="coverage">1087<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.null(names(models))) names(models) <- as.character(1:n.m)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">97</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">98</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">99</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Check datasets and define their names</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">100</td> + <td class="coverage">1575<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.null(names(datasets))) names(datasets) <- as.character(1:n.d)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">101</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">102</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Define names for fit index</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">103</td> + <td class="coverage">3982<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dimnames(fit_indices) <- list(model = names(models),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">104</td> + <td class="coverage">3982<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dataset = names(datasets))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">105</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">106</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">107</td> + <td class="coverage">3982<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit_function <- function(fit_index) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">108</td> + <td class="coverage">793<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> w <- which(fit_indices == fit_index, arr.ind = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">109</td> + <td class="coverage">793<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> model_index <- w[1]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">110</td> + <td class="coverage">793<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dataset_index <- w[2]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">111</td> + <td class="coverage">793<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res <- try(mkinfit(models[[model_index]], datasets[[dataset_index]], ...))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">112</td> + <td class="coverage">793<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!inherits(res, "try-error")) res$mkinmod$name <- names(models)[model_index]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">113</td> + <td class="coverage">793<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(res)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">114</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">115</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">116</td> + <td class="coverage">3982<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit_time <- system.time({</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">117</td> + <td class="coverage">3982<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.null(cluster)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">118</td> + <td class="coverage">2154<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> results <- parallel::mclapply(as.list(1:n.fits), fit_function,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">119</td> + <td class="coverage">2154<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mc.cores = cores, mc.preschedule = FALSE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">120</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">121</td> + <td class="coverage">1828<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> results <- parallel::parLapply(cluster, as.list(1:n.fits), fit_function)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">122</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">123</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> })</pre> + </td> + </tr> + <tr class="never"> + <td class="num">124</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">125</td> + <td class="coverage">3798<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> attributes(results) <- attributes(fit_indices)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">126</td> + <td class="coverage">3798<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> attr(results, "call") <- call</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">127</td> + <td class="coverage">3798<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> attr(results, "time") <- fit_time</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">128</td> + <td class="coverage">3798<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(results) <- "mmkin"</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">129</td> + <td class="coverage">3798<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(results)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">130</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">131</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">132</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Subsetting method for mmkin objects</pre> + </td> + </tr> + <tr class="never"> + <td class="num">133</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">134</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param x An \code{\link{mmkin} object}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">135</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param i Row index selecting the fits for specific models</pre> + </td> + </tr> + <tr class="never"> + <td class="num">136</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param j Column index selecting the fits to specific datasets</pre> + </td> + </tr> + <tr class="never"> + <td class="num">137</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param ... Not used, only there to satisfy the generic method definition</pre> + </td> + </tr> + <tr class="never"> + <td class="num">138</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param drop If FALSE, the method always returns an mmkin object, otherwise</pre> + </td> + </tr> + <tr class="never"> + <td class="num">139</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' either a list of mkinfit objects or a single mkinfit object.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">140</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return An object of class \code{\link{mmkin}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">141</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @author Johannes Ranke</pre> + </td> + </tr> + <tr class="never"> + <td class="num">142</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname Extract.mmkin</pre> + </td> + </tr> + <tr class="never"> + <td class="num">143</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">144</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">145</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Only use one core, to pass R CMD check --as-cran</pre> + </td> + </tr> + <tr class="never"> + <td class="num">146</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fits <- mmkin(c("SFO", "FOMC"), list(B = FOCUS_2006_B, C = FOCUS_2006_C),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">147</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' cores = 1, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">148</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fits["FOMC", ]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">149</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fits[, "B"]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">150</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fits["SFO", "B"]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">151</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">152</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' head(</pre> + </td> + </tr> + <tr class="never"> + <td class="num">153</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # This extracts an mkinfit object with lots of components</pre> + </td> + </tr> + <tr class="never"> + <td class="num">154</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fits[["FOMC", "B"]]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">155</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' )</pre> + </td> + </tr> + <tr class="never"> + <td class="num">156</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">157</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">`[.mmkin` <- function(x, i, j, ..., drop = FALSE) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">158</td> + <td class="coverage">2760<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(x) <- NULL</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">159</td> + <td class="coverage">2760<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> x_sub <- x[i, j, drop = drop]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">160</td> + <td class="coverage">2760<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!drop) class(x_sub) <- "mmkin"</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">161</td> + <td class="coverage">2760<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(x_sub)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">162</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">163</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">164</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Print method for mmkin objects</pre> + </td> + </tr> + <tr class="never"> + <td class="num">165</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">166</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param x An [mmkin] object.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">167</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots Not used.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">168</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname mmkin</pre> + </td> + </tr> + <tr class="never"> + <td class="num">169</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">170</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">print.mmkin <- function(x, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">171</td> + <td class="coverage">375<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("<mmkin> object\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">172</td> + <td class="coverage">375<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("Status of individual fits:\n\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">173</td> + <td class="coverage">375<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(status(x))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">174</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">175</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">176</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">177</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">update.mmkin <- function(object, ..., evaluate = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">178</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">179</td> + <td class="coverage">256<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> call <- attr(object, "call")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">180</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">181</td> + <td class="coverage">256<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> update_arguments <- match.call(expand.dots = FALSE)$...</pre> + </td> + </tr> + <tr class="never"> + <td class="num">182</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">183</td> + <td class="coverage">256<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(update_arguments) > 0) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">184</td> + <td class="coverage">256<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> update_arguments_in_call <- !is.na(match(names(update_arguments), names(call)))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">185</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">186</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">187</td> + <td class="coverage">256<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (a in names(update_arguments)[update_arguments_in_call]) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">188</td> + <td class="coverage">115<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> call[[a]] <- update_arguments[[a]]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">189</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">190</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">191</td> + <td class="coverage">256<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> update_arguments_not_in_call <- !update_arguments_in_call</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">192</td> + <td class="coverage">256<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(any(update_arguments_not_in_call)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">193</td> + <td class="coverage">206<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> call <- c(as.list(call), update_arguments[update_arguments_not_in_call])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">194</td> + <td class="coverage">206<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> call <- as.call(call)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">195</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">196</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">197</td> + <td class="coverage">256<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(evaluate) eval(call, parent.frame())</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">198</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> else call</pre> + </td> + </tr> + <tr class="never"> + <td class="num">199</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/mkinpredict.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Produce predictions from a kinetic model using specific parameters</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' This function produces a time series for all the observed variables in a</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' kinetic model as specified by [mkinmod], using a specific set of</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' kinetic parameters and initial values for the state variables.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @aliases mkinpredict mkinpredict.mkinmod mkinpredict.mkinfit</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param x A kinetic model as produced by [mkinmod], or a kinetic fit as</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fitted by [mkinfit]. In the latter case, the fitted parameters are used for</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the prediction.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param odeparms A numeric vector specifying the parameters used in the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' kinetic model, which is generally defined as a set of ordinary differential</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' equations.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param odeini A numeric vector containing the initial values of the state</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' variables of the model. Note that the state variables can differ from the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' observed variables, for example in the case of the SFORB model.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param outtimes A numeric vector specifying the time points for which model</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' predictions should be generated.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param solution_type The method that should be used for producing the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' predictions. This should generally be "analytical" if there is only one</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' observed variable, and usually "deSolve" in the case of several observed</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' variables. The third possibility "eigen" is fast in comparison to uncompiled</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ODE models, but not applicable to some models, e.g. using FOMC for the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parent compound.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param method.ode The solution method passed via [mkinpredict] to [ode]] in</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' case the solution type is "deSolve" and we are not using compiled code.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' When using compiled code, only lsoda is supported.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param use_compiled If set to \code{FALSE}, no compiled version of the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' [mkinmod] model is used, even if is present.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param use_symbols If set to \code{TRUE} (default), symbol info present in</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the [mkinmod] object is used if available for accessing compiled code</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param atol Absolute error tolerance, passed to the ode solver.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param rtol Absolute error tolerance, passed to the ode solver.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param maxsteps Maximum number of steps, passed to the ode solver.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param map_output Boolean to specify if the output should list values for</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the observed variables (default) or for all state variables (if set to</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' FALSE). Setting this to FALSE has no effect for analytical solutions,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' as these always return mapped output.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param na_stop Should it be an error if [ode] returns NaN values</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots Further arguments passed to the ode solver in case such a</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' solver is used.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return A matrix with the numeric solution in wide format</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @author Johannes Ranke</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' SFO <- mkinmod(degradinol = mkinsub("SFO"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">47</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Compare solution types</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' mkinpredict(SFO, c(k_degradinol = 0.3), c(degradinol = 100), 0:20,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' solution_type = "analytical")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' mkinpredict(SFO, c(k_degradinol = 0.3), c(degradinol = 100), 0:20,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' solution_type = "deSolve")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' mkinpredict(SFO, c(k_degradinol = 0.3), c(degradinol = 100), 0:20,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' solution_type = "deSolve", use_compiled = FALSE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">54</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' mkinpredict(SFO, c(k_degradinol = 0.3), c(degradinol = 100), 0:20,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">55</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' solution_type = "eigen")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">57</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Compare integration methods to analytical solution</pre> + </td> + </tr> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' mkinpredict(SFO, c(k_degradinol = 0.3), c(degradinol = 100), 0:20,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' solution_type = "analytical")[21,]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">60</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' mkinpredict(SFO, c(k_degradinol = 0.3), c(degradinol = 100), 0:20,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">61</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' method = "lsoda", use_compiled = FALSE)[21,]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">62</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' mkinpredict(SFO, c(k_degradinol = 0.3), c(degradinol = 100), 0:20,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">63</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' method = "ode45", use_compiled = FALSE)[21,]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">64</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' mkinpredict(SFO, c(k_degradinol = 0.3), c(degradinol = 100), 0:20,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">65</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' method = "rk4", use_compiled = FALSE)[21,]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">66</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # rk4 is not as precise here</pre> + </td> + </tr> + <tr class="never"> + <td class="num">67</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">68</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # The number of output times used to make a lot of difference until the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">69</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # default for atol was adjusted</pre> + </td> + </tr> + <tr class="never"> + <td class="num">70</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' mkinpredict(SFO, c(k_degradinol = 0.3), c(degradinol = 100),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">71</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' seq(0, 20, by = 0.1))[201,]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">72</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' mkinpredict(SFO, c(k_degradinol = 0.3), c(degradinol = 100),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">73</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' seq(0, 20, by = 0.01))[2001,]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">74</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">75</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Comparison of the performance of solution types</pre> + </td> + </tr> + <tr class="never"> + <td class="num">76</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' SFO_SFO = mkinmod(parent = list(type = "SFO", to = "m1"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">77</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' m1 = list(type = "SFO"), use_of_ff = "max")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">78</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' if(require(rbenchmark)) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">79</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' benchmark(replications = 10, order = "relative", columns = c("test", "relative", "elapsed"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">80</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' eigen = mkinpredict(SFO_SFO,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">81</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' c(k_parent = 0.15, f_parent_to_m1 = 0.5, k_m1 = 0.01),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">82</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' c(parent = 100, m1 = 0), seq(0, 20, by = 0.1),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">83</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' solution_type = "eigen")[201,],</pre> + </td> + </tr> + <tr class="never"> + <td class="num">84</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' deSolve_compiled = mkinpredict(SFO_SFO,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">85</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' c(k_parent = 0.15, f_parent_to_m1 = 0.5, k_m1 = 0.01),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">86</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' c(parent = 100, m1 = 0), seq(0, 20, by = 0.1),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">87</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' solution_type = "deSolve")[201,],</pre> + </td> + </tr> + <tr class="never"> + <td class="num">88</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' deSolve = mkinpredict(SFO_SFO,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">89</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' c(k_parent = 0.15, f_parent_to_m1 = 0.5, k_m1 = 0.01),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">90</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' c(parent = 100, m1 = 0), seq(0, 20, by = 0.1),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">91</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' solution_type = "deSolve", use_compiled = FALSE)[201,],</pre> + </td> + </tr> + <tr class="never"> + <td class="num">92</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' analytical = mkinpredict(SFO_SFO,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">93</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' c(k_parent = 0.15, f_parent_to_m1 = 0.5, k_m1 = 0.01),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">94</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' c(parent = 100, m1 = 0), seq(0, 20, by = 0.1),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">95</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' solution_type = "analytical", use_compiled = FALSE)[201,])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">96</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">97</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">98</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">99</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Predict from a fitted model</pre> + </td> + </tr> + <tr class="never"> + <td class="num">100</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f <- mkinfit(SFO_SFO, FOCUS_2006_C, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">101</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f <- mkinfit(SFO_SFO, FOCUS_2006_C, quiet = TRUE, solution_type = "deSolve")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">102</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' head(mkinpredict(f))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">103</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">104</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">105</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">106</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">mkinpredict <- function(x, odeparms, odeini, outtimes, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">107</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">108</td> + <td class="coverage">47544878<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> UseMethod("mkinpredict", x)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">109</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">110</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">111</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname mkinpredict</pre> + </td> + </tr> + <tr class="never"> + <td class="num">112</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">113</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">mkinpredict.mkinmod <- function(x,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">114</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> odeparms = c(k_parent_sink = 0.1),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">115</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> odeini = c(parent = 100),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">116</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> outtimes = seq(0, 120, by = 0.1),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">117</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> solution_type = "deSolve",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">118</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> use_compiled = "auto",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">119</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> use_symbols = FALSE,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">120</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> method.ode = "lsoda", atol = 1e-8, rtol = 1e-10, maxsteps = 20000L,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">121</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> map_output = TRUE,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">122</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> na_stop = TRUE,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">123</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">124</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">125</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">126</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Names of state variables and observed variables</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">127</td> + <td class="coverage">47544878<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mod_vars <- names(x$diffs)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">128</td> + <td class="coverage">47544878<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> obs_vars <- names(x$spec)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">129</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">130</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Order the inital values for state variables if they are named</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">131</td> + <td class="coverage">47544878<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.null(names(odeini))) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">132</td> + <td class="coverage">47544878<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeini <- odeini[mod_vars]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">133</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">134</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">135</td> + <td class="coverage">47544878<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> out_obs <- matrix(NA, nrow = length(outtimes), ncol = 1 + length(obs_vars),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">136</td> + <td class="coverage">47544878<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dimnames = list(as.character(outtimes), c("time", obs_vars)))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">137</td> + <td class="coverage">47544878<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> out_obs[, "time"] <- outtimes</pre> + </td> + </tr> + <tr class="never"> + <td class="num">138</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">139</td> + <td class="coverage">47544878<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n_out_na <- 0 # to check if we get NA values with deSolve</pre> + </td> + </tr> + <tr class="never"> + <td class="num">140</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">141</td> + <td class="coverage">47544878<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (solution_type == "analytical") {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">142</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # This is clumsy, as we wanted fast analytical predictions for mkinfit,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">143</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # which bypasses mkinpredict in the case of analytical solutions</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">144</td> + <td class="coverage">1843695<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> pseudo_observed <-</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">145</td> + <td class="coverage">1843695<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> data.frame(name = rep(obs_vars, each = length(outtimes)),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">146</td> + <td class="coverage">1843695<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> time = rep(outtimes, length(obs_vars)))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">147</td> + <td class="coverage">1843695<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> pseudo_observed$predicted <- x$deg_func(pseudo_observed, odeini, odeparms)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">148</td> + <td class="coverage">1843695<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (obs_var in obs_vars) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">149</td> + <td class="coverage">2431585<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> out_obs[, obs_var] <- pseudo_observed[pseudo_observed$name == obs_var, "predicted"]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">150</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">151</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # We don't have solutions for unobserved state variables, the output of</pre> + </td> + </tr> + <tr class="never"> + <td class="num">152</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # analytical solutions is always mapped to observed variables</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">153</td> + <td class="coverage">1843695<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(out_obs)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">154</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">155</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">156</td> + <td class="coverage">45701183<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (solution_type == "eigen") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">157</td> + <td class="coverage">97082<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> evalparse <- function(string) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">158</td> + <td class="coverage">392283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> eval(parse(text=string), as.list(c(odeparms, odeini)))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">159</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">160</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">161</td> + <td class="coverage">97082<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> coefmat.num <- matrix(sapply(as.vector(x$coefmat), evalparse),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">162</td> + <td class="coverage">97082<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> nrow = length(mod_vars))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">163</td> + <td class="coverage">97082<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> e <- eigen(coefmat.num)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">164</td> + <td class="coverage">97082<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> c <- solve(e$vectors, odeini)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">165</td> + <td class="coverage">97082<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f.out <- function(t) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">166</td> + <td class="coverage">1085040<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> e$vectors %*% diag(exp(e$values * t), nrow=length(mod_vars)) %*% c</pre> + </td> + </tr> + <tr class="never"> + <td class="num">167</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">168</td> + <td class="coverage">97082<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> o <- matrix(mapply(f.out, outtimes),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">169</td> + <td class="coverage">97082<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> nrow = length(mod_vars), ncol = length(outtimes))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">170</td> + <td class="coverage">97082<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> out <- cbind(outtimes, t(o))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">171</td> + <td class="coverage">97082<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> colnames(out) <- c("time", mod_vars)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">172</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">173</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">174</td> + <td class="coverage">45701183<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (solution_type == "deSolve") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">175</td> + <td class="coverage">45604101<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.null(x$cf) & use_compiled[1] != FALSE) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">176</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">177</td> + <td class="coverage">45603235<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.null(x$symbols) & use_symbols) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">178</td> + <td class="coverage">1427314<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lsoda_func <- x$symbols</pre> + </td> + </tr> + <tr class="never"> + <td class="num">179</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">180</td> + <td class="coverage">44175921<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lsoda_func <- "diffs"</pre> + </td> + </tr> + <tr class="never"> + <td class="num">181</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">182</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">183</td> + <td class="coverage">45603235<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> out <- deSolve::lsoda(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">184</td> + <td class="coverage">45603235<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> y = odeini,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">185</td> + <td class="coverage">45603235<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> times = outtimes,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">186</td> + <td class="coverage">45603235<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> func = lsoda_func,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">187</td> + <td class="coverage">45603235<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> initfunc = "initpar",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">188</td> + <td class="coverage">45603235<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dllname = x$dll_info[["name"]],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">189</td> + <td class="coverage">45603235<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms = odeparms[x$parms], # Order matters when using compiled models</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">190</td> + <td class="coverage">45603235<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> atol = atol,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">191</td> + <td class="coverage">45603235<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rtol = rtol,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">192</td> + <td class="coverage">45603235<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> maxsteps = maxsteps,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">193</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> ...</pre> + </td> + </tr> + <tr class="never"> + <td class="num">194</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> )</pre> + </td> + </tr> + <tr class="never"> + <td class="num">195</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">196</td> + <td class="coverage">45603235<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> colnames(out) <- c("time", mod_vars)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">197</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">198</td> + <td class="coverage">866<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mkindiff <- function(t, state, parms) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">199</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">200</td> + <td class="coverage">145229<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> time <- t</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">201</td> + <td class="coverage">145229<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> diffs <- vector()</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">202</td> + <td class="coverage">145229<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (box in names(x$diffs))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">203</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">204</td> + <td class="coverage">145229<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> diffname <- paste("d", box, sep="_")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">205</td> + <td class="coverage">145229<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> diffs[diffname] <- with(as.list(c(time, state, parms)),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">206</td> + <td class="coverage">145229<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> eval(parse(text=x$diffs[[box]])))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">207</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">208</td> + <td class="coverage">145229<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(list(c(diffs)))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">209</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">210</td> + <td class="coverage">866<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> out <- deSolve::ode(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">211</td> + <td class="coverage">866<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> y = odeini,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">212</td> + <td class="coverage">866<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> times = outtimes,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">213</td> + <td class="coverage">866<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> func = mkindiff,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">214</td> + <td class="coverage">866<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms = odeparms,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">215</td> + <td class="coverage">866<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> method = method.ode,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">216</td> + <td class="coverage">866<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> atol = atol,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">217</td> + <td class="coverage">866<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rtol = rtol,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">218</td> + <td class="coverage">866<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> maxsteps = maxsteps,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">219</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> ...</pre> + </td> + </tr> + <tr class="never"> + <td class="num">220</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> )</pre> + </td> + </tr> + <tr class="never"> + <td class="num">221</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">222</td> + <td class="coverage">45604101<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n_out_na <- sum(is.na(out))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">223</td> + <td class="coverage">45604101<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (n_out_na > 0 & na_stop) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">224</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("odeini:\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">225</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> print(odeini)</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">226</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("odeparms:\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">227</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> print(odeparms)</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">228</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("out:\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">229</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> print(out)</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">230</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> stop("Differential equations were not integrated for all output times because\n",</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">231</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> n_out_na, " NaN values occurred in output from ode()")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">232</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">233</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">234</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">235</td> + <td class="coverage">45701183<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (map_output) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">236</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Output transformation for models with unobserved compartments like SFORB</pre> + </td> + </tr> + <tr class="never"> + <td class="num">237</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # if not already mapped in analytical solution</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">238</td> + <td class="coverage">45701183<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (n_out_na > 0 & !na_stop) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">239</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> available <- c(TRUE, rep(FALSE, length(outtimes) - 1))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">240</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">241</td> + <td class="coverage">45701183<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> available <- rep(TRUE, length(outtimes))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">242</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">243</td> + <td class="coverage">45701183<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (var in names(x$map)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">244</td> + <td class="coverage">93237433<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if((length(x$map[[var]]) == 1)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">245</td> + <td class="coverage">93235081<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> out_obs[available, var] <- out[available, var]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">246</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">247</td> + <td class="coverage">2352<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> out_obs[available, var] <- out[available, x$map[[var]][1]] +</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">248</td> + <td class="coverage">2352<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> out[available, x$map[[var]][2]]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">249</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">250</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">251</td> + <td class="coverage">45701183<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(out_obs)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">252</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">253</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> dimnames(out) <- list(time = as.character(outtimes), c("time", mod_vars))</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">254</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> return(out)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">255</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">256</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">257</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">258</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname mkinpredict</pre> + </td> + </tr> + <tr class="never"> + <td class="num">259</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">260</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">mkinpredict.mkinfit <- function(x,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">261</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> odeparms = x$bparms.ode,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">262</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> odeini = x$bparms.state,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">263</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> outtimes = seq(0, 120, by = 0.1),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">264</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> solution_type = "deSolve",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">265</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> use_compiled = "auto",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">266</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> method.ode = "lsoda", atol = 1e-8, rtol = 1e-10,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">267</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> map_output = TRUE, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">268</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">269</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> mkinpredict(x$mkinmod, odeparms, odeini, outtimes, solution_type, use_compiled,</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">270</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> method.ode, atol, rtol, map_output, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">271</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/anova.saem.mmkin.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Anova method for saem.mmkin objects</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Generate an anova object. The method to calculate the BIC is that from the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' saemix package. As in other prominent anova methods, models are sorted by</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' number of parameters, and the tests (if requested) are always relative to</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the model on the previous line.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param object An [saem.mmkin] object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param ... further such objects</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param method Method for likelihood calculation: "is" (importance sampling),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' "lin" (linear approximation), or "gq" (Gaussian quadrature). Passed</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' to [saemix::logLik.SaemixObject]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param test Should a likelihood ratio test be performed? If TRUE,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the alternative models are tested against the first model. Should</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' only be done for nested models.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param model.names Optional character vector of model names</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom stats anova logLik update pchisq terms</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom methods is</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom utils capture.output</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return an "anova" data frame; the traditional (S3) result of anova()</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">anova.saem.mmkin <- function(object, ...,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> method = c("is", "lin", "gq"), test = FALSE, model.names = NULL)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # The following code is heavily inspired by anova.lmer in the lme4 package</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">26</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mCall <- match.call(expand.dots = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">27</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dots <- list(...)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">28</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> method <- match.arg(method)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">30</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> is_model <- sapply(dots, is, "saem.mmkin")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">31</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (any(is_model)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">32</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mods <- c(list(object), dots[is_model])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">33</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> successful <- sapply(mods, function(x) !inherits(x$so, "try-error"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">35</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.null(model.names))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">36</td> + <td class="coverage">284<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> model.names <- vapply(as.list(mCall)[c(FALSE, TRUE, is_model)], deparse1, "")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Sanitize model names</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">39</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(model.names) != length(mods))</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">40</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> stop("Model names vector and model list have different lengths")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">42</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (any(duplicated(model.names)))</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">43</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> stop("Duplicate model names are not allowed")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">45</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (max(nchar(model.names)) > 200) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">46</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> warning("Model names longer than 200 characters, assigning generic names")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">47</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> model.names <- paste0("MODEL",seq_along(model.names))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">49</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(mods) <- model.names</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">50</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mods <- mods[successful]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Ensure same data, ignoring covariates</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">53</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> same_data <- sapply(mods[-1], function(x) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">54</td> + <td class="coverage">1182<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> identical(mods[[1]]$data[c("ds", "name", "time", "value")],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">55</td> + <td class="coverage">1182<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> x$data[c("ds", "name", "time", "value")])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> })</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">57</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!all(same_data)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">58</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> stop(sum(!same_data), " objects have not been fitted to the same data")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">60</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">61</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> llks <- lapply(names(mods), function(x) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">62</td> + <td class="coverage">1700<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> llk <- try(logLik(mods[[x]], method = method), silent = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">63</td> + <td class="coverage">1700<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (inherits(llk, "try-error")) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">64</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> warning("Could not obtain log likelihood with '", method, "' method for ", x)</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">65</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> llk <- NA</pre> + </td> + </tr> + <tr class="never"> + <td class="num">66</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">67</td> + <td class="coverage">1700<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(llk)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">68</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> })</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">69</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> available <- !sapply(llks, is.na)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">70</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> llks <- llks[available]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">71</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mods <- mods[available]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">72</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">73</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Order models by increasing degrees of freedom:</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">74</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> npar <- vapply(llks, attr, FUN.VALUE=numeric(1), "df")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">75</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ii <- order(npar)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">76</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mods <- mods[ii]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">77</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> llks <- llks[ii]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">78</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> npar <- npar[ii]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">79</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">80</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Describe data for the header, as in summary.saem.mmkin</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">81</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> header <- paste("Data:", nrow(object$data), "observations of",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">82</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> length(unique(object$data$name)), "variable(s) grouped in",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">83</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> length(unique(object$data$ds)), "datasets\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">84</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">85</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Calculate statistics</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">86</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> llk <- unlist(llks)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">87</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> chisq <- 2 * pmax(0, c(NA, diff(llk)))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">88</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dfChisq <- c(NA, diff(npar))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">89</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">90</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> bic <- function(x, method) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">91</td> + <td class="coverage">1700<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> BIC(x$so, method = method)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">92</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">93</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> val <- data.frame(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">94</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> npar = npar,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">95</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> AIC = sapply(llks, AIC),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">96</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> BIC = sapply(mods, bic, method = method), # We use the saemix method here</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">97</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> Lik = llk,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">98</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> row.names = names(mods), check.names = FALSE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">99</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">100</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (test) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">101</td> + <td class="coverage">196<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> testval <- data.frame(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">102</td> + <td class="coverage">196<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> Chisq = chisq,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">103</td> + <td class="coverage">196<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> Df = dfChisq,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">104</td> + <td class="coverage">196<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "Pr(>Chisq)" = ifelse(dfChisq == 0, NA,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">105</td> + <td class="coverage">196<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> pchisq(chisq, dfChisq, lower.tail = FALSE)),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">106</td> + <td class="coverage">196<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> row.names = names(mods), check.names = FALSE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">107</td> + <td class="coverage">196<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> val <- cbind(val, testval)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">108</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">109</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(val) <- c("anova", class(val))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">110</td> + <td class="coverage">518<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> structure(val, heading = c(header))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">111</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">112</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> stop("Currently, no anova method is implemented for the case of a single saem.mmkin object")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">113</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">114</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/create_deg_func.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Create degradation functions for known analytical solutions</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param spec List of model specifications as contained in mkinmod objects</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param use_of_ff Minimum or maximum use of formation fractions</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return Degradation function to be attached to mkinmod objects</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' SFO_SFO <- mkinmod(</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parent = mkinsub("SFO", "m1"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' m1 = mkinsub("SFO"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' FOCUS_D <- subset(FOCUS_2006_D, value != 0) # to avoid warnings</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit_1 <- mkinfit(SFO_SFO, FOCUS_D, solution_type = "analytical", quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit_2 <- mkinfit(SFO_SFO, FOCUS_D, solution_type = "deSolve", quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' if (require(rbenchmark))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' benchmark(</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' analytical = mkinfit(SFO_SFO, FOCUS_D, solution_type = "analytical", quiet = TRUE),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' deSolve = mkinfit(SFO_SFO, FOCUS_D, solution_type = "deSolve", quiet = TRUE),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' replications = 2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' DFOP_SFO <- mkinmod(</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parent = mkinsub("DFOP", "m1"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' m1 = mkinsub("SFO"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' benchmark(</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' analytical = mkinfit(DFOP_SFO, FOCUS_D, solution_type = "analytical", quiet = TRUE),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' deSolve = mkinfit(DFOP_SFO, FOCUS_D, solution_type = "deSolve", quiet = TRUE),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' replications = 2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">create_deg_func <- function(spec, use_of_ff = c("min", "max")) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">31</td> + <td class="coverage">8117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> use_of_ff <- match.arg(use_of_ff)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">32</td> + <td class="coverage">8117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> min_ff <- use_of_ff == "min"</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">33</td> + <td class="coverage">8117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> obs_vars <- names(spec)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">35</td> + <td class="coverage">8117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parent <- obs_vars[1]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">36</td> + <td class="coverage">8117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parent_type <- spec[[1]]$type</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">38</td> + <td class="coverage">8117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> supported <- TRUE # This may be modified below</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">40</td> + <td class="coverage">8117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> predicted_text <- character(0)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">42</td> + <td class="coverage">8117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (parent_type == "SFO") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">43</td> + <td class="coverage">5916<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (min_ff) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">44</td> + <td class="coverage">599<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> targets <- c(spec[[1]]$to, if (spec[[1]]$sink) "sink" else NULL)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">45</td> + <td class="coverage">599<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k_parent <- paste(paste0("k_", parent, "_", targets), collapse = " + ")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">47</td> + <td class="coverage">5317<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k_parent <- paste0("k_", parent)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">51</td> + <td class="coverage">8117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> predicted_text[parent] <- paste0(parent_type, ".solution(t, odeini['", parent,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">52</td> + <td class="coverage">8117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (parent_type == "SFORB") "_free", "'], ",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">53</td> + <td class="coverage">8117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> switch(parent_type,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">54</td> + <td class="coverage">8117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> SFO = k_parent,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">55</td> + <td class="coverage">8117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> FOMC = "alpha, beta",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">56</td> + <td class="coverage">8117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> IORE = paste0("k__iore_", parent, if (min_ff) "_sink" else "", ", N_", parent),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">57</td> + <td class="coverage">8117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> DFOP = "k1, k2, g",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">58</td> + <td class="coverage">8117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> SFORB = paste0("k_", parent, "_free_bound, k_", parent, "_bound_free, k_", parent, "_free", if (min_ff) "_sink" else ""),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">59</td> + <td class="coverage">8117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> HS = "k1, k2, tb",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">60</td> + <td class="coverage">8117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> logistic = "kmax, k0, r"</pre> + </td> + </tr> + <tr class="never"> + <td class="num">61</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> ),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">62</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> ")")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">63</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">64</td> + <td class="coverage">3728<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(obs_vars) >= 2) supported <- FALSE</pre> + </td> + </tr> + <tr class="never"> + <td class="num">65</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Except for the following cases:</pre> + </td> + </tr> + <tr class="never"> + <td class="num">66</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">67</td> + <td class="coverage">8117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(obs_vars) == 2) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">68</td> + <td class="coverage">3036<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n1 <- obs_vars[1]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">69</td> + <td class="coverage">3036<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n2 <- obs_vars[2]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">70</td> + <td class="coverage">3036<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n10 <- paste0("odeini['", parent, "']")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">71</td> + <td class="coverage">3036<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n20 <- paste0("odeini['", n2, "']")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">72</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">73</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # sfo_sfo</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">74</td> + <td class="coverage">3036<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (all(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">75</td> + <td class="coverage">3036<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> spec[[1]]$sink == FALSE,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">76</td> + <td class="coverage">3036<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> spec[[1]]$type == "SFO",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">77</td> + <td class="coverage">3036<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> spec[[2]]$type == "SFO",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">78</td> + <td class="coverage">3036<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> is.null(spec[[2]]$to))) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">79</td> + <td class="coverage">741<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> supported <- TRUE</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">80</td> + <td class="coverage">741<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k1 <- k_parent</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">81</td> + <td class="coverage">741<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k2 <- paste0("k_", n2, if(min_ff) "_sink" else "")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">82</td> + <td class="coverage">741<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> predicted_text[n2] <- paste0(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">83</td> + <td class="coverage">741<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "(((", k2, "-", k1, ")*", n20, "-", k1, "*", n10, ")*exp(-", k2, "*t)+",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">84</td> + <td class="coverage">741<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k1, "*", n10, "*exp(-", k1, "*t))/(", k2, "-", k1, ")")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">85</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">86</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">87</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # sfo_f12_sfo</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">88</td> + <td class="coverage">3036<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (all(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">89</td> + <td class="coverage">3036<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> use_of_ff == "max",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">90</td> + <td class="coverage">3036<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> spec[[1]]$sink == TRUE,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">91</td> + <td class="coverage">3036<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> spec[[1]]$type == "SFO",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">92</td> + <td class="coverage">3036<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> spec[[2]]$type == "SFO",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">93</td> + <td class="coverage">3036<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> is.null(spec[[2]]$to))) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">94</td> + <td class="coverage">1129<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> supported <- TRUE</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">95</td> + <td class="coverage">1129<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k1 <- k_parent</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">96</td> + <td class="coverage">1129<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k2 <- paste0("k_", n2)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">97</td> + <td class="coverage">1129<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f12 <- paste0("f_", n1, "_to_", n2)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">98</td> + <td class="coverage">1129<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> predicted_text[n2] <- paste0(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">99</td> + <td class="coverage">1129<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "(((", k2, "-", k1, ")*", n20, "-", f12, "*", k1, "*", n10, ")*exp(-", k2, "*t)+",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">100</td> + <td class="coverage">1129<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f12, "*", k1, "*", n10, "*exp(-", k1, "*t))/(", k2, "-", k1, ")")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">101</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">102</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">103</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # sfo_k120_sfo</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">104</td> + <td class="coverage">3036<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (all(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">105</td> + <td class="coverage">3036<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> use_of_ff == "min",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">106</td> + <td class="coverage">3036<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> spec[[1]]$sink == TRUE,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">107</td> + <td class="coverage">3036<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> spec[[1]]$type == "SFO",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">108</td> + <td class="coverage">3036<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> spec[[2]]$type == "SFO",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">109</td> + <td class="coverage">3036<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> is.null(spec[[2]]$to))) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">110</td> + <td class="coverage">351<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> supported <- TRUE</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">111</td> + <td class="coverage">351<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k12 <- paste0("k_", n1, "_", n2)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">112</td> + <td class="coverage">351<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k10 <- paste0("k_", n1, "_sink")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">113</td> + <td class="coverage">351<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k2 <- paste0("k_", n2, "_sink")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">114</td> + <td class="coverage">351<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> predicted_text[n2] <- paste0(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">115</td> + <td class="coverage">351<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "(((", k2, "-", k12, "-", k10, ")*", n20, "-", k12, "*", n10, ")*exp(-", k2, "*t)+",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">116</td> + <td class="coverage">351<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k12, "*", n10, "*exp(-(", k_parent, ")*t))/(", k2, "-(", k_parent, "))")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">117</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">118</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">119</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # dfop_f12_sfo</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">120</td> + <td class="coverage">3036<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (all(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">121</td> + <td class="coverage">3036<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> use_of_ff == "max",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">122</td> + <td class="coverage">3036<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> spec[[1]]$sink == TRUE,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">123</td> + <td class="coverage">3036<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> spec[[1]]$type == "DFOP",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">124</td> + <td class="coverage">3036<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> spec[[2]]$type == "SFO",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">125</td> + <td class="coverage">3036<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> is.null(spec[[2]]$to))) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">126</td> + <td class="coverage">565<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> supported <- TRUE</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">127</td> + <td class="coverage">565<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f12 <- paste0("f_", n1, "_to_", n2)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">128</td> + <td class="coverage">565<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k2 <- paste0("k_", n2)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">129</td> + <td class="coverage">565<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> predicted_text[n2] <- paste0(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">130</td> + <td class="coverage">565<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "((", f12, "* g - ", f12, ") * k2 * ", n10, " * exp(- k2 * t))/(k2 - ", k2, ") - ",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">131</td> + <td class="coverage">565<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "((", f12, "* g) * k1 * ", n10, " * exp(- k1 * t))/(k1 - ", k2, ") + ",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">132</td> + <td class="coverage">565<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "(((k1 - ", k2, ") * k2 - ", k2, "* k1 + ", k2, "^2) * ", n20, "+",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">133</td> + <td class="coverage">565<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "((", f12, "* k1 + (", f12, "*g - ", f12, ") * ", k2, ") * k2 - ", f12, " * g * ", k2, " * k1) * ", n10, ") * ",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">134</td> + <td class="coverage">565<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "exp( - ", k2, " * t)/((k1 - ", k2, ") * k2 - ", k2, " * k1 + ", k2, "^2)")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">135</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">136</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">137</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">138</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">139</td> + <td class="coverage">8117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (supported) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">140</td> + <td class="coverage">7175<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> deg_func <- function(observed, odeini, odeparms) {}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">141</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">142</td> + <td class="coverage">7175<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f_body <- paste0("{\n",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">143</td> + <td class="coverage">7175<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "predicted <- numeric(0)\n",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">144</td> + <td class="coverage">7175<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "with(as.list(odeparms), {\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">145</td> + <td class="coverage">7175<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (obs_var in obs_vars) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">146</td> + <td class="coverage">9961<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f_body <- paste0(f_body,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">147</td> + <td class="coverage">9961<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "t <- observed[observed$name == '", obs_var, "', 'time']\n",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">148</td> + <td class="coverage">9961<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "predicted <<- c(predicted, ", predicted_text[obs_var], ")\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">149</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">150</td> + <td class="coverage">7175<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f_body <- paste0(f_body,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">151</td> + <td class="coverage">7175<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "})\n",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">152</td> + <td class="coverage">7175<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "return(predicted)\n}\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">153</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">154</td> + <td class="coverage">7175<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> body(deg_func) <- parse(text = f_body)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">155</td> + <td class="coverage">7175<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(deg_func)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">156</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">157</td> + <td class="coverage">942<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(NULL)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">158</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">159</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/nlme.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Helper functions to create nlme models from mmkin row objects</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' These functions facilitate setting up a nonlinear mixed effects model for</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' an mmkin row object. An mmkin row object is essentially a list of mkinfit</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' objects that have been obtained by fitting the same model to a list of</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' datasets. They are used internally by the [nlme.mmkin()] method.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param object An mmkin row object containing several fits of the same model to different datasets</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @import nlme</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname nlme</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @seealso \code{\link{nlme.mmkin}}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' sampling_times = c(0, 1, 3, 7, 14, 28, 60, 90, 120)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' m_SFO <- mkinmod(parent = mkinsub("SFO"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' d_SFO_1 <- mkinpredict(m_SFO,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' c(k_parent = 0.1),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' c(parent = 98), sampling_times)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' d_SFO_1_long <- mkin_wide_to_long(d_SFO_1, time = "time")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' d_SFO_2 <- mkinpredict(m_SFO,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' c(k_parent = 0.05),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' c(parent = 102), sampling_times)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' d_SFO_2_long <- mkin_wide_to_long(d_SFO_2, time = "time")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' d_SFO_3 <- mkinpredict(m_SFO,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' c(k_parent = 0.02),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' c(parent = 103), sampling_times)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' d_SFO_3_long <- mkin_wide_to_long(d_SFO_3, time = "time")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' d1 <- add_err(d_SFO_1, function(value) 3, n = 1)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' d2 <- add_err(d_SFO_2, function(value) 2, n = 1)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' d3 <- add_err(d_SFO_3, function(value) 4, n = 1)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ds <- c(d1 = d1, d2 = d2, d3 = d3)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f <- mmkin("SFO", ds, cores = 1, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' mean_dp <- mean_degparms(f)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' grouped_data <- nlme_data(f)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' nlme_f <- nlme_function(f)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # These assignments are necessary for these objects to be</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # visible to nlme and augPred when evaluation is done by</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # pkgdown to generate the html docs.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' assign("nlme_f", nlme_f, globalenv())</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' assign("grouped_data", grouped_data, globalenv())</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' library(nlme)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' m_nlme <- nlme(value ~ nlme_f(name, time, parent_0, log_k_parent_sink),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' data = grouped_data,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fixed = parent_0 + log_k_parent_sink ~ 1,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">47</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' random = pdDiag(parent_0 + log_k_parent_sink ~ 1),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' start = mean_dp)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' summary(m_nlme)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(augPred(m_nlme, level = 0:1), layout = c(3, 1))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # augPred does not work on fits with more than one state</pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # variable</pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' #</pre> + </td> + </tr> + <tr class="never"> + <td class="num">54</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # The procedure is greatly simplified by the nlme.mmkin function</pre> + </td> + </tr> + <tr class="never"> + <td class="num">55</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_nlme <- nlme(f)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(f_nlme)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">57</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return A function that can be used with nlme</pre> + </td> + </tr> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">nlme_function <- function(object) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">60</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (nrow(object) > 1) stop("Only row objects allowed")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">61</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">62</td> + <td class="coverage">1168<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mkin_model <- object[[1]]$mkinmod</pre> + </td> + </tr> + <tr class="never"> + <td class="num">63</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">64</td> + <td class="coverage">1168<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparm_names <- names(mean_degparms(object))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">65</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">66</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Inspired by https://stackoverflow.com/a/12983961/3805440</pre> + </td> + </tr> + <tr class="never"> + <td class="num">67</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # and https://stackoverflow.com/a/26280789/3805440</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">68</td> + <td class="coverage">1168<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> model_function_alist <- replicate(length(degparm_names) + 2, substitute())</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">69</td> + <td class="coverage">1168<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(model_function_alist) <- c("name", "time", degparm_names)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">70</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">71</td> + <td class="coverage">1168<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> model_function_body <- quote({</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">72</td> + <td class="coverage">252739<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> arg_frame <- as.data.frame(as.list((environment())), stringsAsFactors = FALSE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">73</td> + <td class="coverage">252739<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res_frame <- arg_frame[1:2]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">74</td> + <td class="coverage">252739<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parm_frame <- arg_frame[-(1:2)]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">75</td> + <td class="coverage">252739<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms_unique <- unique(parm_frame)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">76</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">77</td> + <td class="coverage">252739<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n_unique <- nrow(parms_unique)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">78</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">79</td> + <td class="coverage">252739<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> times_ds <- list()</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">80</td> + <td class="coverage">252739<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names_ds <- list()</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">81</td> + <td class="coverage">252739<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (i in 1:n_unique) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">82</td> + <td class="coverage">2342789<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> times_ds[[i]] <-</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">83</td> + <td class="coverage">2342789<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> arg_frame[which(arg_frame[[3]] == parms_unique[i, 1]), "time"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">84</td> + <td class="coverage">2342789<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names_ds[[i]] <-</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">85</td> + <td class="coverage">2342789<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> arg_frame[which(arg_frame[[3]] == parms_unique[i, 1]), "name"]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">86</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">87</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">88</td> + <td class="coverage">252739<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res_list <- lapply(1:n_unique, function(x) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">89</td> + <td class="coverage">2342789<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transparms_optim <- unlist(parms_unique[x, , drop = TRUE])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">90</td> + <td class="coverage">2342789<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms_fixed <- object[[1]]$bparms.fixed</pre> + </td> + </tr> + <tr class="never"> + <td class="num">91</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">92</td> + <td class="coverage">2342789<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeini_optim_parm_names <- grep('_0$', names(transparms_optim), value = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">93</td> + <td class="coverage">2342789<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeini_optim <- transparms_optim[odeini_optim_parm_names]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">94</td> + <td class="coverage">2342789<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(odeini_optim) <- gsub('_0$', '', odeini_optim_parm_names)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">95</td> + <td class="coverage">2342789<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeini_fixed_parm_names <- grep('_0$', names(parms_fixed), value = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">96</td> + <td class="coverage">2342789<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeini_fixed <- parms_fixed[odeini_fixed_parm_names]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">97</td> + <td class="coverage">2342789<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(odeini_fixed) <- gsub('_0$', '', odeini_fixed_parm_names)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">98</td> + <td class="coverage">2342789<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeini <- c(odeini_optim, odeini_fixed)[names(mkin_model$diffs)]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">99</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">100</td> + <td class="coverage">2342789<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ode_transparms_optim_names <- setdiff(names(transparms_optim), odeini_optim_parm_names)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">101</td> + <td class="coverage">2342789<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeparms_optim <- backtransform_odeparms(transparms_optim[ode_transparms_optim_names], mkin_model,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">102</td> + <td class="coverage">2342789<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_rates = object[[1]]$transform_rates,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">103</td> + <td class="coverage">2342789<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_fractions = object[[1]]$transform_fractions)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">104</td> + <td class="coverage">2342789<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeparms_fixed_names <- setdiff(names(parms_fixed), odeini_fixed_parm_names)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">105</td> + <td class="coverage">2342789<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeparms_fixed <- parms_fixed[odeparms_fixed_names]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">106</td> + <td class="coverage">2342789<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeparms <- c(odeparms_optim, odeparms_fixed)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">107</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">108</td> + <td class="coverage">2342789<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> out_wide <- mkinpredict(mkin_model,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">109</td> + <td class="coverage">2342789<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> odeparms = odeparms, odeini = odeini,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">110</td> + <td class="coverage">2342789<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> solution_type = object[[1]]$solution_type,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">111</td> + <td class="coverage">2342789<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> outtimes = sort(unique(times_ds[[x]])))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">112</td> + <td class="coverage">2342789<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> out_array <- out_wide[, -1, drop = FALSE]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">113</td> + <td class="coverage">2342789<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rownames(out_array) <- as.character(unique(times_ds[[x]]))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">114</td> + <td class="coverage">2342789<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> out_times <- as.character(times_ds[[x]])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">115</td> + <td class="coverage">2342789<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> out_names <- as.character(names_ds[[x]])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">116</td> + <td class="coverage">2342789<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> out_values <- mapply(function(times, names) out_array[times, names],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">117</td> + <td class="coverage">2342789<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> out_times, out_names)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">118</td> + <td class="coverage">2342789<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(as.numeric(out_values))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">119</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> })</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">120</td> + <td class="coverage">252739<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res <- unlist(res_list)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">121</td> + <td class="coverage">252739<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(res)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">122</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> })</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">123</td> + <td class="coverage">1168<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> model_function <- as.function(c(model_function_alist, model_function_body))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">124</td> + <td class="coverage">1168<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(model_function)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">125</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">126</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">127</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname nlme</pre> + </td> + </tr> + <tr class="never"> + <td class="num">128</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom rlang !!!</pre> + </td> + </tr> + <tr class="never"> + <td class="num">129</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return A \code{\link{groupedData}} object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">130</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">131</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">nlme_data <- function(object) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">132</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (nrow(object) > 1) stop("Only row objects allowed")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">133</td> + <td class="coverage">5677<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ds_names <- colnames(object)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">134</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">135</td> + <td class="coverage">5677<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ds_list <- lapply(object, function(x) x$data[c("time", "variable", "observed")])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">136</td> + <td class="coverage">5677<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(ds_list) <- ds_names</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">137</td> + <td class="coverage">5677<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ds_nlme <- vctrs::vec_rbind(!!!ds_list, .names_to = "ds")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">138</td> + <td class="coverage">5677<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ds_nlme$variable <- as.character(ds_nlme$variable)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">139</td> + <td class="coverage">5677<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ds_nlme$ds <- ordered(ds_nlme$ds, levels = unique(ds_nlme$ds))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">140</td> + <td class="coverage">5677<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ds_nlme_renamed <- data.frame(ds = ds_nlme$ds, name = ds_nlme$variable,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">141</td> + <td class="coverage">5677<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> time = ds_nlme$time, value = ds_nlme$observed,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">142</td> + <td class="coverage">5677<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> stringsAsFactors = FALSE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">143</td> + <td class="coverage">5677<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ds_nlme_grouped <- groupedData(value ~ time | ds, ds_nlme_renamed, order.groups = FALSE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">144</td> + <td class="coverage">5677<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(ds_nlme_grouped)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">145</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/transform_odeparms.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Functions to transform and backtransform kinetic parameters for fitting</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' The transformations are intended to map parameters that should only take on</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' restricted values to the full scale of real numbers. For kinetic rate</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' constants and other parameters that can only take on positive values, a</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' simple log transformation is used. For compositional parameters, such as the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' formations fractions that should always sum up to 1 and can not be negative,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the [ilr] transformation is used.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' The transformation of sets of formation fractions is fragile, as it supposes</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the same ordering of the components in forward and backward transformation.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' This is no problem for the internal use in [mkinfit].</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param parms Parameters of kinetic models as used in the differential</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' equations.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param transparms Transformed parameters of kinetic models as used in the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fitting procedure.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param mkinmod The kinetic model of class [mkinmod], containing</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the names of the model variables that are needed for grouping the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' formation fractions before [ilr] transformation, the parameter</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' names and the information if the pathway to sink is included in the model.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param transform_rates Boolean specifying if kinetic rate constants should</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' be transformed in the model specification used in the fitting for better</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' compliance with the assumption of normal distribution of the estimator. If</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' TRUE, also alpha and beta parameters of the FOMC model are</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' log-transformed, as well as k1 and k2 rate constants for the DFOP and HS</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' models and the break point tb of the HS model.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param transform_fractions Boolean specifying if formation fractions</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' constants should be transformed in the model specification used in the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fitting for better compliance with the assumption of normal distribution</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' of the estimator. The default (TRUE) is to do transformations.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' The g parameter of the DFOP model is also seen as a fraction.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' If a single fraction is transformed (g parameter of DFOP or only a single</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' target variable e.g. a single metabolite plus a pathway to sink), a</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' logistic transformation is used [stats::qlogis()]. In other cases, i.e. if</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' two or more formation fractions need to be transformed whose sum cannot</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' exceed one, the [ilr] transformation is used.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return A vector of transformed or backtransformed parameters</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom stats plogis qlogis</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @author Johannes Ranke</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' SFO_SFO <- mkinmod(</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parent = list(type = "SFO", to = "m1", sink = TRUE),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' m1 = list(type = "SFO"), use_of_ff = "min")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">47</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Fit the model to the FOCUS example dataset D using defaults</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' FOCUS_D <- subset(FOCUS_2006_D, value != 0) # remove zero values to avoid warning</pre> + </td> + </tr> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit <- mkinfit(SFO_SFO, FOCUS_D, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit.s <- summary(fit)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Transformed and backtransformed parameters</pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' print(fit.s$par, 3)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' print(fit.s$bpar, 3)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">54</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">55</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Compare to the version without transforming rate parameters (does not work</pre> + </td> + </tr> + <tr class="never"> + <td class="num">57</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # with analytical solution, we get NA values for m1 in predictions)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit.2 <- mkinfit(SFO_SFO, FOCUS_D, transform_rates = FALSE,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' solution_type = "deSolve", quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">60</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit.2.s <- summary(fit.2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">61</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' print(fit.2.s$par, 3)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">62</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' print(fit.2.s$bpar, 3)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">63</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">64</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">65</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' initials <- fit$start$value</pre> + </td> + </tr> + <tr class="never"> + <td class="num">66</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' names(initials) <- rownames(fit$start)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">67</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' transformed <- fit$start_transformed$value</pre> + </td> + </tr> + <tr class="never"> + <td class="num">68</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' names(transformed) <- rownames(fit$start_transformed)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">69</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' transform_odeparms(initials, SFO_SFO)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">70</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' backtransform_odeparms(transformed, SFO_SFO)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">71</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">72</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">73</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # The case of formation fractions (this is now the default)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">74</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' SFO_SFO.ff <- mkinmod(</pre> + </td> + </tr> + <tr class="never"> + <td class="num">75</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parent = list(type = "SFO", to = "m1", sink = TRUE),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">76</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' m1 = list(type = "SFO"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">77</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' use_of_ff = "max")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">78</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">79</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit.ff <- mkinfit(SFO_SFO.ff, FOCUS_D, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">80</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit.ff.s <- summary(fit.ff)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">81</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' print(fit.ff.s$par, 3)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">82</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' print(fit.ff.s$bpar, 3)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">83</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' initials <- c("f_parent_to_m1" = 0.5)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">84</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' transformed <- transform_odeparms(initials, SFO_SFO.ff)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">85</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' backtransform_odeparms(transformed, SFO_SFO.ff)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">86</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">87</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # And without sink</pre> + </td> + </tr> + <tr class="never"> + <td class="num">88</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' SFO_SFO.ff.2 <- mkinmod(</pre> + </td> + </tr> + <tr class="never"> + <td class="num">89</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parent = list(type = "SFO", to = "m1", sink = FALSE),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">90</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' m1 = list(type = "SFO"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">91</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' use_of_ff = "max")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">92</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">93</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">94</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit.ff.2 <- mkinfit(SFO_SFO.ff.2, FOCUS_D, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">95</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit.ff.2.s <- summary(fit.ff.2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">96</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' print(fit.ff.2.s$par, 3)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">97</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' print(fit.ff.2.s$bpar, 3)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">98</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">99</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">100</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export transform_odeparms</pre> + </td> + </tr> + <tr class="never"> + <td class="num">101</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">transform_odeparms <- function(parms, mkinmod,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">102</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_rates = TRUE, transform_fractions = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">103</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">104</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # We need the model specification for the names of the model</pre> + </td> + </tr> + <tr class="never"> + <td class="num">105</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # variables and the information on the sink</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">106</td> + <td class="coverage">25587<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> spec = mkinmod$spec</pre> + </td> + </tr> + <tr class="never"> + <td class="num">107</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">108</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Set up container for transformed parameters</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">109</td> + <td class="coverage">25587<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transparms <- numeric(0)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">110</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">111</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Do not transform initial values for state variables</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">112</td> + <td class="coverage">25587<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> state.ini.optim <- parms[grep("_0$", names(parms))]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">113</td> + <td class="coverage">25587<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transparms[names(state.ini.optim)] <- state.ini.optim</pre> + </td> + </tr> + <tr class="never"> + <td class="num">114</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">115</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Log transformation for rate constants if requested</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">116</td> + <td class="coverage">25587<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k <- parms[grep("^k_", names(parms))]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">117</td> + <td class="coverage">25587<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k__iore <- parms[grep("^k__iore_", names(parms))]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">118</td> + <td class="coverage">25587<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k <- c(k, k__iore)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">119</td> + <td class="coverage">25587<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(k) > 0) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">120</td> + <td class="coverage">15485<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(transform_rates) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">121</td> + <td class="coverage">14379<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transparms[paste0("log_", names(k))] <- log(k)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">122</td> + <td class="coverage">1106<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> } else transparms[names(k)] <- k</pre> + </td> + </tr> + <tr class="never"> + <td class="num">123</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">124</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">125</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Do not transform exponents in IORE models</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">126</td> + <td class="coverage">25587<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> N <- parms[grep("^N", names(parms))]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">127</td> + <td class="coverage">25587<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transparms[names(N)] <- N</pre> + </td> + </tr> + <tr class="never"> + <td class="num">128</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">129</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Go through state variables and transform formation fractions if requested</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">130</td> + <td class="coverage">25587<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mod_vars = names(spec)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">131</td> + <td class="coverage">25587<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (box in mod_vars) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">132</td> + <td class="coverage">41283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f <- parms[grep(paste("^f", box, sep = "_"), names(parms))]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">133</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">134</td> + <td class="coverage">41283<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(f) > 0) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">135</td> + <td class="coverage">6522<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(transform_fractions) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">136</td> + <td class="coverage">5910<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (spec[[box]]$sink) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">137</td> + <td class="coverage">5908<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(f) == 1) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">138</td> + <td class="coverage">5894<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> trans_f_name <- paste("f", box, "qlogis", sep = "_")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">139</td> + <td class="coverage">5894<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transparms[trans_f_name] <- qlogis(f)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">140</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">141</td> + <td class="coverage">14<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> trans_f <- ilr(c(f, 1 - sum(f)))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">142</td> + <td class="coverage">14<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> trans_f_names <- paste("f", box, "ilr", 1:length(trans_f), sep = "_")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">143</td> + <td class="coverage">14<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transparms[trans_f_names] <- trans_f</pre> + </td> + </tr> + <tr class="never"> + <td class="num">144</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">145</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">146</td> + <td class="coverage">2<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(f) > 1) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">147</td> + <td class="coverage">2<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> trans_f <- ilr(f)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">148</td> + <td class="coverage">2<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> trans_f_names <- paste("f", box, "ilr", 1:length(trans_f), sep = "_")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">149</td> + <td class="coverage">2<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transparms[trans_f_names] <- trans_f</pre> + </td> + </tr> + <tr class="never"> + <td class="num">150</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">151</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">152</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">153</td> + <td class="coverage">612<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transparms[names(f)] <- f</pre> + </td> + </tr> + <tr class="never"> + <td class="num">154</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">155</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">156</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">157</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">158</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Transform also FOMC parameters alpha and beta, DFOP and HS rates k1 and k2</pre> + </td> + </tr> + <tr class="never"> + <td class="num">159</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # and HS parameter tb as well as logistic model parameters kmax, k0 and r if</pre> + </td> + </tr> + <tr class="never"> + <td class="num">160</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # transformation of rates is requested</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">161</td> + <td class="coverage">25587<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (pname in c("alpha", "beta", "k1", "k2", "tb", "kmax", "k0", "r")) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">162</td> + <td class="coverage">204696<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.na(parms[pname])) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">163</td> + <td class="coverage">6006<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (transform_rates) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">164</td> + <td class="coverage">6006<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transparms[paste0("log_", pname)] <- log(parms[pname])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">165</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">166</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> transparms[pname] <- parms[pname]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">167</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">168</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">169</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">170</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">171</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # DFOP parameter g is treated as a fraction</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">172</td> + <td class="coverage">25587<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.na(parms["g"])) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">173</td> + <td class="coverage">1978<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> g <- parms["g"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">174</td> + <td class="coverage">1978<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (transform_fractions) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">175</td> + <td class="coverage">1978<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transparms["g_qlogis"] <- qlogis(g)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">176</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">177</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> transparms["g"] <- g</pre> + </td> + </tr> + <tr class="never"> + <td class="num">178</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">179</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">180</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">181</td> + <td class="coverage">25587<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(transparms)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">182</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">183</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">184</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname transform_odeparms</pre> + </td> + </tr> + <tr class="never"> + <td class="num">185</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export backtransform_odeparms</pre> + </td> + </tr> + <tr class="never"> + <td class="num">186</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">backtransform_odeparms <- function(transparms, mkinmod,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">187</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_rates = TRUE,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">188</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_fractions = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">189</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">190</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # We need the model specification for the names of the model</pre> + </td> + </tr> + <tr class="never"> + <td class="num">191</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # variables and the information on the sink</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">192</td> + <td class="coverage">49214214<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> spec = mkinmod$spec</pre> + </td> + </tr> + <tr class="never"> + <td class="num">193</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">194</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Set up container for backtransformed parameters</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">195</td> + <td class="coverage">49214214<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms <- numeric(0)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">196</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">197</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Do not transform initial values for state variables</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">198</td> + <td class="coverage">49214214<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> state.ini.optim <- transparms[grep("_0$", names(transparms))]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">199</td> + <td class="coverage">49214214<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms[names(state.ini.optim)] <- state.ini.optim</pre> + </td> + </tr> + <tr class="never"> + <td class="num">200</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">201</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Exponential transformation for rate constants</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">202</td> + <td class="coverage">49214214<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(transform_rates) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">203</td> + <td class="coverage">49140623<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> trans_k <- transparms[grep("^log_k_", names(transparms))]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">204</td> + <td class="coverage">49140623<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> trans_k__iore <- transparms[grep("^log_k__iore_", names(transparms))]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">205</td> + <td class="coverage">49140623<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> trans_k = c(trans_k, trans_k__iore)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">206</td> + <td class="coverage">49140623<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(trans_k) > 0) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">207</td> + <td class="coverage">47598103<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k_names <- gsub("^log_k", "k", names(trans_k))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">208</td> + <td class="coverage">47598103<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms[k_names] <- exp(trans_k)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">209</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">210</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">211</td> + <td class="coverage">73591<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> trans_k <- transparms[grep("^k_", names(transparms))]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">212</td> + <td class="coverage">73591<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms[names(trans_k)] <- trans_k</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">213</td> + <td class="coverage">73591<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> trans_k__iore <- transparms[grep("^k__iore_", names(transparms))]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">214</td> + <td class="coverage">73591<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms[names(trans_k__iore)] <- trans_k__iore</pre> + </td> + </tr> + <tr class="never"> + <td class="num">215</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">216</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">217</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Do not transform exponents in IORE models</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">218</td> + <td class="coverage">49214214<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> N <- transparms[grep("^N", names(transparms))]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">219</td> + <td class="coverage">49214214<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms[names(N)] <- N</pre> + </td> + </tr> + <tr class="never"> + <td class="num">220</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">221</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Go through state variables and apply inverse transformations to formation fractions</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">222</td> + <td class="coverage">49214214<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mod_vars = names(spec)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">223</td> + <td class="coverage">49214214<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (box in mod_vars) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">224</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Get the names as used in the model</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">225</td> + <td class="coverage">97593385<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f_names = grep(paste("^f", box, sep = "_"), mkinmod$parms, value = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">226</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">227</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Get the formation fraction parameters</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">228</td> + <td class="coverage">97593385<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> trans_f = transparms[grep(paste("^f", box, sep = "_"), names(transparms))]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">229</td> + <td class="coverage">97593385<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(trans_f) > 0) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">230</td> + <td class="coverage">46632823<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(transform_fractions) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">231</td> + <td class="coverage">46588453<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (any(grepl("qlogis", names(trans_f)))) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">232</td> + <td class="coverage">46059152<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f_tmp <- plogis(trans_f)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">233</td> + <td class="coverage">46059152<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms[f_names] <- f_tmp</pre> + </td> + </tr> + <tr class="never"> + <td class="num">234</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">235</td> + <td class="coverage">529301<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f_tmp <- invilr(trans_f)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">236</td> + <td class="coverage">529301<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (spec[[box]]$sink) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">237</td> + <td class="coverage">528393<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms[f_names] <- f_tmp[1:length(f_tmp)-1]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">238</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">239</td> + <td class="coverage">908<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms[f_names] <- f_tmp</pre> + </td> + </tr> + <tr class="never"> + <td class="num">240</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">241</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">242</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">243</td> + <td class="coverage">44370<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms[names(trans_f)] <- trans_f</pre> + </td> + </tr> + <tr class="never"> + <td class="num">244</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">245</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">246</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">247</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">248</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Transform parameters also for FOMC, DFOP, HS and logistic models</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">249</td> + <td class="coverage">49214214<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (pname in c("alpha", "beta", "k1", "k2", "tb", "kmax", "k0", "r")) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">250</td> + <td class="coverage">393713712<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (transform_rates) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">251</td> + <td class="coverage">393124984<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> pname_trans = paste0("log_", pname)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">252</td> + <td class="coverage">393124984<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.na(transparms[pname_trans])) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">253</td> + <td class="coverage">4306142<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms[pname] <- exp(transparms[pname_trans])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">254</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">255</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">256</td> + <td class="coverage">588728<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.na(transparms[pname])) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">257</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> parms[pname] <- transparms[pname]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">258</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">259</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">260</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">261</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">262</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # DFOP parameter g is now transformed using qlogis</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">263</td> + <td class="coverage">49214214<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.na(transparms["g_qlogis"])) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">264</td> + <td class="coverage">2034008<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> g_qlogis <- transparms["g_qlogis"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">265</td> + <td class="coverage">2034008<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms["g"] <- plogis(g_qlogis)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">266</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">267</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # In earlier times we used ilr for g, so we keep this around</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">268</td> + <td class="coverage">49214214<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.na(transparms["g_ilr"])) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">269</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> g_ilr <- transparms["g_ilr"]</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">270</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> parms["g"] <- invilr(g_ilr)[1]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">271</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">272</td> + <td class="coverage">49214214<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.na(transparms["g"])) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">273</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> parms["g"] <- transparms["g"]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">274</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">275</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">276</td> + <td class="coverage">49214214<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(parms)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">277</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">278</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"># vim: set ts=2 sw=2 expandtab:</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/hierarchical_kinetics.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Hierarchical kinetics template</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' R markdown format for setting up hierarchical kinetics based on a template</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' provided with the mkin package. This format is based on [rmarkdown::pdf_document].</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Chunk options are adapted. Echoing R code from code chunks and caching are</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' turned on per default. character for prepending output from code chunks is</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' set to the empty string, code tidying is off, figure alignment defaults to</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' centering, and positioning of figures is set to "H", which means that</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' figures will not move around in the document, but stay where the user</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' includes them.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' The latter feature (positioning the figures with "H") depends on the LaTeX</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' package 'float'. In addition, the LaTeX package 'listing' is used in the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' template for showing model fit summaries in the Appendix. This means that</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the LaTeX packages 'float' and 'listing' need to be installed in the TeX</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' distribution used.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' On Windows, the easiest way to achieve this (if no TeX distribution</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' is present before) is to install the 'tinytex' R package, to run</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' 'tinytex::install_tinytex()' to get the basic tiny Tex distribution,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' and then to run 'tinytex::tlmgr_install(c("float", "listing"))'.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @inheritParams rmarkdown::pdf_document</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param ... Arguments to \code{rmarkdown::pdf_document}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return R Markdown output format to pass to</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \code{\link[rmarkdown:render]{render}}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' library(rmarkdown)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # The following is now commented out after the relase of v1.2.3 for the generation</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # of online docs, as the command creates a directory and opens an editor</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' #draft("example_analysis.rmd", template = "hierarchical_kinetics", package = "mkin")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">hierarchical_kinetics <- function(..., keep_tex = FALSE) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="missed"> + <td class="num">41</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (getRversion() < "4.1.0")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">42</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> stop("You need R with version > 4.1.0 to compile this document")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="missed"> + <td class="num">44</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (!requireNamespace("knitr")) stop("Please install the knitr package to use this template")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">45</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (!requireNamespace("rmarkdown")) stop("Please install the rmarkdown package to use this template")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">46</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> knitr::opts_chunk$set(cache = TRUE, comment = "", tidy = FALSE, echo = TRUE)</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">47</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> knitr::opts_chunk$set(fig.align = "center", fig.pos = "H")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">48</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> options(knitr.kable.NA = "")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="missed"> + <td class="num">50</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> fmt <- rmarkdown::pdf_document(...,</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">51</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> keep_tex = keep_tex,</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">52</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> toc = TRUE,</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">53</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> toc_depth = 3,</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">54</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> includes = rmarkdown::includes(in_header = "header.tex"),</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">55</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> extra_dependencies = c("float", "listing", "framed")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> )</pre> + </td> + </tr> + <tr class="never"> + <td class="num">57</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="missed"> + <td class="num">58</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> return(fmt)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/nlme.mmkin.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"># Code inspired by nlme::nlme.nlsList and R/nlme_fit.R from nlmixr</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"># We need to assign the degradation function created in nlme.mmkin to an</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"># environment that is always accessible, also e.g. when evaluation is done by</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"># testthat or pkgdown. Therefore parent.frame() is not good enough. The</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"># following environment will be in the mkin namespace.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">.nlme_env <- new.env(parent = emptyenv())</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">nlme::nlme</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Retrieve a degradation function from the mmkin namespace</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom utils getFromNamespace</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return A function that was likely previously assigned from within</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' nlme.mmkin</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">get_deg_func <- function() {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">19</td> + <td class="coverage">217279<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(get("deg_func", getFromNamespace(".nlme_env", "mkin")))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Create an nlme model for an mmkin row object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' This functions sets up a nonlinear mixed effects model for an mmkin row</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' object. An mmkin row object is essentially a list of mkinfit objects that</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' have been obtained by fitting the same model to a list of datasets.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Note that the convergence of the nlme algorithms depends on the quality</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' of the data. In degradation kinetics, we often only have few datasets</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' (e.g. data for few soils) and complicated degradation models, which may</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' make it impossible to obtain convergence with nlme.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param model An [mmkin] row object.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param data Ignored, data are taken from the mmkin model</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param fixed Ignored, all degradation parameters fitted in the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' mmkin model are used as fixed parameters</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param random If not specified, no correlations between random effects are</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' set up for the optimised degradation model parameters. This is</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' achieved by using the [nlme::pdDiag] method.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param groups See the documentation of nlme</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param start If not specified, mean values of the fitted degradation</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parameters taken from the mmkin object are used</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param correlation See the documentation of nlme</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param weights passed to nlme</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param subset passed to nlme</pre> + </td> + </tr> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param method passed to nlme</pre> + </td> + </tr> + <tr class="never"> + <td class="num">47</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param na.action passed to nlme</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param naPattern passed to nlme</pre> + </td> + </tr> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param control passed to nlme</pre> + </td> + </tr> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param verbose passed to nlme</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom stats na.fail as.formula</pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return Upon success, a fitted 'nlme.mmkin' object, which is an nlme object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' with additional elements. It also inherits from 'mixed.mmkin'.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">54</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @note As the object inherits from [nlme::nlme], there is a wealth of</pre> + </td> + </tr> + <tr class="never"> + <td class="num">55</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' methods that will automatically work on 'nlme.mmkin' objects, such as</pre> + </td> + </tr> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' [nlme::intervals()], [nlme::anova.lme()] and [nlme::coef.lme()].</pre> + </td> + </tr> + <tr class="never"> + <td class="num">57</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @seealso [nlme_function()], [plot.mixed.mmkin], [summary.nlme.mmkin]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">60</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ds <- lapply(experimental_data_for_UBA_2019[6:10],</pre> + </td> + </tr> + <tr class="never"> + <td class="num">61</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' function(x) subset(x$data[c("name", "time", "value")], name == "parent"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">62</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">63</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">64</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f <- mmkin(c("SFO", "DFOP"), ds, quiet = TRUE, cores = 1)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">65</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' library(nlme)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">66</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_nlme_sfo <- nlme(f["SFO", ])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">67</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_nlme_dfop <- nlme(f["DFOP", ])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">68</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' anova(f_nlme_sfo, f_nlme_dfop)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">69</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' print(f_nlme_dfop)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">70</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(f_nlme_dfop)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">71</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' endpoints(f_nlme_dfop)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">72</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">73</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ds_2 <- lapply(experimental_data_for_UBA_2019[6:10],</pre> + </td> + </tr> + <tr class="never"> + <td class="num">74</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' function(x) x$data[c("name", "time", "value")])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">75</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' m_sfo_sfo <- mkinmod(parent = mkinsub("SFO", "A1"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">76</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' A1 = mkinsub("SFO"), use_of_ff = "min", quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">77</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' m_sfo_sfo_ff <- mkinmod(parent = mkinsub("SFO", "A1"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">78</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' A1 = mkinsub("SFO"), use_of_ff = "max", quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">79</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' m_dfop_sfo <- mkinmod(parent = mkinsub("DFOP", "A1"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">80</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' A1 = mkinsub("SFO"), quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">81</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">82</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_2 <- mmkin(list("SFO-SFO" = m_sfo_sfo,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">83</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' "SFO-SFO-ff" = m_sfo_sfo_ff,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">84</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' "DFOP-SFO" = m_dfop_sfo),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">85</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ds_2, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">86</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">87</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_nlme_sfo_sfo <- nlme(f_2["SFO-SFO", ])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">88</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(f_nlme_sfo_sfo)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">89</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">90</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # With formation fractions this does not coverge with defaults</pre> + </td> + </tr> + <tr class="never"> + <td class="num">91</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # f_nlme_sfo_sfo_ff <- nlme(f_2["SFO-SFO-ff", ])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">92</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' #plot(f_nlme_sfo_sfo_ff)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">93</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">94</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # For the following, we need to increase pnlsMaxIter and the tolerance</pre> + </td> + </tr> + <tr class="never"> + <td class="num">95</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # to get convergence</pre> + </td> + </tr> + <tr class="never"> + <td class="num">96</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_nlme_dfop_sfo <- nlme(f_2["DFOP-SFO", ],</pre> + </td> + </tr> + <tr class="never"> + <td class="num">97</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' control = list(pnlsMaxIter = 120, tolerance = 5e-4))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">98</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">99</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(f_nlme_dfop_sfo)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">100</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">101</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' anova(f_nlme_dfop_sfo, f_nlme_sfo_sfo)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">102</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">103</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' endpoints(f_nlme_sfo_sfo)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">104</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' endpoints(f_nlme_dfop_sfo)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">105</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">106</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' if (length(findFunction("varConstProp")) > 0) { # tc error model for nlme available</pre> + </td> + </tr> + <tr class="never"> + <td class="num">107</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Attempts to fit metabolite kinetics with the tc error model are possible,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">108</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # but need tweeking of control values and sometimes do not converge</pre> + </td> + </tr> + <tr class="never"> + <td class="num">109</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">110</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_tc <- mmkin(c("SFO", "DFOP"), ds, quiet = TRUE, error_model = "tc")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">111</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_nlme_sfo_tc <- nlme(f_tc["SFO", ])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">112</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_nlme_dfop_tc <- nlme(f_tc["DFOP", ])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">113</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' AIC(f_nlme_sfo, f_nlme_sfo_tc, f_nlme_dfop, f_nlme_dfop_tc)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">114</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' print(f_nlme_dfop_tc)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">115</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">116</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">117</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_2_obs <- update(f_2, error_model = "obs")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">118</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_nlme_sfo_sfo_obs <- nlme(f_2_obs["SFO-SFO", ])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">119</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' print(f_nlme_sfo_sfo_obs)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">120</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_nlme_dfop_sfo_obs <- nlme(f_2_obs["DFOP-SFO", ],</pre> + </td> + </tr> + <tr class="never"> + <td class="num">121</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' control = list(pnlsMaxIter = 120, tolerance = 5e-4))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">122</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">123</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_2_tc <- update(f_2, error_model = "tc")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">124</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # f_nlme_sfo_sfo_tc <- nlme(f_2_tc["SFO-SFO", ]) # No convergence with 50 iterations</pre> + </td> + </tr> + <tr class="never"> + <td class="num">125</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # f_nlme_dfop_sfo_tc <- nlme(f_2_tc["DFOP-SFO", ],</pre> + </td> + </tr> + <tr class="never"> + <td class="num">126</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # control = list(pnlsMaxIter = 120, tolerance = 5e-4)) # Error in X[, fmap[[nm]]] <- gradnm</pre> + </td> + </tr> + <tr class="never"> + <td class="num">127</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">128</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' anova(f_nlme_dfop_sfo, f_nlme_dfop_sfo_obs)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">129</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">130</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">131</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">nlme.mmkin <- function(model, data = "auto",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">132</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> fixed = lapply(as.list(names(mean_degparms(model))),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">133</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> function(el) eval(parse(text = paste(el, 1, sep = "~")))),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">134</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> random = pdDiag(fixed),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">135</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> groups,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">136</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> start = mean_degparms(model, random = TRUE, test_log_parms = TRUE),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">137</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> correlation = NULL, weights = NULL,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">138</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> subset, method = c("ML", "REML"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">139</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> na.action = na.fail, naPattern,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">140</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> control = list(), verbose= FALSE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">141</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">142</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (nrow(model) > 1) stop("Only row objects allowed")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">143</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">144</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> thisCall <- as.list(match.call())[-1]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">145</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">146</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Warn in case arguments were used that are overriden</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">147</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (any(!is.na(match(names(thisCall),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">148</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> c("data"))))) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">149</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> warning("'nlme.mmkin' will redefine 'data'")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">150</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">151</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">152</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Get native symbol info for speed</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">153</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (model[[1]]$solution_type == "deSolve" & !is.null(model[[1]]$mkinmod$cf)) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">154</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # The mkinmod stored in the first fit will be used by nlme</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">155</td> + <td class="coverage">189<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> model[[1]]$mkinmod$symbols <- deSolve::checkDLL(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">156</td> + <td class="coverage">189<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dllname = model[[1]]$mkinmod$dll_info[["name"]],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">157</td> + <td class="coverage">189<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> func = "diffs", initfunc = "initpar",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">158</td> + <td class="coverage">189<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> jacfunc = NULL, nout = 0, outnames = NULL)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">159</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">160</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">161</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> deg_func <- nlme_function(model)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">162</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">163</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> assign("deg_func", deg_func, getFromNamespace(".nlme_env", "mkin"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">164</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">165</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # For the formula, get the degradation function from the mkin namespace</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">166</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> this_model_text <- paste0("value ~ mkin::get_deg_func()(",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">167</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> paste(names(formals(deg_func)), collapse = ", "), ")")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">168</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> this_model <- as.formula(this_model_text)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">169</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">170</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> thisCall[["model"]] <- this_model</pre> + </td> + </tr> + <tr class="never"> + <td class="num">171</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">172</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> thisCall[["data"]] <- nlme_data(model)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">173</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">174</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> thisCall[["start"]] <- start</pre> + </td> + </tr> + <tr class="never"> + <td class="num">175</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">176</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> thisCall[["fixed"]] <- fixed</pre> + </td> + </tr> + <tr class="never"> + <td class="num">177</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">178</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> thisCall[["random"]] <- random</pre> + </td> + </tr> + <tr class="never"> + <td class="num">179</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">180</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> error_model <- model[[1]]$err_mod</pre> + </td> + </tr> + <tr class="never"> + <td class="num">181</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">182</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (missing(weights)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">183</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> thisCall[["weights"]] <- switch(error_model,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">184</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> const = NULL,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">185</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> obs = varIdent(form = ~ 1 | name),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">186</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> tc = varConstProp())</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">187</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> sigma <- switch(error_model,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">188</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> tc = 1,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">189</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> NULL)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">190</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">191</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">192</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> control <- thisCall[["control"]]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">193</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (error_model == "tc") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">194</td> + <td class="coverage">928<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> control$sigma = 1</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">195</td> + <td class="coverage">928<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> thisCall[["control"]] <- control</pre> + </td> + </tr> + <tr class="never"> + <td class="num">196</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">197</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">198</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit_time <- system.time(val <- do.call("nlme.formula", thisCall))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">199</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> val$time <- fit_time</pre> + </td> + </tr> + <tr class="never"> + <td class="num">200</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">201</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> val$mkinmod <- model[[1]]$mkinmod</pre> + </td> + </tr> + <tr class="never"> + <td class="num">202</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Don't return addresses that will become invalid</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">203</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> val$mkinmod$symbols <- NULL</pre> + </td> + </tr> + <tr class="never"> + <td class="num">204</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">205</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> val$data <- thisCall[["data"]]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">206</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> val$mmkin <- model</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">207</td> + <td class="coverage">824<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.list(start)) val$mean_dp_start <- start$fixed</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">208</td> + <td class="coverage">189<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> else val$mean_dp_start <- start</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">209</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> val$transform_rates <- model[[1]]$transform_rates</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">210</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> val$transform_fractions <- model[[1]]$transform_fractions</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">211</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> val$solution_type <- model[[1]]$solution_type</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">212</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> val$err_mode <- error_model</pre> + </td> + </tr> + <tr class="never"> + <td class="num">213</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">214</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> val$bparms.optim <- backtransform_odeparms(val$coefficients$fixed,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">215</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> val$mkinmod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">216</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_rates = val$transform_rates,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">217</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform_fractions = val$transform_fractions)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">218</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">219</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> val$bparms.fixed <- model[[1]]$bparms.fixed</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">220</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> val$date.fit <- date()</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">221</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> val$nlmeversion <- as.character(utils::packageVersion("nlme"))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">222</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> val$mkinversion <- as.character(utils::packageVersion("mkin"))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">223</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> val$Rversion <- paste(R.version$major, R.version$minor, sep=".")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">224</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(val) <- c("nlme.mmkin", "mixed.mmkin", "nlme", "lme")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">225</td> + <td class="coverage">1013<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(val)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">226</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">227</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">228</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">229</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname nlme.mmkin</pre> + </td> + </tr> + <tr class="never"> + <td class="num">230</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param x An nlme.mmkin object to print</pre> + </td> + </tr> + <tr class="never"> + <td class="num">231</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param digits Number of digits to use for printing</pre> + </td> + </tr> + <tr class="never"> + <td class="num">232</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">print.nlme.mmkin <- function(x, digits = max(3, getOption("digits") - 3), ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">233</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat( "Kinetic nonlinear mixed-effects model fit by " )</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">234</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat( if(x$method == "REML") "REML\n" else "maximum likelihood\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">235</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nStructural model:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">236</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> diffs <- x$mmkin[[1]]$mkinmod$diffs</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">237</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> nice_diffs <- gsub("^(d.*) =", "\\1/dt =", diffs)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">238</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> writeLines(strwrap(nice_diffs, exdent = 11))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">239</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nData:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">240</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat(nrow(x$data), "observations of",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">241</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> length(unique(x$data$name)), "variable(s) grouped in",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">242</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> length(unique(x$data$ds)), "datasets\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">243</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nLog-", if(x$method == "REML") "restricted-" else "",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">244</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "likelihood: ", format(x$logLik, digits = digits), "\n", sep = "")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">245</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fixF <- x$call$fixed</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">246</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nFixed effects:\n",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">247</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> deparse(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">248</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(inherits(fixF, "formula") || is.call(fixF) || is.name(fixF))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">249</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> x$call$fixed</pre> + </td> + </tr> + <tr class="never"> + <td class="num">250</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> else</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">251</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lapply(fixF, function(el) as.name(deparse(el)))), "\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">252</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(fixef(x), digits = digits, ...)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">253</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">254</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(summary(x$modelStruct), sigma = x$sigma, digits = digits, ...)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">255</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> invisible(x)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">256</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">257</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">258</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">259</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname nlme.mmkin</pre> + </td> + </tr> + <tr class="never"> + <td class="num">260</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param object An nlme.mmkin object to update</pre> + </td> + </tr> + <tr class="never"> + <td class="num">261</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param ... Update specifications passed to update.nlme</pre> + </td> + </tr> + <tr class="never"> + <td class="num">262</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">update.nlme.mmkin <- function(object, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">263</td> + <td class="coverage">85<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res <- NextMethod()</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">264</td> + <td class="coverage">85<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res$mmkin <- object$mmkin</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">265</td> + <td class="coverage">85<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(res) <- c("nlme.mmkin", "nlme", "lme")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">266</td> + <td class="coverage">85<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(res)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">267</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/mkinresplot.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">utils::globalVariables(c("variable", "residual"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Function to plot residuals stored in an mkin object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' This function plots the residuals for the specified subset of the observed</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' variables from an mkinfit object. A combined plot of the fitted model and</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the residuals can be obtained using \code{\link{plot.mkinfit}} using the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' argument \code{show_residuals = TRUE}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom stats residuals</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param object A fit represented in an \code{\link{mkinfit}} object.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param obs_vars A character vector of names of the observed variables for</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' which residuals should be plotted. Defaults to all observed variables in</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the model</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param xlim plot range in x direction.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param xlab Label for the x axis.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param standardized Should the residuals be standardized by dividing by the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' standard deviation given by the error model of the fit?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param ylab Label for the y axis.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param maxabs Maximum absolute value of the residuals. This is used for the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' scaling of the y axis and defaults to "auto".</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param legend Should a legend be plotted?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param lpos Where should the legend be placed? Default is "topright". Will</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' be passed on to \code{\link{legend}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param col_obs Colors for the observed variables.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param pch_obs Symbols to be used for the observed variables.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param frame Should a frame be drawn around the plots?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots further arguments passed to \code{\link{plot}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return Nothing is returned by this function, as it is called for its side</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' effect, namely to produce a plot.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @author Johannes Ranke and Katrin Lindenberger</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @seealso \code{\link{mkinplot}}, for a way to plot the data and the fitted</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' lines of the mkinfit object, and \code{\link{plot_res}} for a function</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' combining the plot of the fit and the residual plot.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' model <- mkinmod(parent = mkinsub("SFO", "m1"), m1 = mkinsub("SFO"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit <- mkinfit(model, FOCUS_2006_D, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' mkinresplot(fit, "m1")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">mkinresplot <- function (object,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> obs_vars = names(object$mkinmod$map),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> xlim = c(0, 1.1 * max(object$data$time)),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> standardized = FALSE,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> xlab = "Time", ylab = ifelse(standardized, "Standardized residual", "Residual"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">47</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> maxabs = "auto", legend = TRUE, lpos = "topright",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> col_obs = "auto", pch_obs = "auto",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> frame = TRUE,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">52</td> + <td class="coverage">1228<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> obs_vars_all <- as.character(unique(object$data$variable))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">54</td> + <td class="coverage">1228<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(obs_vars) > 0){</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">55</td> + <td class="coverage">1228<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> obs_vars <- intersect(obs_vars_all, obs_vars)</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">56</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> } else obs_vars <- obs_vars_all</pre> + </td> + </tr> + <tr class="never"> + <td class="num">57</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">58</td> + <td class="coverage">1228<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (standardized) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">59</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> res_col <- "standardized"</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">60</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> object$data[[res_col]] <- residuals(object, standardized = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">61</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">62</td> + <td class="coverage">1228<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res_col <- "residual"</pre> + </td> + </tr> + <tr class="never"> + <td class="num">63</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">64</td> + <td class="coverage">1228<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res <- subset(object$data, variable %in% obs_vars)[res_col]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">65</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">66</td> + <td class="coverage">1228<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (maxabs == "auto") maxabs = max(abs(res), na.rm = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">67</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">68</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Set colors and symbols</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">69</td> + <td class="coverage">1228<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (col_obs[1] == "auto") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">70</td> + <td class="coverage">948<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> col_obs <- 1:length(obs_vars)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">71</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">72</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">73</td> + <td class="coverage">1228<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (pch_obs[1] == "auto") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">74</td> + <td class="coverage">948<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> pch_obs <- 1:length(obs_vars)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">75</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">76</td> + <td class="coverage">1228<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(col_obs) <- names(pch_obs) <- obs_vars</pre> + </td> + </tr> + <tr class="never"> + <td class="num">77</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">78</td> + <td class="coverage">1228<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> plot(0, type = "n", frame = frame,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">79</td> + <td class="coverage">1228<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> xlab = xlab, ylab = ylab,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">80</td> + <td class="coverage">1228<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> xlim = xlim,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">81</td> + <td class="coverage">1228<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ylim = c(-1.2 * maxabs, 1.2 * maxabs), ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">82</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">83</td> + <td class="coverage">1228<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for(obs_var in obs_vars){</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">84</td> + <td class="coverage">1298<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> residuals_plot <- subset(object$data, variable == obs_var, c("time", res_col))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">85</td> + <td class="coverage">1298<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> points(residuals_plot, pch = pch_obs[obs_var], col = col_obs[obs_var])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">86</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">87</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">88</td> + <td class="coverage">1228<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> abline(h = 0, lty = 2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">89</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">90</td> + <td class="coverage">1228<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (legend == TRUE) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">91</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> legend(lpos, inset = c(0.05, 0.05), legend = obs_vars,</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">92</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> col = col_obs[obs_vars], pch = pch_obs[obs_vars])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">93</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">94</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/plot.mmkin.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Plot model fits (observed and fitted) and the residuals for a row or column</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' of an mmkin object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' When x is a row selected from an mmkin object (\code{\link{[.mmkin}}), the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' same model fitted for at least one dataset is shown. When it is a column,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the fit of at least one model to the same dataset is shown.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' If the current plot device is a \code{\link[tikzDevice]{tikz}} device, then</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' latex is being used for the formatting of the chi2 error level.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param x An object of class \code{\link{mmkin}}, with either one row or one</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' column.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param main The main title placed on the outer margin of the plot.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param legends An index for the fits for which legends should be shown.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param resplot Should the residuals plotted against time, using</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \code{\link{mkinresplot}}, or as squared residuals against predicted</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' values, with the error model, using \code{\link{mkinerrplot}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param ylab Label for the y axis.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param standardized Should the residuals be standardized? This option</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' is passed to \code{\link{mkinresplot}}, it only takes effect if</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' `resplot = "time"`.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param show_errmin Should the chi2 error level be shown on top of the plots</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' to the left?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param errmin_var The variable for which the FOCUS chi2 error value should</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' be shown.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param errmin_digits The number of significant digits for rounding the FOCUS</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' chi2 error percentage.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param cex Passed to the plot functions and \code{\link{mtext}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param rel.height.middle The relative height of the middle plot, if more</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' than two rows of plots are shown.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param ymax Maximum y axis value for \code{\link{plot.mkinfit}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots Further arguments passed to \code{\link{plot.mkinfit}} and</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \code{\link{mkinresplot}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return The function is called for its side effect.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @author Johannes Ranke</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Only use one core not to offend CRAN checks</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fits <- mmkin(c("FOMC", "HS"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' list("FOCUS B" = FOCUS_2006_B, "FOCUS C" = FOCUS_2006_C), # named list for titles</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' cores = 1, quiet = TRUE, error_model = "tc")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(fits[, "FOCUS C"])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(fits["FOMC", ])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(fits["FOMC", ], show_errmin = FALSE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">47</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # We can also plot a single fit, if we like the way plot.mmkin works, but then the plot</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # height should be smaller than the plot width (this is not possible for the html pages</pre> + </td> + </tr> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # generated by pkgdown, as far as I know).</pre> + </td> + </tr> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(fits["FOMC", "FOCUS C"]) # same as plot(fits[1, 2])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Show the error models</pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(fits["FOMC", ], resplot = "errmod")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">54</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">55</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">57</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">plot.mmkin <- function(x, main = "auto", legends = 1,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> resplot = c("time", "errmod"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> ylab = "Residue",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">60</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> standardized = FALSE,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">61</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> show_errmin = TRUE,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">62</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> errmin_var = "All data", errmin_digits = 3,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">63</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> cex = 0.7, rel.height.middle = 0.9,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">64</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> ymax = "auto", ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">65</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">66</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">67</td> + <td class="coverage">316<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> oldpar <- par(no.readonly = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">68</td> + <td class="coverage">316<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> on.exit(par(oldpar, no.readonly = TRUE))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">69</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">70</td> + <td class="coverage">316<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n.m <- nrow(x)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">71</td> + <td class="coverage">316<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n.d <- ncol(x)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">72</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">73</td> + <td class="coverage">316<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> resplot <- match.arg(resplot)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">74</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">75</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # We can handle either a row (different models, same dataset)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">76</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # or a column (same model, different datasets)</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">77</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (n.m > 1 & n.d > 1) stop("Please select fits either for one model or for one dataset")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">78</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (n.m == 1 & n.d == 1) loop_over = "none"</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">79</td> + <td class="coverage">246<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (n.m > 1) loop_over <- "models"</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">80</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (n.d > 1) loop_over <- "datasets"</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">81</td> + <td class="coverage">316<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n.fits <- length(x)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">82</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">83</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Set the main plot titles from the names of the models or the datasets</pre> + </td> + </tr> + <tr class="never"> + <td class="num">84</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Will be integer indexes if no other names are present in the mmkin object</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">85</td> + <td class="coverage">316<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (main == "auto") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">86</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> main = switch(loop_over,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">87</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> none = paste(rownames(x), colnames(x)),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">88</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> models = colnames(x),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">89</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> datasets = rownames(x))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">90</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">91</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">92</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Set relative plot heights, so the first and the last plot are the norm</pre> + </td> + </tr> + <tr class="never"> + <td class="num">93</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # and the middle plots (if n.fits >2) are smaller by rel.height.middle</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">94</td> + <td class="coverage">316<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rel.heights <- if (n.fits > 2) c(1, rep(rel.height.middle, n.fits - 2), 1)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">95</td> + <td class="coverage">316<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> else rep(1, n.fits)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">96</td> + <td class="coverage">316<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> layout(matrix(1:(2 * n.fits), n.fits, 2, byrow = TRUE), heights = rel.heights)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">97</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">98</td> + <td class="coverage">316<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> par(cex = cex)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">99</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">100</td> + <td class="coverage">316<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (i.fit in 1:n.fits) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">101</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">102</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Margins for top row of plots when we have more than one row</pre> + </td> + </tr> + <tr class="never"> + <td class="num">103</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Reduce bottom margin by 2.1 - hides x axis legend</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">104</td> + <td class="coverage">948<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (i.fit == 1 & n.fits > 1) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">105</td> + <td class="coverage">316<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> par(mar = c(3.0, 4.1, 4.1, 2.1))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">106</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">107</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">108</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Margins for middle rows of plots, if any</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">109</td> + <td class="coverage">948<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (i.fit > 1 & i.fit < n.fits) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">110</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Reduce top margin by 2 after the first plot as we have no main title,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">111</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # reduced plot height, therefore we need rel.height.middle in the layout</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">112</td> + <td class="coverage">316<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> par(mar = c(3.0, 4.1, 2.1, 2.1))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">113</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">114</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">115</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Margins for bottom row of plots when we have more than one row</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">116</td> + <td class="coverage">948<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (i.fit == n.fits & n.fits > 1) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">117</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Restore bottom margin for last plot to show x axis legend</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">118</td> + <td class="coverage">316<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> par(mar = c(5.1, 4.1, 2.1, 2.1))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">119</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">120</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">121</td> + <td class="coverage">948<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit <- x[[i.fit]]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">122</td> + <td class="coverage">948<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (ymax == "auto") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">123</td> + <td class="coverage">948<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> plot(fit, legend = legends == i.fit, ylab = ylab, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">124</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">125</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> plot(fit, legend = legends == i.fit, ylim = c(0, ymax), ylab = ylab, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">126</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">127</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">128</td> + <td class="coverage">948<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> title(main, outer = TRUE, line = -2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">129</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">130</td> + <td class="coverage">948<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit_name <- switch(loop_over,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">131</td> + <td class="coverage">948<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> models = rownames(x)[i.fit],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">132</td> + <td class="coverage">948<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> datasets = colnames(x)[i.fit],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">133</td> + <td class="coverage">948<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> none = "")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">134</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">135</td> + <td class="coverage">948<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (show_errmin) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">136</td> + <td class="coverage">948<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> chi2 <- signif(100 * mkinerrmin(fit)[errmin_var, "err.min"], errmin_digits)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">137</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">138</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Use LateX if the current plotting device is tikz</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">139</td> + <td class="coverage">948<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (names(dev.cur()) == "tikz output") {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">140</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> chi2_text <- paste0(fit_name, " $\\chi^2$ error level = ", chi2, "\\%")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">141</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">142</td> + <td class="coverage">948<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> chi2_perc <- paste0(chi2, "%")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">143</td> + <td class="coverage">948<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> chi2_text <- bquote(.(fit_name) ~ chi^2 ~ "error level" == .(chi2_perc))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">144</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">145</td> + <td class="coverage">948<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mtext(chi2_text, cex = cex, line = 0.4)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">146</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">147</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> mtext(fit_name, cex = cex, line = 0.4)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">148</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">149</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">150</td> + <td class="coverage">948<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (resplot == "time") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">151</td> + <td class="coverage">948<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mkinresplot(fit, legend = FALSE, standardized = standardized, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">152</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">153</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> mkinerrplot(fit, legend = FALSE, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">154</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">155</td> + <td class="coverage">948<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mtext(paste(fit_name, "residuals"), cex = cex, line = 0.4)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">156</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">157</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/summary.mmkin.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Summary method for class "mmkin"</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Shows status information on the [mkinfit] objects contained in the object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' and gives an overview of ill-defined parameters calculated by [illparms].</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param object an object of class [mmkin]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param x an object of class \code{summary.mmkin}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param conf.level confidence level for testing parameters</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param digits number of digits to use for printing</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots optional arguments passed to methods like \code{print}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fits <- mmkin(</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' c("SFO", "FOMC"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' list("FOCUS A" = FOCUS_2006_A,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' "FOCUS C" = FOCUS_2006_C),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' quiet = TRUE, cores = 1)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' summary(fits)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">summary.mmkin <- function(object, conf.level = 0.95, ...) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">23</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ans <- list(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">24</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> err_mod = object[[1, 1]]$err_mod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">25</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> time = attr(object, "time"),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">26</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> illparms = illparms(object),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">27</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> status = status(object)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> )</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">30</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(ans) <- c("summary.mmkin")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">31</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(ans)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname summary.mmkin</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">print.summary.mmkin <- function(x, digits = max(3, getOption("digits") - 3), ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">37</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.null(x$err_mod)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">38</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("Error model: ")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">39</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat(switch(x$err_mod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">40</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> const = "Constant variance",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">41</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> obs = "Variance unique to each observed variable",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">42</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> tc = "Two-component variance function"), "\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">44</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("Fitted in", x$time[["elapsed"]], "s\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">46</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nStatus:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">47</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(x$status)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">49</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (any(x$illparms != "")) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">50</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nIll-defined parameters:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">51</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(x$illparms)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">54</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> invisible(x)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">55</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/read_spreadsheet.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Read datasets and relevant meta information from a spreadsheet file</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' This function imports one dataset from each sheet of a spreadsheet file.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' These sheets are selected based on the contents of a sheet 'Datasets', with</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' a column called 'Dataset Number', containing numbers identifying the dataset</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' sheets to be read in. In the second column there must be a grouping</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' variable, which will often be named 'Soil'. Optionally, time normalization</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' factors can be given in columns named 'Temperature' and 'Moisture'.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' There must be a sheet 'Compounds', with columns 'Name' and 'Acronym'.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' The first row read after the header read in from this sheet is assumed</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' to contain name and acronym of the parent compound.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' The dataset sheets should be named using the dataset numbers read in from</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the 'Datasets' sheet, i.e. '1', '2', ... . In each dataset sheet, the name</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' of the observed variable (e.g. the acronym of the parent compound or</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' one of its transformation products) should be in the first column,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the time values should be in the second colum, and the observed value</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' in the third column.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' In case relevant covariate data are available, they should be given</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' in a sheet 'Covariates', containing one line for each value of the grouping</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' variable specified in 'Datasets'. These values should be in the first</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' column and the column must have the same name as the second column in</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' 'Datasets'. Covariates will be read in from columns four and higher.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Their names should preferably not contain special characters like spaces,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' so they can be easily used for specifying covariate models.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' A similar data structure is defined as the R6 class [mkindsg], but</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' is probably more complicated to use.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param path Absolute or relative path to the spreadsheet file</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param valid_datasets Optional numeric index of the valid datasets, default is</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' to use all datasets</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param parent_only Should only the parent data be used?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param normalize Should the time scale be normalized using temperature</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' and moisture normalisation factors in the sheet 'Datasets'?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">read_spreadsheet <- function(path, valid_datasets = "all",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> parent_only = FALSE, normalize = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">42</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!requireNamespace("readxl", quietly = TRUE))</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">43</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> stop("Please install the readxl package to use this function")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Read the compound table</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">46</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> compounds <- readxl::read_excel(path, sheet = "Compounds")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">47</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parent <- compounds[1, ]$Acronym</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Read in meta information</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">50</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ds_meta <- readxl::read_excel(path, sheet = "Datasets")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">51</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ds_meta["Dataset Number"] <- as.character(ds_meta[["Dataset Number"]])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Select valid datasets</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">54</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (valid_datasets[1] == "all") valid_datasets <- 1:nrow(ds_meta)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">55</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ds_numbers_valid <- ds_meta[valid_datasets, ]$`Dataset Number`</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">56</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> grouping_factor <- names(ds_meta[2]) # Often "Soil"</pre> + </td> + </tr> + <tr class="never"> + <td class="num">57</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Read in valid datasets</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">59</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ds_raw <- lapply(ds_numbers_valid,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">60</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> function(dsn) readxl::read_excel(path, sheet = as.character(dsn)))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">61</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">62</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Make data frames compatible with mmkin</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">63</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ds_tmp <- lapply(ds_raw, function(x) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">64</td> + <td class="coverage">1287<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ds_ret <- x[1:3] |></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">65</td> + <td class="coverage">1287<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rlang::set_names(c("name", "time", "value")) |></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">66</td> + <td class="coverage">1287<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform(value = as.numeric(value))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">67</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> })</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">68</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(ds_tmp) <- ds_numbers_valid</pre> + </td> + </tr> + <tr class="never"> + <td class="num">69</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">70</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Normalize with temperature and moisture correction factors</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">71</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (normalize) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">72</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ds_norm <- lapply(ds_numbers_valid, function(ds_number) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">73</td> + <td class="coverage">1287<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f_corr <- as.numeric(ds_meta[ds_number, c("Temperature", "Moisture")])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">74</td> + <td class="coverage">1287<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ds_corr <- ds_tmp[[ds_number]] |></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">75</td> + <td class="coverage">1287<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transform(time = time * f_corr[1] * f_corr[2])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">76</td> + <td class="coverage">1287<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(ds_corr)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">77</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> })</pre> + </td> + </tr> + <tr class="never"> + <td class="num">78</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">79</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> ds_norm <- ds_tmp</pre> + </td> + </tr> + <tr class="never"> + <td class="num">80</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">81</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(ds_norm) <- ds_numbers_valid</pre> + </td> + </tr> + <tr class="never"> + <td class="num">82</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">83</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Select parent data only if requested</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">84</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (parent_only) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">85</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> ds_norm <- lapply(ds_norm, function(x) subset(x, name == parent))</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">86</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> compounds <- compounds[1, ]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">87</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">88</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">89</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Create a single long table to combine datasets with the same group name</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">90</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ds_all <- vctrs::vec_rbind(!!!ds_norm, .names_to = "Dataset Number")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">91</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ds_all_group <- merge(ds_all, ds_meta[c("Dataset Number", grouping_factor)])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">92</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> groups <- unique(ds_meta[valid_datasets, ][[grouping_factor]])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">93</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">94</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ds <- lapply(groups, function(x) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">95</td> + <td class="coverage">819<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ret <- ds_all_group[ds_all_group[[grouping_factor]] == x, ]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">96</td> + <td class="coverage">819<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ret[c("name", "time", "value")]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">97</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">98</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> )</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">99</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(ds) <- groups</pre> + </td> + </tr> + <tr class="never"> + <td class="num">100</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">101</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Get covariates</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">102</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covariates_raw <- readxl::read_excel(path, sheet = "Covariates")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">103</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covariates <- as.data.frame(covariates_raw[4:ncol(covariates_raw)])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">104</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> nocov <- setdiff(groups, covariates_raw[[1]])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">105</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(nocov) > 0) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">106</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> message("Did not find covariate data for ", paste(nocov, collapse = ", "))</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">107</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> message("Not returning covariate data")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">108</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> attr(ds, "covariates") <- NULL</pre> + </td> + </tr> + <tr class="never"> + <td class="num">109</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">110</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rownames(covariates) <- covariates_raw[[1]]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">111</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covariates <- covariates[which(colnames(covariates) != "Remarks")]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">112</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Attach covariate data if available</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">113</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> attr(ds, "covariates") <- covariates[groups, , drop = FALSE]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">114</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">115</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">116</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Attach the compound list to support automatic model building</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">117</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> attr(ds, "compounds") <- as.data.frame(compounds)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">118</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">119</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(ds)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">120</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/CAKE_export.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Export a list of datasets format to a CAKE study file</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' In addition to the datasets, the pathways in the degradation model can be</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' specified as well.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param ds A named list of datasets in long format as compatible with</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \code{\link{mkinfit}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param map A character vector with CAKE compartment names (Parent, A1, ...),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' named with the names used in the list of datasets.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param links An optional character vector of target compartments, named with</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the names of the source compartments. In order to make this easier, the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' names are used as in the datasets supplied.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param filename Where to write the result. Should end in .csf in order to be</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' compatible with CAKE.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param path An optional path to the output file.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param overwrite If TRUE, existing files are overwritten.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param study The name of the study.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param description An optional description.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param time_unit The time unit for the residue data.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param res_unit The unit used for the residues.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param comment An optional comment.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param date The date of file creation.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param optimiser Can be OLS or IRLS.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom utils write.table</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return The function is called for its side effect.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @author Johannes Ranke</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">CAKE_export <- function(ds, map = c(parent = "Parent"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> links = NA,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> filename = "CAKE_export.csf", path = ".", overwrite = FALSE,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> study = "Degradinol aerobic soil degradation",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> description = "",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> time_unit = "days",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> res_unit = "% AR",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> comment = "",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> date = Sys.Date(),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> optimiser = "IRLS")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">39</td> + <td class="coverage">741<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> file <- file.path(path, filename)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">40</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (file.exists(file) & !overwrite) stop(file, " already exists, stopping")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">41</td> + <td class="coverage">494<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> csf <- file(file, encoding = "latin1", open = "w+")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">42</td> + <td class="coverage">494<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> on.exit(close(csf))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">44</td> + <td class="coverage">494<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> CAKE_compartments = c("Parent", "A1", "A2", "A3", "B1", "B2", "C1")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">45</td> + <td class="coverage">494<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!all(map %in% CAKE_compartments)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">46</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> stop("The elements of map have to be CAKE compartment names")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">47</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">49</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> add <- function(x) cat(paste0(x, "\r\n"), file = csf, append = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">50</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> add0 <- function(x) cat(x, file = csf, append = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">52</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> add("[FileInfo]")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">53</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> add("CAKE-Version: 3.4 (Release)")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">54</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> add(paste("Name:", study))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">55</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> add(paste("Description:", description))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">56</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> add(paste("MeasurementUnits:", res_unit))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">57</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> add(paste("TimeUnits:", time_unit))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">58</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> add(paste("Comments:", comment))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">59</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> add(paste("Date:", date))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">60</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> add(paste("Optimiser:", optimiser))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">61</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> add("")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">62</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">63</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> add("[Data]")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">64</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">65</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (i in seq_along(ds)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">66</td> + <td class="coverage">494<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> add(paste("NewDataSet:", names(ds)[i]))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">67</td> + <td class="coverage">494<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> d <- mkin_long_to_wide(ds[[i]])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">68</td> + <td class="coverage">494<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(d) <- c("Time", map[names(d)[-1]])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">69</td> + <td class="coverage">494<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> write.table(d, csf,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">70</td> + <td class="coverage">494<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> sep = "\t", col.names = TRUE,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">71</td> + <td class="coverage">494<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> row.names = FALSE,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">72</td> + <td class="coverage">494<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> quote = FALSE, eol = "\r\n", na = "")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">73</td> + <td class="coverage">494<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> add("")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">74</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">75</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">76</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.na(links)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">77</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> add("")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">78</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> add("[Model]")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">79</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> add(paste0("ParentCompartment: Parent\t", names(map)[1], "\t", names(map)[1]))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">80</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (name in names(map)[-1]) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">81</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> add(paste0("Compartment: ", map[name], "\t", name, "\t", name))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">82</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">83</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (li in names(links)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">84</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> add(paste0("Link: ", map[li], "\t", map[links[li]], "\t0.5\t0\t1\tFree\tExplicit"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">85</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">86</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">87</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">88</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">89</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> add("")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">90</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> add("[ComponentNames]")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">91</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (name in names(map)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">92</td> + <td class="coverage">494<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> add(paste0(map[name], ":", name))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">93</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">94</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">95</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/summary_listing.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Display the output of a summary function according to the output format</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' This function is intended for use in a R markdown code chunk with the chunk</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' option `results = "asis"`.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param object The object for which the summary is to be listed</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param caption An optional caption</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param label An optional label, ignored in html output</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param clearpage Should a new page be started after the listing? Ignored in html output</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">summary_listing <- function(object, caption = NULL, label = NULL,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> clearpage = TRUE) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">13</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (knitr::is_latex_output()) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">14</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> tex_listing(object = object, caption = caption, label = label,</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">15</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> clearpage = clearpage)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">17</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (knitr::is_html_output()) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">18</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> html_listing(object = object, caption = caption)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname summary_listing</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">tex_listing <- function(object, caption = NULL, label = NULL,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> clearpage = TRUE) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">26</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">27</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\\begin{listing}", "\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">28</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.null(caption)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">29</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\\caption{", caption, "}", "\n", sep = "")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">31</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.null(label)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">32</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\\caption{", label, "}", "\n", sep = "")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">34</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\\begin{snugshade}", "\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">35</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\\scriptsize", "\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">36</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\\begin{verbatim}", "\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">37</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat(capture.output(suppressWarnings(summary(object))), sep = "\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">38</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">39</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\\end{verbatim}", "\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">40</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\\end{snugshade}", "\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">41</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\\end{listing}", "\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">42</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (clearpage) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">43</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\\clearpage", "\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">47</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname summary_listing</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">html_listing <- function(object, caption = NULL) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">50</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">51</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.null(caption)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">52</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("<caption>", caption, "</caption>", "\n", sep = "")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">54</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("<pre><code>\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">55</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat(capture.output(suppressWarnings(summary(object))), sep = "\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">56</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">57</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("</pre></code>\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/multistart.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Perform a hierarchical model fit with multiple starting values</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' The purpose of this method is to check if a certain algorithm for fitting</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' nonlinear hierarchical models (also known as nonlinear mixed-effects models)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' will reliably yield results that are sufficiently similar to each other, if</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' started with a certain range of reasonable starting parameters. It is</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' inspired by the article on practical identifiabiliy in the frame of nonlinear</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' mixed-effects models by Duchesne et al (2021).</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param object The fit object to work with</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param n How many different combinations of starting parameters should be</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' used?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param cores How many fits should be run in parallel (only on posix platforms)?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param cluster A cluster as returned by [parallel::makeCluster] to be used</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' for parallel execution.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots Passed to the update function.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param x The multistart object to print</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return A list of [saem.mmkin] objects, with class attributes</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' 'multistart.saem.mmkin' and 'multistart'.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @seealso [parplot], [llhist]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @references Duchesne R, Guillemin A, Gandrillon O, Crauste F. Practical</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' identifiability in the frame of nonlinear mixed effects models: the example</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' of the in vitro erythropoiesis. BMC Bioinformatics. 2021 Oct 4;22(1):478.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' doi: 10.1186/s12859-021-04373-4.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' library(mkin)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' dmta_ds <- lapply(1:7, function(i) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ds_i <- dimethenamid_2018$ds[[i]]$data</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ds_i[ds_i$name == "DMTAP", "name"] <- "DMTA"</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ds_i$time <- ds_i$time * dimethenamid_2018$f_time_norm[i]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ds_i</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' })</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' names(dmta_ds) <- sapply(dimethenamid_2018$ds, function(ds) ds$title)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' dmta_ds[["Elliot"]] <- rbind(dmta_ds[["Elliot 1"]], dmta_ds[["Elliot 2"]])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' dmta_ds[["Elliot 1"]] <- dmta_ds[["Elliot 2"]] <- NULL</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_mmkin <- mmkin("DFOP", dmta_ds, error_model = "tc", cores = 7, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_saem_full <- saem(f_mmkin)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_saem_full_multi <- multistart(f_saem_full, n = 16, cores = 16)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parplot(f_saem_full_multi, lpos = "topleft")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' illparms(f_saem_full)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_saem_reduced <- update(f_saem_full, no_random_effect = "log_k2")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">47</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' illparms(f_saem_reduced)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # On Windows, we need to create a PSOCK cluster first and refer to it</pre> + </td> + </tr> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # in the call to multistart()</pre> + </td> + </tr> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' library(parallel)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' cl <- makePSOCKcluster(12)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_saem_reduced_multi <- multistart(f_saem_reduced, n = 16, cluster = cl)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parplot(f_saem_reduced_multi, lpos = "topright", ylim = c(0.5, 2))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">54</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' stopCluster(cl)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">55</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">multistart <- function(object, n = 50,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">57</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> cores = if (Sys.info()["sysname"] == "Windows") 1 else parallel::detectCores(),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> cluster = NULL, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">60</td> + <td class="coverage">200<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> UseMethod("multistart", object)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">61</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">62</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">63</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname multistart</pre> + </td> + </tr> + <tr class="never"> + <td class="num">64</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">65</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">multistart.saem.mmkin <- function(object, n = 50, cores = 1,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">66</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> cluster = NULL, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">67</td> + <td class="coverage">200<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> call <- match.call()</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">68</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (n <= 1) stop("Please specify an n of at least 2")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">69</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">70</td> + <td class="coverage">200<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mmkin_object <- object$mmkin</pre> + </td> + </tr> + <tr class="never"> + <td class="num">71</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">72</td> + <td class="coverage">200<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mmkin_parms <- parms(mmkin_object, errparms = FALSE,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">73</td> + <td class="coverage">200<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> transformed = object$transformations == "mkin")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">74</td> + <td class="coverage">200<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> start_parms <- apply(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">75</td> + <td class="coverage">200<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mmkin_parms, 1,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">76</td> + <td class="coverage">200<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> function(x) stats::runif(n, min(x), max(x)))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">77</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">78</td> + <td class="coverage">200<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> saem_call <- object$call</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">79</td> + <td class="coverage">200<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> saem_call[[1]] <- saem</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">80</td> + <td class="coverage">200<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> saem_call[[2]] <- mmkin_object</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">81</td> + <td class="coverage">200<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> i_startparms <- which(names(saem_call) == "degparms_start")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">82</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">83</td> + <td class="coverage">200<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fit_function <- function(x) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">84</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">85</td> + <td class="coverage">16<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> new_startparms <- str2lang(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">86</td> + <td class="coverage">16<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> paste0(capture.output(dput(start_parms[x, ])),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">87</td> + <td class="coverage">16<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> collapse = ""))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">88</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">89</td> + <td class="coverage">16<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(i_startparms) == 0) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">90</td> + <td class="coverage">16<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> saem_call <- c(as.list(saem_call), degparms_start = new_startparms)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">91</td> + <td class="coverage">16<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> saem_call <- as.call(saem_call)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">92</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">93</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> saem_call[i_startparms] <- new_startparms</pre> + </td> + </tr> + <tr class="never"> + <td class="num">94</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">95</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">96</td> + <td class="coverage">16<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ret <- eval(saem_call)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">97</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">98</td> + <td class="coverage">16<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(ret)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">99</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">100</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">101</td> + <td class="coverage">200<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.null(cluster)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">102</td> + <td class="coverage">200<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res <- parallel::mclapply(1:n, fit_function,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">103</td> + <td class="coverage">200<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mc.cores = cores, mc.preschedule = FALSE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">104</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">105</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> res <- parallel::parLapplyLB(cluster, 1:n, fit_function)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">106</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">107</td> + <td class="coverage">184<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> attr(res, "orig") <- object</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">108</td> + <td class="coverage">184<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> attr(res, "start_parms") <- start_parms</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">109</td> + <td class="coverage">184<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> attr(res, "call") <- call</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">110</td> + <td class="coverage">184<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(res) <- c("multistart.saem.mmkin", "multistart")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">111</td> + <td class="coverage">184<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(res)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">112</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">113</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">114</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">115</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">status.multistart <- function(object, ...) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">116</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> all_summary_warnings <- character()</pre> + </td> + </tr> + <tr class="never"> + <td class="num">117</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="missed"> + <td class="num">118</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> result <- lapply(object,</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">119</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> function(fit) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">120</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (inherits(fit, "try-error")) return("E")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">121</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">122</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> return("OK")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">123</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">124</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> })</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">125</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> result <- unlist(result)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">126</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="missed"> + <td class="num">127</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> class(result) <- "status.multistart"</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">128</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> return(result)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">129</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">130</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">131</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">132</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">status.multistart.saem.mmkin <- function(object, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">133</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> all_summary_warnings <- character()</pre> + </td> + </tr> + <tr class="never"> + <td class="num">134</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">135</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> result <- lapply(object,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">136</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> function(fit) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">137</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (inherits(fit$so, "try-error")) return("E")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">138</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">139</td> + <td class="coverage">704<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return("OK")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">140</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">141</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> })</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">142</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> result <- unlist(result)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">143</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">144</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(result) <- "status.multistart"</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">145</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(result)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">146</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">147</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">148</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">149</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">print.status.multistart <- function(x, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">150</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(x) <- NULL</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">151</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(table(x, dnn = NULL))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">152</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (any(x == "OK")) cat("OK: Fit terminated successfully\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">153</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (any(x == "E")) cat("E: Error\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">154</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">155</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">156</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname multistart</pre> + </td> + </tr> + <tr class="never"> + <td class="num">157</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">158</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">print.multistart <- function(x, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">159</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("<multistart> object with", length(x), "fits:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">160</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(status(x))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">161</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">162</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">163</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname multistart</pre> + </td> + </tr> + <tr class="never"> + <td class="num">164</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">165</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">best <- function(object, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">166</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">167</td> + <td class="coverage">184<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> UseMethod("best", object)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">168</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">169</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">170</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">171</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return The object with the highest likelihood</pre> + </td> + </tr> + <tr class="never"> + <td class="num">172</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname multistart</pre> + </td> + </tr> + <tr class="never"> + <td class="num">173</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">best.default <- function(object, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">174</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">175</td> + <td class="coverage">184<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(object[[which.best(object)]])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">176</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">177</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">178</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return The index of the object with the highest likelihood</pre> + </td> + </tr> + <tr class="never"> + <td class="num">179</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname multistart</pre> + </td> + </tr> + <tr class="never"> + <td class="num">180</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">181</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">which.best <- function(object, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">182</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">183</td> + <td class="coverage">360<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> UseMethod("which.best", object)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">184</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">185</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">186</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname multistart</pre> + </td> + </tr> + <tr class="never"> + <td class="num">187</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">188</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">which.best.default <- function(object, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">189</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">190</td> + <td class="coverage">360<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> llfunc <- function(object) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">191</td> + <td class="coverage">2528<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ret <- try(logLik(object))</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">192</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (inherits(ret, "try-error")) return(NA)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">193</td> + <td class="coverage">2528<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> else return(ret)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">194</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">195</td> + <td class="coverage">360<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ll <- sapply(object, llfunc)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">196</td> + <td class="coverage">360<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(which.max(ll))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">197</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">198</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">199</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">200</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">update.multistart <- function(object, ..., evaluate = TRUE) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">201</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> call <- attr(object, "call")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">202</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # For some reason we get multistart.saem.mmkin in call[[1]] when using multistart</pre> + </td> + </tr> + <tr class="never"> + <td class="num">203</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # from the loaded package so we need to fix this so we do not have to export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">204</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # multistart.saem.mmkin</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">205</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> call[[1]] <- multistart</pre> + </td> + </tr> + <tr class="never"> + <td class="num">206</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="missed"> + <td class="num">207</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> update_arguments <- match.call(expand.dots = FALSE)$...</pre> + </td> + </tr> + <tr class="never"> + <td class="num">208</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="missed"> + <td class="num">209</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(update_arguments) > 0) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">210</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> update_arguments_in_call <- !is.na(match(names(update_arguments), names(call)))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">211</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">212</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="missed"> + <td class="num">213</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> for (a in names(update_arguments)[update_arguments_in_call]) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">214</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> call[[a]] <- update_arguments[[a]]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">215</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">216</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="missed"> + <td class="num">217</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> update_arguments_not_in_call <- !update_arguments_in_call</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">218</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if(any(update_arguments_not_in_call)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">219</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> call <- c(as.list(call), update_arguments[update_arguments_not_in_call])</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">220</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> call <- as.call(call)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">221</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">222</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if(evaluate) eval(call, parent.frame())</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">223</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> else call</pre> + </td> + </tr> + <tr class="never"> + <td class="num">224</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/lrtest.mkinfit.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom lmtest lrtest</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">lmtest::lrtest</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Likelihood ratio test for mkinfit models</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Compare two mkinfit models based on their likelihood. If two fitted</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' mkinfit objects are given as arguments, it is checked if they have been</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fitted to the same data. It is the responsibility of the user to make sure</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' that the models are nested, i.e. one of them has less degrees of freedom</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' and can be expressed by fixing the parameters of the other.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Alternatively, an argument to mkinfit can be given which is then passed</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' to \code{\link{update.mkinfit}} to obtain the alternative model.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' The comparison is then made by the \code{\link[lmtest]{lrtest.default}}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' method from the lmtest package. The model with the higher number of fitted</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parameters (alternative hypothesis) is listed first, then the model with the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' lower number of fitted parameters (null hypothesis).</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom stats logLik update</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param object An \code{\link{mkinfit}} object, or an \code{\link{mmkin}} column</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' object containing two fits to the same data.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param object_2 Optionally, another mkinfit object fitted to the same data.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots Argument to \code{\link{mkinfit}}, passed to</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \code{\link{update.mkinfit}} for creating the alternative fitted object.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' test_data <- subset(synthetic_data_for_UBA_2014[[12]]$data, name == "parent")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' sfo_fit <- mkinfit("SFO", test_data, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' dfop_fit <- mkinfit("DFOP", test_data, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' lrtest(dfop_fit, sfo_fit)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' lrtest(sfo_fit, dfop_fit)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # The following two examples are commented out as they fail during</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # generation of the static help pages by pkgdown</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' #lrtest(dfop_fit, error_model = "tc")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' #lrtest(dfop_fit, fixed_parms = c(k2 = 0))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # However, this equivalent syntax also works for static help pages</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' lrtest(dfop_fit, update(dfop_fit, error_model = "tc"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' lrtest(dfop_fit, update(dfop_fit, fixed_parms = c(k2 = 0)))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">lrtest.mkinfit <- function(object, object_2 = NULL, ...) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">47</td> + <td class="coverage">6<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> name_function <- function(x) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">48</td> + <td class="coverage">10<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object_name <- paste(x$mkinmod$name, "with error model", x$err_mod)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">49</td> + <td class="coverage">10<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(x$bparms.fixed) > 0) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">50</td> + <td class="coverage">7<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object_name <- paste(object_name,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">51</td> + <td class="coverage">7<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "and fixed parameter(s)",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">52</td> + <td class="coverage">7<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> paste(names(x$bparms.fixed), collapse = ", "))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">54</td> + <td class="coverage">10<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(object_name)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">55</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">57</td> + <td class="coverage">6<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.null(object_2)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">58</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> object_2 <- update(object, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">60</td> + <td class="coverage">6<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> data_object <- object$data[c("time", "variable", "observed")]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">61</td> + <td class="coverage">6<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> data_object_2 <- object_2$data[c("time", "variable", "observed")]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">62</td> + <td class="coverage">6<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!identical(data_object, data_object_2)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">63</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> stop("It seems that the mkinfit objects have not been fitted to the same data")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">64</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">65</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">66</td> + <td class="coverage">5<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (attr(logLik(object), "df") > attr(logLik(object_2), "df")) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">67</td> + <td class="coverage">2<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lmtest::lrtest.default(object, object_2, name = name_function)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">68</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">69</td> + <td class="coverage">3<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lmtest::lrtest.default(object_2, object, name = name_function)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">70</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">71</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">72</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">73</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname lrtest.mkinfit</pre> + </td> + </tr> + <tr class="never"> + <td class="num">74</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">75</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">lrtest.mmkin <- function(object, ...) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">76</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (nrow(object) != 2 | ncol(object) > 1) stop("Only works for a column containing two mkinfit objects")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">77</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> object[[1, 1]]$mkinmod$name <- rownames(object)[1]</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">78</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> object[[2, 1]]$mkinmod$name <- rownames(object)[2]</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">79</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> lrtest(object[[1, 1]], object[[2, 1]])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">80</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/aw.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Calculate Akaike weights for model averaging</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Akaike weights are calculated based on the relative</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' expected Kullback-Leibler information as specified</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' by Burnham and Anderson (2004).</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param object An [mmkin] column object, containing two or more</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' [mkinfit] models that have been fitted to the same data,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' or an mkinfit object. In the latter case, further mkinfit</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' objects fitted to the same data should be specified</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' as dots arguments.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots Not used in the method for [mmkin] column objects,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' further [mkinfit] objects in the method for mkinfit objects.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @references Burnham KP and Anderson DR (2004) Multimodel</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Inference: Understanding AIC and BIC in Model Selection.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' *Sociological Methods & Research* **33**(2) 261-304</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @md</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_sfo <- mkinfit("SFO", FOCUS_2006_D, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_dfop <- mkinfit("DFOP", FOCUS_2006_D, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' aw_sfo_dfop <- aw(f_sfo, f_dfop)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' sum(aw_sfo_dfop)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' aw_sfo_dfop # SFO gets more weight as it has less parameters and a similar fit</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f <- mmkin(c("SFO", "FOMC", "DFOP"), list("FOCUS D" = FOCUS_2006_D), cores = 1, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' aw(f)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' sum(aw(f))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' aw(f[c("SFO", "DFOP")])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">31</td> + <td class="coverage">1482<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r">aw <- function(object, ...) UseMethod("aw")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">.aw <- function(all_objects) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">34</td> + <td class="coverage">494<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> AIC_all <- sapply(all_objects, AIC)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">35</td> + <td class="coverage">494<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> delta_i <- AIC_all - min(AIC_all)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">36</td> + <td class="coverage">494<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> denom <- sum(exp(-delta_i/2))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">37</td> + <td class="coverage">494<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> w_i <- exp(-delta_i/2) / denom</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">38</td> + <td class="coverage">494<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(w_i)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname aw</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">aw.mkinfit <- function(object, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">44</td> + <td class="coverage">988<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> oo <- list(...)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">45</td> + <td class="coverage">988<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> data_object <- object$data[c("time", "variable", "observed")]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">46</td> + <td class="coverage">988<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (i in seq_along(oo)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">47</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!inherits(oo[[i]], "mkinfit")) stop("Please supply only mkinfit objects")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">48</td> + <td class="coverage">988<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> data_other_object <- oo[[i]]$data[c("time", "variable", "observed")]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">49</td> + <td class="coverage">988<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!identical(data_object, data_other_object)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">50</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> stop("It seems that the mkinfit objects have not all been fitted to the same data")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">53</td> + <td class="coverage">494<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> all_objects <- list(object, ...)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">54</td> + <td class="coverage">494<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> .aw(all_objects)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">55</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">57</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname aw</pre> + </td> + </tr> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">aw.mmkin <- function(object, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">60</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (ncol(object) > 1) stop("Please supply an mmkin column object")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">61</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> do.call(aw, object)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">62</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">63</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">64</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">65</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname aw</pre> + </td> + </tr> + <tr class="never"> + <td class="num">66</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">aw.mixed.mmkin <- function(object, ...) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">67</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> oo <- list(...)</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">68</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> data_object <- object$data[c("ds", "name", "time", "value")]</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">69</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> for (i in seq_along(oo)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">70</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (!inherits(oo[[i]], "mixed.mmkin")) stop("Please supply objects inheriting from mixed.mmkin")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">71</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> data_other_object <- oo[[i]]$data[c("ds", "name", "time", "value")]</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">72</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (!identical(data_object, data_other_object)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">73</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> stop("It seems that the mixed.mmkin objects have not all been fitted to the same data")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">74</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">75</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">76</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> all_objects <- list(object, ...)</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">77</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> .aw(all_objects)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">78</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">79</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">80</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">81</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname aw</pre> + </td> + </tr> + <tr class="never"> + <td class="num">82</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">aw.multistart <- function(object, ...) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">83</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> do.call(aw, object)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">84</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/mean_degparms.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Calculate mean degradation parameters for an mmkin row object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return If random is FALSE (default), a named vector containing mean values</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' of the fitted degradation model parameters. If random is TRUE, a list with</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fixed and random effects, in the format required by the start argument of</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' nlme for the case of a single grouping variable ds.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param object An mmkin row object containing several fits of the same model to different datasets</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param random Should a list with fixed and random effects be returned?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param test_log_parms If TRUE, log parameters are only considered in</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the mean calculations if their untransformed counterparts (most likely</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' rate constants) pass the t-test for significant difference from zero.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param conf.level Possibility to adjust the required confidence level</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' for parameter that are tested if requested by 'test_log_parms'.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param default_log_parms If set to a numeric value, this is used</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' as a default value for the tested log parameters that failed the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' t-test.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">mean_degparms <- function(object, random = FALSE, test_log_parms = FALSE, conf.level = 0.6,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> default_log_parms = NA)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">21</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (nrow(object) > 1) stop("Only row objects allowed")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">22</td> + <td class="coverage">7271<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parm_mat_trans <- sapply(object, parms, transformed = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">24</td> + <td class="coverage">7271<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (test_log_parms) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">25</td> + <td class="coverage">4668<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parm_mat_dim <- dim(parm_mat_trans)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">26</td> + <td class="coverage">4668<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parm_mat_dimnames <- dimnames(parm_mat_trans)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">28</td> + <td class="coverage">4668<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> log_parm_trans_names <- grep("^log_", rownames(parm_mat_trans), value = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">29</td> + <td class="coverage">4668<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> log_parm_names <- gsub("^log_", "", log_parm_trans_names)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">31</td> + <td class="coverage">4668<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> t_test_back_OK <- matrix(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">32</td> + <td class="coverage">4668<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> sapply(object, function(o) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">33</td> + <td class="coverage">49860<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> suppressWarnings(summary(o)$bpar[log_parm_names, "Pr(>t)"] < (1 - conf.level))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">34</td> + <td class="coverage">4668<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> }), nrow = length(log_parm_names))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">35</td> + <td class="coverage">4668<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rownames(t_test_back_OK) <- log_parm_trans_names</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">37</td> + <td class="coverage">4668<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parm_mat_trans_OK <- parm_mat_trans</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">38</td> + <td class="coverage">4668<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (trans_parm in log_parm_trans_names) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">39</td> + <td class="coverage">9398<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parm_mat_trans_OK[trans_parm, ] <- ifelse(t_test_back_OK[trans_parm, ],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">40</td> + <td class="coverage">9398<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parm_mat_trans[trans_parm, ], log(default_log_parms))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">43</td> + <td class="coverage">2603<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parm_mat_trans_OK <- parm_mat_trans</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">46</td> + <td class="coverage">7271<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mean_degparm_names <- setdiff(rownames(parm_mat_trans), names(object[[1]]$errparms))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">47</td> + <td class="coverage">7271<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparm_mat_trans <- parm_mat_trans[mean_degparm_names, , drop = FALSE]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">48</td> + <td class="coverage">7271<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> degparm_mat_trans_OK <- parm_mat_trans_OK[mean_degparm_names, , drop = FALSE]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # fixed in the sense of fixed effects, as this function was</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # written to supply starting parameters for nlme</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">52</td> + <td class="coverage">7271<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fixed <- apply(degparm_mat_trans_OK, 1, mean, na.rm = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">53</td> + <td class="coverage">7271<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (random) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">54</td> + <td class="coverage">2322<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> random <- t(apply(degparm_mat_trans[mean_degparm_names, , drop = FALSE], 2, function(column) column - fixed))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">55</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # If we only have one parameter, apply returns a vector so we get a single row</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">56</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (nrow(degparm_mat_trans) == 1) random <- t(random)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">57</td> + <td class="coverage">2322<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rownames(random) <- levels(nlme_data(object)$ds)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # For nlmixr we can specify starting values for standard deviations eta, and</pre> + </td> + </tr> + <tr class="never"> + <td class="num">60</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # we ignore uncertain parameters if test_log_parms is FALSE</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">61</td> + <td class="coverage">2322<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> eta <- apply(degparm_mat_trans_OK, 1, stats::sd, na.rm = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">62</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">63</td> + <td class="coverage">2322<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(list(fixed = fixed, random = list(ds = random), eta = eta))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">64</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">65</td> + <td class="coverage">4949<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(fixed)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">66</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">67</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">68</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/ilr.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"># This file is part of the R package mkin</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"># mkin is free software: you can redistribute it and/or modify it under the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"># terms of the GNU General Public License as published by the Free Software</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"># Foundation, either version 3 of the License, or (at your option) any later</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"># version.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"># This program is distributed in the hope that it will be useful, but WITHOUT</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"># ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"># FOR A PARTICULAR PURPOSE. See the GNU General Public License for more</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"># details.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"># You should have received a copy of the GNU General Public License along with</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"># this program. If not, see <http://www.gnu.org/licenses/></pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Function to perform isometric log-ratio transformation</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' This implementation is a special case of the class of isometric log-ratio</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' transformations.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @aliases ilr invilr</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param x A numeric vector. Naturally, the forward transformation is only</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' sensible for vectors with all elements being greater than zero.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return The result of the forward or backward transformation. The returned</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' components always sum to 1 for the case of the inverse log-ratio</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' transformation.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @author René Lehmann and Johannes Ranke</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @seealso Another implementation can be found in R package</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \code{robCompositions}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @references Peter Filzmoser, Karel Hron (2008) Outlier Detection for</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Compositional Data Using Robust Methods. Math Geosci 40 233-248</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @keywords manip</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Order matters</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ilr(c(0.1, 1, 10))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ilr(c(10, 1, 0.1))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Equal entries give ilr transformations with zeros as elements</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ilr(c(3, 3, 3))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Almost equal entries give small numbers</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ilr(c(0.3, 0.4, 0.3))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Only the ratio between the numbers counts, not their sum</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' invilr(ilr(c(0.7, 0.29, 0.01)))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' invilr(ilr(2.1 * c(0.7, 0.29, 0.01)))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Inverse transformation of larger numbers gives unequal elements</pre> + </td> + </tr> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' invilr(-10)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">47</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' invilr(c(-10, 0))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # The sum of the elements of the inverse ilr is 1</pre> + </td> + </tr> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' sum(invilr(c(-10, 0)))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # This is why we do not need all elements of the inverse transformation to go back:</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' a <- c(0.1, 0.3, 0.5)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' b <- invilr(a)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' length(b) # Four elements</pre> + </td> + </tr> + <tr class="never"> + <td class="num">54</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ilr(c(b[1:3], 1 - sum(b[1:3]))) # Gives c(0.1, 0.3, 0.5)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">55</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">57</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">ilr <- function(x) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">58</td> + <td class="coverage">16<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> z <- vector()</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">59</td> + <td class="coverage">16<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (i in 1:(length(x) - 1)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">60</td> + <td class="coverage">44<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> z[i] <- sqrt(i/(i+1)) * log((prod(x[1:i]))^(1/i) / x[i+1])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">61</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">62</td> + <td class="coverage">16<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(z)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">63</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">64</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">65</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname ilr</pre> + </td> + </tr> + <tr class="never"> + <td class="num">66</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">67</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">invilr<-function(x) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">68</td> + <td class="coverage">529301<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> D <- length(x) + 1</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">69</td> + <td class="coverage">529301<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> z <- c(x, 0)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">70</td> + <td class="coverage">529301<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> y <- rep(0, D)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">71</td> + <td class="coverage">529301<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> s <- sqrt(1:D*2:(D+1))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">72</td> + <td class="coverage">529301<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> q <- z/s</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">73</td> + <td class="coverage">529301<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> y[1] <- sum(q[1:D])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">74</td> + <td class="coverage">529301<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (i in 2:D) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">75</td> + <td class="coverage">1585969<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> y[i] <- sum(q[i:D]) - sqrt((i-1)/i) * z[i-1]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">76</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">77</td> + <td class="coverage">529301<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> z <- vector()</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">78</td> + <td class="coverage">529301<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (i in 1:D) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">79</td> + <td class="coverage">2115270<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> z[i] <- exp(y[i])/sum(exp(y))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">80</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">81</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">82</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Work around a numerical problem with NaN values returned by the above</pre> + </td> + </tr> + <tr class="never"> + <td class="num">83</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Only works if there is only one NaN value: replace it with 1</pre> + </td> + </tr> + <tr class="never"> + <td class="num">84</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # if the sum of the other components is < 1e-10</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">85</td> + <td class="coverage">529301<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (sum(is.na(z)) == 1 && sum(z[!is.na(z)]) < 1e-10)</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">86</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> z = ifelse(is.na(z), 1, z)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">87</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">88</td> + <td class="coverage">529301<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(z)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">89</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/max_twa_parent.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Function to calculate maximum time weighted average concentrations from</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' kinetic models fitted with mkinfit</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' This function calculates maximum moving window time weighted average</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' concentrations (TWAs) for kinetic models fitted with \code{\link{mkinfit}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Currently, only calculations for the parent are implemented for the SFO,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' FOMC, DFOP and HS models, using the analytical formulas given in the PEC</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' soil section of the FOCUS guidance.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @aliases max_twa_parent max_twa_sfo max_twa_fomc max_twa_dfop max_twa_hs</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param fit An object of class \code{\link{mkinfit}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param windows The width of the time windows for which the TWAs should be</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' calculated.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param M0 The initial concentration for which the maximum time weighted</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' average over the decline curve should be calculated. The default is to use</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' a value of 1, which means that a relative maximum time weighted average</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' factor (f_twa) is calculated.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param k The rate constant in the case of SFO kinetics.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param t The width of the time window.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param alpha Parameter of the FOMC model.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param beta Parameter of the FOMC model.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param k1 The first rate constant of the DFOP or the HS kinetics.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param k2 The second rate constant of the DFOP or the HS kinetics.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param g Parameter of the DFOP model.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param tb Parameter of the HS model.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return For \code{max_twa_parent}, a numeric vector, named using the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \code{windows} argument. For the other functions, a numeric vector of</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' length one (also known as 'a number').</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @author Johannes Ranke</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @references FOCUS (2006) \dQuote{Guidance Document on Estimating Persistence</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' and Degradation Kinetics from Environmental Fate Studies on Pesticides in</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' EU Registration} Report of the FOCUS Work Group on Degradation Kinetics,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' EC Document Reference Sanco/10058/2005 version 2.0, 434 pp,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \url{http://esdac.jrc.ec.europa.eu/projects/degradation-kinetics}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit <- mkinfit("FOMC", FOCUS_2006_C, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' max_twa_parent(fit, c(7, 21))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">max_twa_parent <- function(fit, windows) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">42</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms.all <- c(fit$bparms.optim, fit$bparms.fixed)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">43</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> obs_vars <- fit$obs_vars</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">44</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(obs_vars) > 1) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">45</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> warning("Calculation of maximum time weighted average concentrations is",</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">46</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> "currently only implemented for the parent compound using",</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">47</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> "analytical solutions")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">49</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> obs_var <- obs_vars[1]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">50</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> spec = fit$mkinmod$spec</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">51</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> type = spec[[1]]$type</pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">53</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> M0 <- parms.all[paste0(obs_var, "_0")]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">54</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">55</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (type == "SFO") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">56</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k_name <- paste0("k_", obs_var)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">57</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (fit$mkinmod$use_of_ff == "min") {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">58</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> k_name <- paste0(k_name, "_sink")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">60</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k <- parms.all[k_name]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">61</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> twafunc <- function(t) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">62</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> max_twa_sfo(M0, k, t)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">63</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">64</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">65</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (type == "FOMC") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">66</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> alpha <- parms.all["alpha"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">67</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> beta <- parms.all["beta"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">68</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> twafunc <- function(t) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">69</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> max_twa_fomc(M0, alpha, beta, t)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">70</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">71</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">72</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (type == "DFOP") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">73</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k1 <- parms.all["k1"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">74</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k2 <- parms.all["k2"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">75</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> g <- parms.all["g"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">76</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> twafunc <- function(t) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">77</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> max_twa_dfop(M0, k1, k2, g, t)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">78</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">79</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">80</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (type == "HS") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">81</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k1 <- parms.all["k1"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">82</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> k2 <- parms.all["k2"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">83</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> tb <- parms.all["tb"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">84</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> twafunc <- function(t) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">85</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ifelse(t <= tb,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">86</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> max_twa_sfo(M0, k1, t),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">87</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> max_twa_hs(M0, k1, k2, tb, t)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">88</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> )</pre> + </td> + </tr> + <tr class="never"> + <td class="num">89</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">90</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">91</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (type %in% c("IORE", "SFORB")) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">92</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> stop("Calculation of maximum time weighted average concentrations is currently ",</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">93</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> "not implemented for the ", type, " model.")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">94</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">95</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res <- twafunc(windows)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">96</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(res) <- windows</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">97</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(res)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">98</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">99</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">100</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname max_twa_parent</pre> + </td> + </tr> + <tr class="never"> + <td class="num">101</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">102</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">max_twa_sfo <- function(M0 = 1, k, t) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">103</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> M0 * (1 - exp(- k * t)) / (k * t)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">104</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">105</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">106</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname max_twa_parent</pre> + </td> + </tr> + <tr class="never"> + <td class="num">107</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">108</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">max_twa_fomc <- function(M0 = 1, alpha, beta, t) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">109</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> M0 * (beta)/(t * (1 - alpha)) * ((t/beta + 1)^(1 - alpha) - 1)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">110</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">111</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">112</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname max_twa_parent</pre> + </td> + </tr> + <tr class="never"> + <td class="num">113</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">114</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">max_twa_dfop <- function(M0 = 1, k1, k2, g, t) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">115</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> M0/t * ((g/k1) * (1 - exp(- k1 * t)) + ((1 - g)/k2) * (1 - exp(- k2 * t)))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">116</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">117</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">118</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname max_twa_parent</pre> + </td> + </tr> + <tr class="never"> + <td class="num">119</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">120</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">max_twa_hs <- function(M0 = 1, k1, k2, tb, t) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">121</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> (M0 / t) * (</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">122</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> (1/k1) * (1 - exp(- k1 * tb)) +</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">123</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> (exp(- k1 * tb) / k2) * (1 - exp(- k2 * (t - tb)))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">124</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> )</pre> + </td> + </tr> + <tr class="never"> + <td class="num">125</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/f_time_norm_focus.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">utils::globalVariables("D24_2014")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Normalisation factors for aerobic soil degradation according to FOCUS guidance</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Time step normalisation factors for aerobic soil degradation as described</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' in Appendix 8 to the FOCUS kinetics guidance (FOCUS 2014, p. 369).</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param object An object containing information used for the calculations</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param temperature Numeric vector of temperatures in °C</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param moisture Numeric vector of moisture contents in \\% w/w</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param field_moisture Numeric vector of moisture contents at field capacity</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' (pF2) in \\% w/w</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param study_moisture_ref_source Source for the reference value</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' used to calculate the study moisture. If 'auto', preference is given</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' to a reference moisture given in the meta information, otherwise</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the focus soil moisture for the soil class is used</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param Q10 The Q10 value used for temperature normalisation</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param walker The Walker exponent used for moisture normalisation</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param f_na The factor to use for NA values. If set to NA, only factors</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' for complete cases will be returned.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots Currently not used</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @references</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' FOCUS (2006) \dQuote{Guidance Document on Estimating Persistence</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' and Degradation Kinetics from Environmental Fate Studies on Pesticides in</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' EU Registration} Report of the FOCUS Work Group on Degradation Kinetics,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' EC Document Reference Sanco/10058/2005 version 2.0, 434 pp,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \url{http://esdac.jrc.ec.europa.eu/projects/degradation-kinetics}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' FOCUS (2014) \dQuote{Generic guidance for Estimating Persistence</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' and Degradation Kinetics from Environmental Fate Studies on Pesticides in</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' EU Registration} Report of the FOCUS Work Group on Degradation Kinetics,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Version 1.1, 18 December 2014</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \url{http://esdac.jrc.ec.europa.eu/projects/degradation-kinetics}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @seealso [focus_soil_moisture]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_time_norm_focus(25, 20, 25) # 1.37, compare FOCUS 2014 p. 184</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' D24_2014$meta</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # No moisture normalisation in the first dataset, so we use f_na = 1 to get</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # temperature only normalisation as in the EU evaluation</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_time_norm_focus(D24_2014, study_moisture_ref_source = "focus", f_na = 1)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">f_time_norm_focus <- function(object, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">43</td> + <td class="coverage">765<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> UseMethod("f_time_norm_focus")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname f_time_norm_focus</pre> + </td> + </tr> + <tr class="never"> + <td class="num">47</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">f_time_norm_focus.numeric <- function(object,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> moisture = NA, field_moisture = NA,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> temperature = object,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> Q10 = 2.58, walker = 0.7, f_na = NA, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">53</td> + <td class="coverage">459<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f_temp <- ifelse(is.na(temperature),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">54</td> + <td class="coverage">459<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f_na,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">55</td> + <td class="coverage">459<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ifelse(temperature <= 0,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">56</td> + <td class="coverage">459<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> 0,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">57</td> + <td class="coverage">459<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> Q10^((temperature - 20)/10)))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">58</td> + <td class="coverage">459<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f_moist <- ifelse(is.na(moisture),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">59</td> + <td class="coverage">459<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f_na,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">60</td> + <td class="coverage">459<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ifelse(moisture >= field_moisture,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">61</td> + <td class="coverage">459<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> 1,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">62</td> + <td class="coverage">459<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> (moisture / field_moisture)^walker))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">63</td> + <td class="coverage">459<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f_time_norm <- f_temp * f_moist</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">64</td> + <td class="coverage">459<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f_time_norm</pre> + </td> + </tr> + <tr class="never"> + <td class="num">65</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">66</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">67</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname f_time_norm_focus</pre> + </td> + </tr> + <tr class="never"> + <td class="num">68</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">69</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">f_time_norm_focus.mkindsg <- function(object,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">70</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> study_moisture_ref_source = c("auto", "meta", "focus"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">71</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> Q10 = 2.58, walker = 0.7, f_na = NA, ...) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">72</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">73</td> + <td class="coverage">306<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> study_moisture_ref_source <- match.arg(study_moisture_ref_source)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">74</td> + <td class="coverage">306<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> meta <- object$meta</pre> + </td> + </tr> + <tr class="never"> + <td class="num">75</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">76</td> + <td class="coverage">306<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.null(meta$field_moisture)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">77</td> + <td class="coverage">306<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> field_moisture <- focus_soil_moisture[meta$usda_soil_type, "pF2"]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">78</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">79</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> field_moisture <- ifelse(is.na(meta$field_moisture),</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">80</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> focus_soil_moisture[meta$usda_soil_type, "pF2"],</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">81</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> meta$field_moisture)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">82</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">83</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">84</td> + <td class="coverage">306<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> study_moisture_ref_focus <-</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">85</td> + <td class="coverage">306<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> focus_soil_moisture[as.matrix(meta[c("usda_soil_type", "study_moisture_ref_type")])]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">86</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">87</td> + <td class="coverage">306<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (study_moisture_ref_source == "auto") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">88</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> study_moisture_ref <- ifelse (is.na(meta$study_ref_moisture),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">89</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> study_moisture_ref_focus,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">90</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> meta$study_ref_moisture)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">91</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">92</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (study_moisture_ref_source == "meta") {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">93</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> study_moisture_ref <- meta$study_moisture_ref</pre> + </td> + </tr> + <tr class="never"> + <td class="num">94</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">95</td> + <td class="coverage">153<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> study_moisture_ref <- study_moisture_ref_focus</pre> + </td> + </tr> + <tr class="never"> + <td class="num">96</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">97</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">98</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">99</td> + <td class="coverage">306<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if ("study_moisture" %in% names(meta)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">100</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> study_moisture <- ifelse(is.na(meta$study_moisture),</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">101</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> meta$rel_moisture * study_moisture_ref,</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">102</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> meta$study_moisture)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">103</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">104</td> + <td class="coverage">306<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> study_moisture <- meta$rel_moisture * study_moisture_ref</pre> + </td> + </tr> + <tr class="never"> + <td class="num">105</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">106</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">107</td> + <td class="coverage">306<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$f_time_norm <- f_time_norm_focus(meta$temperature,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">108</td> + <td class="coverage">306<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> moisture = study_moisture, field_moisture = field_moisture,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">109</td> + <td class="coverage">306<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> Q10 = Q10, walker = walker, f_na = f_na)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">110</td> + <td class="coverage">306<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> message("$f_time_norm was (re)set to normalised values")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">111</td> + <td class="coverage">306<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> invisible(object$f_time_norm)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">112</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/mkinds.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' A dataset class for mkin</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @description</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' At the moment this dataset class is hardly used in mkin. For example,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' mkinfit does not take mkinds datasets as argument, but works with dataframes</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' such as the on contained in the data field of mkinds objects. Some datasets</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' provided by this package come as mkinds objects nevertheless.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom R6 R6Class</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' mds <- mkinds$new("FOCUS A", FOCUS_2006_A)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' print(mds)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">mkinds <- R6Class("mkinds",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> public = list(</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> #' @field title A full title for the dataset</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> title = NULL,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> #' @field sampling_times The sampling times</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> sampling_times = NULL,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> #' @field time_unit The time unit</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> time_unit = NULL,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> #' @field observed Names of the observed variables</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> observed = NULL,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> #' @field unit The unit of the observations</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> unit = NULL,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> #' @field replicates The maximum number of replicates per sampling time</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> replicates = NULL,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> #' @field data A data frame with at least the columns name, time</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> #' and value in order to be compatible with mkinfit</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> data = NULL,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> #' @description</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> #' Create a new mkinds object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> #' @param title The dataset title</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> #' @param data The data</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> #' @param time_unit The time unit</pre> + </td> + </tr> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> #' @param unit The unit of the observations</pre> + </td> + </tr> + <tr class="never"> + <td class="num">47</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> initialize = function(title = "", data, time_unit = NA, unit = NA) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">49</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> self$title <- title</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">50</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> self$sampling_times <- sort(unique(data$time))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">51</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> self$time_unit <- time_unit</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">52</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> self$observed <- unique(data$name)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">53</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> self$unit <- unit</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">54</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> self$replicates <- max(by(data, list(data$name, data$time), nrow))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">55</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.null(data$override)) data$override <- NA</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">56</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.null(data$err)) data$err <- 1</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">57</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> self$data <- data</pre> + </td> + </tr> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">60</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> )</pre> + </td> + </tr> + <tr class="never"> + <td class="num">61</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">62</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">63</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Print mkinds objects</pre> + </td> + </tr> + <tr class="never"> + <td class="num">64</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">65</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname mkinds</pre> + </td> + </tr> + <tr class="never"> + <td class="num">66</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param x An [mkinds] object.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">67</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param data Should the data be printed?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">68</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots Not used.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">69</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">70</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">print.mkinds <- function(x, data = FALSE, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">71</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("<mkinds> with $title: ", x$title, "\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">72</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("Observed compounds $observed: ", paste(x$observed, collapse = ", "), "\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">73</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("Sampling times $sampling_times:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">74</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat(paste(x$sampling_times, collapse = ", "), "\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">75</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("With a maximum of ", x$replicates, " replicates\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">76</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.na(x$time_unit)) cat("Time unit: ", x$time_unit, "\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">77</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.na(x$unit)) cat("Observation unit: ", x$unit, "\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">78</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (data) print(mkin_long_to_wide(x$data))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">79</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">80</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">81</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' A class for dataset groups for mkin</pre> + </td> + </tr> + <tr class="never"> + <td class="num">82</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">83</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @description</pre> + </td> + </tr> + <tr class="never"> + <td class="num">84</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' A container for working with datasets that share at least one compound,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">85</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' so that combined evaluations are desirable.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">86</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">87</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Time normalisation factors are initialised with a value of 1 for each</pre> + </td> + </tr> + <tr class="never"> + <td class="num">88</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' dataset if no data are supplied.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">89</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">90</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">91</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">92</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' mdsg <- mkindsg$new("Experimental X", experimental_data_for_UBA_2019[6:10])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">93</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' print(mdsg)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">94</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' print(mdsg, verbose = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">95</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' print(mdsg, verbose = TRUE, data = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">96</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">97</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">98</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">mkindsg <- R6Class("mkindsg",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">99</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> public = list(</pre> + </td> + </tr> + <tr class="never"> + <td class="num">100</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">101</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> #' @field title A title for the dataset group</pre> + </td> + </tr> + <tr class="never"> + <td class="num">102</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> title = NULL,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">103</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">104</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> #' @field ds A list of mkinds objects</pre> + </td> + </tr> + <tr class="never"> + <td class="num">105</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> ds = NULL,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">106</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">107</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> #' @field observed_n Occurrence counts of compounds in datasets</pre> + </td> + </tr> + <tr class="never"> + <td class="num">108</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> observed_n = NULL,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">109</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">110</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> #' @field f_time_norm Time normalisation factors</pre> + </td> + </tr> + <tr class="never"> + <td class="num">111</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> f_time_norm = NULL,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">112</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">113</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> #' @field meta A data frame with a row for each dataset,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">114</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> #' containing additional information in the form</pre> + </td> + </tr> + <tr class="never"> + <td class="num">115</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> #' of categorical data (factors) or numerical data</pre> + </td> + </tr> + <tr class="never"> + <td class="num">116</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> #' (e.g. temperature, moisture,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">117</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> #' or covariates like soil pH).</pre> + </td> + </tr> + <tr class="never"> + <td class="num">118</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> meta = NULL,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">119</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">120</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> #' @description</pre> + </td> + </tr> + <tr class="never"> + <td class="num">121</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> #' Create a new mkindsg object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">122</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> #' @param title The title</pre> + </td> + </tr> + <tr class="never"> + <td class="num">123</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> #' @param ds A list of mkinds objects</pre> + </td> + </tr> + <tr class="never"> + <td class="num">124</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> #' @param f_time_norm Time normalisation factors</pre> + </td> + </tr> + <tr class="never"> + <td class="num">125</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> #' @param meta The meta data</pre> + </td> + </tr> + <tr class="never"> + <td class="num">126</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> initialize = function(title = "", ds,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">127</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> f_time_norm = rep(1, length(ds)), meta)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">128</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">129</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> self$title <- title</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">130</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (all(sapply(ds, inherits, "mkinds"))) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">131</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> self$ds <- ds</pre> + </td> + </tr> + <tr class="never"> + <td class="num">132</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">133</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> stop("Please supply a list of mkinds objects")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">134</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">135</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">136</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> all_observed <- unlist(lapply(ds, function(x) x$observed))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">137</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> observed <- factor(all_observed, levels = unique(all_observed))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">138</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> self$observed_n <- table(observed)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">139</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(dimnames(self$observed_n)) <- NULL</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">140</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> self$f_time_norm <- f_time_norm</pre> + </td> + </tr> + <tr class="never"> + <td class="num">141</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">142</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!missing(meta)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">143</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> rownames(meta) <- lapply(ds, function(x) x$title)</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">144</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> self$meta <- meta</pre> + </td> + </tr> + <tr class="never"> + <td class="num">145</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">146</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">147</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> )</pre> + </td> + </tr> + <tr class="never"> + <td class="num">148</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">149</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">150</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Print mkindsg objects</pre> + </td> + </tr> + <tr class="never"> + <td class="num">151</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">152</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname mkindsg</pre> + </td> + </tr> + <tr class="never"> + <td class="num">153</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param x An [mkindsg] object.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">154</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param verbose Should the mkinds objects be printed?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">155</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param data Should the mkinds objects be printed with their data?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">156</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots Not used.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">157</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">158</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">print.mkindsg <- function(x, data = FALSE, verbose = data, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">159</td> + <td class="coverage">208<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("<mkindsg> holding", length(x$ds), "mkinds objects\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">160</td> + <td class="coverage">208<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("Title $title: ", x$title, "\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">161</td> + <td class="coverage">208<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("Occurrence of observed compounds $observed_n:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">162</td> + <td class="coverage">208<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(x$observed_n)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">163</td> + <td class="coverage">208<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (any(x$f_time_norm != 1)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">164</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("Time normalisation factors $f_time_norm:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">165</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(x$f_time_norm)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">166</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">167</td> + <td class="coverage">208<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.null(x$meta)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">168</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("Meta information $meta:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">169</td> + <td class="coverage">104<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(x$meta)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">170</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">171</td> + <td class="coverage">208<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (verbose) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">172</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nDatasets $ds:")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">173</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> for (ds in x$ds) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">174</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">175</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> print(ds, data = data)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">176</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">177</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">178</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/mkinerrmin.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">utils::globalVariables(c("name", "value_mean"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Calculate the minimum error to assume in order to pass the variance test</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' This function finds the smallest relative error still resulting in passing</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the chi-squared test as defined in the FOCUS kinetics report from 2006.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' This function is used internally by \code{\link{summary.mkinfit}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param fit an object of class \code{\link{mkinfit}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param alpha The confidence level chosen for the chi-squared test.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom stats qchisq aggregate</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return A dataframe with the following components: \item{err.min}{The</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' relative error, expressed as a fraction.} \item{n.optim}{The number of</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' optimised parameters attributed to the data series.} \item{df}{The number of</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' remaining degrees of freedom for the chi2 error level calculations. Note</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' that mean values are used for the chi2 statistic and therefore every time</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' point with observed values in the series only counts one time.} The</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' dataframe has one row for the total dataset and one further row for each</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' observed state variable in the model.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @references FOCUS (2006) \dQuote{Guidance Document on Estimating Persistence</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' and Degradation Kinetics from Environmental Fate Studies on Pesticides in EU</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Registration} Report of the FOCUS Work Group on Degradation Kinetics, EC</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Document Reference Sanco/10058/2005 version 2.0, 434 pp,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \url{http://esdac.jrc.ec.europa.eu/projects/degradation-kinetics}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @keywords manip</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' SFO_SFO = mkinmod(parent = mkinsub("SFO", to = "m1"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' m1 = mkinsub("SFO"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' use_of_ff = "max")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit_FOCUS_D = mkinfit(SFO_SFO, FOCUS_2006_D, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' round(mkinerrmin(fit_FOCUS_D), 4)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit_FOCUS_E = mkinfit(SFO_SFO, FOCUS_2006_E, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' round(mkinerrmin(fit_FOCUS_E), 4)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">mkinerrmin <- function(fit, alpha = 0.05)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">43</td> + <td class="coverage">53943<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms.optim <- fit$par</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">45</td> + <td class="coverage">53943<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> kinerrmin <- function(errdata, n.parms) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">46</td> + <td class="coverage">124726<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> means.mean <- mean(errdata$observed, na.rm = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">47</td> + <td class="coverage">124726<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> df = nrow(errdata) - n.parms</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">49</td> + <td class="coverage">124726<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> err.min <- sqrt((1 / qchisq(1 - alpha, df)) *</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">50</td> + <td class="coverage">124726<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> sum((errdata$observed - errdata$predicted)^2)/(means.mean^2))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">52</td> + <td class="coverage">124726<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(list(err.min = err.min, n.optim = n.parms, df = df))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">54</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">55</td> + <td class="coverage">53943<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> errdata <- aggregate(cbind(observed, predicted) ~ time + variable, data = fit$data, mean, na.rm=TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">56</td> + <td class="coverage">53943<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> errdata <- errdata[order(errdata$time, errdata$variable), ]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">57</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Remove values at time zero for variables whose value for state.ini is fixed,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # as these will not have any effect in the optimization and should therefore not</pre> + </td> + </tr> + <tr class="never"> + <td class="num">60</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # be counted as degrees of freedom.</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">61</td> + <td class="coverage">53943<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fixed_initials = gsub("_0$", "", rownames(subset(fit$fixed, type == "state")))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">62</td> + <td class="coverage">53943<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> errdata <- subset(errdata, !(time == 0 & variable %in% fixed_initials))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">63</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">64</td> + <td class="coverage">53943<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n.optim.overall <- length(parms.optim) - length(fit$errparms)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">65</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">66</td> + <td class="coverage">53943<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> errmin.overall <- kinerrmin(errdata, n.optim.overall)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">67</td> + <td class="coverage">53943<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> errmin <- data.frame(err.min = errmin.overall$err.min,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">68</td> + <td class="coverage">53943<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n.optim = errmin.overall$n.optim, df = errmin.overall$df)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">69</td> + <td class="coverage">53943<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rownames(errmin) <- "All data"</pre> + </td> + </tr> + <tr class="never"> + <td class="num">70</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">71</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # The degrees of freedom are counted according to FOCUS kinetics (2011, p. 164)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">72</td> + <td class="coverage">53943<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (obs_var in fit$obs_vars)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">73</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">74</td> + <td class="coverage">70783<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> errdata.var <- subset(errdata, variable == obs_var)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">75</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">76</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Check if initial value is optimised</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">77</td> + <td class="coverage">70783<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n.initials.optim <- length(grep(paste(obs_var, ".*", "_0", sep=""), names(parms.optim)))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">78</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">79</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Rate constants and IORE exponents are attributed to the source variable</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">80</td> + <td class="coverage">70783<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n.k.optim <- length(grep(paste("^k", obs_var, sep="_"), names(parms.optim)))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">81</td> + <td class="coverage">70783<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n.k.optim <- n.k.optim + length(grep(paste("^log_k", obs_var, sep="_"),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">82</td> + <td class="coverage">70783<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(parms.optim)))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">83</td> + <td class="coverage">70783<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n.k__iore.optim <- length(grep(paste("^k__iore", obs_var, sep="_"), names(parms.optim)))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">84</td> + <td class="coverage">70783<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n.k__iore.optim <- n.k__iore.optim + length(grep(paste("^log_k__iore",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">85</td> + <td class="coverage">70783<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> obs_var, sep = "_"), names(parms.optim)))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">86</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">87</td> + <td class="coverage">70783<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n.N.optim <- length(grep(paste("^N", obs_var, sep="_"), names(parms.optim)))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">88</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">89</td> + <td class="coverage">70783<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n.ff.optim <- 0</pre> + </td> + </tr> + <tr class="never"> + <td class="num">90</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Formation fractions are attributed to the target variable, so look</pre> + </td> + </tr> + <tr class="never"> + <td class="num">91</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # for source compartments with formation fractions</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">92</td> + <td class="coverage">70783<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (source_var in fit$obs_vars) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">93</td> + <td class="coverage">112543<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n.ff.source = length(grep(paste("^f", source_var, sep = "_"),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">94</td> + <td class="coverage">112543<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(parms.optim)))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">95</td> + <td class="coverage">112543<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n.paths.source = length(fit$mkinmod$spec[[source_var]]$to)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">96</td> + <td class="coverage">112543<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (target_var in fit$mkinmod$spec[[source_var]]$to) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">97</td> + <td class="coverage">46296<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (obs_var == target_var) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">98</td> + <td class="coverage">17974<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n.ff.optim <- n.ff.optim + n.ff.source/n.paths.source</pre> + </td> + </tr> + <tr class="never"> + <td class="num">99</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">100</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">101</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">102</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">103</td> + <td class="coverage">70783<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n.optim <- sum(n.initials.optim, n.k.optim, n.k__iore.optim, n.N.optim, n.ff.optim)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">104</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">105</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # FOMC, DFOP and HS parameters are only counted if we are looking at the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">106</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # first variable in the model which is always the source variable</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">107</td> + <td class="coverage">70783<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (obs_var == fit$obs_vars[[1]]) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">108</td> + <td class="coverage">53943<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> special_parms = c("alpha", "log_alpha", "beta", "log_beta",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">109</td> + <td class="coverage">53943<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "k1", "log_k1", "k2", "log_k2",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">110</td> + <td class="coverage">53943<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "g", "g_ilr", "g_qlogis", "tb", "log_tb")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">111</td> + <td class="coverage">53943<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n.optim <- n.optim + length(intersect(special_parms, names(parms.optim)))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">112</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">113</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">114</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Calculate and add a line to the dataframe holding the results</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">115</td> + <td class="coverage">70783<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> errmin.tmp <- kinerrmin(errdata.var, n.optim)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">116</td> + <td class="coverage">70783<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> errmin[obs_var, c("err.min", "n.optim", "df")] <- errmin.tmp</pre> + </td> + </tr> + <tr class="never"> + <td class="num">117</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">118</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">119</td> + <td class="coverage">53943<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(errmin)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">120</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/residuals.mkinfit.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Extract residuals from an mkinfit model</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param object A \code{\link{mkinfit}} object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param standardized Should the residuals be standardized by dividing by the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' standard deviation obtained from the fitted error model?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots Not used</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f <- mkinfit("DFOP", FOCUS_2006_C, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' residuals(f)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' residuals(f, standardized = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">residuals.mkinfit <- function(object, standardized = FALSE, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">13</td> + <td class="coverage">2493<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res <- object$data[["residual"]]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">14</td> + <td class="coverage">2493<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (standardized) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">15</td> + <td class="coverage">2428<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (object$err_mod == "const") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">16</td> + <td class="coverage">543<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> sigma_fitted <- object$errparms["sigma"]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">18</td> + <td class="coverage">2428<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (object$err_mod == "obs") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">19</td> + <td class="coverage">65<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> sigma_names = paste0("sigma_", object$data[["variable"]])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">20</td> + <td class="coverage">65<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> sigma_fitted <- object$errparms[sigma_names]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">22</td> + <td class="coverage">2428<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (object$err_mod == "tc") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">23</td> + <td class="coverage">1820<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> sigma_fitted <- sigma_twocomp(object$data[["predicted"]],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">24</td> + <td class="coverage">1820<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> sigma_low = object$errparms[1],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">25</td> + <td class="coverage">1820<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rsd_high = object$errparms[2])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">27</td> + <td class="coverage">2428<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(res / sigma_fitted)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">29</td> + <td class="coverage">65<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(res)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/AIC.mmkin.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Calculate the AIC for a column of an mmkin object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Provides a convenient way to compare different kinetic models fitted to the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' same dataset.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom stats AIC BIC</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param object An object of class \code{\link{mmkin}}, containing only one</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' column.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots For compatibility with the generic method</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param k As in the generic method</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return As in the generic method (a numeric value for single fits, or a</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' dataframe if there are several fits in the column).</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @author Johannes Ranke</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{ # skip, as it takes > 10 s on winbuilder</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f <- mmkin(c("SFO", "FOMC", "DFOP"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' list("FOCUS A" = FOCUS_2006_A,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' "FOCUS C" = FOCUS_2006_C), cores = 1, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # We get a warning because the FOMC model does not converge for the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # FOCUS A dataset, as it is well described by SFO</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' AIC(f["SFO", "FOCUS A"]) # We get a single number for a single fit</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' AIC(f[["SFO", "FOCUS A"]]) # or when extracting an mkinfit object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # For FOCUS A, the models fit almost equally well, so the higher the number</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # of parameters, the higher (worse) the AIC</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' AIC(f[, "FOCUS A"])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' AIC(f[, "FOCUS A"], k = 0) # If we do not penalize additional parameters, we get nearly the same</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' BIC(f[, "FOCUS A"]) # Comparing the BIC gives a very similar picture</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # For FOCUS C, the more complex models fit better</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' AIC(f[, "FOCUS C"])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' BIC(f[, "FOCUS C"])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">AIC.mmkin <- function(object, ..., k = 2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # We can only handle a single column</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">41</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (ncol(object) != 1) stop("Please provide a single column object")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">42</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n.fits <- length(object)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">43</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> model_names <- rownames(object)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">45</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> code <- paste0("AIC(",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">46</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> paste0("object[[", 1:n.fits, "]]", collapse = ", "),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">47</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ", k = k)")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">48</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res <- eval(parse(text = code))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">49</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (n.fits > 1) rownames(res) <- model_names</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">50</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(res)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname AIC.mmkin</pre> + </td> + </tr> + <tr class="never"> + <td class="num">54</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">55</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">BIC.mmkin <- function(object, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">57</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # We can only handle a single column</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">58</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (ncol(object) != 1) stop("Please provide a single column object")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">59</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n.fits <- length(object)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">60</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> model_names <- rownames(object)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">61</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">62</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> code <- paste0("BIC(",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">63</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> paste0("object[[", 1:n.fits, "]]", collapse = ", "),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">64</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> ")")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">65</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res <- eval(parse(text = code))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">66</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (n.fits > 1) rownames(res) <- model_names</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">67</td> + <td class="coverage">247<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(res)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">68</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/intervals.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom nlme intervals</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">nlme::intervals</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Confidence intervals for parameters in saem.mmkin objects</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param object The fitted saem.mmkin object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param level The confidence level. Must be the default of 0.95 as this is what</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' is available in the saemix object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param backtransform In case the model was fitted with mkin transformations,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' should we backtransform the parameters where a one to one correlation</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' between transformed and backtransformed parameters exists?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots For compatibility with the generic method</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return An object with 'intervals.saem.mmkin' and 'intervals.lme' in the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' class attribute</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">intervals.saem.mmkin <- function(object, level = 0.95, backtransform = TRUE, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">19</td> + <td class="coverage">2481<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!identical(level, 0.95)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">20</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> stop("Confidence intervals are only available for a level of 95%")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">23</td> + <td class="coverage">2481<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mod_vars <- names(object$mkinmod$diffs)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">25</td> + <td class="coverage">2481<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> pnames <- names(object$mean_dp_start)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Confidence intervals are available in the SaemixObject, so</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # we just need to extract them and put them into a list modelled</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # after the result of nlme::intervals.lme</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">31</td> + <td class="coverage">2481<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> conf.int <- object$so@results@conf.int</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">32</td> + <td class="coverage">2481<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rownames(conf.int) <- conf.int$name</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">33</td> + <td class="coverage">2481<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> colnames(conf.int)[2] <- "est."</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">34</td> + <td class="coverage">2481<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> confint_trans <- as.matrix(conf.int[pnames, c("lower", "est.", "upper")])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Fixed effects</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # In case objects were produced by earlier versions of saem</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">38</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.null(object$transformations)) object$transformations <- "mkin"</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">40</td> + <td class="coverage">2481<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (object$transformations == "mkin" & backtransform) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">41</td> + <td class="coverage">2286<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> bp <- backtransform_odeparms(confint_trans[, "est."], object$mkinmod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">42</td> + <td class="coverage">2286<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$transform_rates, object$transform_fractions)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">43</td> + <td class="coverage">2286<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> bpnames <- names(bp)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Transform boundaries of CI for one parameter at a time,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # with the exception of sets of formation fractions (single fractions are OK).</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">47</td> + <td class="coverage">2286<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f_names_skip <- character(0)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">48</td> + <td class="coverage">2286<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (box in mod_vars) { # Figure out sets of fractions to skip</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">49</td> + <td class="coverage">2396<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f_names <- grep(paste("^f", box, sep = "_"), pnames, value = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">50</td> + <td class="coverage">2396<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n_paths <- length(f_names)</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">51</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (n_paths > 1) f_names_skip <- c(f_names_skip, f_names)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">54</td> + <td class="coverage">2286<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> confint_back <- matrix(NA, nrow = length(bp), ncol = 3,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">55</td> + <td class="coverage">2286<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dimnames = list(bpnames, colnames(confint_trans)))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">56</td> + <td class="coverage">2286<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> confint_back[, "est."] <- bp</pre> + </td> + </tr> + <tr class="never"> + <td class="num">57</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">58</td> + <td class="coverage">2286<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (pname in pnames) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">59</td> + <td class="coverage">6314<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!pname %in% f_names_skip) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">60</td> + <td class="coverage">6314<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> par.lower <- confint_trans[pname, "lower"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">61</td> + <td class="coverage">6314<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> par.upper <- confint_trans[pname, "upper"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">62</td> + <td class="coverage">6314<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(par.lower) <- names(par.upper) <- pname</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">63</td> + <td class="coverage">6314<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> bpl <- backtransform_odeparms(par.lower, object$mkinmod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">64</td> + <td class="coverage">6314<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$transform_rates,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">65</td> + <td class="coverage">6314<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$transform_fractions)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">66</td> + <td class="coverage">6314<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> bpu <- backtransform_odeparms(par.upper, object$mkinmod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">67</td> + <td class="coverage">6314<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$transform_rates,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">68</td> + <td class="coverage">6314<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$transform_fractions)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">69</td> + <td class="coverage">6314<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> confint_back[names(bpl), "lower"] <- bpl</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">70</td> + <td class="coverage">6314<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> confint_back[names(bpu), "upper"] <- bpu</pre> + </td> + </tr> + <tr class="never"> + <td class="num">71</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">72</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">73</td> + <td class="coverage">2286<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> confint_ret <- confint_back</pre> + </td> + </tr> + <tr class="never"> + <td class="num">74</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">75</td> + <td class="coverage">195<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> confint_ret <- confint_trans</pre> + </td> + </tr> + <tr class="never"> + <td class="num">76</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">77</td> + <td class="coverage">2481<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> attr(confint_ret, "label") <- "Fixed effects:"</pre> + </td> + </tr> + <tr class="never"> + <td class="num">78</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">79</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Random effects</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">80</td> + <td class="coverage">2481<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> sdnames <- intersect(rownames(conf.int), paste("SD", pnames, sep = "."))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">81</td> + <td class="coverage">2481<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> corrnames <- grep("^Corr.", rownames(conf.int), value = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">82</td> + <td class="coverage">2481<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ranef_ret <- as.matrix(conf.int[c(sdnames, corrnames), c("lower", "est.", "upper")])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">83</td> + <td class="coverage">2481<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> sdnames_ret <- paste0(gsub("SD\\.", "sd(", sdnames), ")")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">84</td> + <td class="coverage">2481<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> corrnames_ret <- gsub("Corr\\.(.*)\\.(.*)", "corr(\\1,\\2)", corrnames)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">85</td> + <td class="coverage">2481<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rownames(ranef_ret) <- c(sdnames_ret, corrnames_ret)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">86</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">87</td> + <td class="coverage">2481<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> attr(ranef_ret, "label") <- "Random effects:"</pre> + </td> + </tr> + <tr class="never"> + <td class="num">88</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">89</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">90</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Error model</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">91</td> + <td class="coverage">2481<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> enames <- if (object$err_mod == "const") "a.1" else c("a.1", "b.1")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">92</td> + <td class="coverage">2481<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> err_ret <- as.matrix(conf.int[enames, c("lower", "est.", "upper")])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">93</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">94</td> + <td class="coverage">2481<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res <- list(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">95</td> + <td class="coverage">2481<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fixed = confint_ret,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">96</td> + <td class="coverage">2481<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> random = ranef_ret,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">97</td> + <td class="coverage">2481<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> errmod = err_ret</pre> + </td> + </tr> + <tr class="never"> + <td class="num">98</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> )</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">99</td> + <td class="coverage">2481<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(res) <- c("intervals.saemix.mmkin", "intervals.lme")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">100</td> + <td class="coverage">2481<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> attr(res, "level") <- level</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">101</td> + <td class="coverage">2481<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(res)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">102</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/update.mkinfit.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Update an mkinfit model with different arguments</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' This function will return an updated mkinfit object. The fitted degradation</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' model parameters from the old fit are used as starting values for the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' updated fit. Values specified as 'parms.ini' and/or 'state.ini' will</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' override these starting values.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param object An mkinfit object to be updated</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots Arguments to \code{\link{mkinfit}} that should replace</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the arguments from the original call. Arguments set to NULL will</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' remove arguments given in the original call</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param evaluate Should the call be evaluated or returned as a call</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit <- mkinfit("SFO", subset(FOCUS_2006_D, value != 0), quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parms(fit)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot_err(fit)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit_2 <- update(fit, error_model = "tc")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parms(fit_2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot_err(fit_2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">update.mkinfit <- function(object, ..., evaluate = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">25</td> + <td class="coverage">5<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> call <- object$call</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">27</td> + <td class="coverage">5<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> update_arguments <- match.call(expand.dots = FALSE)$...</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Get optimised ODE parameters and let parms.ini override them</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">30</td> + <td class="coverage">5<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ode_optim_names <- intersect(names(object$bparms.optim), names(object$bparms.ode))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">31</td> + <td class="coverage">5<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ode_start <- object$bparms.optim[ode_optim_names]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">32</td> + <td class="coverage">5<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if ("parms.ini" %in% names(update_arguments)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">33</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> ode_start[names(update_arguments["parms.ini"])] <- update_arguments["parms.ini"]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">35</td> + <td class="coverage">5<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(ode_start)) update_arguments[["parms.ini"]] <- ode_start</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Get optimised values for initial states and let state.ini override them</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">38</td> + <td class="coverage">5<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> state_optim_names <- intersect(names(object$bparms.optim), paste0(names(object$bparms.state), "_0"))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">39</td> + <td class="coverage">5<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> state_start <- object$bparms.optim[state_optim_names]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">40</td> + <td class="coverage">5<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(state_start) <- gsub("_0$", "", names(state_start))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">41</td> + <td class="coverage">5<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if ("state.ini" %in% names(update_arguments)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">42</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> state_start[names(update_arguments["state.ini"])] <- update_arguments["state.ini"]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">44</td> + <td class="coverage">5<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(state_start)) update_arguments[["state.ini"]] <- state_start</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">46</td> + <td class="coverage">5<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(update_arguments) > 0) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">47</td> + <td class="coverage">5<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> update_arguments_in_call <- !is.na(match(names(update_arguments), names(call)))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">49</td> + <td class="coverage">5<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (a in names(update_arguments)[update_arguments_in_call]) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">50</td> + <td class="coverage">3<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> call[[a]] <- update_arguments[[a]]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">53</td> + <td class="coverage">5<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> update_arguments_not_in_call <- !update_arguments_in_call</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">54</td> + <td class="coverage">5<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(any(update_arguments_not_in_call)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">55</td> + <td class="coverage">5<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> call <- c(as.list(call), update_arguments[update_arguments_not_in_call])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">56</td> + <td class="coverage">5<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> call <- as.call(call)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">57</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">59</td> + <td class="coverage">5<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(evaluate) eval(call, parent.frame())</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">60</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> else call</pre> + </td> + </tr> + <tr class="never"> + <td class="num">61</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/confint.mkinfit.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Confidence intervals for parameters of mkinfit objects</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' The default method 'quadratic' is based on the quadratic approximation of</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the curvature of the likelihood function at the maximum likelihood parameter</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' estimates.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' The alternative method 'profile' is based on the profile likelihood for each</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parameter. The 'profile' method uses two nested optimisations and can take a</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' very long time, even if parallelized by specifying 'cores' on unixoid</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' platforms. The speed of the method could likely be improved by using the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' method of Venzon and Moolgavkar (1988).</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param object An \code{\link{mkinfit}} object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param parm A vector of names of the parameters which are to be given</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' confidence intervals. If missing, all parameters are considered.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param level The confidence level required</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param alpha The allowed error probability, overrides 'level' if specified.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param cutoff Possibility to specify an alternative cutoff for the difference</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' in the log-likelihoods at the confidence boundary. Specifying an explicit</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' cutoff value overrides arguments 'level' and 'alpha'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param method The 'quadratic' method approximates the likelihood function at</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the optimised parameters using the second term of the Taylor expansion,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' using a second derivative (hessian) contained in the object.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' The 'profile' method searches the parameter space for the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' cutoff of the confidence intervals by means of a likelihood ratio test.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param transformed If the quadratic approximation is used, should it be</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' applied to the likelihood based on the transformed parameters?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param backtransform If we approximate the likelihood in terms of the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' transformed parameters, should we backtransform the parameters with</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' their confidence intervals?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param rel_tol If the method is 'profile', what should be the accuracy</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' of the lower and upper bounds, relative to the estimate obtained from</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the quadratic method?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param cores The number of cores to be used for multicore processing.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' On Windows machines, cores > 1 is currently not supported.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param quiet Should we suppress the message "Profiling the likelihood"</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return A matrix with columns giving lower and upper confidence limits for</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' each parameter.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots Not used</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom stats qnorm</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @references</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Bates DM and Watts GW (1988) Nonlinear regression analysis & its applications</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Pawitan Y (2013) In all likelihood - Statistical modelling and</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' inference using likelihood. Clarendon Press, Oxford.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Venzon DJ and Moolgavkar SH (1988) A Method for Computing</pre> + </td> + </tr> + <tr class="never"> + <td class="num">47</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Profile-Likelihood Based Confidence Intervals, Applied Statistics, 37,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' 87–94.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f <- mkinfit("SFO", FOCUS_2006_C, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' confint(f, method = "quadratic")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">54</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' confint(f, method = "profile")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">55</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Set the number of cores for the profiling method for further examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">57</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' if (identical(Sys.getenv("NOT_CRAN"), "true")) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' n_cores <- parallel::detectCores() - 1</pre> + </td> + </tr> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' } else {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">60</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' n_cores <- 1</pre> + </td> + </tr> + <tr class="never"> + <td class="num">61</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">62</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' if (Sys.getenv("TRAVIS") != "") n_cores = 1</pre> + </td> + </tr> + <tr class="never"> + <td class="num">63</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' if (Sys.info()["sysname"] == "Windows") n_cores = 1</pre> + </td> + </tr> + <tr class="never"> + <td class="num">64</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">65</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' SFO_SFO <- mkinmod(parent = mkinsub("SFO", "m1"), m1 = mkinsub("SFO"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">66</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' use_of_ff = "min", quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">67</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' SFO_SFO.ff <- mkinmod(parent = mkinsub("SFO", "m1"), m1 = mkinsub("SFO"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">68</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' use_of_ff = "max", quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">69</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_d_1 <- mkinfit(SFO_SFO, subset(FOCUS_2006_D, value != 0), quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">70</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' system.time(ci_profile <- confint(f_d_1, method = "profile", cores = 1, quiet = TRUE))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">71</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Using more cores does not save much time here, as parent_0 takes up most of the time</pre> + </td> + </tr> + <tr class="never"> + <td class="num">72</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # If we additionally exclude parent_0 (the confidence of which is often of</pre> + </td> + </tr> + <tr class="never"> + <td class="num">73</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # minor interest), we get a nice performance improvement if we use at least 4 cores</pre> + </td> + </tr> + <tr class="never"> + <td class="num">74</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' system.time(ci_profile_no_parent_0 <- confint(f_d_1, method = "profile",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">75</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' c("k_parent_sink", "k_parent_m1", "k_m1_sink", "sigma"), cores = n_cores))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">76</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ci_profile</pre> + </td> + </tr> + <tr class="never"> + <td class="num">77</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ci_quadratic_transformed <- confint(f_d_1, method = "quadratic")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">78</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ci_quadratic_transformed</pre> + </td> + </tr> + <tr class="never"> + <td class="num">79</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ci_quadratic_untransformed <- confint(f_d_1, method = "quadratic", transformed = FALSE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">80</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ci_quadratic_untransformed</pre> + </td> + </tr> + <tr class="never"> + <td class="num">81</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Against the expectation based on Bates and Watts (1988), the confidence</pre> + </td> + </tr> + <tr class="never"> + <td class="num">82</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # intervals based on the internal parameter transformation are less</pre> + </td> + </tr> + <tr class="never"> + <td class="num">83</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # congruent with the likelihood based intervals. Note the superiority of the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">84</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # interval based on the untransformed fit for k_m1_sink</pre> + </td> + </tr> + <tr class="never"> + <td class="num">85</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' rel_diffs_transformed <- abs((ci_quadratic_transformed - ci_profile)/ci_profile)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">86</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' rel_diffs_untransformed <- abs((ci_quadratic_untransformed - ci_profile)/ci_profile)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">87</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' rel_diffs_transformed < rel_diffs_untransformed</pre> + </td> + </tr> + <tr class="never"> + <td class="num">88</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' signif(rel_diffs_transformed, 3)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">89</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' signif(rel_diffs_untransformed, 3)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">90</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">91</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">92</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Investigate a case with formation fractions</pre> + </td> + </tr> + <tr class="never"> + <td class="num">93</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_d_2 <- mkinfit(SFO_SFO.ff, subset(FOCUS_2006_D, value != 0), quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">94</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ci_profile_ff <- confint(f_d_2, method = "profile", cores = n_cores)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">95</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ci_profile_ff</pre> + </td> + </tr> + <tr class="never"> + <td class="num">96</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ci_quadratic_transformed_ff <- confint(f_d_2, method = "quadratic")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">97</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ci_quadratic_transformed_ff</pre> + </td> + </tr> + <tr class="never"> + <td class="num">98</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ci_quadratic_untransformed_ff <- confint(f_d_2, method = "quadratic", transformed = FALSE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">99</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ci_quadratic_untransformed_ff</pre> + </td> + </tr> + <tr class="never"> + <td class="num">100</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' rel_diffs_transformed_ff <- abs((ci_quadratic_transformed_ff - ci_profile_ff)/ci_profile_ff)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">101</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' rel_diffs_untransformed_ff <- abs((ci_quadratic_untransformed_ff - ci_profile_ff)/ci_profile_ff)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">102</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # While the confidence interval for the parent rate constant is closer to</pre> + </td> + </tr> + <tr class="never"> + <td class="num">103</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # the profile based interval when using the internal parameter</pre> + </td> + </tr> + <tr class="never"> + <td class="num">104</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # transformation, the interval for the metabolite rate constant is 'better</pre> + </td> + </tr> + <tr class="never"> + <td class="num">105</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # without internal parameter transformation.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">106</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' rel_diffs_transformed_ff < rel_diffs_untransformed_ff</pre> + </td> + </tr> + <tr class="never"> + <td class="num">107</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' rel_diffs_transformed_ff</pre> + </td> + </tr> + <tr class="never"> + <td class="num">108</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' rel_diffs_untransformed_ff</pre> + </td> + </tr> + <tr class="never"> + <td class="num">109</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">110</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # The profiling for the following fit does not finish in a reasonable time,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">111</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # therefore we use the quadratic approximation</pre> + </td> + </tr> + <tr class="never"> + <td class="num">112</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' m_synth_DFOP_par <- mkinmod(parent = mkinsub("DFOP", c("M1", "M2")),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">113</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' M1 = mkinsub("SFO"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">114</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' M2 = mkinsub("SFO"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">115</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' use_of_ff = "max", quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">116</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' DFOP_par_c <- synthetic_data_for_UBA_2014[[12]]$data</pre> + </td> + </tr> + <tr class="never"> + <td class="num">117</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_tc_2 <- mkinfit(m_synth_DFOP_par, DFOP_par_c, error_model = "tc",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">118</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' error_model_algorithm = "direct", quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">119</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' confint(f_tc_2, method = "quadratic")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">120</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' confint(f_tc_2, "parent_0", method = "quadratic")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">121</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">122</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">123</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">confint.mkinfit <- function(object, parm,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">124</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> level = 0.95, alpha = 1 - level, cutoff,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">125</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> method = c("quadratic", "profile"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">126</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> transformed = TRUE, backtransform = TRUE,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">127</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> cores = parallel::detectCores(), rel_tol = 0.01, quiet = FALSE, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">128</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">129</td> + <td class="coverage">1260<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> tparms <- parms(object, transformed = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">130</td> + <td class="coverage">1260<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> bparms <- parms(object, transformed = FALSE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">131</td> + <td class="coverage">1260<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> tpnames <- names(tparms)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">132</td> + <td class="coverage">1260<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> bpnames <- names(bparms)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">133</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">134</td> + <td class="coverage">1260<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return_pnames <- if (missing(parm)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">135</td> + <td class="coverage">210<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (backtransform) bpnames else tpnames</pre> + </td> + </tr> + <tr class="never"> + <td class="num">136</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">137</td> + <td class="coverage">210<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parm</pre> + </td> + </tr> + <tr class="never"> + <td class="num">138</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">139</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">140</td> + <td class="coverage">1260<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> p <- length(return_pnames)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">141</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">142</td> + <td class="coverage">1260<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> method <- match.arg(method)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">143</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">144</td> + <td class="coverage">1260<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> a <- c(alpha / 2, 1 - (alpha / 2))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">145</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">146</td> + <td class="coverage">1260<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> quantiles <- qt(a, object$df.residual)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">147</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">148</td> + <td class="coverage">1260<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covar_pnames <- if (missing(parm)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">149</td> + <td class="coverage">420<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (transformed) tpnames else bpnames</pre> + </td> + </tr> + <tr class="never"> + <td class="num">150</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">151</td> + <td class="coverage">210<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parm</pre> + </td> + </tr> + <tr class="never"> + <td class="num">152</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">153</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">154</td> + <td class="coverage">1260<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return_parms <- if (backtransform) bparms[return_pnames]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">155</td> + <td class="coverage">1260<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> else tparms[return_pnames]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">156</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">157</td> + <td class="coverage">1260<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covar_parms <- if (transformed) tparms[covar_pnames]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">158</td> + <td class="coverage">1260<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> else bparms[covar_pnames]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">159</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">160</td> + <td class="coverage">1260<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (transformed) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">161</td> + <td class="coverage">840<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covar <- try(solve(object$hessian), silent = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">162</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">163</td> + <td class="coverage">420<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> covar <- try(solve(object$hessian_notrans), silent = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">164</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">165</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">166</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # If inverting the covariance matrix failed or produced NA values</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">167</td> + <td class="coverage">1260<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.numeric(covar) | is.na(covar[1])) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">168</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> ses <- lci <- uci <- rep(NA, p)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">169</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">170</td> + <td class="coverage">1260<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ses <- sqrt(diag(covar))[covar_pnames]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">171</td> + <td class="coverage">1260<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lci <- covar_parms + quantiles[1] * ses</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">172</td> + <td class="coverage">1260<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> uci <- covar_parms + quantiles[2] * ses</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">173</td> + <td class="coverage">1260<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (transformed & backtransform) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">174</td> + <td class="coverage">630<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lci_back <- backtransform_odeparms(lci,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">175</td> + <td class="coverage">630<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$mkinmod, object$transform_rates, object$transform_fractions)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">176</td> + <td class="coverage">630<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> uci_back <- backtransform_odeparms(uci,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">177</td> + <td class="coverage">630<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$mkinmod, object$transform_rates, object$transform_fractions)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">178</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">179</td> + <td class="coverage">630<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return_errparm_names <- intersect(names(object$errparms), return_pnames)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">180</td> + <td class="coverage">630<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lci <- c(lci_back, lci[return_errparm_names])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">181</td> + <td class="coverage">630<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> uci <- c(uci_back, uci[return_errparm_names])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">182</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">183</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">184</td> + <td class="coverage">1260<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ci <- cbind(lower = lci, upper = uci)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">185</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">186</td> + <td class="coverage">1260<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (method == "profile") {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">187</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">188</td> + <td class="coverage">210<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ci_quadratic <- ci</pre> + </td> + </tr> + <tr class="never"> + <td class="num">189</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">190</td> + <td class="coverage">210<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!quiet) message("Profiling the likelihood")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">191</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">192</td> + <td class="coverage">210<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lci <- uci <- rep(NA, p)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">193</td> + <td class="coverage">210<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(lci) <- names(uci) <- return_pnames</pre> + </td> + </tr> + <tr class="never"> + <td class="num">194</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">195</td> + <td class="coverage">210<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> profile_pnames <- if(missing(parm)) names(parms(object))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">196</td> + <td class="coverage">210<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> else parm</pre> + </td> + </tr> + <tr class="never"> + <td class="num">197</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">198</td> + <td class="coverage">210<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (missing(cutoff)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">199</td> + <td class="coverage">210<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cutoff <- 0.5 * qchisq(1 - alpha, 1)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">200</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">201</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">202</td> + <td class="coverage">210<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> all_parms <- parms(object)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">203</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">204</td> + <td class="coverage">210<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> get_ci <- function(pname) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">205</td> + <td class="coverage">3<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> pnames_free <- setdiff(names(all_parms), pname)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">206</td> + <td class="coverage">3<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> profile_ll <- function(x)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">207</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">208</td> + <td class="coverage">80<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> pll_cost <- function(P) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">209</td> + <td class="coverage">3132<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms_cost <- all_parms</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">210</td> + <td class="coverage">3132<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms_cost[pnames_free] <- P[pnames_free]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">211</td> + <td class="coverage">3132<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parms_cost[pname] <- x</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">212</td> + <td class="coverage">3132<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> - object$ll(parms_cost)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">213</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">214</td> + <td class="coverage">80<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> - nlminb(all_parms[pnames_free], pll_cost)$objective</pre> + </td> + </tr> + <tr class="never"> + <td class="num">215</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">216</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">217</td> + <td class="coverage">3<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cost <- function(x) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">218</td> + <td class="coverage">80<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> (cutoff - (object$logLik - profile_ll(x)))^2</pre> + </td> + </tr> + <tr class="never"> + <td class="num">219</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">220</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">221</td> + <td class="coverage">3<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lower_quadratic <- ci_quadratic["lower"][pname]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">222</td> + <td class="coverage">3<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> upper_quadratic <- ci_quadratic["upper"][pname]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">223</td> + <td class="coverage">3<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ltol <- if (!is.na(lower_quadratic)) rel_tol * lower_quadratic else .Machine$double.eps^0.25</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">224</td> + <td class="coverage">3<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> utol <- if (!is.na(upper_quadratic)) rel_tol * upper_quadratic else .Machine$double.eps^0.25</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">225</td> + <td class="coverage">3<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lci_pname <- optimize(cost, lower = 0, upper = all_parms[pname], tol = ltol)$minimum</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">226</td> + <td class="coverage">3<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> uci_pname <- optimize(cost, lower = all_parms[pname],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">227</td> + <td class="coverage">3<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> upper = ifelse(grepl("^f_|^g$", pname), 1, 15 * all_parms[pname]),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">228</td> + <td class="coverage">3<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> tol = utol)$minimum</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">229</td> + <td class="coverage">3<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(c(lci_pname, uci_pname))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">230</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">231</td> + <td class="coverage">210<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ci <- t(parallel::mcmapply(get_ci, profile_pnames, mc.cores = cores))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">232</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">233</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">234</td> + <td class="coverage">1257<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> colnames(ci) <- paste0(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">235</td> + <td class="coverage">1257<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> format(100 * a, trim = TRUE, scientific = FALSE, digits = 3), "%")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">236</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">237</td> + <td class="coverage">1257<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(ci)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">238</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/set_nd_nq.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Set non-detects and unquantified values in residue series without replicates</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' This function automates replacing unquantified values in residue time and</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' depth series. For time series, the function performs part of the residue</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' processing proposed in the FOCUS kinetics guidance for parent compounds</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' and metabolites. For two-dimensional residue series over time and depth,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' it automates the proposal of Boesten et al (2015).</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param res_raw Character vector of a residue time series, or matrix of</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' residue values with rows representing depth profiles for a specific sampling</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' time, and columns representing time series of residues at the same depth.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Values below the limit of detection (lod) have to be coded as "nd", values</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' between the limit of detection and the limit of quantification, if any, have</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' to be coded as "nq". Samples not analysed have to be coded as "na". All</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' values that are not "na", "nd" or "nq" have to be coercible to numeric</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param lod Limit of detection (numeric)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param loq Limit of quantification(numeric). Must be specified if the FOCUS rule to</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' stop after the first non-detection is to be applied</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param time_zero_presence Do we assume that residues occur at time zero?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' This only affects samples from the first sampling time that have been</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' reported as "nd" (not detected).</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @references Boesten, J. J. T. I., van der Linden, A. M. A., Beltman, W. H.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' J. and Pol, J. W. (2015). Leaching of plant protection products and their</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' transformation products; Proposals for improving the assessment of leaching</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' to groundwater in the Netherlands — Version 2. Alterra report 2630, Alterra</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Wageningen UR (University & Research centre)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @references FOCUS (2014) Generic Guidance for Estimating Persistence and Degradation</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Kinetics from Environmental Fate Studies on Pesticides in EU Registration, Version 1.1,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' 18 December 2014, p. 251</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return A numeric vector, if a vector was supplied, or a numeric matrix otherwise</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # FOCUS (2014) p. 75/76 and 131/132</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parent_1 <- c(.12, .09, .05, .03, "nd", "nd", "nd", "nd", "nd", "nd")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' set_nd_nq(parent_1, 0.02)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parent_2 <- c(.12, .09, .05, .03, "nd", "nd", .03, "nd", "nd", "nd")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' set_nd_nq(parent_2, 0.02)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' set_nd_nq_focus(parent_2, 0.02, loq = 0.05)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parent_3 <- c(.12, .09, .05, .03, "nd", "nd", .06, "nd", "nd", "nd")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' set_nd_nq(parent_3, 0.02)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' set_nd_nq_focus(parent_3, 0.02, loq = 0.05)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' metabolite <- c("nd", "nd", "nd", 0.03, 0.06, 0.10, 0.11, 0.10, 0.09, 0.05, 0.03, "nd", "nd")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' set_nd_nq(metabolite, 0.02)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' set_nd_nq_focus(metabolite, 0.02, 0.05)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' #</pre> + </td> + </tr> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Boesten et al. (2015), p. 57/58</pre> + </td> + </tr> + <tr class="never"> + <td class="num">47</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' table_8 <- matrix(</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' c(10, 10, rep("nd", 4),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' 10, 10, rep("nq", 2), rep("nd", 2),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' 10, 10, 10, "nq", "nd", "nd",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' "nq", 10, "nq", rep("nd", 3),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' "nd", "nq", "nq", rep("nd", 3),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' rep("nd", 6), rep("nd", 6)),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">54</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ncol = 6, byrow = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">55</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' set_nd_nq(table_8, 0.5, 1.5, time_zero_presence = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' table_10 <- matrix(</pre> + </td> + </tr> + <tr class="never"> + <td class="num">57</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' c(10, 10, rep("nd", 4),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' 10, 10, rep("nd", 4),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' 10, 10, 10, rep("nd", 3),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">60</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' "nd", 10, rep("nd", 4),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">61</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' rep("nd", 18)),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">62</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ncol = 6, byrow = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">63</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' set_nd_nq(table_10, 0.5, time_zero_presence = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">64</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">set_nd_nq <- function(res_raw, lod, loq = NA, time_zero_presence = FALSE) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">65</td> + <td class="coverage">10<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.character(res_raw)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">66</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> stop("Please supply a vector or a matrix of character values")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">67</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">68</td> + <td class="coverage">10<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.vector(res_raw)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">69</td> + <td class="coverage">8<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> was_vector <- TRUE</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">70</td> + <td class="coverage">8<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res_raw <- as.matrix(res_raw)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">71</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">72</td> + <td class="coverage">2<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> was_vector <- FALSE</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">73</td> + <td class="coverage">2<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.matrix(res_raw)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">74</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> stop("Please supply a vector or a matrix of character values")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">75</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">76</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">77</td> + <td class="coverage">10<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> nq <- 0.5 * (loq + lod)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">78</td> + <td class="coverage">10<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> nda <- 0.5 * lod # not detected but adjacent to detection</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">79</td> + <td class="coverage">10<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res_raw[res_raw == "nq"] <- nq</pre> + </td> + </tr> + <tr class="never"> + <td class="num">80</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">81</td> + <td class="coverage">10<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!time_zero_presence) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">82</td> + <td class="coverage">8<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (j in 1:ncol(res_raw)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">83</td> + <td class="coverage">3<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (res_raw[1, j] == "nd") res_raw[1, j] <- "na"</pre> + </td> + </tr> + <tr class="never"> + <td class="num">84</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">85</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">86</td> + <td class="coverage">10<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res_raw[res_raw == "na"] <- NA</pre> + </td> + </tr> + <tr class="never"> + <td class="num">87</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">88</td> + <td class="coverage">10<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> not_nd_na <- function(value) !(grepl("nd", value) | is.na(value))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">89</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">90</td> + <td class="coverage">10<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (i in 1:nrow(res_raw)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">91</td> + <td class="coverage">94<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (j in 1:ncol(res_raw)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">92</td> + <td class="coverage">164<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.na(res_raw[i, j]) && res_raw[i, j] == "nd") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">93</td> + <td class="coverage">98<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (i > 1) { # check earlier sample in same layer</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">94</td> + <td class="coverage">17<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (not_nd_na(res_raw[i - 1, j])) res_raw[i, j] <- "nda"</pre> + </td> + </tr> + <tr class="never"> + <td class="num">95</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">96</td> + <td class="coverage">98<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (i < nrow(res_raw)) { # check later sample</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">97</td> + <td class="coverage">7<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (not_nd_na(res_raw[i + 1, j])) res_raw[i, j] <- "nda"</pre> + </td> + </tr> + <tr class="never"> + <td class="num">98</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">99</td> + <td class="coverage">98<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (j > 1) { # check above sample at the same time</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">100</td> + <td class="coverage">9<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (not_nd_na(res_raw[i, j - 1])) res_raw[i, j] <- "nda"</pre> + </td> + </tr> + <tr class="never"> + <td class="num">101</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">102</td> + <td class="coverage">98<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (j < ncol(res_raw)) { # check sample below at the same time</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">103</td> + <td class="coverage">2<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (not_nd_na(res_raw[i, j + 1])) res_raw[i, j] <- "nda"</pre> + </td> + </tr> + <tr class="never"> + <td class="num">104</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">105</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">106</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">107</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">108</td> + <td class="coverage">10<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res_raw[res_raw == "nda"] <- nda</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">109</td> + <td class="coverage">10<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res_raw[res_raw == "nd"] <- NA</pre> + </td> + </tr> + <tr class="never"> + <td class="num">110</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">111</td> + <td class="coverage">10<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> result <- as.numeric(res_raw)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">112</td> + <td class="coverage">10<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dim(result) <- dim(res_raw)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">113</td> + <td class="coverage">10<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dimnames(result) <- dimnames(res_raw)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">114</td> + <td class="coverage">8<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (was_vector) result <- as.vector(result)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">115</td> + <td class="coverage">10<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(result)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">116</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">117</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">118</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @describeIn set_nd_nq Set non-detects in residue time series according to FOCUS rules</pre> + </td> + </tr> + <tr class="never"> + <td class="num">119</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param set_first_sample_nd Should the first sample be set to "first_sample_nd_value"</pre> + </td> + </tr> + <tr class="never"> + <td class="num">120</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' in case it is a non-detection?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">121</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param first_sample_nd_value Value to be used for the first sample if it is a non-detection</pre> + </td> + </tr> + <tr class="never"> + <td class="num">122</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param ignore_below_loq_after_first_nd Should we ignore values below the LOQ after the first</pre> + </td> + </tr> + <tr class="never"> + <td class="num">123</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' non-detection that occurs after the quantified values?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">124</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">125</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">set_nd_nq_focus <- function(res_raw, lod, loq = NA,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">126</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> set_first_sample_nd = TRUE, first_sample_nd_value = 0,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">127</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> ignore_below_loq_after_first_nd = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">128</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">129</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="missed"> + <td class="num">130</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.vector(res_raw)) stop("FOCUS rules are only specified for one-dimensional time series")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">131</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">132</td> + <td class="coverage">5<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (ignore_below_loq_after_first_nd & is.na(loq)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">133</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> stop("You need to specify an LOQ")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">134</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">135</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">136</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n <- length(res_raw)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">137</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (ignore_below_loq_after_first_nd) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">138</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (i in 3:n) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">139</td> + <td class="coverage">35<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!res_raw[i - 2] %in% c("na", "nd")) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">140</td> + <td class="coverage">21<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (res_raw[i - 1] == "nd") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">141</td> + <td class="coverage">5<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res_remaining <- res_raw[i:n]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">142</td> + <td class="coverage">5<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res_remaining_unquantified <- ifelse(res_remaining == "na", TRUE,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">143</td> + <td class="coverage">5<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ifelse(res_remaining == "nd", TRUE,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">144</td> + <td class="coverage">5<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ifelse(res_remaining == "nq", TRUE,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">145</td> + <td class="coverage">5<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ifelse(suppressWarnings(as.numeric(res_remaining)) < loq, TRUE, FALSE))))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">146</td> + <td class="coverage">5<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res_remaining_numeric <- suppressWarnings(as.numeric(res_remaining))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">147</td> + <td class="coverage">5<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res_remaining_below_loq <- ifelse(res_remaining == "nq", TRUE,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">148</td> + <td class="coverage">5<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ifelse(!is.na(res_remaining_numeric) & res_remaining_numeric < loq, TRUE, FALSE))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">149</td> + <td class="coverage">5<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (all(res_remaining_unquantified)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">150</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> res_raw[i:n] <- ifelse(res_remaining_below_loq, "nd", res_remaining)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">151</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">152</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">153</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">154</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">155</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">156</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">157</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> result <- set_nd_nq(res_raw, lod = lod, loq = loq)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">158</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">159</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (set_first_sample_nd) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">160</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (res_raw[1] == "nd") result[1] <- first_sample_nd_value</pre> + </td> + </tr> + <tr class="never"> + <td class="num">161</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">162</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">163</td> + <td class="coverage">4<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(result)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">164</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/mkinparplot.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Function to plot the confidence intervals obtained using mkinfit</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' This function plots the confidence intervals for the parameters fitted using</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \code{\link{mkinfit}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param object A fit represented in an \code{\link{mkinfit}} object.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return Nothing is returned by this function, as it is called for its side</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' effect, namely to produce a plot.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @author Johannes Ranke</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' model <- mkinmod(</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' T245 = mkinsub("SFO", to = c("phenol"), sink = FALSE),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' phenol = mkinsub("SFO", to = c("anisole")),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' anisole = mkinsub("SFO"), use_of_ff = "max")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit <- mkinfit(model, subset(mccall81_245T, soil == "Commerce"), quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' mkinparplot(fit)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">mkinparplot <- function(object) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">22</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> state.optim = rownames(subset(object$start, type == "state"))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">23</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> deparms.optim = rownames(subset(object$start, type == "deparm"))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">24</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fractions.optim = grep("^f_", deparms.optim, value = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">25</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> N.optim = grep("^N_", deparms.optim, value = TRUE)</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">26</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if ("g" %in% deparms.optim) fractions.optim <- c("g", fractions.optim)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">27</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rates.optim.unsorted = setdiff(deparms.optim, union(fractions.optim, N.optim))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">28</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rates.optim <- rownames(object$start[rates.optim.unsorted, ])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">29</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n.plot <- c(state.optim = length(state.optim),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">30</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rates.optim = length(rates.optim),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">31</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> N.optim = length(N.optim),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">32</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fractions.optim = length(fractions.optim))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">33</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n.plot <- n.plot[n.plot > 0]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">35</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> oldpar <- par(no.readonly = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">36</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> on.exit(par(oldpar, no.readonly = TRUE))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">37</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> layout(matrix(1:length(n.plot), ncol = 1), heights = n.plot + 1)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">39</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> s <- summary(object)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">40</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> bpar <- data.frame(t(s$bpar[, c("Estimate", "Lower", "Upper")]))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">41</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> par(mar = c(2.1, 2.1, 0.1, 2.1))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">42</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> par(cex = 1)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">43</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (type in names(n.plot)) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">44</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parnames <- get(type)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">45</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> values <- bpar[parnames]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">46</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> values_with_confints <- data.frame(t(subset(data.frame(t(values)), !is.na("Lower"))))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">47</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> xlim = switch(type,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">48</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> state.optim = range(c(0, unlist(values)),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">49</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> na.rm = TRUE, finite = TRUE),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">50</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rates.optim = range(c(0, unlist(values)),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">51</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> na.rm = TRUE, finite = TRUE),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">52</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> N.optim = range(c(0, 1, unlist(values)),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">53</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> na.rm = TRUE, finite = TRUE),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">54</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> fractions.optim = range(c(0, 1, unlist(values)),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">55</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> na.rm = TRUE, finite = TRUE))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">56</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parname_index <- length(parnames):1 # Reverse order for strip chart</pre> + </td> + </tr> + <tr class="never"> + <td class="num">57</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">58</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> stripchart(values["Estimate", ][parname_index],</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">59</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> xlim = xlim,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">60</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ylim = c(0.5, length(get(type)) + 0.5),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">61</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> yaxt = "n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">62</td> + <td class="coverage">70<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (type %in% c("rates.optim", "fractions.optim")) abline(v = 0, lty = 2)</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">63</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (type %in% c("N.optim", "fractions.optim")) abline(v = 1, lty = 2)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">64</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> position <- ifelse(values["Estimate", ] < mean(xlim), "right", "left")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">65</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> text(ifelse(position == "left", min(xlim), max(xlim)),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">66</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parname_index, parnames,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">67</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> pos = ifelse(position == "left", 4, 2))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">68</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">69</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> values.upper.nonInf <- ifelse(values["Upper", ] == Inf, 1.5 * xlim[[2]], values["Upper", ])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">70</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Suppress warnings for non-existing arrow lengths</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">71</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> suppressWarnings(arrows(as.numeric(values["Lower", ]), parname_index,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">72</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> as.numeric(values.upper.nonInf), parname_index,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">73</td> + <td class="coverage">140<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> code = 3, angle = 90, length = 0.05))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">74</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">75</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/summary.saem.mmkin.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Summary method for class "saem.mmkin"</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Lists model equations, initial parameter values, optimised parameters</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' for fixed effects (population), random effects (deviations from the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' population mean) and residual error model, as well as the resulting</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' endpoints such as formation fractions and DT50 values. Optionally</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' (default is FALSE), the data are listed in full.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param object an object of class [saem.mmkin]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param x an object of class [summary.saem.mmkin]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param data logical, indicating whether the full data should be included in</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the summary.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param verbose Should the summary be verbose?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param distimes logical, indicating whether DT50 and DT90 values should be</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' included.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param digits Number of digits to use for printing</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots optional arguments passed to methods like \code{print}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @inheritParams endpoints</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return The summary function returns a list based on the [saemix::SaemixObject]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' obtained in the fit, with at least the following additional components</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{saemixversion, mkinversion, Rversion}{The saemix, mkin and R versions used}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{date.fit, date.summary}{The dates where the fit and the summary were</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' produced}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{diffs}{The differential equations used in the degradation model}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{use_of_ff}{Was maximum or minimum use made of formation fractions}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{data}{The data}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{confint_trans}{Transformed parameters as used in the optimisation, with confidence intervals}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{confint_back}{Backtransformed parameters, with confidence intervals if available}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{confint_errmod}{Error model parameters with confidence intervals}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{ff}{The estimated formation fractions derived from the fitted</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' model.}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{distimes}{The DT50 and DT90 values for each observed variable.}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \item{SFORB}{If applicable, eigenvalues of SFORB components of the model.}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' The print method is called for its side effect, i.e. printing the summary.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom stats predict vcov</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @author Johannes Ranke for the mkin specific parts</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' saemix authors for the parts inherited from saemix.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Generate five datasets following DFOP-SFO kinetics</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' sampling_times = c(0, 1, 3, 7, 14, 28, 60, 90, 120)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' dfop_sfo <- mkinmod(parent = mkinsub("DFOP", "m1"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' m1 = mkinsub("SFO"), quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' set.seed(1234)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' k1_in <- rlnorm(5, log(0.1), 0.3)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' k2_in <- rlnorm(5, log(0.02), 0.3)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' g_in <- plogis(rnorm(5, qlogis(0.5), 0.3))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">47</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_parent_to_m1_in <- plogis(rnorm(5, qlogis(0.3), 0.3))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' k_m1_in <- rlnorm(5, log(0.02), 0.3)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' pred_dfop_sfo <- function(k1, k2, g, f_parent_to_m1, k_m1) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' mkinpredict(dfop_sfo,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' c(k1 = k1, k2 = k2, g = g, f_parent_to_m1 = f_parent_to_m1, k_m1 = k_m1),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' c(parent = 100, m1 = 0),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">54</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' sampling_times)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">55</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">57</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ds_mean_dfop_sfo <- lapply(1:5, function(i) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' mkinpredict(dfop_sfo,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' c(k1 = k1_in[i], k2 = k2_in[i], g = g_in[i],</pre> + </td> + </tr> + <tr class="never"> + <td class="num">60</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_parent_to_m1 = f_parent_to_m1_in[i], k_m1 = k_m1_in[i]),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">61</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' c(parent = 100, m1 = 0),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">62</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' sampling_times)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">63</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' })</pre> + </td> + </tr> + <tr class="never"> + <td class="num">64</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' names(ds_mean_dfop_sfo) <- paste("ds", 1:5)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">65</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">66</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ds_syn_dfop_sfo <- lapply(ds_mean_dfop_sfo, function(ds) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">67</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' add_err(ds,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">68</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' sdfunc = function(value) sqrt(1^2 + value^2 * 0.07^2),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">69</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' n = 1)[[1]]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">70</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' })</pre> + </td> + </tr> + <tr class="never"> + <td class="num">71</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">72</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">73</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Evaluate using mmkin and saem</pre> + </td> + </tr> + <tr class="never"> + <td class="num">74</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_mmkin_dfop_sfo <- mmkin(list(dfop_sfo), ds_syn_dfop_sfo,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">75</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' quiet = TRUE, error_model = "tc", cores = 5)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">76</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_saem_dfop_sfo <- saem(f_mmkin_dfop_sfo)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">77</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' print(f_saem_dfop_sfo)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">78</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' illparms(f_saem_dfop_sfo)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">79</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_saem_dfop_sfo_2 <- update(f_saem_dfop_sfo,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">80</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' no_random_effect = c("parent_0", "log_k_m1"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">81</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' illparms(f_saem_dfop_sfo_2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">82</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' intervals(f_saem_dfop_sfo_2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">83</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' summary(f_saem_dfop_sfo_2, data = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">84</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Add a correlation between random effects of g and k2</pre> + </td> + </tr> + <tr class="never"> + <td class="num">85</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' cov_model_3 <- f_saem_dfop_sfo_2$so@model@covariance.model</pre> + </td> + </tr> + <tr class="never"> + <td class="num">86</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' cov_model_3["log_k2", "g_qlogis"] <- 1</pre> + </td> + </tr> + <tr class="never"> + <td class="num">87</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' cov_model_3["g_qlogis", "log_k2"] <- 1</pre> + </td> + </tr> + <tr class="never"> + <td class="num">88</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_saem_dfop_sfo_3 <- update(f_saem_dfop_sfo,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">89</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' covariance.model = cov_model_3)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">90</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' intervals(f_saem_dfop_sfo_3)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">91</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # The correlation does not improve the fit judged by AIC and BIC, although</pre> + </td> + </tr> + <tr class="never"> + <td class="num">92</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # the likelihood is higher with the additional parameter</pre> + </td> + </tr> + <tr class="never"> + <td class="num">93</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' anova(f_saem_dfop_sfo, f_saem_dfop_sfo_2, f_saem_dfop_sfo_3)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">94</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">95</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">96</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">97</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">summary.saem.mmkin <- function(object, data = FALSE, verbose = FALSE,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">98</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> covariates = NULL, covariate_quantile = 0.5,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">99</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> distimes = TRUE, ...) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">100</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">101</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mod_vars <- names(object$mkinmod$diffs)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">102</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">103</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> pnames <- names(object$mean_dp_start)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">104</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names_fixed_effects <- object$so@results@name.fixed</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">105</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n_fixed <- length(names_fixed_effects)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">106</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">107</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> conf.int <- object$so@results@conf.int</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">108</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> rownames(conf.int) <- conf.int$name</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">109</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> confint_trans <- as.matrix(parms(object, ci = TRUE))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">110</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> colnames(confint_trans)[1] <- "est."</pre> + </td> + </tr> + <tr class="never"> + <td class="num">111</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">112</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # In case objects were produced by earlier versions of saem</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">113</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (is.null(object$transformations)) object$transformations <- "mkin"</pre> + </td> + </tr> + <tr class="never"> + <td class="num">114</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">115</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (object$transformations == "mkin") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">116</td> + <td class="coverage">396<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> bp <- backtransform_odeparms(confint_trans[pnames, "est."], object$mkinmod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">117</td> + <td class="coverage">396<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$transform_rates, object$transform_fractions)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">118</td> + <td class="coverage">396<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> bpnames <- names(bp)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">119</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">120</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Transform boundaries of CI for one parameter at a time,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">121</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # with the exception of sets of formation fractions (single fractions are OK).</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">122</td> + <td class="coverage">396<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f_names_skip <- character(0)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">123</td> + <td class="coverage">396<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (box in mod_vars) { # Figure out sets of fractions to skip</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">124</td> + <td class="coverage">492<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> f_names <- grep(paste("^f", box, sep = "_"), pnames, value = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">125</td> + <td class="coverage">492<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n_paths <- length(f_names)</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">126</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (n_paths > 1) f_names_skip <- c(f_names_skip, f_names)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">127</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">128</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">129</td> + <td class="coverage">396<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> confint_back <- matrix(NA, nrow = length(bp), ncol = 3,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">130</td> + <td class="coverage">396<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dimnames = list(bpnames, colnames(confint_trans)))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">131</td> + <td class="coverage">396<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> confint_back[, "est."] <- bp</pre> + </td> + </tr> + <tr class="never"> + <td class="num">132</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">133</td> + <td class="coverage">396<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (pname in pnames) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">134</td> + <td class="coverage">1291<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!pname %in% f_names_skip) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">135</td> + <td class="coverage">1291<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> par.lower <- confint_trans[pname, "lower"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">136</td> + <td class="coverage">1291<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> par.upper <- confint_trans[pname, "upper"]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">137</td> + <td class="coverage">1291<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(par.lower) <- names(par.upper) <- pname</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">138</td> + <td class="coverage">1291<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> bpl <- backtransform_odeparms(par.lower, object$mkinmod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">139</td> + <td class="coverage">1291<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$transform_rates,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">140</td> + <td class="coverage">1291<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$transform_fractions)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">141</td> + <td class="coverage">1291<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> bpu <- backtransform_odeparms(par.upper, object$mkinmod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">142</td> + <td class="coverage">1291<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$transform_rates,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">143</td> + <td class="coverage">1291<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$transform_fractions)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">144</td> + <td class="coverage">1291<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> confint_back[names(bpl), "lower"] <- bpl</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">145</td> + <td class="coverage">1291<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> confint_back[names(bpu), "upper"] <- bpu</pre> + </td> + </tr> + <tr class="never"> + <td class="num">146</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">147</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">148</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">149</td> + <td class="coverage">404<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> confint_back <- confint_trans[names_fixed_effects, ]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">150</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">151</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">152</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Correlation of fixed effects (inspired by summary.nlme)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">153</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cov_so <- try(solve(object$so@results@fim), silent = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">154</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (inherits(cov_so, "try-error")) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">155</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> object$corFixed <- NA</pre> + </td> + </tr> + <tr class="never"> + <td class="num">156</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">157</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> varFix <- cov_so[1:n_fixed, 1:n_fixed]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">158</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> stdFix <- sqrt(diag(varFix))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">159</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$corFixed <- array(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">160</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> t(varFix/stdFix)/stdFix,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">161</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> dim(varFix),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">162</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> list(names_fixed_effects, names_fixed_effects))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">163</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">164</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">165</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Random effects</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">166</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> sdnames <- intersect(rownames(conf.int), paste0("SD.", pnames))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">167</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> corrnames <- grep("^Corr.", rownames(conf.int), value = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">168</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> confint_ranef <- as.matrix(conf.int[c(sdnames, corrnames), c("estimate", "lower", "upper")])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">169</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> colnames(confint_ranef)[1] <- "est."</pre> + </td> + </tr> + <tr class="never"> + <td class="num">170</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">171</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Error model</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">172</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> enames <- if (object$err_mod == "const") "a.1" else c("a.1", "b.1")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">173</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> confint_errmod <- as.matrix(conf.int[enames, c("estimate", "lower", "upper")])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">174</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> colnames(confint_errmod)[1] <- "est."</pre> + </td> + </tr> + <tr class="never"> + <td class="num">175</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">176</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$confint_trans <- confint_trans</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">177</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$confint_ranef <- confint_ranef</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">178</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$confint_errmod <- confint_errmod</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">179</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$confint_back <- confint_back</pre> + </td> + </tr> + <tr class="never"> + <td class="num">180</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">181</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$date.summary = date()</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">182</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$use_of_ff = object$mkinmod$use_of_ff</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">183</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$error_model_algorithm = object$mmkin_orig[[1]]$error_model_algorithm</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">184</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> err_mod = object$mmkin_orig[[1]]$err_mod</pre> + </td> + </tr> + <tr class="never"> + <td class="num">185</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">186</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$diffs <- object$mkinmod$diffs</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">187</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$print_data <- data # boolean: Should we print the data?</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">188</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> so_pred <- object$so@results@predictions</pre> + </td> + </tr> + <tr class="never"> + <td class="num">189</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">190</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(object$data)[4] <- "observed" # rename value to observed</pre> + </td> + </tr> + <tr class="never"> + <td class="num">191</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">192</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$verbose <- verbose</pre> + </td> + </tr> + <tr class="never"> + <td class="num">193</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">194</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$fixed <- object$mmkin_orig[[1]]$fixed</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">195</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ll <-try(logLik(object$so, method = "is"), silent = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">196</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (inherits(ll, "try-error")) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">197</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> object$logLik <- object$AIC <- object $BIC <- NA</pre> + </td> + </tr> + <tr class="never"> + <td class="num">198</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">199</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$logLik = logLik(object$so, method = "is")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">200</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$AIC = AIC(object$so)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">201</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$BIC = BIC(object$so)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">202</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">203</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">204</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ep <- endpoints(object)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">205</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$covariates <- ep$covariates</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">206</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(ep$ff) != 0)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">207</td> + <td class="coverage">330<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object$ff <- ep$ff</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">208</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (distimes) object$distimes <- ep$distimes</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">209</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(ep$SFORB) != 0) object$SFORB <- ep$SFORB</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">210</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(object) <- c("summary.saem.mmkin")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">211</td> + <td class="coverage">800<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(object)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">212</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">213</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">214</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname summary.saem.mmkin</pre> + </td> + </tr> + <tr class="never"> + <td class="num">215</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">216</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">print.summary.saem.mmkin <- function(x, digits = max(3, getOption("digits") - 3), verbose = x$verbose, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">217</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("saemix version used for fitting: ", x$saemixversion, "\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">218</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("mkin version used for pre-fitting: ", x$mkinversion, "\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">219</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("R version used for fitting: ", x$Rversion, "\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">220</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">221</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("Date of fit: ", x$date.fit, "\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">222</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("Date of summary:", x$date.summary, "\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">223</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">224</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nEquations:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">225</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> nice_diffs <- gsub("^(d.*) =", "\\1/dt =", x[["diffs"]])</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">226</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> writeLines(strwrap(nice_diffs, exdent = 11))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">227</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">228</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nData:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">229</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat(nrow(x$data), "observations of",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">230</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> length(unique(x$data$name)), "variable(s) grouped in",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">231</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> length(unique(x$data$ds)), "datasets\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">232</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">233</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nModel predictions using solution type", x$solution_type, "\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">234</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">235</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nFitted in", x$time[["elapsed"]], "s\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">236</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("Using", paste(x$so@options$nbiter.saemix, collapse = ", "),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">237</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> "iterations and", x$so@options$nb.chains, "chains\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">238</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">239</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nVariance model: ")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">240</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat(switch(x$err_mod,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">241</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> const = "Constant variance",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">242</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> obs = "Variance unique to each observed variable",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">243</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> tc = "Two-component variance function"), "\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">244</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">245</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nStarting values for degradation parameters:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">246</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(x$mean_dp_start, digits = digits)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">247</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">248</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nFixed degradation parameter values:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">249</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(length(x$fixed$value) == 0) cat("None\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">250</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> else print(x$fixed, digits = digits)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">251</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">252</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nStarting values for random effects (square root of initial entries in omega):\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">253</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(sqrt(x$so@model@omega.init), digits = digits)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">254</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">255</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nStarting values for error model parameters:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">256</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> errparms <- x$so@model@error.init</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">257</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(errparms) <- x$so@model@name.sigma</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">258</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> errparms <- errparms[x$so@model@indx.res]</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">259</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(errparms, digits = digits)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">260</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">261</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nResults:\n\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">262</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("Likelihood computed by importance sampling\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">263</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(data.frame(AIC = x$AIC, BIC = x$BIC, logLik = x$logLik,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">264</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> row.names = " "), digits = digits)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">265</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">266</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nOptimised parameters:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">267</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(x$confint_trans, digits = digits)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">268</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">269</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (identical(x$corFixed, NA)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">270</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nCorrelation is not available\n")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">271</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">272</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> corr <- x$corFixed</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">273</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(corr) <- "correlation"</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">274</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(corr, title = "\nCorrelation:", rdig = digits, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">275</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">276</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">277</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nRandom effects:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">278</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(x$confint_ranef, digits = digits)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">279</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">280</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nVariance model:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">281</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(x$confint_errmod, digits = digits)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">282</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">283</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (x$transformations == "mkin") {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">284</td> + <td class="coverage">125<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nBacktransformed parameters:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">285</td> + <td class="coverage">125<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(x$confint_back, digits = digits)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">286</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">287</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">288</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.null(x$covariates)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">289</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nCovariates used for endpoints below:\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">290</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> print(x$covariates)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">291</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">292</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">293</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> printSFORB <- !is.null(x$SFORB)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">294</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(printSFORB){</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">295</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nEstimated Eigenvalues of SFORB model(s):\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">296</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> print(x$SFORB, digits = digits,...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">297</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">298</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">299</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> printff <- !is.null(x$ff)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">300</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(printff){</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">301</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nResulting formation fractions:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">302</td> + <td class="coverage">117<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(data.frame(ff = x$ff), digits = digits,...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">303</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">304</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">305</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> printdistimes <- !is.null(x$distimes)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">306</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if(printdistimes){</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">307</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nEstimated disappearance times:\n")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">308</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> print(x$distimes, digits = digits,...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">309</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">310</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">311</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (x$print_data){</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">312</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> cat("\nData:\n")</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">313</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> print(format(x$data, digits = digits, ...), row.names = FALSE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">314</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">315</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">316</td> + <td class="coverage">242<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> invisible(x)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">317</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/mkin_long_to_wide.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Convert a dataframe from long to wide format</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' This function takes a dataframe in the long form, i.e. with a row for each</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' observed value, and converts it into a dataframe with one independent</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' variable and several dependent variables as columns.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param long_data The dataframe must contain one variable called "time" with</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the time values specified by the \code{time} argument, one column called</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' "name" with the grouping of the observed values, and finally one column of</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' observed values called "value".</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param time The name of the time variable in the long input data.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param outtime The name of the time variable in the wide output data.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return Dataframe in wide format.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @author Johannes Ranke</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' mkin_long_to_wide(FOCUS_2006_D)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export mkin_long_to_wide</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">mkin_long_to_wide <- function(long_data, time = "time", outtime = "time")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">22</td> + <td class="coverage">494<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> colnames <- unique(long_data$name)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">23</td> + <td class="coverage">494<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> wide_data <- data.frame(time = subset(long_data, name == colnames[1], time))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">24</td> + <td class="coverage">494<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> names(wide_data) <- outtime</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">25</td> + <td class="coverage">494<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (var in colnames) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">26</td> + <td class="coverage">741<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> wide_data[var] <- subset(long_data, name == var, value)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">28</td> + <td class="coverage">494<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(wide_data)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/loftest.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Lack-of-fit test for models fitted to data with replicates</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' This is a generic function with a method currently only defined for mkinfit</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' objects. It fits an anova model to the data contained in the object and</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' compares the likelihoods using the likelihood ratio test</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \code{\link[lmtest]{lrtest.default}} from the lmtest package.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' The anova model is interpreted as the simplest form of an mkinfit model,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' assuming only a constant variance about the means, but not enforcing any</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' structure of the means, so we have one model parameter for every mean</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' of replicate samples.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param object A model object with a defined loftest method</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots Not used</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">loftest <- function(object, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">17</td> + <td class="coverage">2<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> UseMethod("loftest")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname loftest</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom stats logLik lm dnorm coef</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @seealso lrtest</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' test_data <- subset(synthetic_data_for_UBA_2014[[12]]$data, name == "parent")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' sfo_fit <- mkinfit("SFO", test_data, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot_res(sfo_fit) # We see a clear pattern in the residuals</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' loftest(sfo_fit) # We have a clear lack of fit</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' #</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # We try a different model (the one that was used to generate the data)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' dfop_fit <- mkinfit("DFOP", test_data, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot_res(dfop_fit) # We don't see systematic deviations, but heteroscedastic residuals</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # therefore we should consider adapting the error model, although we have</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' loftest(dfop_fit) # no lack of fit</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' #</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # This is the anova model used internally for the comparison</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' test_data_anova <- test_data</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' test_data_anova$time <- as.factor(test_data_anova$time)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' anova_fit <- lm(value ~ time, data = test_data_anova)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' summary(anova_fit)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' logLik(anova_fit) # We get the same likelihood and degrees of freedom</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' #</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' test_data_2 <- synthetic_data_for_UBA_2014[[12]]$data</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' m_synth_SFO_lin <- mkinmod(parent = list(type = "SFO", to = "M1"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' M1 = list(type = "SFO", to = "M2"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' M2 = list(type = "SFO"), use_of_ff = "max")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">47</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' sfo_lin_fit <- mkinfit(m_synth_SFO_lin, test_data_2, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot_res(sfo_lin_fit) # not a good model, we try parallel formation</pre> + </td> + </tr> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' loftest(sfo_lin_fit)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' #</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' m_synth_SFO_par <- mkinmod(parent = list(type = "SFO", to = c("M1", "M2")),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' M1 = list(type = "SFO"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' M2 = list(type = "SFO"), use_of_ff = "max")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">54</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' sfo_par_fit <- mkinfit(m_synth_SFO_par, test_data_2, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">55</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot_res(sfo_par_fit) # much better for metabolites</pre> + </td> + </tr> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' loftest(sfo_par_fit)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">57</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' #</pre> + </td> + </tr> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' m_synth_DFOP_par <- mkinmod(parent = list(type = "DFOP", to = c("M1", "M2")),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' M1 = list(type = "SFO"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">60</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' M2 = list(type = "SFO"), use_of_ff = "max")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">61</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' dfop_par_fit <- mkinfit(m_synth_DFOP_par, test_data_2, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">62</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot_res(dfop_par_fit) # No visual lack of fit</pre> + </td> + </tr> + <tr class="never"> + <td class="num">63</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' loftest(dfop_par_fit) # no lack of fit found by the test</pre> + </td> + </tr> + <tr class="never"> + <td class="num">64</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' #</pre> + </td> + </tr> + <tr class="never"> + <td class="num">65</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # The anova model used for comparison in the case of transformation products</pre> + </td> + </tr> + <tr class="never"> + <td class="num">66</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' test_data_anova_2 <- dfop_par_fit$data</pre> + </td> + </tr> + <tr class="never"> + <td class="num">67</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' test_data_anova_2$variable <- as.factor(test_data_anova_2$variable)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">68</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' test_data_anova_2$time <- as.factor(test_data_anova_2$time)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">69</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' anova_fit_2 <- lm(observed ~ time:variable - 1, data = test_data_anova_2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">70</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' summary(anova_fit_2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">71</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">72</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">73</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">loftest.mkinfit <- function(object, ...) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">74</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">75</td> + <td class="coverage">2<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> name_function <- function(x) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">76</td> + <td class="coverage">2<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object_name <- paste(x$mkinmod$name, "with error model", x$err_mod)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">77</td> + <td class="coverage">2<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (length(x$bparms.fixed) > 0) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">78</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> object_name <- paste(object_name,</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">79</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> "and fixed parameter(s)",</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">80</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> paste(names(x$bparms.fixed), collapse = ", "))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">81</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">82</td> + <td class="coverage">2<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(object_name)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">83</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">84</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">85</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Check if we have replicates in the data</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">86</td> + <td class="coverage">2<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (max(aggregate(object$data$observed,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">87</td> + <td class="coverage">2<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> by = list(object$data$variable, object$data$time), length)$x) == 1) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">88</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> stop("Not defined for fits to data without replicates")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">89</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">90</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">91</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> data_anova <- object$data</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">92</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> data_anova$time <- as.factor(data_anova$time)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">93</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> data_anova$variable <- as.factor(data_anova$variable)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">94</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (nlevels(data_anova$variable) == 1) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">95</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object_2 <- lm(observed ~ time - 1, data = data_anova)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">96</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">97</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> object_2 <- lm(observed ~ variable:time - 1,</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">98</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> data = data_anova)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">99</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">100</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">101</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object_2$mkinmod <- list(name = "ANOVA")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">102</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object_2$err_mod <- "const"</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">103</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> sigma_mle <- sqrt(sum(residuals(object_2)^2)/nobs(object_2))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">104</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object_2$logLik <- sum(dnorm(x = object_2$residuals,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">105</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> mean = 0, sd = sigma_mle, log = TRUE))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">106</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object_2$data <- object$data # to make the nobs.mkinfit method work</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">107</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object_2$bparms.optim <- coef(object_2)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">108</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> object_2$errparms <- 1 # We have estimated one error model parameter</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">109</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(object_2) <- "mkinfit"</pre> + </td> + </tr> + <tr class="never"> + <td class="num">110</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">111</td> + <td class="coverage">1<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lmtest::lrtest.default(object_2, object, name = name_function)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">112</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/add_err.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Add normally distributed errors to simulated kinetic degradation data</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Normally distributed errors are added to data predicted for a specific</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' degradation model using \code{\link{mkinpredict}}. The variance of the error</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' may depend on the predicted value and is specified as a standard deviation.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param prediction A prediction from a kinetic model as produced by</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \code{\link{mkinpredict}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param sdfunc A function taking the predicted value as its only argument and</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' returning a standard deviation that should be used for generating the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' random error terms for this value.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param secondary The names of state variables that should have an initial</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' value of zero</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param n The number of datasets to be generated.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param LOD The limit of detection (LOD). Values that are below the LOD after</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' adding the random error will be set to NA.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param reps The number of replicates to be generated within the datasets.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param digits The number of digits to which the values will be rounded.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param seed The seed used for the generation of random numbers. If NA, the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' seed is not set.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom stats rnorm</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return A list of datasets compatible with \code{\link{mmkin}}, i.e. the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' components of the list are datasets compatible with \code{\link{mkinfit}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @author Johannes Ranke</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @references Ranke J and Lehmann R (2015) To t-test or not to t-test, that is</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the question. XV Symposium on Pesticide Chemistry 2-4 September 2015,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Piacenza, Italy</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' https://jrwb.de/posters/piacenza_2015.pdf</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # The kinetic model</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' m_SFO_SFO <- mkinmod(parent = mkinsub("SFO", "M1"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' M1 = mkinsub("SFO"), use_of_ff = "max")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Generate a prediction for a specific set of parameters</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' sampling_times = c(0, 1, 3, 7, 14, 28, 60, 90, 120)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # This is the prediction used for the "Type 2 datasets" on the Piacenza poster</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # from 2015</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' d_SFO_SFO <- mkinpredict(m_SFO_SFO,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' c(k_parent = 0.1, f_parent_to_M1 = 0.5,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' k_M1 = log(2)/1000),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' c(parent = 100, M1 = 0),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' sampling_times)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Add an error term with a constant (independent of the value) standard deviation</pre> + </td> + </tr> + <tr class="never"> + <td class="num">47</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # of 10, and generate three datasets</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' d_SFO_SFO_err <- add_err(d_SFO_SFO, function(x) 10, n = 3, seed = 123456789 )</pre> + </td> + </tr> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Name the datasets for nicer plotting</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' names(d_SFO_SFO_err) <- paste("Dataset", 1:3)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Name the model in the list of models (with only one member in this case) for</pre> + </td> + </tr> + <tr class="never"> + <td class="num">54</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # nicer plotting later on. Be quiet and use only one core not to offend CRAN</pre> + </td> + </tr> + <tr class="never"> + <td class="num">55</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # checks</pre> + </td> + </tr> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">57</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_SFO_SFO <- mmkin(list("SFO-SFO" = m_SFO_SFO),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' d_SFO_SFO_err, cores = 1,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">60</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">61</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(f_SFO_SFO)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">62</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">63</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # We would like to inspect the fit for dataset 3 more closely</pre> + </td> + </tr> + <tr class="never"> + <td class="num">64</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Using double brackets makes the returned object an mkinfit object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">65</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # instead of a list of mkinfit objects, so plot.mkinfit is used</pre> + </td> + </tr> + <tr class="never"> + <td class="num">66</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(f_SFO_SFO[[3]], show_residuals = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">67</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">68</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # If we use single brackets, we should give two indices (model and dataset),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">69</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # and plot.mmkin is used</pre> + </td> + </tr> + <tr class="never"> + <td class="num">70</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(f_SFO_SFO[1, 3])</pre> + </td> + </tr> + <tr class="never"> + <td class="num">71</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">72</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">73</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">74</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">add_err <- function(prediction, sdfunc, secondary = c("M1", "M2"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">75</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> n = 10, LOD = 0.1, reps = 2, digits = 1, seed = NA)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">76</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">77</td> + <td class="coverage">842<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (!is.na(seed)) set.seed(seed)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">78</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">79</td> + <td class="coverage">862<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> prediction <- as.data.frame(prediction)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">80</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">81</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # The output of mkinpredict is in wide format</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">82</td> + <td class="coverage">862<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> d_long = mkin_wide_to_long(prediction, time = "time")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">83</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">84</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Set up the list to be returned</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">85</td> + <td class="coverage">862<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> d_return = list()</pre> + </td> + </tr> + <tr class="never"> + <td class="num">86</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">87</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Generate datasets one by one in a loop</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">88</td> + <td class="coverage">862<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> for (i in 1:n) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">89</td> + <td class="coverage">1712<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> d_rep = data.frame(lapply(d_long, rep, each = reps))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">90</td> + <td class="coverage">1712<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> d_rep$value = rnorm(length(d_rep$value), d_rep$value, sdfunc(d_rep$value))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">91</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">92</td> + <td class="coverage">1712<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> d_rep[d_rep$time == 0 & d_rep$name %in% secondary, "value"] <- 0</pre> + </td> + </tr> + <tr class="never"> + <td class="num">93</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">94</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Set values below the LOD to NA</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">95</td> + <td class="coverage">1712<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> d_NA <- transform(d_rep, value = ifelse(value < LOD, NA, value))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">96</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">97</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Round the values for convenience</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">98</td> + <td class="coverage">1712<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> d_NA$value <- round(d_NA$value, digits)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">99</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">100</td> + <td class="coverage">1712<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> d_return[[i]] <- d_NA</pre> + </td> + </tr> + <tr class="never"> + <td class="num">101</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">102</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">103</td> + <td class="coverage">862<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(d_return)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">104</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/mkin_wide_to_long.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">utils::globalVariables(c("name", "time", "value"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Convert a dataframe with observations over time into long format</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' This function simply takes a dataframe with one independent variable and</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' several dependent variable and converts it into the long form as required by</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \code{\link{mkinfit}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param wide_data The dataframe must contain one variable with the time</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' values specified by the \code{time} argument and usually more than one</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' column of observed values.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param time The name of the time variable.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return Dataframe in long format as needed for \code{\link{mkinfit}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @author Johannes Ranke</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @keywords manip</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' wide <- data.frame(t = c(1,2,3), x = c(1,4,7), y = c(3,4,5))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' mkin_wide_to_long(wide)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' </pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">mkin_wide_to_long <- function(wide_data, time = "t")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">24</td> + <td class="coverage">1127<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> wide_data <- as.data.frame(wide_data)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">25</td> + <td class="coverage">1127<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> colnames <- names(wide_data)</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">26</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (!(time %in% colnames)) stop("The data in wide format have to contain a variable named ", time, ".")</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">27</td> + <td class="coverage">1127<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> vars <- subset(colnames, colnames != time)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">28</td> + <td class="coverage">1127<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> n <- length(colnames) - 1</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">29</td> + <td class="coverage">1127<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> long_data <- data.frame(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">30</td> + <td class="coverage">1127<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> name = rep(vars, each = length(wide_data[[time]])),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">31</td> + <td class="coverage">1127<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> time = as.numeric(rep(wide_data[[time]], n)),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">32</td> + <td class="coverage">1127<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> value = as.numeric(unlist(wide_data[vars])),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">33</td> + <td class="coverage">1127<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> row.names = NULL)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">34</td> + <td class="coverage">1127<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(long_data)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/parent_solutions.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Single First-Order kinetics</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Function describing exponential decline from a defined starting value.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @family parent solutions</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param t Time.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param parent_0 Starting value for the response variable at time zero.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param k Kinetic rate constant.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return The value of the response variable at time \code{t}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @references</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' FOCUS (2006) \dQuote{Guidance Document on Estimating Persistence</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' and Degradation Kinetics from Environmental Fate Studies on Pesticides in</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' EU Registration} Report of the FOCUS Work Group on Degradation Kinetics,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' EC Document Reference Sanco/10058/2005 version 2.0, 434 pp,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \url{http://esdac.jrc.ec.europa.eu/projects/degradation-kinetics}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' FOCUS (2014) \dQuote{Generic guidance for Estimating Persistence</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' and Degradation Kinetics from Environmental Fate Studies on Pesticides in</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' EU Registration} Report of the FOCUS Work Group on Degradation Kinetics,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Version 1.1, 18 December 2014</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \url{http://esdac.jrc.ec.europa.eu/projects/degradation-kinetics}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{plot(function(x) SFO.solution(x, 100, 3), 0, 2)}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">SFO.solution <- function(t, parent_0, k)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">28</td> + <td class="coverage">2338849<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parent = parent_0 * exp(-k * t)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' First-Order Multi-Compartment kinetics</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Function describing exponential decline from a defined starting value, with</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' a decreasing rate constant.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' The form given here differs slightly from the original reference by</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Gustafson and Holden (1990). The parameter \code{beta} corresponds to 1/beta</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' in the original equation.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @family parent solutions</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @inherit SFO.solution</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param alpha Shape parameter determined by coefficient of variation of rate</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' constant values.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param beta Location parameter.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @note The solution of the FOMC kinetic model reduces to the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \code{\link{SFO.solution}} for large values of \code{alpha} and \code{beta}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">47</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' with \eqn{k = \frac{\beta}{\alpha}}{k = beta/alpha}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @references</pre> + </td> + </tr> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' FOCUS (2006) \dQuote{Guidance Document on Estimating Persistence</pre> + </td> + </tr> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' and Degradation Kinetics from Environmental Fate Studies on Pesticides in</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' EU Registration} Report of the FOCUS Work Group on Degradation Kinetics,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' EC Document Reference Sanco/10058/2005 version 2.0, 434 pp,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \url{http://esdac.jrc.ec.europa.eu/projects/degradation-kinetics}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">54</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">55</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' FOCUS (2014) \dQuote{Generic guidance for Estimating Persistence</pre> + </td> + </tr> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' and Degradation Kinetics from Environmental Fate Studies on Pesticides in</pre> + </td> + </tr> + <tr class="never"> + <td class="num">57</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' EU Registration} Report of the FOCUS Work Group on Degradation Kinetics,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Version 1.1, 18 December 2014</pre> + </td> + </tr> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \url{http://esdac.jrc.ec.europa.eu/projects/degradation-kinetics}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">60</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">61</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Gustafson DI and Holden LR (1990) Nonlinear pesticide dissipation in soil:</pre> + </td> + </tr> + <tr class="never"> + <td class="num">62</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' A new model based on spatial variability. \emph{Environmental Science and</pre> + </td> + </tr> + <tr class="never"> + <td class="num">63</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Technology} \bold{24}, 1032-1038</pre> + </td> + </tr> + <tr class="never"> + <td class="num">64</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">65</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">66</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(function(x) FOMC.solution(x, 100, 10, 2), 0, 2, ylim = c(0, 100))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">67</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">68</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">69</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">FOMC.solution <- function(t, parent_0, alpha, beta)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">70</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">71</td> + <td class="coverage">32626<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parent = parent_0 / (t/beta + 1)^alpha</pre> + </td> + </tr> + <tr class="never"> + <td class="num">72</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">73</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">74</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Indeterminate order rate equation kinetics</pre> + </td> + </tr> + <tr class="never"> + <td class="num">75</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">76</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Function describing exponential decline from a defined starting value, with</pre> + </td> + </tr> + <tr class="never"> + <td class="num">77</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' a concentration dependent rate constant.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">78</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">79</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @family parent solutions</pre> + </td> + </tr> + <tr class="never"> + <td class="num">80</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @inherit SFO.solution</pre> + </td> + </tr> + <tr class="never"> + <td class="num">81</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param k__iore Rate constant. Note that this depends on the concentration</pre> + </td> + </tr> + <tr class="never"> + <td class="num">82</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' units used.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">83</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param N Exponent describing the nonlinearity of the rate equation</pre> + </td> + </tr> + <tr class="never"> + <td class="num">84</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @note The solution of the IORE kinetic model reduces to the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">85</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \code{\link{SFO.solution}} if N = 1. The parameters of the IORE model can</pre> + </td> + </tr> + <tr class="never"> + <td class="num">86</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' be transformed to equivalent parameters of the FOMC mode - see the NAFTA</pre> + </td> + </tr> + <tr class="never"> + <td class="num">87</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' guidance for details.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">88</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @references NAFTA Technical Working Group on Pesticides (not dated) Guidance</pre> + </td> + </tr> + <tr class="never"> + <td class="num">89</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' for Evaluating and Calculating Degradation Kinetics in Environmental Media</pre> + </td> + </tr> + <tr class="never"> + <td class="num">90</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">91</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">92</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(function(x) IORE.solution(x, 100, 0.2, 1.3), 0, 2, ylim = c(0, 100))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">93</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">94</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit.fomc <- mkinfit("FOMC", FOCUS_2006_C, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">95</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit.iore <- mkinfit("IORE", FOCUS_2006_C, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">96</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fit.iore.deS <- mkinfit("IORE", FOCUS_2006_C, solution_type = "deSolve", quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">97</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">98</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' print(data.frame(fit.fomc$par, fit.iore$par, fit.iore.deS$par,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">99</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' row.names = paste("model par", 1:4)))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">100</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' print(rbind(fomc = endpoints(fit.fomc)$distimes, iore = endpoints(fit.iore)$distimes,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">101</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' iore.deS = endpoints(fit.iore)$distimes))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">102</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">103</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">104</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">105</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">IORE.solution <- function(t, parent_0, k__iore, N)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">106</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">107</td> + <td class="coverage">42328<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parent = (parent_0^(1 - N) - (1 - N) * k__iore * t)^(1/(1 - N))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">108</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">109</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">110</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Double First-Order in Parallel kinetics</pre> + </td> + </tr> + <tr class="never"> + <td class="num">111</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">112</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Function describing decline from a defined starting value using the sum of</pre> + </td> + </tr> + <tr class="never"> + <td class="num">113</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' two exponential decline functions.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">114</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">115</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @family parent solutions</pre> + </td> + </tr> + <tr class="never"> + <td class="num">116</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @inherit SFO.solution</pre> + </td> + </tr> + <tr class="never"> + <td class="num">117</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param t Time.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">118</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param k1 First kinetic constant.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">119</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param k2 Second kinetic constant.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">120</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param g Fraction of the starting value declining according to the first</pre> + </td> + </tr> + <tr class="never"> + <td class="num">121</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' kinetic constant.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">122</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">123</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">124</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(function(x) DFOP.solution(x, 100, 5, 0.5, 0.3), 0, 4, ylim = c(0,100))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">125</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">126</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">127</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">DFOP.solution <- function(t, parent_0, k1, k2, g)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">128</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">129</td> + <td class="coverage">1904176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parent = g * parent_0 * exp(-k1 * t) +</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">130</td> + <td class="coverage">1904176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> (1 - g) * parent_0 * exp(-k2 * t)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">131</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">132</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">133</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Hockey-Stick kinetics</pre> + </td> + </tr> + <tr class="never"> + <td class="num">134</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">135</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Function describing two exponential decline functions with a break point</pre> + </td> + </tr> + <tr class="never"> + <td class="num">136</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' between them.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">137</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">138</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @family parent solutions</pre> + </td> + </tr> + <tr class="never"> + <td class="num">139</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @inherit DFOP.solution</pre> + </td> + </tr> + <tr class="never"> + <td class="num">140</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param tb Break point. Before this time, exponential decline according to</pre> + </td> + </tr> + <tr class="never"> + <td class="num">141</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \code{k1} is calculated, after this time, exponential decline proceeds</pre> + </td> + </tr> + <tr class="never"> + <td class="num">142</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' according to \code{k2}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">143</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">144</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">145</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(function(x) HS.solution(x, 100, 2, 0.3, 0.5), 0, 2, ylim=c(0,100))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">146</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">147</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">148</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">HS.solution <- function(t, parent_0, k1, k2, tb)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">149</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">150</td> + <td class="coverage">22552<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parent = ifelse(t <= tb,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">151</td> + <td class="coverage">22552<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parent_0 * exp(-k1 * t),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">152</td> + <td class="coverage">22552<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parent_0 * exp(-k1 * tb) * exp(-k2 * (t - tb)))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">153</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">154</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">155</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Single First-Order Reversible Binding kinetics</pre> + </td> + </tr> + <tr class="never"> + <td class="num">156</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">157</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Function describing the solution of the differential equations describing</pre> + </td> + </tr> + <tr class="never"> + <td class="num">158</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the kinetic model with first-order terms for a two-way transfer from a free</pre> + </td> + </tr> + <tr class="never"> + <td class="num">159</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' to a bound fraction, and a first-order degradation term for the free</pre> + </td> + </tr> + <tr class="never"> + <td class="num">160</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fraction. The initial condition is a defined amount in the free fraction</pre> + </td> + </tr> + <tr class="never"> + <td class="num">161</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' and no substance in the bound fraction.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">162</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">163</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @family parent solutions</pre> + </td> + </tr> + <tr class="never"> + <td class="num">164</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @inherit SFO.solution</pre> + </td> + </tr> + <tr class="never"> + <td class="num">165</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param k_12 Kinetic constant describing transfer from free to bound.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">166</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param k_21 Kinetic constant describing transfer from bound to free.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">167</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param k_1output Kinetic constant describing degradation of the free</pre> + </td> + </tr> + <tr class="never"> + <td class="num">168</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' fraction.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">169</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return The value of the response variable, which is the sum of free and</pre> + </td> + </tr> + <tr class="never"> + <td class="num">170</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' bound fractions at time \code{t}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">171</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">172</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">173</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{plot(function(x) SFORB.solution(x, 100, 0.5, 2, 3), 0, 2)}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">174</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">175</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">176</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">SFORB.solution = function(t, parent_0, k_12, k_21, k_1output) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">177</td> + <td class="coverage">9240<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> sqrt_exp = sqrt(1/4 * (k_12 + k_21 + k_1output)^2 - k_1output * k_21)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">178</td> + <td class="coverage">9240<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> b1 = 0.5 * (k_12 + k_21 + k_1output) + sqrt_exp</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">179</td> + <td class="coverage">9240<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> b2 = 0.5 * (k_12 + k_21 + k_1output) - sqrt_exp</pre> + </td> + </tr> + <tr class="never"> + <td class="num">180</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">181</td> + <td class="coverage">9240<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parent = parent_0 *</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">182</td> + <td class="coverage">9240<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> (((k_12 + k_21 - b1)/(b2 - b1)) * exp(-b1 * t) +</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">183</td> + <td class="coverage">9240<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ((k_12 + k_21 - b2)/(b1 - b2)) * exp(-b2 * t))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">184</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + <tr class="never"> + <td class="num">185</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="never"> + <td class="num">186</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Logistic kinetics</pre> + </td> + </tr> + <tr class="never"> + <td class="num">187</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">188</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Function describing exponential decline from a defined starting value, with</pre> + </td> + </tr> + <tr class="never"> + <td class="num">189</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' an increasing rate constant, supposedly caused by microbial growth</pre> + </td> + </tr> + <tr class="never"> + <td class="num">190</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">191</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @family parent solutions</pre> + </td> + </tr> + <tr class="never"> + <td class="num">192</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @inherit SFO.solution</pre> + </td> + </tr> + <tr class="never"> + <td class="num">193</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param kmax Maximum rate constant.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">194</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param k0 Minimum rate constant effective at time zero.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">195</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param r Growth rate of the increase in the rate constant.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">196</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @note The solution of the logistic model reduces to the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">197</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \code{\link{SFO.solution}} if \code{k0} is equal to \code{kmax}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">198</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">199</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">200</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Reproduce the plot on page 57 of FOCUS (2014)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">201</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(function(x) logistic.solution(x, 100, 0.08, 0.0001, 0.2),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">202</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' from = 0, to = 100, ylim = c(0, 100),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">203</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' xlab = "Time", ylab = "Residue")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">204</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(function(x) logistic.solution(x, 100, 0.08, 0.0001, 0.4),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">205</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' from = 0, to = 100, add = TRUE, lty = 2, col = 2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">206</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(function(x) logistic.solution(x, 100, 0.08, 0.0001, 0.8),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">207</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' from = 0, to = 100, add = TRUE, lty = 3, col = 3)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">208</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(function(x) logistic.solution(x, 100, 0.08, 0.001, 0.2),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">209</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' from = 0, to = 100, add = TRUE, lty = 4, col = 4)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">210</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot(function(x) logistic.solution(x, 100, 0.08, 0.08, 0.2),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">211</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' from = 0, to = 100, add = TRUE, lty = 5, col = 5)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">212</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' legend("topright", inset = 0.05,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">213</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' legend = paste0("k0 = ", c(0.0001, 0.0001, 0.0001, 0.001, 0.08),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">214</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' ", r = ", c(0.2, 0.4, 0.8, 0.2, 0.2)),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">215</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' lty = 1:5, col = 1:5)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">216</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">217</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' # Fit with synthetic data</pre> + </td> + </tr> + <tr class="never"> + <td class="num">218</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' logistic <- mkinmod(parent = mkinsub("logistic"))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">219</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">220</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' sampling_times = c(0, 1, 3, 7, 14, 28, 60, 90, 120)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">221</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parms_logistic <- c(kmax = 0.08, k0 = 0.0001, r = 0.2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">222</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' d_logistic <- mkinpredict(logistic,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">223</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parms_logistic, c(parent = 100),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">224</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' sampling_times)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">225</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' d_2_1 <- add_err(d_logistic,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">226</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' sdfunc = function(x) sigma_twocomp(x, 0.5, 0.07),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">227</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' n = 1, reps = 2, digits = 5, LOD = 0.1, seed = 123456)[[1]]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">228</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">229</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' m <- mkinfit("logistic", d_2_1, quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">230</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot_sep(m)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">231</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' summary(m)$bpar</pre> + </td> + </tr> + <tr class="never"> + <td class="num">232</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' endpoints(m)$distimes</pre> + </td> + </tr> + <tr class="never"> + <td class="num">233</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">234</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">235</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">logistic.solution <- function(t, parent_0, kmax, k0, r)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">236</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">237</td> + <td class="coverage">56304<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> parent = parent_0 * (kmax / (kmax - k0 + k0 * exp (r * t))) ^(kmax/r)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">238</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/llhist.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Plot the distribution of log likelihoods from multistart objects</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Produces a histogram of log-likelihoods. In addition, the likelihood of the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' original fit is shown as a red vertical line.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param object The [multistart] object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param breaks Passed to [hist]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param lpos Positioning of the legend.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param main Title of the plot</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots Passed to [hist]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @seealso [multistart]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">llhist <- function(object, breaks = "Sturges", lpos = "topleft", main = "",</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">16</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> oldpar <- par(no.readonly = TRUE)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">17</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> on.exit(par(oldpar, no.readonly = TRUE))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">19</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> if (inherits(object, "multistart.saem.mmkin")) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">20</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> llfunc <- function(object) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">21</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> if (inherits(object$so, "try-error")) return(NA)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">22</td> + <td class="coverage">1408<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> else return(logLik(object$so))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">25</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> stop("llhist is only implemented for multistart.saem.mmkin objects")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">28</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ll_orig <- logLik(attr(object, "orig"))</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">29</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ll <- stats::na.omit(sapply(object, llfunc))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">31</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> par(las = 1)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">32</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> h <- hist(ll, freq = TRUE,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">33</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> xlab = "", main = main,</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">34</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> ylab = "Frequency of log likelihoods", breaks = breaks, ...)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">36</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> freq_factor <- h$counts[1] / h$density[1]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">38</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> abline(v = ll_orig, col = 2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">40</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> legend(lpos, inset = c(0.05, 0.05), bty = "n",</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">41</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> lty = 1, col = c(2),</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">42</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> legend = "original fit")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/logLik.mkinfit.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Calculated the log-likelihood of a fitted mkinfit object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' This function returns the product of the likelihood densities of each</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' observed value, as calculated as part of the fitting procedure using</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \code{\link{dnorm}}, i.e. assuming normal distribution, and with the means</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' predicted by the degradation model, and the standard deviations predicted by</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the error model.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' The total number of estimated parameters returned with the value of the</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' likelihood is calculated as the sum of fitted degradation model parameters</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' and the fitted error model parameters.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param object An object of class \code{\link{mkinfit}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots For compatibility with the generic method</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return An object of class \code{\link{logLik}} with the number of estimated</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parameters (degradation model parameters plus variance model parameters)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' as attribute.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @author Johannes Ranke</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @seealso Compare the AIC of columns of \code{\link{mmkin}} objects using</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \code{\link{AIC.mmkin}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \dontrun{</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' sfo_sfo <- mkinmod(</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' parent = mkinsub("SFO", to = "m1"),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' m1 = mkinsub("SFO")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' )</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' d_t <- subset(FOCUS_2006_D, value != 0)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_nw <- mkinfit(sfo_sfo, d_t, quiet = TRUE) # no weighting (weights are unity)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_obs <- update(f_nw, error_model = "obs")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_tc <- update(f_nw, error_model = "tc")</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' AIC(f_nw, f_obs, f_tc)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">logLik.mkinfit <- function(object, ...) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">37</td> + <td class="coverage">166798<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> val <- object$logLik</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r"> # Number of estimated parameters</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">39</td> + <td class="coverage">166798<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> attr(val, "df") <- length(object$bparms.optim) + length(object$errparms)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">40</td> + <td class="coverage">166798<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> attr(val, "nobs") <- nobs(object)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">41</td> + <td class="coverage">166798<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> class(val) <- "logLik"</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">42</td> + <td class="coverage">166798<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(val)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/nobs.mkinfit.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Number of observations on which an mkinfit object was fitted</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @importFrom stats nobs</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param object An mkinfit object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param \dots For compatibility with the generic method</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return The number of rows in the data included in the mkinfit object</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">8</td> + <td class="coverage">166810<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r">nobs.mkinfit <- function(object, ...) nrow(object$data)</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/sigma_twocomp.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Two-component error model</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Function describing the standard deviation of the measurement error in</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' dependence of the measured value \eqn{y}:</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \deqn{\sigma = \sqrt{ \sigma_{low}^2 + y^2 * {rsd}_{high}^2}} sigma =</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' sqrt(sigma_low^2 + y^2 * rsd_high^2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' This is the error model used for example by Werner et al. (1978). The model</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' proposed by Rocke and Lorenzato (1995) can be written in this form as well,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' but assumes approximate lognormal distribution of errors for high values of</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' y.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param y The magnitude of the observed value</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param sigma_low The asymptotic minimum of the standard deviation for low</pre> + </td> + </tr> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' observed values</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param rsd_high The coefficient describing the increase of the standard</pre> + </td> + </tr> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' deviation with the magnitude of the observed value</pre> + </td> + </tr> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return The standard deviation of the response variable.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @references Werner, Mario, Brooks, Samuel H., and Knott, Lancaster B. (1978)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Additive, Multiplicative, and Mixed Analytical Errors. Clinical Chemistry</pre> + </td> + </tr> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' 24(11), 1895-1898.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Rocke, David M. and Lorenzato, Stefan (1995) A two-component model for</pre> + </td> + </tr> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' measurement error in analytical chemistry. Technometrics 37(2), 176-184.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Ranke J and Meinecke S (2019) Error Models for the Kinetic Evaluation of Chemical</pre> + </td> + </tr> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' Degradation Data. *Environments* 6(12) 124</pre> + </td> + </tr> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' \doi{10.3390/environments6120124}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#'</pre> + </td> + </tr> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @examples</pre> + </td> + </tr> + <tr class="never"> + <td class="num">32</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' times <- c(0, 1, 3, 7, 14, 28, 60, 90, 120)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' d_pred <- data.frame(time = times, parent = 100 * exp(- 0.03 * times))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' set.seed(123456)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' d_syn <- add_err(d_pred, function(y) sigma_twocomp(y, 1, 0.07),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' reps = 2, n = 1)[[1]]</pre> + </td> + </tr> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_nls <- nls(value ~ SSasymp(time, 0, parent_0, lrc), data = d_syn,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">38</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' start = list(parent_0 = 100, lrc = -3))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' library(nlme)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">40</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_gnls <- gnls(value ~ SSasymp(time, 0, parent_0, lrc),</pre> + </td> + </tr> + <tr class="never"> + <td class="num">41</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' data = d_syn, na.action = na.omit,</pre> + </td> + </tr> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' start = list(parent_0 = 100, lrc = -3))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' if (length(findFunction("varConstProp")) > 0) {</pre> + </td> + </tr> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_gnls_tc <- update(f_gnls, weights = varConstProp())</pre> + </td> + </tr> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_gnls_tc_sf <- update(f_gnls_tc, control = list(sigma = 1))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' }</pre> + </td> + </tr> + <tr class="never"> + <td class="num">47</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_mkin <- mkinfit("SFO", d_syn, error_model = "const", quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">48</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' f_mkin_tc <- mkinfit("SFO", d_syn, error_model = "tc", quiet = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' plot_res(f_mkin_tc, standardized = TRUE)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' AIC(f_nls, f_gnls, f_gnls_tc, f_gnls_tc_sf, f_mkin, f_mkin_tc)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">sigma_twocomp <- function(y, sigma_low, rsd_high) {</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">53</td> + <td class="coverage">4250<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> sqrt(sigma_low^2 + y^2 * rsd_high^2)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">54</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <div id="R/mkinsub.R" class="hidden"> + <table class="table-condensed"> + <tbody> + <tr class="never"> + <td class="num">1</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @rdname mkinmod</pre> + </td> + </tr> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param submodel Character vector of length one to specify the submodel type.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' See \code{\link{mkinmod}} for the list of allowed submodel names.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param to Vector of the names of the state variable to which a</pre> + </td> + </tr> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' transformation shall be included in the model.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param sink Should a pathway to sink be included in the model in addition to</pre> + </td> + </tr> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' the pathways to other state variables?</pre> + </td> + </tr> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @param full_name An optional name to be used e.g. for plotting fits</pre> + </td> + </tr> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' performed with the model. You can use non-ASCII characters here, but then</pre> + </td> + </tr> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' your R code will not be portable, \emph{i.e.} may produce unintended plot</pre> + </td> + </tr> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' results on other operating systems or system configurations.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @return A list for use with \code{\link{mkinmod}}.</pre> + </td> + </tr> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">#' @export</pre> + </td> + </tr> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">mkinsub <- function(submodel, to = NULL, sink = TRUE, full_name = NA)</pre> + </td> + </tr> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">{</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">16</td> + <td class="coverage">9864<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> return(list(type = submodel, to = to, sink = sink, full_name = full_name))</pre> + </td> + </tr> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> + <td class="col-sm-12"> + <pre class="language-r">}</pre> + </td> + </tr> + </tbody> + </table> + </div> + <script>$('div#files pre').each(function(i, block) { + hljs.highlightBlock(block); +});</script> + </div> + </div> + </div> + </div> + </div> +</div> +</body> +</html> |