diff options
Diffstat (limited to 'docs/coverage')
| -rw-r--r-- | docs/coverage/coverage.html | 37381 |
1 files changed, 18722 insertions, 18659 deletions
diff --git a/docs/coverage/coverage.html b/docs/coverage/coverage.html index 749ccdd0..a910a2d3 100644 --- a/docs/coverage/coverage.html +++ b/docs/coverage/coverage.html @@ -95,7 +95,7 @@ table.table-condensed { font-size: 11px; }</style> <div class="col-md-8 col-md-offset-2"> - <h2>mkin coverage - 89.32%</h2> + <h2>mkin coverage - 89.31%</h2> <div class="tabbable"> <ul class="nav nav-tabs" data-tabsetid="covr"> <li class="active"> @@ -107,8 +107,8 @@ table.table-condensed { </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 class="datatables html-widget html-fill-item" id="htmlwidget-ed9e8c4b083619214ff3" style="width:100%;height:500px;"></div> + <script type="application/json" data-for="htmlwidget-ed9e8c4b083619214ff3">{"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/parplot.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/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/mkinsub.R<\/a>","<a href=\"#\">R/sigma_twocomp.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,989,129,255,102,89,164,75,145,103,107,267,199,238,159,120,95,56,68,238,31,104,29,43,8,17,54],[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,453,69,159,53,18,56,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,426,65,150,50,17,53,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,4,9,3,1,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","291933","154","29490","3125","529091","18","104","1217374","149","206","3258","1963","773","4031","72485","337","1","247","426770","1607","1285","535","166798","166810","9864","4250"],["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.04%","94.20%","94.34%","94.34%","94.44%","94.64%","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"> @@ -6187,14 +6187,14 @@ table.table-condensed { </tbody> </table> </div> - <div id="R/status.R" class="hidden"> + <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">#' Method to get status information for fit array objects</pre> + <pre class="language-r">#' Summary method for class "nlme.mmkin"</pre> </td> </tr> <tr class="never"> @@ -6208,2190 +6208,1365 @@ table.table-condensed { <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> + <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">#' @param x The object to be printed</pre> + <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">#' @param \dots For potential future extensions</pre> + <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">#' @return An object with the same dimensions as the fit array</pre> + <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">#' suitable printing method.</pre> + <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">#' @export</pre> + <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">status <- function(object, ...)</pre> + <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">{</pre> + <pre class="language-r">#' @param x an object of class [summary.nlme.mmkin]</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">11</td> - <td class="coverage">589<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> UseMethod("status", object)</pre> + <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">}</pre> + <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"></pre> + <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">#' @rdname status</pre> + <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">#' @export</pre> + <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">#' @examples</pre> + <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">#' \dontrun{</pre> + <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">#' fits <- mmkin(</pre> + <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">#' c("SFO", "FOMC"),</pre> + <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">#' list("FOCUS A" = FOCUS_2006_A,</pre> + <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">#' "FOCUS B" = FOCUS_2006_C),</pre> + <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">#' quiet = TRUE)</pre> + <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">#' status(fits)</pre> + <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">#' }</pre> + <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">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> + <pre class="language-r">#' \item{diffs}{The differential equations used in the degradation model}</pre> </td> </tr> <tr class="never"> - <td class="num">92</td> + <td class="num">26</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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">93</td> + <td class="num">27</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> + <pre class="language-r">#' \item{data}{The data}</pre> </td> </tr> <tr class="never"> - <td class="num">95</td> + <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">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> + <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">100</td> + <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">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> + <pre class="language-r">#' \item{confint_back}{Backtransformed parameters, with confidence intervals if available}</pre> </td> </tr> <tr class="never"> - <td class="num">103</td> + <td class="num">30</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">}</pre> + <pre class="language-r">#' \item{ff}{The estimated formation fractions derived from the fitted</pre> </td> </tr> <tr class="never"> - <td class="num">104</td> + <td class="num">31</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' model.}</pre> </td> </tr> <tr class="never"> - <td class="num">105</td> + <td class="num">32</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @rdname status</pre> + <pre class="language-r">#' \item{distimes}{The DT50 and DT90 values for each observed variable.}</pre> </td> </tr> <tr class="never"> - <td class="num">106</td> + <td class="num">33</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <pre class="language-r">#' \item{SFORB}{If applicable, eigenvalues of SFORB components of the model.}</pre> </td> </tr> <tr class="never"> - <td class="num">107</td> + <td class="num">34</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> + <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">116</td> + <td class="num">35</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">}</pre> + <pre class="language-r">#' @importFrom stats predict</pre> </td> </tr> <tr class="never"> - <td class="num">117</td> + <td class="num">36</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' @author Johannes Ranke for the mkin specific parts</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="num">37</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> + <pre class="language-r">#' José Pinheiro and Douglas Bates for the components inherited from nlme</pre> </td> </tr> <tr class="never"> - <td class="num">2</td> + <td class="num">38</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' with mkinfit</pre> + <pre class="language-r">#' @examples</pre> </td> </tr> <tr class="never"> - <td class="num">3</td> + <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">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="num">40</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> + <pre class="language-r">#' # Generate five datasets following SFO kinetics</pre> </td> </tr> <tr class="never"> - <td class="num">6</td> + <td class="num">41</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> + <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">7</td> + <td class="num">42</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> + <pre class="language-r">#' dt50_sfo_in_pop <- 50</pre> </td> </tr> <tr class="never"> - <td class="num">8</td> + <td class="num">43</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> + <pre class="language-r">#' k_in_pop <- log(2) / dt50_sfo_in_pop</pre> </td> </tr> <tr class="never"> - <td class="num">9</td> + <td class="num">44</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r">#' set.seed(1234)</pre> </td> </tr> <tr class="never"> - <td class="num">10</td> + <td class="num">45</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> + <pre class="language-r">#' k_in <- rlnorm(5, log(k_in_pop), 0.5)</pre> </td> </tr> <tr class="never"> - <td class="num">11</td> + <td class="num">46</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> + <pre class="language-r">#' SFO <- mkinmod(parent = mkinsub("SFO"))</pre> </td> </tr> <tr class="never"> - <td class="num">12</td> + <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">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="num">48</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> + <pre class="language-r">#' pred_sfo <- function(k) {</pre> </td> </tr> <tr class="never"> - <td class="num">16</td> + <td class="num">49</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' that contain parameter values for that model.</pre> + <pre class="language-r">#' mkinpredict(SFO,</pre> </td> </tr> <tr class="never"> - <td class="num">17</td> + <td class="num">50</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> + <pre class="language-r">#' c(k_parent = k),</pre> </td> </tr> <tr class="never"> - <td class="num">18</td> + <td class="num">51</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> + <pre class="language-r">#' c(parent = 100),</pre> </td> </tr> <tr class="never"> - <td class="num">19</td> + <td class="num">52</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> + <pre class="language-r">#' sampling_times)</pre> </td> </tr> <tr class="never"> - <td class="num">20</td> + <td class="num">53</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> + <pre class="language-r">#' }</pre> </td> </tr> <tr class="never"> - <td class="num">21</td> + <td class="num">54</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' for the median of the covariate values (50th percentile).</pre> + <pre class="language-r">#'</pre> </td> </tr> <tr class="never"> - <td class="num">22</td> + <td class="num">55</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @importFrom stats optimize</pre> + <pre class="language-r">#' ds_sfo_mean <- lapply(k_in, pred_sfo)</pre> </td> </tr> <tr class="never"> - <td class="num">23</td> + <td class="num">56</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> + <pre class="language-r">#' names(ds_sfo_mean) <- paste("ds", 1:5)</pre> </td> </tr> <tr class="never"> - <td class="num">24</td> + <td class="num">57</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> + <pre class="language-r">#'</pre> </td> </tr> <tr class="never"> - <td class="num">25</td> + <td class="num">58</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> + <pre class="language-r">#' set.seed(12345)</pre> </td> </tr> <tr class="never"> - <td class="num">26</td> + <td class="num">59</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' DFOP rate constants</pre> + <pre class="language-r">#' ds_sfo_syn <- lapply(ds_sfo_mean, function(ds) {</pre> </td> </tr> <tr class="never"> - <td class="num">27</td> + <td class="num">60</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @note The function is used internally by [summary.mkinfit],</pre> + <pre class="language-r">#' add_err(ds,</pre> </td> </tr> <tr class="never"> - <td class="num">28</td> + <td class="num">61</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' [summary.nlme.mmkin] and [summary.saem.mmkin].</pre> + <pre class="language-r">#' sdfunc = function(value) sqrt(1^2 + value^2 * 0.07^2),</pre> </td> </tr> <tr class="never"> - <td class="num">29</td> + <td class="num">62</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @author Johannes Ranke</pre> + <pre class="language-r">#' n = 1)[[1]]</pre> </td> </tr> <tr class="never"> - <td class="num">30</td> + <td class="num">63</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @examples</pre> + <pre class="language-r">#' })</pre> </td> </tr> <tr class="never"> - <td class="num">31</td> + <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">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="num">65</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' endpoints(fit)</pre> + <pre class="language-r">#' \dontrun{</pre> </td> </tr> <tr class="never"> - <td class="num">34</td> + <td class="num">66</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' \dontrun{</pre> + <pre class="language-r">#' # Evaluate using mmkin and nlme</pre> </td> </tr> <tr class="never"> - <td class="num">35</td> + <td class="num">67</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' fit_2 <- mkinfit("DFOP", FOCUS_2006_C, quiet = TRUE)</pre> + <pre class="language-r">#' library(nlme)</pre> </td> </tr> <tr class="never"> - <td class="num">36</td> + <td class="num">68</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' endpoints(fit_2)</pre> + <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">37</td> + <td class="num">69</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' fit_3 <- mkinfit("SFORB", FOCUS_2006_C, quiet = TRUE)</pre> + <pre class="language-r">#' f_nlme <- nlme(f_mmkin)</pre> </td> </tr> <tr class="never"> - <td class="num">38</td> + <td class="num">70</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' endpoints(fit_3)</pre> + <pre class="language-r">#' summary(f_nlme, data = TRUE)</pre> </td> </tr> <tr class="never"> - <td class="num">39</td> + <td class="num">71</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' }</pre> + <pre class="language-r">#' }</pre> </td> </tr> <tr class="never"> - <td class="num">40</td> + <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">41</td> + <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">42</td> + <td class="num">74</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> + <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">45</td> + <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">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="num">76</td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> mod_vars <- names(object$mkinmod$diffs)</pre> </td> </tr> <tr class="never"> - <td class="num">69</td> + <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">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="num">78</td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> DT50 = rep(NA, length(obs_vars)),</pre> + <pre class="language-r"> confint_trans <- intervals(object, which = "fixed", level = 1 - alpha)$fixed</pre> </td> </tr> <tr class="covered"> - <td class="num">77</td> - <td class="coverage">56208<em>x</em></td> + <td class="num">79</td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> DT90 = rep(NA, length(obs_vars)),</pre> + <pre class="language-r"> attr(confint_trans, "label") <- NULL</pre> </td> </tr> <tr class="covered"> - <td class="num">78</td> - <td class="coverage">56208<em>x</em></td> + <td class="num">80</td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> row.names = obs_vars)</pre> + <pre class="language-r"> pnames <- rownames(confint_trans)</pre> </td> </tr> <tr class="never"> - <td class="num">79</td> + <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">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="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> bp <- backtransform_odeparms(confint_trans[, "est."], object$mkinmod,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">83</td> - <td class="coverage"></td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Get formation fractions if directly fitted, and calculate remaining fraction to sink</pre> + <pre class="language-r"> object$transform_rates, object$transform_fractions)</pre> </td> </tr> <tr class="covered"> <td class="num">84</td> - <td class="coverage">73858<em>x</em></td> + <td class="coverage">319<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> + <pre class="language-r"> bpnames <- names(bp)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">85</td> - <td class="coverage">73858<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (length(f_names) > 0) {</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">86</td> - <td class="coverage">15068<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> f_values = degparms[f_names]</pre> + <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">15068<em>x</em></td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> f_to_sink = 1 - sum(f_values)</pre> + <pre class="language-r"> fixed <- fixef(object)</pre> </td> </tr> <tr class="covered"> <td class="num">88</td> - <td class="coverage">15068<em>x</em></td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> names(f_to_sink) = ifelse(type == "SFORB",</pre> + <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">15068<em>x</em></td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> paste(obs_var, "free", "sink", sep = "_"),</pre> + <pre class="language-r"> object$corFixed <- array(</pre> </td> </tr> <tr class="covered"> <td class="num">90</td> - <td class="coverage">15068<em>x</em></td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> paste(obs_var, "sink", sep = "_"))</pre> + <pre class="language-r"> t(object$varFix/stdFixed)/stdFixed,</pre> </td> </tr> <tr class="covered"> <td class="num">91</td> - <td class="coverage">15068<em>x</em></td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> for (f_name in f_names) {</pre> + <pre class="language-r"> dim(object$varFix),</pre> </td> </tr> <tr class="covered"> <td class="num">92</td> - <td class="coverage">17338<em>x</em></td> + <td class="coverage">319<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> + <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> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">94</td> - <td class="coverage">15068<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> ep$ff = append(ep$ff, f_to_sink)</pre> + <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"> }</pre> + <pre class="language-r"> # with the exception of sets of formation fractions (single fractions are OK).</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">96</td> - <td class="coverage"></td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> f_names_skip <- character(0)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">97</td> - <td class="coverage"></td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Get the rest</pre> + <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">73858<em>x</em></td> + <td class="coverage">436<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (type == "SFO") {</pre> + <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">40900<em>x</em></td> + <td class="coverage">436<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> + <pre class="language-r"> n_paths <- length(f_names)</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">100</td> - <td class="coverage">40900<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> k_tot = sum(degparms[k_names])</pre> + <pre class="language-r"> if (n_paths > 1) f_names_skip <- c(f_names_skip, f_names)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">101</td> - <td class="coverage">40900<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> DT50 = log(2)/k_tot</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">102</td> - <td class="coverage">40900<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> DT90 = log(10)/k_tot</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">103</td> - <td class="coverage">40900<em>x</em></td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (mkinmod$use_of_ff == "min" && length(obs_vars) > 1) {</pre> + <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">622<em>x</em></td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> for (k_name in k_names)</pre> + <pre class="language-r"> dimnames = list(bpnames, colnames(confint_trans)))</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">105</td> - <td class="coverage"></td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> {</pre> + <pre class="language-r"> confint_back[, "est."] <- bp</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">106</td> - <td class="coverage">932<em>x</em></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> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">107</td> - <td class="coverage"></td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> for (pname in pnames) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">108</td> - <td class="coverage"></td> + <td class="coverage">1410<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> if (!pname %in% f_names_skip) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">109</td> - <td class="coverage"></td> + <td class="coverage">1410<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> par.lower <- confint_trans[pname, "lower"]</pre> </td> </tr> <tr class="covered"> <td class="num">110</td> - <td class="coverage">73858<em>x</em></td> + <td class="coverage">1410<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (type == "FOMC") {</pre> + <pre class="language-r"> par.upper <- confint_trans[pname, "upper"]</pre> </td> </tr> <tr class="covered"> <td class="num">111</td> - <td class="coverage">1790<em>x</em></td> + <td class="coverage">1410<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> alpha = degparms["alpha"]</pre> + <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">1790<em>x</em></td> + <td class="coverage">1410<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> beta = degparms["beta"]</pre> + <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">1790<em>x</em></td> + <td class="coverage">1410<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> DT50 = beta * (2^(1/alpha) - 1)</pre> + <pre class="language-r"> object$transform_rates,</pre> </td> </tr> <tr class="covered"> <td class="num">114</td> - <td class="coverage">1790<em>x</em></td> + <td class="coverage">1410<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> DT90 = beta * (10^(1/alpha) - 1)</pre> + <pre class="language-r"> object$transform_fractions)</pre> </td> </tr> <tr class="covered"> <td class="num">115</td> - <td class="coverage">1790<em>x</em></td> + <td class="coverage">1410<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> + <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">1790<em>x</em></td> + <td class="coverage">1410<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ep$distimes[obs_var, c("DT50back")] = DT50_back</pre> + <pre class="language-r"> object$transform_rates,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">117</td> - <td class="coverage"></td> + <td class="coverage">1410<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> object$transform_fractions)</pre> </td> </tr> <tr class="covered"> <td class="num">118</td> - <td class="coverage">73858<em>x</em></td> + <td class="coverage">1410<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (type == "IORE") {</pre> + <pre class="language-r"> confint_back[names(bpl), "lower"] <- bpl</pre> </td> </tr> <tr class="covered"> <td class="num">119</td> - <td class="coverage">352<em>x</em></td> + <td class="coverage">1410<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> + <pre class="language-r"> confint_back[names(bpu), "upper"] <- bpu</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">120</td> - <td class="coverage">352<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> k_tot = sum(degparms[k_names])</pre> + <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"> # From the NAFTA kinetics guidance, p. 5</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">122</td> - <td class="coverage">352<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> n = degparms[paste("N", obs_var, sep = "_")]</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">123</td> - <td class="coverage">352<em>x</em></td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> k = k_tot</pre> + <pre class="language-r"> object$confint_trans <- confint_trans</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">124</td> - <td class="coverage"></td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Use the initial concentration of the parent compound</pre> + <pre class="language-r"> object$confint_back <- confint_back</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">125</td> - <td class="coverage">352<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> source_name = mkinmod$map[[1]][[1]]</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">126</td> - <td class="coverage">352<em>x</em></td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> c0 = degparms[paste(source_name, "0", sep = "_")]</pre> + <pre class="language-r"> object$date.summary = date()</pre> </td> </tr> <tr class="covered"> <td class="num">127</td> - <td class="coverage">352<em>x</em></td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> alpha = 1 / (n - 1)</pre> + <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">352<em>x</em></td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> beta = (c0^(1 - n))/(k * (n - 1))</pre> + <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">352<em>x</em></td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> DT50 = beta * (2^(1/alpha) - 1)</pre> + <pre class="language-r"> err_mod = object$mmkin[[1]]$err_mod</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">130</td> - <td class="coverage">352<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> DT90 = beta * (10^(1/alpha) - 1)</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">131</td> - <td class="coverage">352<em>x</em></td> + <td class="coverage">319<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> + <pre class="language-r"> object$diffs <- object$mkinmod$diffs</pre> </td> </tr> <tr class="covered"> <td class="num">132</td> - <td class="coverage">352<em>x</em></td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ep$distimes[obs_var, c("DT50back")] = DT50_back</pre> + <pre class="language-r"> object$print_data <- data</pre> </td> </tr> <tr class="covered"> <td class="num">133</td> - <td class="coverage">352<em>x</em></td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (mkinmod$use_of_ff == "min") {</pre> + <pre class="language-r"> object$data[["observed"]] <- object$data[["value"]]</pre> </td> </tr> - <tr class="missed"> + <tr class="covered"> <td class="num">134</td> - <td class="coverage">!</td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> for (k_name in k_names)</pre> + <pre class="language-r"> object$data[["value"]] <- NULL</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">135</td> - <td class="coverage"></td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> {</pre> + <pre class="language-r"> object$data[["predicted"]] <- predict(object)</pre> </td> </tr> - <tr class="missed"> + <tr class="covered"> <td class="num">136</td> - <td class="coverage">!</td> + <td class="coverage">319<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> + <pre class="language-r"> object$data[["residual"]] <- residuals(object, type = "response")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">137</td> - <td class="coverage"></td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> if (is.null(object$modelStruct$varStruct)) {</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">138</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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"> }</pre> + <pre class="language-r"> } else {</pre> </td> </tr> <tr class="covered"> <td class="num">140</td> - <td class="coverage">73858<em>x</em></td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (type == "DFOP") {</pre> + <pre class="language-r"> object$data[["std"]] <- 1/attr(object$modelStruct$varStruct, "weights")</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">141</td> - <td class="coverage">27729<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> k1 = degparms["k1"]</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="covered"> <td class="num">142</td> - <td class="coverage">27729<em>x</em></td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> k2 = degparms["k2"]</pre> + <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">27729<em>x</em></td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> g = degparms["g"]</pre> + <pre class="language-r"> object$verbose <- verbose</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">144</td> - <td class="coverage">27729<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> f <- function(log_t, x) {</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">145</td> - <td class="coverage">684705<em>x</em></td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> t <- exp(log_t)</pre> + <pre class="language-r"> object$fixed <- object$mmkin[[1]]$fixed</pre> </td> </tr> <tr class="covered"> <td class="num">146</td> - <td class="coverage">684705<em>x</em></td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fraction <- g * exp( - k1 * t) + (1 - g) * exp( - k2 * t)</pre> + <pre class="language-r"> object$AIC = AIC(object)</pre> </td> </tr> <tr class="covered"> <td class="num">147</td> - <td class="coverage">684705<em>x</em></td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> (fraction - (1 - x/100))^2</pre> + <pre class="language-r"> object$BIC = BIC(object)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">148</td> - <td class="coverage"></td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> object$logLik = logLik(object)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">149</td> - <td class="coverage">27729<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> DT50_k1 = log(2)/k1</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">150</td> - <td class="coverage">27729<em>x</em></td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> DT50_k2 = log(2)/k2</pre> + <pre class="language-r"> ep <- endpoints(object)</pre> </td> </tr> <tr class="covered"> <td class="num">151</td> - <td class="coverage">27729<em>x</em></td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> DT90_k1 = log(10)/k1</pre> + <pre class="language-r"> if (length(ep$ff) != 0)</pre> </td> </tr> <tr class="covered"> <td class="num">152</td> - <td class="coverage">27729<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> DT90_k2 = log(10)/k2</pre> + <pre class="language-r"> object$ff <- ep$ff</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">153</td> - <td class="coverage"></td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> if (distimes) object$distimes <- ep$distimes</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">154</td> - <td class="coverage">27729<em>x</em></td> + <td class="coverage">!</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> + <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">27729<em>x</em></td> + <td class="coverage">319<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> silent = TRUE)</pre> + <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">27729<em>x</em></td> + <td class="coverage">319<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> + <pre class="language-r"> return(object)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">157</td> - <td class="coverage">27729<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> silent = TRUE)</pre> + <pre class="language-r">}</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">158</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (inherits(DT50, "try-error")) DT50 = NA</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">159</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (inherits(DT90, "try-error")) DT90 = NA</pre> + <pre class="language-r">#' @rdname summary.nlme.mmkin</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">160</td> - <td class="coverage">27729<em>x</em></td> + <td class="coverage"></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> + <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"></pre> + <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">27729<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ep$distimes[obs_var, c("DT50back")] = DT50_back</pre> + <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">27729<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ep$distimes[obs_var, c("DT50_k1")] = DT50_k1</pre> + <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">27729<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ep$distimes[obs_var, c("DT50_k2")] = DT50_k2</pre> + <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> + <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="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (type == "HS") {</pre> + <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">318<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> k1 = degparms["k1"]</pre> + <pre class="language-r"> cat("Date of summary:", x$date.summary, "\n")</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">168</td> - <td class="coverage">318<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> k2 = degparms["k2"]</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">169</td> - <td class="coverage">318<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> tb = degparms["tb"]</pre> + <pre class="language-r"> cat("\nEquations:\n")</pre> </td> </tr> <tr class="covered"> <td class="num">170</td> - <td class="coverage">318<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> DTx <- function(x) {</pre> + <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">636<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> DTx.a <- (log(100/(100 - x)))/k1</pre> + <pre class="language-r"> writeLines(strwrap(nice_diffs, exdent = 11))</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">172</td> - <td class="coverage">636<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> DTx.b <- tb + (log(100/(100 - x)) - k1 * tb)/k2</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">173</td> - <td class="coverage">339<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (DTx.a < tb) DTx <- DTx.a</pre> + <pre class="language-r"> cat("\nData:\n")</pre> </td> </tr> <tr class="covered"> <td class="num">174</td> - <td class="coverage">297<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> else DTx <- DTx.b</pre> + <pre class="language-r"> cat(nrow(x$data), "observations of",</pre> </td> </tr> <tr class="covered"> <td class="num">175</td> - <td class="coverage">636<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> return(DTx)</pre> + <pre class="language-r"> length(unique(x$data$name)), "variable(s) grouped in",</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">176</td> - <td class="coverage"></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> length(unique(x$data$ds)), "datasets\n")</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">177</td> - <td class="coverage">318<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> DT50 <- DTx(50)</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">178</td> - <td class="coverage">318<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> DT90 <- DTx(90)</pre> + <pre class="language-r"> cat("\nModel predictions using solution type", x$solution_type, "\n")</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">179</td> - <td class="coverage">318<em>x</em></td> + <td class="coverage"></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> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">180</td> - <td class="coverage">318<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> DT50_k1 = log(2)/k1</pre> + <pre class="language-r"> cat("\nFitted in", x$time[["elapsed"]], "s using", x$numIter, "iterations\n")</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">181</td> - <td class="coverage">318<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> DT50_k2 = log(2)/k2</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">182</td> - <td class="coverage">318<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ep$distimes[obs_var, c("DT50back")] = DT50_back</pre> + <pre class="language-r"> cat("\nVariance model: ")</pre> </td> </tr> <tr class="covered"> <td class="num">183</td> - <td class="coverage">318<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ep$distimes[obs_var, c("DT50_k1")] = DT50_k1</pre> + <pre class="language-r"> cat(switch(x$err_mod,</pre> </td> </tr> <tr class="covered"> <td class="num">184</td> - <td class="coverage">318<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ep$distimes[obs_var, c("DT50_k2")] = DT50_k2</pre> + <pre class="language-r"> const = "Constant variance",</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">185</td> - <td class="coverage"></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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">73858<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (type == "SFORB") {</pre> + <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"> # FOCUS kinetics (2006), p. 60 f</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">188</td> - <td class="coverage">2616<em>x</em></td> + <td class="coverage">117<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> + <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">2616<em>x</em></td> + <td class="coverage">117<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> + <pre class="language-r"> print(x$mean_dp_start, digits = digits)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">190</td> - <td class="coverage">2616<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> k_1output = sum(degparms[k_out_names])</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">191</td> - <td class="coverage">2616<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> k_12 = degparms[paste("k", obs_var, "free", "bound", sep="_")]</pre> + <pre class="language-r"> cat("\nFixed degradation parameter values:\n")</pre> </td> </tr> <tr class="covered"> <td class="num">192</td> - <td class="coverage">2616<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> k_21 = degparms[paste("k", obs_var, "bound", "free", sep="_")]</pre> + <pre class="language-r"> if(length(x$fixed$value) == 0) cat("None\n")</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">193</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> else print(x$fixed, digits = digits)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">194</td> - <td class="coverage">2616<em>x</em></td> + <td class="coverage"></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> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">195</td> - <td class="coverage">2616<em>x</em></td> + <td class="coverage">117<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> + <pre class="language-r"> cat("\nResults:\n\n")</pre> </td> </tr> <tr class="covered"> <td class="num">196</td> - <td class="coverage">2616<em>x</em></td> + <td class="coverage">117<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> + <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">2616<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> g = (k_12 + k_21 - b1)/(b2 - b1)</pre> + <pre class="language-r"> row.names = " "), digits = digits, ...)</pre> </td> </tr> <tr class="never"> @@ -8403,58 +7578,58 @@ table.table-condensed { </tr> <tr class="covered"> <td class="num">199</td> - <td class="coverage">2616<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> DT50_b1 = log(2)/b1</pre> + <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">2616<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> DT50_b2 = log(2)/b2</pre> + <pre class="language-r"> print(x$confint_trans, digits = digits, ...)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">201</td> - <td class="coverage">2616<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> DT90_b1 = log(10)/b1</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">202</td> - <td class="coverage">2616<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> DT90_b2 = log(10)/b2</pre> + <pre class="language-r"> if (nrow(x$confint_trans) > 1) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">203</td> - <td class="coverage"></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> corr <- x$corFixed</pre> </td> </tr> <tr class="covered"> <td class="num">204</td> - <td class="coverage">2616<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> SFORB_fraction = function(t) {</pre> + <pre class="language-r"> class(corr) <- "correlation"</pre> </td> </tr> <tr class="covered"> <td class="num">205</td> - <td class="coverage">60096<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> g * exp(-b1 * t) + (1 - g) * exp(-b2 * t)</pre> + <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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> @@ -8466,44 +7641,44 @@ table.table-condensed { </tr> <tr class="covered"> <td class="num">208</td> - <td class="coverage">2616<em>x</em></td> + <td class="coverage">117<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> + <pre class="language-r"> cat("\n") # Random effects</pre> </td> </tr> <tr class="covered"> <td class="num">209</td> - <td class="coverage">2616<em>x</em></td> + <td class="coverage">117<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> + <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">2616<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> silent = TRUE)</pre> + <pre class="language-r"> reEstimates = x$coef$random, digits = digits, verbose = verbose, ...)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">211</td> - <td class="coverage">2616<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> f_90 <- function(log_t) (SFORB_fraction(exp(log_t)) - 0.1)^2</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">212</td> - <td class="coverage">2616<em>x</em></td> + <td class="coverage">117<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> + <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">2616<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> silent = TRUE)</pre> + <pre class="language-r"> print(x$confint_back, digits = digits, ...)</pre> </td> </tr> <tr class="never"> @@ -8513,46 +7688,46 @@ table.table-condensed { <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">215</td> - <td class="coverage">2616<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> DT50 = if (inherits(log_DT50, "try-error")) NA</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">216</td> - <td class="coverage">2616<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> else exp(log_DT50)</pre> + <pre class="language-r"> printSFORB <- !is.null(x$SFORB)</pre> </td> </tr> <tr class="covered"> <td class="num">217</td> - <td class="coverage">2616<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> DT90 = if (inherits(log_DT90, "try-error")) NA</pre> + <pre class="language-r"> if(printSFORB){</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">218</td> - <td class="coverage">2616<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> else exp(log_DT90)</pre> + <pre class="language-r"> cat("\nEstimated Eigenvalues of SFORB model(s):\n")</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">219</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> print(x$SFORB, digits = digits,...)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">220</td> - <td class="coverage">2616<em>x</em></td> + <td class="coverage"></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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> @@ -8564,237 +7739,132 @@ table.table-condensed { </tr> <tr class="covered"> <td class="num">222</td> - <td class="coverage">2616<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> for (k_out_name in k_out_names)</pre> + <pre class="language-r"> printff <- !is.null(x$ff)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">223</td> - <td class="coverage"></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> {</pre> + <pre class="language-r"> if(printff){</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">224</td> - <td class="coverage">2618<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> ep$ff[[sub("k_", "", k_out_name)]] = degparms[[k_out_name]] / k_1output</pre> + <pre class="language-r"> cat("\nResulting formation fractions:\n")</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">225</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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> + <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> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">228</td> - <td class="coverage">2616<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ep$SFORB[[paste(obs_var, "b1", sep="_")]] = b1</pre> + <pre class="language-r"> printdistimes <- !is.null(x$distimes)</pre> </td> </tr> <tr class="covered"> <td class="num">229</td> - <td class="coverage">2616<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ep$SFORB[[paste(obs_var, "b2", sep="_")]] = b2</pre> + <pre class="language-r"> if(printdistimes){</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">230</td> - <td class="coverage"></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Return g for comparison with DFOP</pre> + <pre class="language-r"> cat("\nEstimated disappearance times:\n")</pre> </td> </tr> <tr class="covered"> <td class="num">231</td> - <td class="coverage">2616<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ep$SFORB[[paste(obs_var, "g", sep="_")]] = g</pre> + <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> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">233</td> - <td class="coverage">2616<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> ep$distimes[obs_var, c("DT50back")] = DT50_back</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">234</td> - <td class="coverage">2616<em>x</em></td> + <td class="coverage">117<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> + <pre class="language-r"> if (x$print_data){</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">235</td> - <td class="coverage">2616<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> ep$distimes[obs_var, c(paste("DT50", obs_var, "b2", sep = "_"))] = DT50_b2</pre> + <pre class="language-r"> cat("\nData:\n")</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <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="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> if (type == "logistic") {</pre> + <pre class="language-r"> print(format(x$data, digits = digits, ...), row.names = FALSE)</pre> </td> </tr> <tr class="never"> - <td class="num">238</td> + <td class="num">237</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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">244</td> + <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">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="num">239</td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> return(ep)</pre> + <pre class="language-r"> invisible(x)</pre> </td> </tr> <tr class="never"> - <td class="num">255</td> + <td class="num">240</td> <td class="coverage"></td> <td class="col-sm-12"> <pre class="language-r">}</pre> @@ -8803,63 +7873,63 @@ table.table-condensed { </tbody> </table> </div> - <div id="R/mkinmod.R" class="hidden"> + <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 set up a kinetic model with one or more state variables</pre> + <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">#'</pre> + <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">#' This function is usually called using a call to [mkinsub()] for each observed</pre> + <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">#' variable, specifying the corresponding submodel as well as outgoing pathways</pre> + <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">#' (see examples).</pre> + <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">#'</pre> + <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">#' For the definition of model types and their parameters, the equations given</pre> + <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">#' in the FOCUS and NAFTA guidance documents are used.</pre> + <pre class="language-r">#' advantage that the SFORB model can also be used for metabolites.</pre> </td> </tr> <tr class="never"> @@ -8873,3530 +7943,1724 @@ table.table-condensed { <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> + <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">#' of the system of differential equations is included in the resulting</pre> + <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">#' mkinmod object in some cases, speeding up the solution.</pre> + <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> + <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">#' If a C compiler is found by [pkgbuild::has_compiler()] and there</pre> + <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">#' is more than one observed variable in the specification, C code is generated</pre> + <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">#' for evaluating the differential equations, compiled using</pre> + <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">#' [inline::cfunction()] and added to the resulting mkinmod object.</pre> + <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">#'</pre> + <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 ... For each observed variable, a list as obtained by [mkinsub()]</pre> + <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">#' has to be specified as an argument (see examples). Currently, single</pre> + <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">#' first order kinetics "SFO", indeterminate order rate equation kinetics</pre> + <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">#' "IORE", or single first order with reversible binding "SFORB" are</pre> + <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">#' implemented for all variables, while "FOMC", "DFOP", "HS" and "logistic"</pre> + <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">#' can additionally be chosen for the first variable which is assumed to be</pre> + <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">#' the source compartment.</pre> + <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">#' Additionally, [mkinsub()] has an argument \code{to}, specifying names of</pre> + <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">#' variables to which a transfer is to be assumed in the model.</pre> + <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">#' If the argument \code{use_of_ff} is set to "min"</pre> + <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">#' and the model for the compartment is "SFO" or "SFORB", an</pre> + <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">#' additional [mkinsub()] argument can be \code{sink = FALSE}, effectively</pre> + <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">#' fixing the flux to sink to zero.</pre> + <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">#' In print.mkinmod, this argument is currently not used.</pre> + <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">#' @param use_of_ff Specification of the use of formation fractions in the</pre> + <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">#' model equations and, if applicable, the coefficient matrix. If "max",</pre> + <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">#' formation fractions are always used (default). If "min", a minimum use of</pre> + <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">#' formation fractions is made, i.e. each first-order pathway to a metabolite</pre> + <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">#' has its own rate constant.</pre> + <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">#' @param speclist The specification of the observed variables and their</pre> + <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">#' submodel types and pathways can be given as a single list using this</pre> + <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">#' argument. Default is NULL.</pre> + <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">#' @param quiet Should messages be suppressed?</pre> + <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">#' @param verbose If \code{TRUE}, passed to [inline::cfunction()] if</pre> + <pre class="language-r">endpoints <- function(fit, covariates = NULL, covariate_quantile = 0.5) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">43</td> - <td class="coverage"></td> + <td class="coverage">56208<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' applicable to give detailed information about the C function being built.</pre> + <pre class="language-r"> mkinmod <- fit$mkinmod</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">44</td> - <td class="coverage"></td> + <td class="coverage">56208<em>x</em></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> + <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">#' @param dll_dir Directory where an DLL object, if generated internally by</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">46</td> - <td class="coverage"></td> + <td class="coverage">56208<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' [inline::cfunction()], should be saved. The DLL will only be stored in a</pre> + <pre class="language-r"> if (!is.null(fit$covariate_models)) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">47</td> - <td class="coverage"></td> + <td class="coverage">110<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' permanent location for use in future sessions, if 'dll_dir' and 'name'</pre> + <pre class="language-r"> if (is.null(covariates)) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">48</td> - <td class="coverage"></td> + <td class="coverage">110<em>x</em></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> + <pre class="language-r"> covariates = as.data.frame(</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">49</td> - <td class="coverage"></td> + <td class="coverage">110<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' as the cache remains functional across sessions if the DLL is stored in</pre> + <pre class="language-r"> apply(fit$covariates, 2, quantile,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">50</td> - <td class="coverage"></td> + <td class="coverage">110<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' a user defined location.</pre> + <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">#' @param unload If a DLL from the target location in 'dll_dir' is already</pre> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">52</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#' loaded, should that be unloaded first?</pre> + <pre class="language-r"> covariate_m <- matrix(covariates, byrow = TRUE)</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">53</td> - <td class="coverage"></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> + <pre class="language-r"> colnames(covariate_m) <- names(covariates)</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">54</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#' should this be overwritten?</pre> + <pre class="language-r"> rownames(covariate_m) <- "User"</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">55</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#' @importFrom methods signature</pre> + <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">#' @return A list of class \code{mkinmod} for use with [mkinfit()],</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">57</td> - <td class="coverage"></td> + <td class="coverage">110<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' containing, among others,</pre> + <pre class="language-r"> degparms_trans <- parms(fit, covariates = covariates)[, 1]</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">58</td> - <td class="coverage"></td> + <td class="coverage">110<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' \item{diffs}{</pre> + <pre class="language-r"> if (inherits(fit, "saem.mmkin") & (fit$transformations == "saemix")) {</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">59</td> - <td class="coverage"></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> + <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">#' each modelling variable.</pre> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">61</td> - <td class="coverage"></td> + <td class="coverage">110<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' }</pre> + <pre class="language-r"> degparms <- backtransform_odeparms(degparms_trans,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">62</td> - <td class="coverage"></td> + <td class="coverage">110<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' \item{map}{</pre> + <pre class="language-r"> fit$mkinmod,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">63</td> - <td class="coverage"></td> + <td class="coverage">110<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' A list containing named character vectors for each observed variable,</pre> + <pre class="language-r"> transform_rates = fit$transform_rates,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">64</td> - <td class="coverage"></td> + <td class="coverage">110<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' specifying the modelling variables by which it is represented.</pre> + <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> + <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> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">67</td> - <td class="coverage"></td> + <td class="coverage">56098<em>x</em></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> + <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> + <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> + <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">#' If generated, a function containing the solution of the degradation</pre> + <pre class="language-r"> # Set up object to return</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">71</td> - <td class="coverage"></td> + <td class="coverage">56208<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' model.</pre> + <pre class="language-r"> ep <- list()</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">72</td> - <td class="coverage"></td> + <td class="coverage">56208<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' }</pre> + <pre class="language-r"> ep$covariates <- covariates</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">73</td> - <td class="coverage"></td> + <td class="coverage">56208<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' \item{coefmat}{</pre> + <pre class="language-r"> ep$ff <- vector()</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">74</td> - <td class="coverage"></td> + <td class="coverage">56208<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' The coefficient matrix, if the system of differential equations can be</pre> + <pre class="language-r"> ep$SFORB <- vector()</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">75</td> - <td class="coverage"></td> + <td class="coverage">56208<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' represented by one.</pre> + <pre class="language-r"> ep$distimes <- data.frame(</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">76</td> - <td class="coverage"></td> + <td class="coverage">56208<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' }</pre> + <pre class="language-r"> DT50 = rep(NA, length(obs_vars)),</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">77</td> - <td class="coverage"></td> + <td class="coverage">56208<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' \item{cf}{</pre> + <pre class="language-r"> DT90 = rep(NA, length(obs_vars)),</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">78</td> - <td class="coverage"></td> + <td class="coverage">56208<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' If generated, a compiled function calculating the derivatives as</pre> + <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">#' returned by cfunction.</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">80</td> - <td class="coverage"></td> + <td class="coverage">56208<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' }</pre> + <pre class="language-r"> for (obs_var in obs_vars) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">81</td> - <td class="coverage"></td> + <td class="coverage">73858<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @note The IORE submodel is not well tested for metabolites. When using this</pre> + <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">#' model for metabolites, you may want to read the note in the help</pre> + <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">#' page to [mkinfit].</pre> + <pre class="language-r"> # Get formation fractions if directly fitted, and calculate remaining fraction to sink</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">84</td> - <td class="coverage"></td> + <td class="coverage">73858<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @author Johannes Ranke</pre> + <pre class="language-r"> f_names = grep(paste("^f", obs_var, sep = "_"), names(degparms), value=TRUE)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">85</td> - <td class="coverage"></td> + <td class="coverage">73858<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @references FOCUS (2006) \dQuote{Guidance Document on Estimating Persistence</pre> + <pre class="language-r"> if (length(f_names) > 0) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">86</td> - <td class="coverage"></td> + <td class="coverage">15068<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' and Degradation Kinetics from Environmental Fate Studies on Pesticides in</pre> + <pre class="language-r"> f_values = degparms[f_names]</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">87</td> - <td class="coverage"></td> + <td class="coverage">15068<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' EU Registration} Report of the FOCUS Work Group on Degradation Kinetics,</pre> + <pre class="language-r"> f_to_sink = 1 - sum(f_values)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">88</td> - <td class="coverage"></td> + <td class="coverage">15068<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' EC Document Reference Sanco/10058/2005 version 2.0, 434 pp,</pre> + <pre class="language-r"> names(f_to_sink) = ifelse(type == "SFORB",</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">89</td> - <td class="coverage"></td> + <td class="coverage">15068<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' \url{http://esdac.jrc.ec.europa.eu/projects/degradation-kinetics}</pre> + <pre class="language-r"> paste(obs_var, "free", "sink", sep = "_"),</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">90</td> - <td class="coverage"></td> + <td class="coverage">15068<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> paste(obs_var, "sink", sep = "_"))</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">91</td> - <td class="coverage"></td> + <td class="coverage">15068<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' NAFTA Technical Working Group on Pesticides (not dated) Guidance for</pre> + <pre class="language-r"> for (f_name in f_names) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">92</td> - <td class="coverage"></td> + <td class="coverage">17338<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' Evaluating and Calculating Degradation Kinetics in Environmental Media</pre> + <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">#' @examples</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">94</td> - <td class="coverage"></td> + <td class="coverage">15068<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <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">#' # Specify the SFO model (this is not needed any more, as we can now mkinfit("SFO", ...)</pre> + <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">#' SFO <- mkinmod(parent = mkinsub("SFO"))</pre> + <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> + <pre class="language-r"> # Get the rest</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">98</td> - <td class="coverage"></td> + <td class="coverage">73858<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' # One parent compound, one metabolite, both single first order</pre> + <pre class="language-r"> if (type == "SFO") {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">99</td> - <td class="coverage"></td> + <td class="coverage">40900<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' SFO_SFO <- mkinmod(</pre> + <pre class="language-r"> k_names = grep(paste("^k", obs_var, sep="_"), names(degparms), value=TRUE)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">100</td> - <td class="coverage"></td> + <td class="coverage">40900<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' parent = mkinsub("SFO", "m1"),</pre> + <pre class="language-r"> k_tot = sum(degparms[k_names])</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">101</td> - <td class="coverage"></td> + <td class="coverage">40900<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' m1 = mkinsub("SFO"))</pre> + <pre class="language-r"> DT50 = log(2)/k_tot</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">102</td> - <td class="coverage"></td> + <td class="coverage">40900<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' print(SFO_SFO)</pre> + <pre class="language-r"> DT90 = log(10)/k_tot</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">103</td> - <td class="coverage"></td> + <td class="coverage">40900<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> if (mkinmod$use_of_ff == "min" && length(obs_vars) > 1) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">104</td> - <td class="coverage"></td> + <td class="coverage">622<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' \dontrun{</pre> + <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">#' fit_sfo_sfo <- mkinfit(SFO_SFO, FOCUS_2006_D, quiet = TRUE, solution_type = "deSolve")</pre> + <pre class="language-r"> {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">106</td> - <td class="coverage"></td> + <td class="coverage">932<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <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">#' # Now supplying compound names used for plotting, and write to user defined location</pre> + <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">#' # We need to choose a path outside the session tempdir because this gets removed</pre> + <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">#' DLL_dir <- "~/.local/share/mkin"</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">110</td> - <td class="coverage"></td> + <td class="coverage">73858<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' if (!dir.exists(DLL_dir)) dir.create(DLL_dir)</pre> + <pre class="language-r"> if (type == "FOMC") {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">111</td> - <td class="coverage"></td> + <td class="coverage">1790<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' SFO_SFO.2 <- mkinmod(</pre> + <pre class="language-r"> alpha = degparms["alpha"]</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">112</td> - <td class="coverage"></td> + <td class="coverage">1790<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' parent = mkinsub("SFO", "m1", full_name = "Test compound"),</pre> + <pre class="language-r"> beta = degparms["beta"]</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">113</td> - <td class="coverage"></td> + <td class="coverage">1790<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' m1 = mkinsub("SFO", full_name = "Metabolite M1"),</pre> + <pre class="language-r"> DT50 = beta * (2^(1/alpha) - 1)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">114</td> - <td class="coverage"></td> + <td class="coverage">1790<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' name = "SFO_SFO", dll_dir = DLL_dir, unload = TRUE, overwrite = TRUE)</pre> + <pre class="language-r"> DT90 = beta * (10^(1/alpha) - 1)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">115</td> - <td class="coverage"></td> + <td class="coverage">1790<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' # Now we can save the model and restore it in a new session</pre> + <pre class="language-r"> DT50_back = DT90 / (log(10)/log(2)) # Backcalculated DT50 as recommended in FOCUS 2011</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">116</td> - <td class="coverage"></td> + <td class="coverage">1790<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' saveRDS(SFO_SFO.2, file = "~/SFO_SFO.rds")</pre> + <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">#' # Terminate the R session here if you would like to check, and then do</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">118</td> - <td class="coverage"></td> + <td class="coverage">73858<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' library(mkin)</pre> + <pre class="language-r"> if (type == "IORE") {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">119</td> - <td class="coverage"></td> + <td class="coverage">352<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' SFO_SFO.3 <- readRDS("~/SFO_SFO.rds")</pre> + <pre class="language-r"> k_names = grep(paste("^k__iore", obs_var, sep="_"), names(degparms), value=TRUE)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">120</td> - <td class="coverage"></td> + <td class="coverage">352<em>x</em></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> + <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">#'</pre> + <pre class="language-r"> # From the NAFTA kinetics guidance, p. 5</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">122</td> - <td class="coverage"></td> + <td class="coverage">352<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' # Show details of creating the C function</pre> + <pre class="language-r"> n = degparms[paste("N", obs_var, sep = "_")]</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">123</td> - <td class="coverage"></td> + <td class="coverage">352<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' SFO_SFO <- mkinmod(</pre> + <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">#' parent = mkinsub("SFO", "m1"),</pre> + <pre class="language-r"> # Use the initial concentration of the parent compound</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">125</td> - <td class="coverage"></td> + <td class="coverage">352<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' m1 = mkinsub("SFO"), verbose = TRUE)</pre> + <pre class="language-r"> source_name = mkinmod$map[[1]][[1]]</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">126</td> - <td class="coverage"></td> + <td class="coverage">352<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> c0 = degparms[paste(source_name, "0", sep = "_")]</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">127</td> - <td class="coverage"></td> + <td class="coverage">352<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' # The symbolic solution which is available in this case is not</pre> + <pre class="language-r"> alpha = 1 / (n - 1)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">128</td> - <td class="coverage"></td> + <td class="coverage">352<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' # made for human reading but for speed of computation</pre> + <pre class="language-r"> beta = (c0^(1 - n))/(k * (n - 1))</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">129</td> - <td class="coverage"></td> + <td class="coverage">352<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' SFO_SFO$deg_func</pre> + <pre class="language-r"> DT50 = beta * (2^(1/alpha) - 1)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">130</td> - <td class="coverage"></td> + <td class="coverage">352<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> DT90 = beta * (10^(1/alpha) - 1)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">131</td> - <td class="coverage"></td> + <td class="coverage">352<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' # If we have several parallel metabolites</pre> + <pre class="language-r"> DT50_back = DT90 / (log(10)/log(2)) # Backcalculated DT50 as recommended in FOCUS 2011</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">132</td> - <td class="coverage"></td> + <td class="coverage">352<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' # (compare tests/testthat/test_synthetic_data_for_UBA_2014.R)</pre> + <pre class="language-r"> ep$distimes[obs_var, c("DT50back")] = DT50_back</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">133</td> - <td class="coverage"></td> + <td class="coverage">352<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' m_synth_DFOP_par <- mkinmod(</pre> + <pre class="language-r"> if (mkinmod$use_of_ff == "min") {</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">134</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#' parent = mkinsub("DFOP", c("M1", "M2")),</pre> + <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">#' M1 = mkinsub("SFO"),</pre> + <pre class="language-r"> {</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">136</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#' M2 = mkinsub("SFO"),</pre> + <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">#' quiet = TRUE)</pre> + <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> + <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> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">140</td> - <td class="coverage"></td> + <td class="coverage">73858<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' synthetic_data_for_UBA_2014[[12]]$data,</pre> + <pre class="language-r"> if (type == "DFOP") {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">141</td> - <td class="coverage"></td> + <td class="coverage">27729<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' quiet = TRUE)</pre> + <pre class="language-r"> k1 = degparms["k1"]</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">142</td> - <td class="coverage"></td> + <td class="coverage">27729<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' }</pre> + <pre class="language-r"> k2 = degparms["k2"]</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">143</td> - <td class="coverage"></td> + <td class="coverage">27729<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> g = degparms["g"]</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">144</td> - <td class="coverage"></td> + <td class="coverage">27729<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @export mkinmod</pre> + <pre class="language-r"> f <- function(log_t, x) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">145</td> - <td class="coverage"></td> + <td class="coverage">684705<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">mkinmod <- function(..., use_of_ff = "max", name = NULL,</pre> + <pre class="language-r"> t <- exp(log_t)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">146</td> - <td class="coverage"></td> + <td class="coverage">684705<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> speclist = NULL, quiet = FALSE, verbose = FALSE, dll_dir = NULL,</pre> + <pre class="language-r"> fraction <- g * exp( - k1 * t) + (1 - g) * exp( - k2 * t)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">147</td> - <td class="coverage"></td> + <td class="coverage">684705<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> unload = FALSE, overwrite = FALSE)</pre> + <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> + <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="coverage">27729<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (is.null(speclist)) spec <- list(...)</pre> + <pre class="language-r"> DT50_k1 = log(2)/k1</pre> </td> </tr> <tr class="covered"> <td class="num">150</td> - <td class="coverage">3905<em>x</em></td> + <td class="coverage">27729<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> else spec <- speclist</pre> + <pre class="language-r"> DT50_k2 = log(2)/k2</pre> </td> </tr> <tr class="covered"> <td class="num">151</td> - <td class="coverage">8845<em>x</em></td> + <td class="coverage">27729<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> obs_vars <- names(spec)</pre> + <pre class="language-r"> DT90_k1 = log(10)/k1</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">152</td> - <td class="coverage"></td> + <td class="coverage">27729<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> DT90_k2 = log(10)/k2</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">153</td> - <td class="coverage">8845<em>x</em></td> + <td class="coverage"></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> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">154</td> - <td class="coverage">8845<em>x</em></td> + <td class="coverage">27729<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (!is.null(dll_dir)) {</pre> + <pre class="language-r"> DT50 <- try(exp(optimize(f, c(log(DT50_k1), log(DT50_k2)), x=50)$minimum),</pre> </td> </tr> - <tr class="missed"> + <tr class="covered"> <td class="num">155</td> - <td class="coverage">!</td> + <td class="coverage">27729<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (!dir.exists(dll_dir)) stop(dll_dir, " does not exist")</pre> + <pre class="language-r"> silent = TRUE)</pre> </td> </tr> - <tr class="missed"> + <tr class="covered"> <td class="num">156</td> - <td class="coverage">!</td> + <td class="coverage">27729<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (is.null(name)) stop(save_msg)</pre> + <pre class="language-r"> DT90 <- try(exp(optimize(f, c(log(DT90_k1), log(DT90_k2)), x=90)$minimum),</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">157</td> - <td class="coverage"></td> + <td class="coverage">27729<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> silent = TRUE)</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">158</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> if (inherits(DT50, "try-error")) DT50 = NA</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">159</td> - <td class="coverage"></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> + <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">8845<em>x</em></td> + <td class="coverage">27729<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> for (obs_var in obs_vars) {</pre> + <pre class="language-r"> DT50_back = DT90 / (log(10)/log(2)) # Backcalculated DT50 as recommended in FOCUS 2011</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">161</td> - <td class="coverage">104<em>x</em></td> + <td class="coverage"></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> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">162</td> - <td class="coverage">104<em>x</em></td> + <td class="coverage">27729<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> + <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">104<em>x</em></td> + <td class="coverage">27729<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> + <pre class="language-r"> ep$distimes[obs_var, c("DT50_k1")] = DT50_k1</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">164</td> - <td class="coverage"></td> + <td class="coverage">27729<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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> + <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="coverage">73858<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (!use_of_ff %in% c("min", "max"))</pre> + <pre class="language-r"> if (type == "HS") {</pre> </td> </tr> <tr class="covered"> <td class="num">167</td> - <td class="coverage">104<em>x</em></td> + <td class="coverage">318<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> + <pre class="language-r"> k1 = degparms["k1"]</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">168</td> - <td class="coverage"></td> + <td class="coverage">318<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> k2 = degparms["k2"]</pre> </td> </tr> <tr class="covered"> <td class="num">169</td> - <td class="coverage">8429<em>x</em></td> + <td class="coverage">318<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> parms <- vector()</pre> + <pre class="language-r"> tb = degparms["tb"]</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">170</td> - <td class="coverage"></td> + <td class="coverage">318<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # }}}</pre> + <pre class="language-r"> DTx <- function(x) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">171</td> - <td class="coverage"></td> + <td class="coverage">636<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> DTx.a <- (log(100/(100 - x)))/k1</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">172</td> - <td class="coverage"></td> + <td class="coverage">636<em>x</em></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> + <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">8429<em>x</em></td> + <td class="coverage">339<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> + <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">2280<em>x</em></td> + <td class="coverage">297<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> mat = FALSE</pre> + <pre class="language-r"> else DTx <- DTx.b</pre> </td> </tr> <tr class="covered"> <td class="num">175</td> - <td class="coverage">6149<em>x</em></td> + <td class="coverage">636<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> } else mat = TRUE</pre> + <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> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">177</td> - <td class="coverage"></td> + <td class="coverage">318<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> DT50 <- DTx(50)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">178</td> - <td class="coverage"></td> + <td class="coverage">318<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Establish a list of differential equations as well as a map from observed {{{</pre> + <pre class="language-r"> DT90 <- DTx(90)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">179</td> - <td class="coverage"></td> + <td class="coverage">318<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # compartments to differential equations</pre> + <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">8429<em>x</em></td> + <td class="coverage">318<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> diffs <- vector()</pre> + <pre class="language-r"> DT50_k1 = log(2)/k1</pre> </td> </tr> <tr class="covered"> <td class="num">181</td> - <td class="coverage">8429<em>x</em></td> + <td class="coverage">318<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> map <- list()</pre> + <pre class="language-r"> DT50_k2 = log(2)/k2</pre> </td> </tr> <tr class="covered"> <td class="num">182</td> - <td class="coverage">8429<em>x</em></td> + <td class="coverage">318<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> for (varname in obs_vars)</pre> + <pre class="language-r"> ep$distimes[obs_var, c("DT50back")] = DT50_back</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">183</td> - <td class="coverage"></td> + <td class="coverage">318<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> {</pre> + <pre class="language-r"> ep$distimes[obs_var, c("DT50_k1")] = DT50_k1</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">184</td> - <td class="coverage"></td> + <td class="coverage">318<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Check the type component of the compartment specification {{{</pre> + <pre class="language-r"> ep$distimes[obs_var, c("DT50_k2")] = DT50_k2</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">185</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if(is.null(spec[[varname]]$type)) stop(</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="missed"> + <tr class="covered"> <td class="num">186</td> - <td class="coverage">!</td> + <td class="coverage">73858<em>x</em></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> + <pre class="language-r"> if (type == "SFORB") {</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">187</td> - <td class="coverage">104<em>x</em></td> + <td class="coverage"></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> + <pre class="language-r"> # FOCUS kinetics (2006), p. 60 f</pre> </td> </tr> <tr class="covered"> <td class="num">188</td> - <td class="coverage">104<em>x</em></td> + <td class="coverage">2616<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> + <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">13150<em>x</em></td> + <td class="coverage">2616<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> + <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">104<em>x</em></td> + <td class="coverage">2616<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> + <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">104<em>x</em></td> + <td class="coverage">2616<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> "which is assumed to be the source compartment"))</pre> + <pre class="language-r"> k_12 = degparms[paste("k", obs_var, "free", "bound", sep="_")]</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">192</td> - <td class="coverage"></td> + <td class="coverage">2616<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">194</td> - <td class="coverage"></td> + <td class="coverage">2616<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # New (sub)compartments (boxes) needed for the model type {{{</pre> + <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">13046<em>x</em></td> + <td class="coverage">2616<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> new_boxes <- switch(spec[[varname]]$type,</pre> + <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">13046<em>x</em></td> + <td class="coverage">2616<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> SFO = varname,</pre> + <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">13046<em>x</em></td> + <td class="coverage">2616<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> FOMC = varname,</pre> + <pre class="language-r"> g = (k_12 + k_21 - b1)/(b2 - b1)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">198</td> - <td class="coverage">13046<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> IORE = varname,</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">199</td> - <td class="coverage">13046<em>x</em></td> + <td class="coverage">2616<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> DFOP = varname,</pre> + <pre class="language-r"> DT50_b1 = log(2)/b1</pre> </td> </tr> <tr class="covered"> <td class="num">200</td> - <td class="coverage">13046<em>x</em></td> + <td class="coverage">2616<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> HS = varname,</pre> + <pre class="language-r"> DT50_b2 = log(2)/b2</pre> </td> </tr> <tr class="covered"> <td class="num">201</td> - <td class="coverage">13046<em>x</em></td> + <td class="coverage">2616<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> logistic = varname,</pre> + <pre class="language-r"> DT90_b1 = log(10)/b1</pre> </td> </tr> <tr class="covered"> <td class="num">202</td> - <td class="coverage">13046<em>x</em></td> + <td class="coverage">2616<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> SFORB = paste(varname, c("free", "bound"), sep = "_")</pre> + <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> + <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="coverage">2616<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> map[[varname]] <- new_boxes</pre> + <pre class="language-r"> SFORB_fraction = function(t) {</pre> </td> </tr> <tr class="covered"> <td class="num">205</td> - <td class="coverage">13046<em>x</em></td> + <td class="coverage">60096<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> names(map[[varname]]) <- rep(spec[[varname]]$type, length(new_boxes)) #}}}</pre> + <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"> # Start a new differential equation for each new box {{{</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">207</td> - <td class="coverage">13046<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> new_diffs <- paste("d_", new_boxes, " =", sep = "")</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">208</td> - <td class="coverage">13046<em>x</em></td> + <td class="coverage">2616<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> names(new_diffs) <- new_boxes</pre> + <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">13046<em>x</em></td> + <td class="coverage">2616<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> diffs <- c(diffs, new_diffs) #}}}</pre> + <pre class="language-r"> log_DT50 <- try(optimize(f_50, c(log(DT50_b1), log(DT50_b2)))$minimum,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">210</td> - <td class="coverage"></td> + <td class="coverage">2616<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> } #}}}</pre> + <pre class="language-r"> silent = TRUE)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">211</td> - <td class="coverage"></td> + <td class="coverage">2616<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> f_90 <- function(log_t) (SFORB_fraction(exp(log_t)) - 0.1)^2</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">212</td> - <td class="coverage"></td> + <td class="coverage">2616<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Create content of differential equations and build parameter list {{{</pre> + <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">8221<em>x</em></td> + <td class="coverage">2616<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> for (varname in obs_vars)</pre> + <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="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="num">215</td> + <td class="coverage">2616<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # and a compiler is available</pre> + <pre class="language-r"> DT50 = if (inherits(log_DT50, "try-error")) NA</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="num">216</td> + <td class="coverage">2616<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Translate the R code for the derivatives to C code</pre> + <pre class="language-r"> else exp(log_DT50)</pre> </td> </tr> <tr class="covered"> - <td class="num">403</td> - <td class="coverage">3728<em>x</em></td> + <td class="num">217</td> + <td class="coverage">2616<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> diffs.C <- paste(diffs, collapse = ";\n")</pre> + <pre class="language-r"> DT90 = if (inherits(log_DT90, "try-error")) NA</pre> </td> </tr> <tr class="covered"> - <td class="num">404</td> - <td class="coverage">3728<em>x</em></td> + <td class="num">218</td> + <td class="coverage">2616<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> diffs.C <- paste0(diffs.C, ";")</pre> + <pre class="language-r"> else exp(log_DT90)</pre> </td> </tr> <tr class="never"> - <td class="num">405</td> + <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">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="num">220</td> + <td class="coverage">2616<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> + <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">408</td> + <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">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="num">222</td> + <td class="coverage">2616<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> for (k_out_name in k_out_names)</pre> </td> </tr> <tr class="never"> - <td class="num">412</td> + <td class="num">223</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> + <pre class="language-r"> {</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="num">224</td> + <td class="coverage">2618<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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">419</td> + <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">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="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">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="num">227</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> + <pre class="language-r"> # Return the eigenvalues for comparison with DFOP rate constants</pre> </td> </tr> <tr class="covered"> - <td class="num">434</td> - <td class="coverage">8347<em>x</em></td> + <td class="num">228</td> + <td class="coverage">2616<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> replacement <- paste0("* y[", i - 1, "]")</pre> + <pre class="language-r"> ep$SFORB[[paste(obs_var, "b1", sep="_")]] = b1</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="num">229</td> + <td class="coverage">2616<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> ep$SFORB[[paste(obs_var, "b2", sep="_")]] = b2</pre> </td> </tr> <tr class="never"> - <td class="num">437</td> + <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">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> + <pre class="language-r"> # Return g for comparison with DFOP</pre> </td> </tr> <tr class="covered"> - <td class="num">439</td> - <td class="coverage">3728<em>x</em></td> + <td class="num">231</td> + <td class="coverage">2616<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> f = "numeric", rpar = "numeric", ipar = "integer")</pre> + <pre class="language-r"> ep$SFORB[[paste(obs_var, "g", sep="_")]] = g</pre> </td> </tr> <tr class="never"> - <td class="num">440</td> + <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">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="num">233</td> + <td class="coverage">2616<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> + <pre class="language-r"> ep$distimes[obs_var, c("DT50back")] = DT50_back</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="num">234</td> + <td class="coverage">2616<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <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">445</td> - <td class="coverage">2668<em>x</em></td> + <td class="num">235</td> + <td class="coverage">2616<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> diffs.C</pre> + <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">446</td> + <td class="num">236</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="num">237</td> + <td class="coverage">73858<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> if (type == "logistic") {</pre> </td> </tr> <tr class="never"> - <td class="num">459</td> + <td class="num">238</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # Try to build a shared library</pre> + <pre class="language-r"> # FOCUS kinetics (2014) p. 67</pre> </td> </tr> <tr class="covered"> - <td class="num">460</td> - <td class="coverage">3728<em>x</em></td> + <td class="num">239</td> + <td class="coverage">153<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> model$cf <- try(inline::cfunction(derivs_sig, derivs_code,</pre> + <pre class="language-r"> kmax = degparms["kmax"]</pre> </td> </tr> <tr class="covered"> - <td class="num">461</td> - <td class="coverage">3728<em>x</em></td> + <td class="num">240</td> + <td class="coverage">153<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> otherdefs = initpar_code,</pre> + <pre class="language-r"> k0 = degparms["k0"]</pre> </td> </tr> <tr class="covered"> - <td class="num">462</td> - <td class="coverage">3728<em>x</em></td> + <td class="num">241</td> + <td class="coverage">153<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> verbose = verbose, name = "diffs",</pre> + <pre class="language-r"> r = degparms["r"]</pre> </td> </tr> <tr class="covered"> - <td class="num">463</td> - <td class="coverage">3728<em>x</em></td> + <td class="num">242</td> + <td class="coverage">153<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> convention = ".C", language = "C"),</pre> + <pre class="language-r"> DT50 = (1/r) * log(1 - ((kmax/k0) * (1 - 2^(r/kmax))))</pre> </td> </tr> <tr class="covered"> - <td class="num">464</td> - <td class="coverage">3728<em>x</em></td> + <td class="num">243</td> + <td class="coverage">153<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> silent = TRUE)</pre> + <pre class="language-r"> DT90 = (1/r) * log(1 - ((kmax/k0) * (1 - 10^(r/kmax))))</pre> </td> </tr> <tr class="never"> - <td class="num">465</td> + <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">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="num">245</td> + <td class="coverage">153<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # under Windows, at least when using RStudio</pre> + <pre class="language-r"> DT50_k0 = log(2)/k0</pre> </td> </tr> <tr class="covered"> - <td class="num">471</td> - <td class="coverage">247<em>x</em></td> + <td class="num">246</td> + <td class="coverage">153<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> suppressWarnings(inline::moveDLL(model$cf, name, dll_dir,</pre> + <pre class="language-r"> DT50_kmax = log(2)/kmax</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="num">247</td> + <td class="coverage">153<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> ep$distimes[obs_var, c("DT50_k0")] = DT50_k0</pre> </td> </tr> <tr class="covered"> - <td class="num">474</td> - <td class="coverage">3728<em>x</em></td> + <td class="num">248</td> + <td class="coverage">153<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> model$dll_info <- inline::getDynLib(model$cf)</pre> + <pre class="language-r"> ep$distimes[obs_var, c("DT50_kmax")] = DT50_kmax</pre> </td> </tr> <tr class="never"> - <td class="num">475</td> + <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">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="num">250</td> + <td class="coverage">73858<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\n")</pre> + <pre class="language-r"> ep$distimes[obs_var, c("DT50", "DT90")] = c(DT50, DT90)</pre> </td> </tr> <tr class="never"> - <td class="num">506</td> + <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">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="num">252</td> + <td class="coverage">38846<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cat("Differential equations:\n")</pre> + <pre class="language-r"> if (length(ep$ff) == 0) ep$ff <- NULL</pre> </td> </tr> <tr class="covered"> - <td class="num">510</td> - <td class="coverage">104<em>x</em></td> + <td class="num">253</td> + <td class="coverage">53592<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> nice_diffs <- gsub("^(d.*) =", "\\1/dt =", x[["diffs"]])</pre> + <pre class="language-r"> if (length(ep$SFORB) == 0) ep$SFORB <- NULL</pre> </td> </tr> <tr class="covered"> - <td class="num">511</td> - <td class="coverage">104<em>x</em></td> + <td class="num">254</td> + <td class="coverage">56208<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> writeLines(strwrap(nice_diffs, exdent = 11))</pre> + <pre class="language-r"> return(ep)</pre> </td> </tr> <tr class="never"> - <td class="num">512</td> + <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">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> @@ -14506,490 +11770,490 @@ table.table-condensed { </tbody> </table> </div> - <div id="R/nafta.R" class="hidden"> + <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">#' Evaluate parent kinetics using the NAFTA guidance</pre> + <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> + <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> + <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">#' and returns an object of class \code{nafta} that has methods for printing</pre> + <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">#' and plotting.</pre> + <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">#'</pre> + <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">#' @param ds A dataframe that must contain one variable called "time" with the</pre> + <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">#' time values specified by the \code{time} argument, one column called</pre> + <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">#' "name" with the grouping of the observed values, and finally one column of</pre> + <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">#' observed values called "value".</pre> + <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 title Optional title of the dataset</pre> + <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 quiet Should the evaluation text be shown?</pre> + <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">#' @param \dots Further arguments passed to \code{\link{mmkin}} (not for the</pre> + <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">#' printing method).</pre> + <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">#' @importFrom stats qf</pre> + <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">#' @return An list of class \code{nafta}. The list element named "mmkin" is the</pre> + <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">#' \code{\link{mmkin}} object containing the fits of the three models. The</pre> + <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">#' list element named "title" contains the title of the dataset used. The</pre> + <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">#' list element "data" contains the dataset used in the fits.</pre> + <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">#' @author Johannes Ranke</pre> + <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">#' @source NAFTA (2011) Guidance for evaluating and calculating degradation</pre> + <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">#' kinetics in environmental media. NAFTA Technical Working Group on</pre> + <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">#' Pesticides</pre> + <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">#' \url{https://www.epa.gov/pesticide-science-and-assessing-pesticide-risks/guidance-evaluating-and-calculating-degradation}</pre> + <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">#' accessed 2019-02-22</pre> + <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">#'</pre> + <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">#' US EPA (2015) Standard Operating Procedure for Using the NAFTA Guidance to</pre> + <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">#' Calculate Representative Half-life Values and Characterizing Pesticide</pre> + <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">#' Degradation</pre> + <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">#' \url{https://www.epa.gov/pesticide-science-and-assessing-pesticide-risks/standard-operating-procedure-using-nafta-guidance}</pre> + <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">#' @examples</pre> + <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">#'</pre> + <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">#' nafta_evaluation <- nafta(NAFTA_SOP_Appendix_D, cores = 1)</pre> + <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">#' print(nafta_evaluation)</pre> + <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">#' plot(nafta_evaluation)</pre> + <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">#'</pre> + <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">#' @export</pre> + <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">nafta <- function(ds, title = NA, quiet = FALSE, ...) {</pre> + <pre class="language-r">#' mkinerrplot(fit)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">39</td> - <td class="coverage">264<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (length(levels(ds$name)) > 1) {</pre> + <pre class="language-r">#' }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">40</td> - <td class="coverage">88<em>x</em></td> + <td class="coverage"></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> + <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> + <pre class="language-r">#' @export</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">42</td> - <td class="coverage">176<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> n <- nrow(subset(ds, !is.na(value)))</pre> + <pre class="language-r">mkinerrplot <- function (object,</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">43</td> - <td class="coverage">176<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> models <- c("SFO", "IORE", "DFOP")</pre> + <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"></pre> + <pre class="language-r"> xlim = c(0, 1.1 * max(object$data$predicted)),</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">45</td> - <td class="coverage">176<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> result <- list(title = title, data = ds)</pre> + <pre class="language-r"> xlab = "Predicted", ylab = "Squared residual",</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">46</td> - <td class="coverage">176<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> result$mmkin <- mmkin(models, list(ds), quiet = TRUE, ...)</pre> + <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"></pre> + <pre class="language-r"> col_obs = "auto", pch_obs = "auto",</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">48</td> - <td class="coverage">176<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> distimes <- lapply(result$mmkin, function(x) as.numeric(endpoints(x)$distimes["parent", ]))</pre> + <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> + <pre class="language-r"> ...)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">50</td> - <td class="coverage">176<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> result$distimes <- matrix(NA, nrow = 3, ncol = 3,</pre> + <pre class="language-r">{</pre> </td> </tr> <tr class="covered"> <td class="num">51</td> - <td class="coverage">176<em>x</em></td> + <td class="coverage">275<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> dimnames = list(models, c("DT50", "DT90", "DT50_rep")))</pre> + <pre class="language-r"> obs_vars_all <- as.character(unique(object$data$variable))</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">52</td> - <td class="coverage">176<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> result$distimes["SFO", ] <- distimes[[1]][c(1, 2, 1)]</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">53</td> - <td class="coverage">176<em>x</em></td> + <td class="coverage">275<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> result$distimes["IORE", ] <- distimes[[2]][c(1, 2, 3)]</pre> + <pre class="language-r"> if (length(obs_vars) > 0){</pre> </td> </tr> <tr class="covered"> <td class="num">54</td> - <td class="coverage">176<em>x</em></td> + <td class="coverage">275<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> result$distimes["DFOP", ] <- distimes[[3]][c(1, 2, 5)]</pre> + <pre class="language-r"> obs_vars <- intersect(obs_vars_all, obs_vars)</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">55</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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"> # Get parameters with statistics</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">57</td> - <td class="coverage">176<em>x</em></td> + <td class="coverage">275<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> result$parameters <- lapply(result$mmkin, function(x) {</pre> + <pre class="language-r"> residuals <- subset(object$data, variable %in% obs_vars, residual)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">58</td> - <td class="coverage">528<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> summary(x)$bpar[, c(1, 4:6)]</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">59</td> - <td class="coverage"></td> + <td class="coverage">275<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> })</pre> + <pre class="language-r"> if (maxy == "auto") maxy = max(residuals^2, na.rm = TRUE)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">60</td> - <td class="coverage">176<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> names(result$parameters) <- models</pre> + <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> + <pre class="language-r"> # Set colors and symbols</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">62</td> - <td class="coverage"></td> + <td class="coverage">275<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Compare the sum of squared residuals (SSR) to the upper bound of the</pre> + <pre class="language-r"> if (col_obs[1] == "auto") {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">63</td> - <td class="coverage"></td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # confidence region of the SSR for the IORE model</pre> + <pre class="language-r"> col_obs <- 1:length(obs_vars)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">64</td> - <td class="coverage">176<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> result$S <- sapply(result$mmkin, function(x) sum(x$data$residual^2))</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">65</td> - <td class="coverage">176<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> names(result$S) <- c("SFO", "IORE", "DFOP")</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">66</td> - <td class="coverage"></td> + <td class="coverage">275<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Equation (3) on p. 3</pre> + <pre class="language-r"> if (pch_obs[1] == "auto") {</pre> </td> </tr> <tr class="covered"> <td class="num">67</td> - <td class="coverage">176<em>x</em></td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> p <- 3</pre> + <pre class="language-r"> pch_obs <- 1:length(obs_vars)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">68</td> - <td class="coverage">176<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> result$S["IORE"]</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="covered"> <td class="num">69</td> - <td class="coverage">176<em>x</em></td> + <td class="coverage">275<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> + <pre class="language-r"> names(col_obs) <- names(pch_obs) <- obs_vars</pre> </td> </tr> <tr class="never"> @@ -15001,580 +12265,258 @@ table.table-condensed { </tr> <tr class="covered"> <td class="num">71</td> - <td class="coverage">176<em>x</em></td> + <td class="coverage">275<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> + <pre class="language-r"> plot(0, type = "n",</pre> </td> </tr> <tr class="covered"> <td class="num">72</td> - <td class="coverage">176<em>x</em></td> + <td class="coverage">275<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> result$distimes, quiet = quiet)</pre> + <pre class="language-r"> xlab = xlab, ylab = ylab,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">73</td> - <td class="coverage"></td> + <td class="coverage">275<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> xlim = xlim,</pre> </td> </tr> <tr class="covered"> <td class="num">74</td> - <td class="coverage">176<em>x</em></td> + <td class="coverage">275<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> class(result) <- "nafta"</pre> + <pre class="language-r"> ylim = c(0, 1.2 * maxy), frame = frame, ...)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">75</td> - <td class="coverage">176<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> return(result)</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">76</td> - <td class="coverage"></td> + <td class="coverage">275<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">}</pre> + <pre class="language-r"> for(obs_var in obs_vars){</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">77</td> - <td class="coverage"></td> + <td class="coverage">410<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> residuals_plot <- subset(object$data, variable == obs_var, c("predicted", "residual"))</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">78</td> - <td class="coverage"></td> + <td class="coverage">410<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' Plot the results of the three models used in the NAFTA scheme.</pre> + <pre class="language-r"> points(residuals_plot[["predicted"]],</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">79</td> - <td class="coverage"></td> + <td class="coverage">410<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> residuals_plot[["residual"]]^2,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">80</td> - <td class="coverage"></td> + <td class="coverage">410<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' The plots are ordered with increasing complexity of the model in this</pre> + <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">#' function (SFO, then IORE, then DFOP).</pre> + <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> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">83</td> - <td class="coverage"></td> + <td class="coverage">275<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' Calls \code{\link{plot.mmkin}}.</pre> + <pre class="language-r"> if (object$err_mod == "const") {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">84</td> - <td class="coverage"></td> + <td class="coverage">140<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <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">#' @param x An object of class \code{\link{nafta}}.</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">86</td> - <td class="coverage"></td> + <td class="coverage">275<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @param legend Should a legend be added?</pre> + <pre class="language-r"> if (object$err_mod == "obs") {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">87</td> - <td class="coverage"></td> + <td class="coverage">65<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @param main Possibility to override the main title of the plot.</pre> + <pre class="language-r"> for (obs_var in obs_vars) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">88</td> - <td class="coverage"></td> + <td class="coverage">130<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @param \dots Further arguments passed to \code{\link{plot.mmkin}}.</pre> + <pre class="language-r"> sigma_name = paste0("sigma_", obs_var)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">89</td> - <td class="coverage"></td> + <td class="coverage">130<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @return The function is called for its side effect.</pre> + <pre class="language-r"> abline(h = object$errparms[sigma_name]^2, lty = 2,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">90</td> - <td class="coverage"></td> + <td class="coverage">130<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @author Johannes Ranke</pre> + <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">#' @export</pre> + <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.nafta <- function(x, legend = FALSE, main = "auto", ...) {</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="covered"> <td class="num">93</td> - <td class="coverage">176<em>x</em></td> + <td class="coverage">275<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (main == "auto") {</pre> + <pre class="language-r"> if (object$err_mod == "tc") {</pre> </td> </tr> - <tr class="missed"> + <tr class="covered"> <td class="num">94</td> - <td class="coverage">!</td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (is.na(x$title)) main = ""</pre> + <pre class="language-r"> sigma_plot <- function(predicted) {</pre> </td> </tr> <tr class="covered"> <td class="num">95</td> - <td class="coverage">176<em>x</em></td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> else main = x$title</pre> + <pre class="language-r"> sigma_twocomp(predicted,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">96</td> - <td class="coverage"></td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> sigma_low = object$errparms[1],</pre> </td> </tr> <tr class="covered"> <td class="num">97</td> - <td class="coverage">176<em>x</em></td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> plot(x$mmkin, ..., legend = legend, main = main)</pre> + <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> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">99</td> - <td class="coverage"></td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> plot(sigma_plot, from = 0, to = max(object$data$predicted),</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">100</td> - <td class="coverage"></td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' Print nafta objects</pre> + <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> + <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="num">103</td> + <td class="coverage">275<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r"> if (legend == TRUE) {</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="num">104</td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> legend(lpos, inset = c(0.05, 0.05), legend = obs_vars,</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="num">105</td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> col = col_obs[obs_vars], pch = pch_obs[obs_vars])</pre> </td> </tr> <tr class="never"> - <td class="num">151</td> + <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">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="num">107</td> <td class="coverage"></td> <td class="col-sm-12"> <pre class="language-r">}</pre> @@ -15583,273 +12525,273 @@ table.table-condensed { </tbody> </table> </div> - <div id="R/summary.nlme.mmkin.R" class="hidden"> + <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">#' Summary method for class "nlme.mmkin"</pre> + <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> + <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> + <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">#' for fixed effects (population), random effects (deviations from the</pre> + <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">#' population mean) and residual error model, as well as the resulting</pre> + <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">#' endpoints such as formation fractions and DT50 values. Optionally</pre> + <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">#' (default is FALSE), the data are listed in full.</pre> + <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">#'</pre> + <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">#' @param object an object of class [nlme.mmkin]</pre> + <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">#' @param x an object of class [summary.nlme.mmkin]</pre> + <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">#' @param data logical, indicating whether the full data should be included in</pre> + <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">#' the summary.</pre> + <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">#' @param verbose Should the summary be verbose?</pre> + <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">#' @param distimes logical, indicating whether DT50 and DT90 values should be</pre> + <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">#' included.</pre> + <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">#' @param alpha error level for confidence interval estimation from the t</pre> + <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">#' distribution</pre> + <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">#' @param digits Number of digits to use for printing</pre> + <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 \dots optional arguments passed to methods like \code{print}.</pre> + <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">#' @return The summary function returns a list based on the [nlme] object</pre> + <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">#' obtained in the fit, with at least the following additional components</pre> + <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">#' \item{nlmeversion, mkinversion, Rversion}{The nlme, mkin and R versions used}</pre> + <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">#' \item{date.fit, date.summary}{The dates where the fit and the summary were</pre> + <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">#' produced}</pre> + <pre class="language-r">#' @param observed A dataframe or an object coercible to a dataframe</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> + <pre class="language-r">#' (e.g. a \code{tibble}) with the observed data. The first column called</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> + <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">27</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' \item{data}{The data}</pre> + <pre class="language-r">#' The second column must contain the times of observation, named "time".</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> + <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">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> + <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">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> + <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">31</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' model.}</pre> + <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">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> + <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">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> + <pre class="language-r">#' detection.</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> + <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">35</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @importFrom stats predict</pre> + <pre class="language-r">#' including parameters to be optimised and potentially also fixed 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">#' @author Johannes Ranke for the mkin specific parts</pre> + <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">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> + <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">38</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @examples</pre> + <pre class="language-r">#' not in the model gives an error.</pre> </td> </tr> <tr class="never"> @@ -15863,7742 +12805,6647 @@ table.table-condensed { <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> + <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">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> + <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">42</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' dt50_sfo_in_pop <- 50</pre> + <pre class="language-r">#' fitted model, which contains the differential equation parameters from</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> + <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">44</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' set.seed(1234)</pre> + <pre class="language-r">#' given below.</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> + <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">46</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' SFO <- mkinmod(parent = mkinsub("SFO"))</pre> + <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">47</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <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">48</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' pred_sfo <- function(k) {</pre> + <pre class="language-r">#' variables (see \code{map} component of [mkinmod]). The 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">#' mkinpredict(SFO,</pre> + <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">50</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' c(k_parent = k),</pre> + <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">51</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' c(parent = 100),</pre> + <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">52</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' sampling_times)</pre> + <pre class="language-r">#' value is set to 100.</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> + <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">54</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <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">55</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' ds_sfo_mean <- lapply(k_in, pred_sfo)</pre> + <pre class="language-r">#' default values. Otherwise, inital values for all error model parameters</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> + <pre class="language-r">#' must be given.</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> + <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">58</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' set.seed(12345)</pre> + <pre class="language-r">#' rather kept at the values specified in \code{parms.ini}. Alternatively,</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> + <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">60</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' add_err(ds,</pre> + <pre class="language-r">#' in parms.ini.</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> + <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">62</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' n = 1)[[1]]</pre> + <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">63</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' })</pre> + <pre class="language-r">#' state variables except for the first 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">#'</pre> + <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">65</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' \dontrun{</pre> + <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">66</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' # Evaluate using mmkin and nlme</pre> + <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">67</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' library(nlme)</pre> + <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">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> + <pre class="language-r">#' observed mean value is the new time zero.</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> + <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">70</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' summary(f_nlme, data = TRUE)</pre> + <pre class="language-r">#' differential equations is based on the spectral decomposition of the</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> + <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">72</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r">#' numerical [ode solver from package deSolve][deSolve::ode()] is used. If</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> + <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">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> + <pre class="language-r">#' only implemented for relatively simple degradation models. The default is</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> + <pre class="language-r">#' "auto", which uses "analytical" if possible, otherwise "deSolve" if a</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">76</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> mod_vars <- names(object$mkinmod$diffs)</pre> + <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">77</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' can be expressed using eigenvalues and eigenvectors.</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">78</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> confint_trans <- intervals(object, which = "fixed", level = 1 - alpha)$fixed</pre> + <pre class="language-r">#' @param method.ode The solution method passed via [mkinpredict()]</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">79</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> attr(confint_trans, "label") <- NULL</pre> + <pre class="language-r">#' to [deSolve::ode()] in case the solution type is "deSolve". The default</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">80</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> pnames <- rownames(confint_trans)</pre> + <pre class="language-r">#' "lsoda" is performant, but sometimes fails to converge.</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> + <pre class="language-r">#' @param use_compiled If set to \code{FALSE}, no compiled version of the</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">82</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> bp <- backtransform_odeparms(confint_trans[, "est."], object$mkinmod,</pre> + <pre class="language-r">#' [mkinmod] model is used in the calls to [mkinpredict()] even if a compiled</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">83</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$transform_rates, object$transform_fractions)</pre> + <pre class="language-r">#' version is present.</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">84</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> bpnames <- names(bp)</pre> + <pre class="language-r">#' @param control A list of control arguments passed to [stats::nlminb()].</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> + <pre class="language-r">#' @param transform_rates Boolean specifying if kinetic rate constants should</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> + <pre class="language-r">#' be transformed in the model specification used in the fitting for better</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">87</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> fixed <- fixef(object)</pre> + <pre class="language-r">#' compliance with the assumption of normal distribution of the estimator. If</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">88</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> stdFixed <- sqrt(diag(as.matrix(object$varFix)))</pre> + <pre class="language-r">#' TRUE, also alpha and beta parameters of the FOMC model are</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">89</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$corFixed <- array(</pre> + <pre class="language-r">#' log-transformed, as well as k1 and k2 rate constants for the DFOP and HS</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">90</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> t(object$varFix/stdFixed)/stdFixed,</pre> + <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="covered"> + <tr class="never"> <td class="num">91</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> dim(object$varFix),</pre> + <pre class="language-r">#' a lower bound for the rates in the optimisation.</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">92</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> list(names(fixed), names(fixed)))</pre> + <pre class="language-r">#' @param transform_fractions Boolean specifying if 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"></pre> + <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">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> + <pre class="language-r">#' better compliance with the assumption of normal distribution of the</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> + <pre class="language-r">#' estimator. The default (TRUE) is to do transformations. If TRUE,</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">96</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> f_names_skip <- character(0)</pre> + <pre class="language-r">#' the g parameter of the DFOP model is also transformed. Transformations</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">97</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> for (box in mod_vars) { # Figure out sets of fractions to skip</pre> + <pre class="language-r">#' are described in [transform_odeparms].</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">98</td> - <td class="coverage">436<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> f_names <- grep(paste("^f", box, sep = "_"), pnames, value = TRUE)</pre> + <pre class="language-r">#' @param quiet Suppress printing out the current value of the negative</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">99</td> - <td class="coverage">436<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> n_paths <- length(f_names)</pre> + <pre class="language-r">#' log-likelihood after each improvement?</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">100</td> - <td class="coverage">!</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> + <pre class="language-r">#' @param atol Absolute error tolerance, passed to [deSolve::ode()]. Default</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> + <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">102</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' function which is used per default.</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">103</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> confint_back <- matrix(NA, nrow = length(bp), ncol = 3,</pre> + <pre class="language-r">#' @param rtol Absolute error tolerance, passed to [deSolve::ode()]. Default</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">104</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> dimnames = list(bpnames, colnames(confint_trans)))</pre> + <pre class="language-r">#' is 1e-10, much lower than in [deSolve::lsoda()].</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">105</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> confint_back[, "est."] <- bp</pre> + <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">106</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' deviation is assumed.</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">107</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> for (pname in pnames) {</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">108</td> - <td class="coverage">1410<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (!pname %in% f_names_skip) {</pre> + <pre class="language-r">#' If the error model is "obs", each observed variable is assumed to have its</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">109</td> - <td class="coverage">1410<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> par.lower <- confint_trans[pname, "lower"]</pre> + <pre class="language-r">#' own variance.</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">110</td> - <td class="coverage">1410<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> par.upper <- confint_trans[pname, "upper"]</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">111</td> - <td class="coverage">1410<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> names(par.lower) <- names(par.upper) <- pname</pre> + <pre class="language-r">#' If the error model is "tc" (two-component error model), a two component</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">112</td> - <td class="coverage">1410<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> bpl <- backtransform_odeparms(par.lower, object$mkinmod,</pre> + <pre class="language-r">#' error model similar to the one described by Rocke and Lorenzato (1995) is</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">113</td> - <td class="coverage">1410<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$transform_rates,</pre> + <pre class="language-r">#' used for setting up the likelihood function. Note that this model</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">114</td> - <td class="coverage">1410<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$transform_fractions)</pre> + <pre class="language-r">#' deviates from the model by Rocke and Lorenzato, as their model implies</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">115</td> - <td class="coverage">1410<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> bpu <- backtransform_odeparms(par.upper, object$mkinmod,</pre> + <pre class="language-r">#' that the errors follow a lognormal distribution for large values, not a</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">116</td> - <td class="coverage">1410<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$transform_rates,</pre> + <pre class="language-r">#' normal distribution as assumed by this method.</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">117</td> - <td class="coverage">1410<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$transform_fractions)</pre> + <pre class="language-r">#' @param error_model_algorithm If "auto", the selected algorithm depends on</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">118</td> - <td class="coverage">1410<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> confint_back[names(bpl), "lower"] <- bpl</pre> + <pre class="language-r">#' the error model. If the error model is "const", unweighted nonlinear</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">119</td> - <td class="coverage">1410<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> confint_back[names(bpu), "upper"] <- bpu</pre> + <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">120</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">#' "tc", the "d_3" algorithm is selected.</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> + <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> + <pre class="language-r">#' The algorithm "d_3" will directly minimize the negative log-likelihood</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">123</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$confint_trans <- confint_trans</pre> + <pre class="language-r">#' and independently also use the three step algorithm described below.</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">124</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$confint_back <- confint_back</pre> + <pre class="language-r">#' The fit with the higher likelihood is returned.</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> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">126</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$date.summary = date()</pre> + <pre class="language-r">#' The algorithm "direct" will directly minimize the negative log-likelihood.</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">127</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$use_of_ff = object$mkinmod$use_of_ff</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">128</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$error_model_algorithm = object$mmkin[[1]]$error_model_algorithm</pre> + <pre class="language-r">#' The algorithm "twostep" will minimize the negative log-likelihood after an</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">129</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> err_mod = object$mmkin[[1]]$err_mod</pre> + <pre class="language-r">#' initial unweighted least squares optimisation step.</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> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">131</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$diffs <- object$mkinmod$diffs</pre> + <pre class="language-r">#' The algorithm "threestep" starts with unweighted least squares, then</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">132</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$print_data <- data</pre> + <pre class="language-r">#' optimizes only the error model using the degradation model parameters</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">133</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$data[["observed"]] <- object$data[["value"]]</pre> + <pre class="language-r">#' found, and then minimizes the negative log-likelihood with free</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">134</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$data[["value"]] <- NULL</pre> + <pre class="language-r">#' degradation and error model parameters.</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">135</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$data[["predicted"]] <- predict(object)</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">136</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$data[["residual"]] <- residuals(object, type = "response")</pre> + <pre class="language-r">#' The algorithm "fourstep" starts with unweighted least squares, then</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">137</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (is.null(object$modelStruct$varStruct)) {</pre> + <pre class="language-r">#' optimizes only the error model using the degradation model parameters</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">138</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$data[["std"]] <- object$sigma</pre> + <pre class="language-r">#' found, then optimizes the degradation model again with fixed error model</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> + <pre class="language-r">#' parameters, and finally minimizes the negative log-likelihood with free</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">140</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$data[["std"]] <- 1/attr(object$modelStruct$varStruct, "weights")</pre> + <pre class="language-r">#' degradation and error model parameters.</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> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">142</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$data[["standardized"]] <- residuals(object, type = "pearson")</pre> + <pre class="language-r">#' The algorithm "IRLS" (Iteratively Reweighted Least Squares) starts with</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">143</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$verbose <- verbose</pre> + <pre class="language-r">#' unweighted least squares, and then iterates optimization of the error</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> + <pre class="language-r">#' model parameters and subsequent optimization of the degradation model</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">145</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$fixed <- object$mmkin[[1]]$fixed</pre> + <pre class="language-r">#' using those error model parameters, until the error model parameters</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">146</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$AIC = AIC(object)</pre> + <pre class="language-r">#' converge.</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">147</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$BIC = BIC(object)</pre> + <pre class="language-r">#' @param reweight.tol Tolerance for the convergence criterion calculated from</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">148</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$logLik = logLik(object)</pre> + <pre class="language-r">#' the error model parameters 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"></pre> + <pre class="language-r">#' @param reweight.max.iter Maximum number of iterations in IRLS fits.</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">150</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> ep <- endpoints(object)</pre> + <pre class="language-r">#' @param trace_parms Should a trace of the parameter values be listed?</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">151</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (length(ep$ff) != 0)</pre> + <pre class="language-r">#' @param test_residuals Should the residuals be tested for normal distribution?</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">152</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$ff <- ep$ff</pre> + <pre class="language-r">#' @param \dots Further arguments that will be passed on to</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">153</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (distimes) object$distimes <- ep$distimes</pre> + <pre class="language-r">#' [deSolve::ode()].</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">154</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (length(ep$SFORB) != 0) object$SFORB <- ep$SFORB</pre> + <pre class="language-r">#' @importFrom stats nlminb aggregate dist shapiro.test</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">155</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> class(object) <- c("summary.nlme.mmkin", "nlme.mmkin", "nlme", "lme")</pre> + <pre class="language-r">#' @return A list with "mkinfit" in the class attribute.</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">156</td> - <td class="coverage">319<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> return(object)</pre> + <pre class="language-r">#' @note When using the "IORE" submodel for metabolites, fitting with</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> + <pre class="language-r">#' "transform_rates = TRUE" (the default) often leads to failures of 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"></pre> + <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">159</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @rdname summary.nlme.mmkin</pre> + <pre class="language-r">#' internal rate transformation.</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> + <pre class="language-r">#' @author Johannes Ranke</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> + <pre class="language-r">#' @seealso [summary.mkinfit], [plot.mkinfit], [parms] and [lrtest].</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">162</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("nlme version used for fitting: ", x$nlmeversion, "\n")</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">163</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("mkin version used for pre-fitting: ", x$mkinversion, "\n")</pre> + <pre class="language-r">#' Comparisons of models fitted to the same data can be made using</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">164</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("R version used for fitting: ", x$Rversion, "\n")</pre> + <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">165</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">166</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("Date of fit: ", x$date.fit, "\n")</pre> + <pre class="language-r">#' Fitting of several models to several datasets in a single call to</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">167</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("Date of summary:", x$date.summary, "\n")</pre> + <pre class="language-r">#' \code{\link{mmkin}}.</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> + <pre class="language-r">#' @references Rocke DM and Lorenzato S (1995) A two-component model</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">169</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nEquations:\n")</pre> + <pre class="language-r">#' for measurement error in analytical chemistry. *Technometrics* 37(2), 176-184.</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">170</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> nice_diffs <- gsub("^(d.*) =", "\\1/dt =", x[["diffs"]])</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">171</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> writeLines(strwrap(nice_diffs, exdent = 11))</pre> + <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">172</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' Degradation Data. *Environments* 6(12) 124</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">173</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nData:\n")</pre> + <pre class="language-r">#' \doi{10.3390/environments6120124}.</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">174</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat(nrow(x$data), "observations of",</pre> + <pre class="language-r">#' @examples</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">175</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> length(unique(x$data$name)), "variable(s) grouped in",</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">176</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> length(unique(x$data$ds)), "datasets\n")</pre> + <pre class="language-r">#' # Use shorthand notation for parent only degradation</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> + <pre class="language-r">#' fit <- mkinfit("FOMC", FOCUS_2006_C, quiet = TRUE)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">178</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nModel predictions using solution type", x$solution_type, "\n")</pre> + <pre class="language-r">#' summary(fit)</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> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">180</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nFitted in", x$time[["elapsed"]], "s using", x$numIter, "iterations\n")</pre> + <pre class="language-r">#' # One parent compound, one metabolite, both single first order.</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> + <pre class="language-r">#' # We remove zero values from FOCUS dataset D in order to avoid warnings</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">182</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nVariance model: ")</pre> + <pre class="language-r">#' FOCUS_D <- subset(FOCUS_2006_D, value != 0)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">183</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat(switch(x$err_mod,</pre> + <pre class="language-r">#' # Use mkinsub for convenience in model formulation. Pathway to sink included per default.</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">184</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> const = "Constant variance",</pre> + <pre class="language-r">#' SFO_SFO <- mkinmod(</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">185</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> obs = "Variance unique to each observed variable",</pre> + <pre class="language-r">#' parent = mkinsub("SFO", "m1"),</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">186</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> tc = "Two-component variance function"), "\n")</pre> + <pre class="language-r">#' m1 = mkinsub("SFO"))</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> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">188</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nMean of starting values for individual parameters:\n")</pre> + <pre class="language-r">#' # Fit the model quietly to the FOCUS example dataset D using defaults</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">189</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> print(x$mean_dp_start, digits = digits)</pre> + <pre class="language-r">#' fit <- mkinfit(SFO_SFO, FOCUS_D, quiet = TRUE)</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> + <pre class="language-r">#' plot_sep(fit)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">191</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nFixed degradation parameter values:\n")</pre> + <pre class="language-r">#' # As lower parent values appear to have lower variance, we try an alternative error model</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">192</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if(length(x$fixed$value) == 0) cat("None\n")</pre> + <pre class="language-r">#' fit.tc <- mkinfit(SFO_SFO, FOCUS_D, quiet = TRUE, error_model = "tc")</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">193</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> else print(x$fixed, digits = digits)</pre> + <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">194</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' lrtest(fit.tc, fit)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">195</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nResults:\n\n")</pre> + <pre class="language-r">#' # We can also allow for different variances of parent and metabolite as error model</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">196</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> print(data.frame(AIC = x$AIC, BIC = x$BIC, logLik = x$logLik,</pre> + <pre class="language-r">#' fit.obs <- mkinfit(SFO_SFO, FOCUS_D, quiet = TRUE, error_model = "obs")</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">197</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> row.names = " "), digits = digits, ...)</pre> + <pre class="language-r">#' # The two-component error model has significantly higher likelihood</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> + <pre class="language-r">#' lrtest(fit.obs, fit.tc)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">199</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nOptimised, transformed parameters with symmetric confidence intervals:\n")</pre> + <pre class="language-r">#' parms(fit.tc)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">200</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> print(x$confint_trans, digits = digits, ...)</pre> + <pre class="language-r">#' endpoints(fit.tc)</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> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">202</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (nrow(x$confint_trans) > 1) {</pre> + <pre class="language-r">#' # We can show a quick (only one replication) benchmark for this case, as we</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">203</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> corr <- x$corFixed</pre> + <pre class="language-r">#' # have several alternative solution methods for the model. We skip</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">204</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> class(corr) <- "correlation"</pre> + <pre class="language-r">#' # uncompiled deSolve, as it is so slow. More benchmarks are found in the</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">205</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> print(corr, title = "\nCorrelation:", rdig = digits, ...)</pre> + <pre class="language-r">#' # benchmark vignette</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> + <pre class="language-r">#' \dontrun{</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> + <pre class="language-r">#' if(require(rbenchmark)) {</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">208</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\n") # Random effects</pre> + <pre class="language-r">#' benchmark(replications = 1, order = "relative", columns = c("test", "relative", "elapsed"),</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">209</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> print(summary(x$modelStruct), sigma = x$sigma,</pre> + <pre class="language-r">#' deSolve_compiled = mkinfit(SFO_SFO, FOCUS_D, quiet = TRUE, error_model = "tc",</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">210</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> reEstimates = x$coef$random, digits = digits, verbose = verbose, ...)</pre> + <pre class="language-r">#' solution_type = "deSolve", use_compiled = TRUE),</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> + <pre class="language-r">#' eigen = mkinfit(SFO_SFO, FOCUS_D, quiet = TRUE, error_model = "tc",</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">212</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nBacktransformed parameters with asymmetric confidence intervals:\n")</pre> + <pre class="language-r">#' solution_type = "eigen"),</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">213</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> print(x$confint_back, digits = digits, ...)</pre> + <pre class="language-r">#' analytical = mkinfit(SFO_SFO, FOCUS_D, quiet = TRUE, error_model = "tc",</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> + <pre class="language-r">#' solution_type = "analytical"))</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> + <pre class="language-r">#' }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">216</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> printSFORB <- !is.null(x$SFORB)</pre> + <pre class="language-r">#' }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">217</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if(printSFORB){</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">218</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nEstimated Eigenvalues of SFORB model(s):\n")</pre> + <pre class="language-r">#' # Use stepwise fitting, using optimised parameters from parent only fit, FOMC-SFO</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">219</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> print(x$SFORB, digits = digits,...)</pre> + <pre class="language-r">#' \dontrun{</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> + <pre class="language-r">#' FOMC_SFO <- mkinmod(</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> + <pre class="language-r">#' parent = mkinsub("FOMC", "m1"),</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">222</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> printff <- !is.null(x$ff)</pre> + <pre class="language-r">#' m1 = mkinsub("SFO"))</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">223</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if(printff){</pre> + <pre class="language-r">#' fit.FOMC_SFO <- mkinfit(FOMC_SFO, FOCUS_D, quiet = TRUE)</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">224</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nResulting formation fractions:\n")</pre> + <pre class="language-r">#' # Again, we get a warning and try a more sophisticated error model</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">225</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> print(data.frame(ff = x$ff), digits = digits, ...)</pre> + <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">226</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">#' # This model has a higher likelihood, but not significantly so</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> + <pre class="language-r">#' lrtest(fit.tc, fit.FOMC_SFO.tc)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">228</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> printdistimes <- !is.null(x$distimes)</pre> + <pre class="language-r">#' # Also, the missing standard error for log_beta and the t-tests for alpha</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">229</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if(printdistimes){</pre> + <pre class="language-r">#' # and beta indicate overparameterisation</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">230</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nEstimated disappearance times:\n")</pre> + <pre class="language-r">#' summary(fit.FOMC_SFO.tc, data = FALSE)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">231</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> print(x$distimes, digits = digits, ...)</pre> + <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> + <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">233</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' fit.FOMC = mkinfit("FOMC", FOCUS_2006_D, quiet = TRUE, error_model = "tc")</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">234</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (x$print_data){</pre> + <pre class="language-r">#' fit.FOMC_SFO <- mkinfit(FOMC_SFO, FOCUS_D, quiet = TRUE,</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">235</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nData:\n")</pre> + <pre class="language-r">#' parms.ini = fit.FOMC$bparms.ode, error_model = "tc")</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">236</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> print(format(x$data, digits = digits, ...), row.names = FALSE)</pre> + <pre class="language-r">#' }</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> + <pre class="language-r">#' @export</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> + <pre class="language-r">mkinfit <- function(mkinmod, observed,</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">239</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> invisible(x)</pre> + <pre class="language-r"> parms.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">}</pre> + <pre class="language-r"> state.ini = "auto",</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="num">241</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">utils::globalVariables(c("variable", "residual"))</pre> + <pre class="language-r"> err.ini = "auto",</pre> </td> </tr> <tr class="never"> - <td class="num">2</td> + <td class="num">242</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> fixed_parms = NULL,</pre> </td> </tr> <tr class="never"> - <td class="num">3</td> + <td class="num">243</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> + <pre class="language-r"> fixed_initials = names(mkinmod$diffs)[-1],</pre> </td> </tr> <tr class="never"> - <td class="num">4</td> + <td class="num">244</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' </pre> + <pre class="language-r"> from_max_mean = FALSE,</pre> </td> </tr> <tr class="never"> - <td class="num">5</td> + <td class="num">245</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> + <pre class="language-r"> solution_type = c("auto", "analytical", "eigen", "deSolve"),</pre> </td> </tr> <tr class="never"> - <td class="num">6</td> + <td class="num">246</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> + <pre class="language-r"> method.ode = "lsoda",</pre> </td> </tr> <tr class="never"> - <td class="num">7</td> + <td class="num">247</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> + <pre class="language-r"> use_compiled = "auto",</pre> </td> </tr> <tr class="never"> - <td class="num">8</td> + <td class="num">248</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> + <pre class="language-r"> control = list(eval.max = 300, iter.max = 200),</pre> </td> </tr> <tr class="never"> - <td class="num">9</td> + <td class="num">249</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' using the argument \code{show_errplot = TRUE}.</pre> + <pre class="language-r"> transform_rates = TRUE,</pre> </td> </tr> <tr class="never"> - <td class="num">10</td> + <td class="num">250</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' </pre> + <pre class="language-r"> transform_fractions = TRUE,</pre> </td> </tr> <tr class="never"> - <td class="num">11</td> + <td class="num">251</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> + <pre class="language-r"> quiet = FALSE,</pre> </td> </tr> <tr class="never"> - <td class="num">12</td> + <td class="num">252</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> + <pre class="language-r"> atol = 1e-8, rtol = 1e-10,</pre> </td> </tr> <tr class="never"> - <td class="num">13</td> + <td class="num">253</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> + <pre class="language-r"> error_model = c("const", "obs", "tc"),</pre> </td> </tr> <tr class="never"> - <td class="num">14</td> + <td class="num">254</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' the model</pre> + <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">15</td> + <td class="num">255</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @param xlim plot range in x direction.</pre> + <pre class="language-r"> reweight.tol = 1e-8, reweight.max.iter = 10,</pre> </td> </tr> <tr class="never"> - <td class="num">16</td> + <td class="num">256</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @param xlab Label for the x axis.</pre> + <pre class="language-r"> trace_parms = FALSE,</pre> </td> </tr> <tr class="never"> - <td class="num">17</td> + <td class="num">257</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @param ylab Label for the y axis.</pre> + <pre class="language-r"> test_residuals = FALSE,</pre> </td> </tr> <tr class="never"> - <td class="num">18</td> + <td class="num">258</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> + <pre class="language-r"> ...)</pre> </td> </tr> <tr class="never"> - <td class="num">19</td> + <td class="num">259</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' the y axis and defaults to "auto".</pre> + <pre class="language-r">{</pre> </td> </tr> - <tr class="never"> - <td class="num">20</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">260</td> + <td class="coverage">9202<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @param legend Should a legend be plotted?</pre> + <pre class="language-r"> call <- match.call()</pre> </td> </tr> <tr class="never"> - <td class="num">21</td> + <td class="num">261</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> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> - <td class="num">22</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">262</td> + <td class="coverage">9202<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' be passed on to \code{\link{legend}}.</pre> + <pre class="language-r"> summary_warnings <- character()</pre> </td> </tr> <tr class="never"> - <td class="num">23</td> + <td class="num">263</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @param col_obs Colors for the observed variables.</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">24</td> + <td class="num">264</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> + <pre class="language-r"> # Derive the name used for the model</pre> </td> </tr> - <tr class="never"> - <td class="num">25</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">265</td> + <td class="coverage">9202<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @param frame Should a frame be drawn around the plots?</pre> + <pre class="language-r"> if (is.character(mkinmod)) {</pre> </td> </tr> - <tr class="never"> - <td class="num">26</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">266</td> + <td class="coverage">4009<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @param \dots further arguments passed to \code{\link{plot}}.</pre> + <pre class="language-r"> mkinmod_name <- mkinmod</pre> </td> </tr> <tr class="never"> - <td class="num">27</td> + <td class="num">267</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> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="never"> - <td class="num">28</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">268</td> + <td class="coverage">5193<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' effect, namely to produce a plot.</pre> + <pre class="language-r"> if (is.null(mkinmod$name)) {</pre> </td> </tr> - <tr class="never"> - <td class="num">29</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">269</td> + <td class="coverage">5071<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @author Johannes Ranke</pre> + <pre class="language-r"> mkinmod_name <- deparse(substitute(mkinmod))</pre> </td> </tr> <tr class="never"> - <td class="num">30</td> + <td class="num">270</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> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="never"> - <td class="num">31</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">271</td> + <td class="coverage">18<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' lines of the mkinfit object.</pre> + <pre class="language-r"> mkinmod_name <- mkinmod$name</pre> </td> </tr> <tr class="never"> - <td class="num">32</td> + <td class="num">272</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @keywords hplot</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">33</td> + <td class="num">273</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @examples</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">34</td> + <td class="num">274</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' </pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">35</td> + <td class="num">275</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' \dontrun{</pre> + <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">36</td> + <td class="num">276</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' model <- mkinmod(parent = mkinsub("SFO", "m1"), m1 = mkinsub("SFO"))</pre> + <pre class="language-r"> # if a suitable string is given</pre> </td> </tr> - <tr class="never"> - <td class="num">37</td> - <td class="coverage"></td> + <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">#' fit <- mkinfit(model, FOCUS_2006_D, error_model = "tc", quiet = TRUE)</pre> + <pre class="language-r"> parent_models_available = c("SFO", "FOMC", "DFOP", "HS", "SFORB", "IORE", "logistic")</pre> </td> </tr> - <tr class="never"> - <td class="num">38</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">278</td> + <td class="coverage">9098<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' mkinerrplot(fit)</pre> + <pre class="language-r"> if (!inherits(mkinmod, "mkinmod")) {</pre> </td> </tr> - <tr class="never"> - <td class="num">39</td> - <td class="coverage"></td> + <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">#' }</pre> + <pre class="language-r"> presumed_parent_name = observed[which.max(observed$value), "name"]</pre> </td> </tr> - <tr class="never"> - <td class="num">40</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">280</td> + <td class="coverage">4009<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' </pre> + <pre class="language-r"> if (mkinmod[[1]] %in% parent_models_available) {</pre> </td> </tr> - <tr class="never"> - <td class="num">41</td> - <td class="coverage"></td> + <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">#' @export</pre> + <pre class="language-r"> speclist <- list(list(type = mkinmod, sink = TRUE))</pre> </td> </tr> - <tr class="never"> - <td class="num">42</td> - <td class="coverage"></td> + <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">mkinerrplot <- function (object,</pre> + <pre class="language-r"> names(speclist) <- presumed_parent_name</pre> </td> </tr> - <tr class="never"> - <td class="num">43</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">283</td> + <td class="coverage">3905<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> obs_vars = names(object$mkinmod$map),</pre> + <pre class="language-r"> mkinmod <- mkinmod(speclist = speclist, use_of_ff = "max")</pre> </td> </tr> <tr class="never"> - <td class="num">44</td> + <td class="num">284</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> xlim = c(0, 1.1 * max(object$data$predicted)),</pre> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="never"> - <td class="num">45</td> - <td class="coverage"></td> + <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"> xlab = "Predicted", ylab = "Squared residual",</pre> + <pre class="language-r"> stop("Argument mkinmod must be of class mkinmod or a string containing one of\n ",</pre> </td> </tr> - <tr class="never"> - <td class="num">46</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">286</td> + <td class="coverage">104<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> maxy = "auto", legend= TRUE, lpos = "topright",</pre> + <pre class="language-r"> paste(parent_models_available, collapse = ", "))</pre> </td> </tr> <tr class="never"> - <td class="num">47</td> + <td class="num">287</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> col_obs = "auto", pch_obs = "auto",</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">48</td> + <td class="num">288</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> frame = TRUE,</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">49</td> + <td class="num">289</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> ...)</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">50</td> + <td class="num">290</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">{</pre> + <pre class="language-r"> # Get the names of the state variables in the model</pre> </td> </tr> <tr class="covered"> - <td class="num">51</td> - <td class="coverage">275<em>x</em></td> + <td class="num">291</td> + <td class="coverage">8994<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> obs_vars_all <- as.character(unique(object$data$variable))</pre> + <pre class="language-r"> mod_vars <- names(mkinmod$diffs)</pre> </td> </tr> <tr class="never"> - <td class="num">52</td> + <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">53</td> - <td class="coverage">275<em>x</em></td> + <tr class="never"> + <td class="num">293</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (length(obs_vars) > 0){</pre> + <pre class="language-r"> # Get the names of observed variables</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="num">294</td> + <td class="coverage">8994<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> } else obs_vars <- obs_vars_all</pre> + <pre class="language-r"> obs_vars <- names(mkinmod$spec)</pre> </td> </tr> <tr class="never"> - <td class="num">56</td> + <td class="num">295</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="num">296</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> # Coerce observed data to a dataframe</pre> </td> </tr> <tr class="covered"> - <td class="num">59</td> - <td class="coverage">275<em>x</em></td> + <td class="num">297</td> + <td class="coverage">8994<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (maxy == "auto") maxy = max(residuals^2, na.rm = TRUE)</pre> + <pre class="language-r"> observed <- as.data.frame(observed)</pre> </td> </tr> <tr class="never"> - <td class="num">60</td> + <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">61</td> + <td class="num">299</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # Set colors and symbols</pre> + <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">62</td> - <td class="coverage">275<em>x</em></td> + <td class="num">300</td> + <td class="coverage">8994<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (col_obs[1] == "auto") {</pre> + <pre class="language-r"> observed <- subset(observed, name %in% obs_vars)</pre> </td> </tr> <tr class="covered"> - <td class="num">63</td> - <td class="coverage">70<em>x</em></td> + <td class="num">301</td> + <td class="coverage">8994<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> col_obs <- 1:length(obs_vars)</pre> + <pre class="language-r"> observed <- subset(observed, !is.na(value))</pre> </td> </tr> <tr class="never"> - <td class="num">64</td> + <td class="num">302</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">65</td> + <td class="num">303</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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">66</td> - <td class="coverage">275<em>x</em></td> + <td class="num">304</td> + <td class="coverage">8994<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (pch_obs[1] == "auto") {</pre> + <pre class="language-r"> if (any(observed$value == 0)) {</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="num">305</td> + <td class="coverage">529<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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">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="num">306</td> + <td class="coverage">529<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> summary_warnings <- c(summary_warnings, Z = zero_warning)</pre> </td> </tr> <tr class="covered"> - <td class="num">71</td> - <td class="coverage">275<em>x</em></td> + <td class="num">307</td> + <td class="coverage">529<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> plot(0, type = "n",</pre> + <pre class="language-r"> warning(zero_warning)</pre> </td> </tr> <tr class="covered"> - <td class="num">72</td> - <td class="coverage">275<em>x</em></td> + <td class="num">308</td> + <td class="coverage">529<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> xlab = xlab, ylab = ylab,</pre> + <pre class="language-r"> observed <- subset(observed, value != 0)</pre> </td> </tr> - <tr class="covered"> - <td class="num">73</td> - <td class="coverage">275<em>x</em></td> + <tr class="never"> + <td class="num">309</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> xlim = xlim,</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> - <td class="num">74</td> - <td class="coverage">275<em>x</em></td> + <tr class="never"> + <td class="num">310</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> ylim = c(0, 1.2 * maxy), frame = frame, ...)</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">75</td> + <td class="num">311</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> # Sort observed values for efficient analytical predictions</pre> </td> </tr> <tr class="covered"> - <td class="num">76</td> - <td class="coverage">275<em>x</em></td> + <td class="num">312</td> + <td class="coverage">8994<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> for(obs_var in obs_vars){</pre> + <pre class="language-r"> observed$name <- ordered(observed$name, levels = obs_vars)</pre> </td> </tr> <tr class="covered"> - <td class="num">77</td> - <td class="coverage">410<em>x</em></td> + <td class="num">313</td> + <td class="coverage">8994<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> + <pre class="language-r"> observed <- observed[order(observed$name, observed$time), ]</pre> </td> </tr> - <tr class="covered"> - <td class="num">78</td> - <td class="coverage">410<em>x</em></td> + <tr class="never"> + <td class="num">314</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> points(residuals_plot[["predicted"]],</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> - <td class="num">79</td> - <td class="coverage">410<em>x</em></td> + <tr class="never"> + <td class="num">315</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> residuals_plot[["residual"]]^2,</pre> + <pre class="language-r"> # Obtain data for decline from maximum mean value if requested</pre> </td> </tr> <tr class="covered"> - <td class="num">80</td> - <td class="coverage">410<em>x</em></td> + <td class="num">316</td> + <td class="coverage">8994<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> pch = pch_obs[obs_var], col = col_obs[obs_var])</pre> + <pre class="language-r"> if (from_max_mean) {</pre> </td> </tr> <tr class="never"> - <td class="num">81</td> + <td class="num">317</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> # This is only used for simple decline models</pre> </td> </tr> - <tr class="never"> - <td class="num">82</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">318</td> + <td class="coverage">459<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> if (length(obs_vars) > 1)</pre> </td> </tr> <tr class="covered"> - <td class="num">83</td> - <td class="coverage">275<em>x</em></td> + <td class="num">319</td> + <td class="coverage">153<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (object$err_mod == "const") {</pre> + <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">84</td> - <td class="coverage">140<em>x</em></td> + <td class="num">320</td> + <td class="coverage">306<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> abline(h = object$errparms^2, lty = 2, col = 1)</pre> + <pre class="language-r"> observed$name <- as.character(observed$name)</pre> </td> </tr> <tr class="never"> - <td class="num">85</td> + <td class="num">321</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> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">87</td> - <td class="coverage">65<em>x</em></td> + <td class="num">322</td> + <td class="coverage">306<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> for (obs_var in obs_vars) {</pre> + <pre class="language-r"> means <- aggregate(value ~ time, data = observed, mean, na.rm=TRUE)</pre> </td> </tr> <tr class="covered"> - <td class="num">88</td> - <td class="coverage">130<em>x</em></td> + <td class="num">323</td> + <td class="coverage">306<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> sigma_name = paste0("sigma_", obs_var)</pre> + <pre class="language-r"> t_of_max <- means[which.max(means$value), "time"]</pre> </td> </tr> <tr class="covered"> - <td class="num">89</td> - <td class="coverage">130<em>x</em></td> + <td class="num">324</td> + <td class="coverage">306<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> abline(h = object$errparms[sigma_name]^2, lty = 2,</pre> + <pre class="language-r"> observed <- subset(observed, time >= t_of_max)</pre> </td> </tr> <tr class="covered"> - <td class="num">90</td> - <td class="coverage">130<em>x</em></td> + <td class="num">325</td> + <td class="coverage">306<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> col = col_obs[obs_var])</pre> + <pre class="language-r"> observed$time <- observed$time - t_of_max</pre> </td> </tr> <tr class="never"> - <td class="num">91</td> + <td class="num">326</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">92</td> + <td class="num">327</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> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> - <td class="num">95</td> - <td class="coverage">70<em>x</em></td> + <tr class="never"> + <td class="num">328</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> sigma_twocomp(predicted,</pre> + <pre class="language-r"> # Number observations used for fitting</pre> </td> </tr> <tr class="covered"> - <td class="num">96</td> - <td class="coverage">70<em>x</em></td> + <td class="num">329</td> + <td class="coverage">8841<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> sigma_low = object$errparms[1],</pre> + <pre class="language-r"> n_observed <- nrow(observed)</pre> </td> </tr> - <tr class="covered"> - <td class="num">97</td> - <td class="coverage">70<em>x</em></td> + <tr class="never"> + <td class="num">330</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> rsd_high = object$errparms[2])^2</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">98</td> + <td class="num">331</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> # Define starting values for parameters where not specified by the user</pre> </td> </tr> <tr class="covered"> - <td class="num">99</td> - <td class="coverage">70<em>x</em></td> + <td class="num">332</td> + <td class="coverage">8371<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> plot(sigma_plot, from = 0, to = max(object$data$predicted),</pre> + <pre class="language-r"> if (parms.ini[[1]] == "auto") parms.ini = vector()</pre> </td> </tr> - <tr class="covered"> - <td class="num">100</td> - <td class="coverage">70<em>x</em></td> + <tr class="never"> + <td class="num">333</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> add = TRUE, lty = 2, col = 1)</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">101</td> + <td class="num">334</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> # Override parms.ini for parameters given as a numeric vector in</pre> </td> </tr> <tr class="never"> - <td class="num">102</td> + <td class="num">335</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> # fixed_parms</pre> </td> </tr> <tr class="covered"> - <td class="num">103</td> - <td class="coverage">275<em>x</em></td> + <td class="num">336</td> + <td class="coverage">8841<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (legend == TRUE) {</pre> + <pre class="language-r"> if (is.numeric(fixed_parms)) {</pre> </td> </tr> <tr class="covered"> - <td class="num">104</td> - <td class="coverage">70<em>x</em></td> + <td class="num">337</td> + <td class="coverage">3<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> + <pre class="language-r"> fixed_parm_names <- names(fixed_parms)</pre> </td> </tr> <tr class="covered"> - <td class="num">105</td> - <td class="coverage">70<em>x</em></td> + <td class="num">338</td> + <td class="coverage">3<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> col = col_obs[obs_vars], pch = pch_obs[obs_vars])</pre> + <pre class="language-r"> parms.ini[fixed_parm_names] <- fixed_parms</pre> </td> </tr> - <tr class="never"> - <td class="num">106</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">339</td> + <td class="coverage">3<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> fixed_parms <- fixed_parm_names</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="num">340</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' Plot parameter variability of multistart objects</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">2</td> + <td class="num">341</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">3</td> + <td class="num">342</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> + <pre class="language-r"> # Warn for inital parameter specifications that are not in the model</pre> </td> </tr> - <tr class="never"> - <td class="num">4</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">343</td> + <td class="coverage">8841<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' either by the parameters of the run with the highest likelihood,</pre> + <pre class="language-r"> wrongpar.names <- setdiff(names(parms.ini), mkinmod$parms)</pre> </td> </tr> - <tr class="never"> - <td class="num">5</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">344</td> + <td class="coverage">8841<em>x</em></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> + <pre class="language-r"> if (length(wrongpar.names) > 0) {</pre> </td> </tr> - <tr class="never"> - <td class="num">6</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">345</td> + <td class="coverage">257<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> warning("Initial parameter(s) ", paste(wrongpar.names, collapse = ", "),</pre> </td> </tr> - <tr class="never"> - <td class="num">7</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">346</td> + <td class="coverage">257<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' Starting values of degradation model parameters and error model parameters</pre> + <pre class="language-r"> " not used in the model")</pre> </td> </tr> - <tr class="never"> - <td class="num">8</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">347</td> + <td class="coverage">257<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' are shown as green circles. The results obtained in the original run</pre> + <pre class="language-r"> parms.ini <- parms.ini[setdiff(names(parms.ini), wrongpar.names)]</pre> </td> </tr> <tr class="never"> - <td class="num">9</td> + <td class="num">348</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' are shown as red circles.</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">10</td> + <td class="num">349</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">11</td> + <td class="num">350</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @param object The [multistart] object</pre> + <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">12</td> + <td class="num">351</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> + <pre class="language-r"> # fitted in the transformed way</pre> </td> </tr> - <tr class="never"> - <td class="num">13</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">352</td> + <td class="coverage">8841<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @param llquant Fractional value for selecting only the fits with higher</pre> + <pre class="language-r"> if (mkinmod$use_of_ff == "max" & transform_fractions == FALSE) {</pre> </td> </tr> - <tr class="never"> - <td class="num">14</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">353</td> + <td class="coverage">410<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' likelihoods. Overrides 'llmin'.</pre> + <pre class="language-r"> warning("The sum of formation fractions may exceed one if you do not use ",</pre> </td> </tr> - <tr class="never"> - <td class="num">15</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">354</td> + <td class="coverage">410<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @param scale By default, scale parameters using the best</pre> + <pre class="language-r"> "transform_fractions = TRUE." )</pre> </td> </tr> - <tr class="never"> - <td class="num">16</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">355</td> + <td class="coverage">410<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' available fit.</pre> + <pre class="language-r"> for (box in mod_vars) {</pre> </td> </tr> <tr class="never"> - <td class="num">17</td> + <td class="num">356</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> + <pre class="language-r"> # Stop if formation fractions are not transformed and we have no sink</pre> </td> </tr> - <tr class="never"> - <td class="num">18</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">357</td> + <td class="coverage">716<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @param main Title of the plot</pre> + <pre class="language-r"> if (mkinmod$spec[[box]]$sink == FALSE) {</pre> </td> </tr> - <tr class="never"> - <td class="num">19</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">358</td> + <td class="coverage">104<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @param lpos Positioning of the legend.</pre> + <pre class="language-r"> stop("If formation fractions are not transformed during the fitting, ",</pre> </td> </tr> - <tr class="never"> - <td class="num">20</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">359</td> + <td class="coverage">104<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @param \dots Passed to [boxplot]</pre> + <pre class="language-r"> "it is not supported to turn off pathways to sink.\n ",</pre> </td> </tr> - <tr class="never"> - <td class="num">21</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">360</td> + <td class="coverage">104<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @references Duchesne R, Guillemin A, Gandrillon O, Crauste F. Practical</pre> + <pre class="language-r"> "Consider turning on the transformation of formation fractions or ",</pre> </td> </tr> - <tr class="never"> - <td class="num">22</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">361</td> + <td class="coverage">104<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' identifiability in the frame of nonlinear mixed effects models: the example</pre> + <pre class="language-r"> "setting up a model with use_of_ff = 'min'.\n")</pre> </td> </tr> <tr class="never"> - <td class="num">23</td> + <td class="num">362</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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">24</td> + <td class="num">363</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' doi: 10.1186/s12859-021-04373-4.</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">25</td> + <td class="num">364</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @seealso [multistart]</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">26</td> + <td class="num">365</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @importFrom stats median quantile</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">27</td> + <td class="num">366</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <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">28</td> + <td class="num">367</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">parplot <- function(object, ...) {</pre> + <pre class="language-r"> # this is not supported</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="num">368</td> + <td class="coverage">8737<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">}</pre> + <pre class="language-r"> if (transform_fractions == TRUE && length(fixed_parms) > 0) {</pre> </td> </tr> - <tr class="never"> - <td class="num">31</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">369</td> + <td class="coverage">107<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> if (any(grepl("^f_", fixed_parms))) {</pre> </td> </tr> - <tr class="never"> - <td class="num">32</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">370</td> + <td class="coverage">104<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @rdname parplot</pre> + <pre class="language-r"> stop("Fixing formation fractions is not supported when using the ilr ",</pre> </td> </tr> - <tr class="never"> - <td class="num">33</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">371</td> + <td class="coverage">104<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <pre class="language-r"> "transformation.")</pre> </td> </tr> <tr class="never"> - <td class="num">34</td> + <td class="num">372</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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">35</td> + <td class="num">373</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> scale = c("best", "median"),</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">36</td> + <td class="num">374</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> lpos = "bottomleft", main = "", ...)</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">37</td> + <td class="num">375</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> + <pre class="language-r"> # Set initial parameter values, including a small increment (salt)</pre> </td> </tr> <tr class="never"> - <td class="num">40</td> + <td class="num">376</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> + <pre class="language-r"> # to avoid linear dependencies (singular matrix) in Eigenvalue based solutions</pre> </td> </tr> <tr class="covered"> - <td class="num">42</td> - <td class="coverage">176<em>x</em></td> + <td class="num">377</td> + <td class="coverage">8633<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> orig_parms <- parms(orig)</pre> + <pre class="language-r"> k_salt = 0</pre> </td> </tr> <tr class="covered"> - <td class="num">43</td> - <td class="coverage">176<em>x</em></td> + <td class="num">378</td> + <td class="coverage">8633<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> start_degparms <- orig$mean_dp_start</pre> + <pre class="language-r"> defaultpar.names <- setdiff(mkinmod$parms, names(parms.ini))</pre> </td> </tr> <tr class="covered"> - <td class="num">44</td> - <td class="coverage">176<em>x</em></td> + <td class="num">379</td> + <td class="coverage">8633<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> all_parms <- parms(object, exclude_failed = FALSE)</pre> + <pre class="language-r"> for (parmname in defaultpar.names) {</pre> </td> </tr> <tr class="never"> - <td class="num">45</td> + <td class="num">380</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> # Default values for rate constants, depending on the parameterisation</pre> </td> </tr> <tr class="covered"> - <td class="num">46</td> - <td class="coverage">176<em>x</em></td> + <td class="num">381</td> + <td class="coverage">20999<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (inherits(object, "multistart.saem.mmkin")) {</pre> + <pre class="language-r"> if (grepl("^k", parmname)) {</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="num">382</td> + <td class="coverage">15908<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (inherits(object$so, "try-error")) return(NA)</pre> + <pre class="language-r"> parms.ini[parmname] = 0.1 + k_salt</pre> </td> </tr> <tr class="covered"> - <td class="num">49</td> - <td class="coverage">1408<em>x</em></td> + <td class="num">383</td> + <td class="coverage">15908<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> else return(logLik(object$so))</pre> + <pre class="language-r"> k_salt = k_salt + 1e-4</pre> </td> </tr> <tr class="never"> - <td class="num">50</td> + <td class="num">384</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="num">385</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> + <pre class="language-r"> # Default values for rate constants for reversible binding</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="num">386</td> + <td class="coverage">26<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (llmin != -Inf) warning("Overriding 'llmin' because 'llquant' was specified")</pre> + <pre class="language-r"> if (grepl("free_bound$", parmname)) parms.ini[parmname] = 0.1</pre> </td> </tr> <tr class="covered"> - <td class="num">57</td> - <td class="coverage">88<em>x</em></td> + <td class="num">387</td> + <td class="coverage">26<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> llmin <- quantile(ll, 1 - llquant)</pre> + <pre class="language-r"> if (grepl("bound_free$", parmname)) parms.ini[parmname] = 0.02</pre> </td> </tr> <tr class="never"> - <td class="num">58</td> + <td class="num">388</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> + <pre class="language-r"> # Default values for IORE exponents</pre> </td> </tr> <tr class="covered"> - <td class="num">60</td> + <td class="num">389</td> <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> selected_parms <- all_parms[selected, ]</pre> + <pre class="language-r"> if (grepl("^N", parmname)) parms.ini[parmname] = 1.1</pre> </td> </tr> <tr class="never"> - <td class="num">61</td> + <td class="num">390</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> # Default values for the FOMC, DFOP and HS models</pre> </td> </tr> <tr class="covered"> - <td class="num">62</td> - <td class="coverage">176<em>x</em></td> + <td class="num">391</td> + <td class="coverage">238<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> par(las = 1)</pre> + <pre class="language-r"> if (parmname == "alpha") parms.ini[parmname] = 1</pre> </td> </tr> <tr class="covered"> - <td class="num">63</td> - <td class="coverage">176<em>x</em></td> + <td class="num">392</td> + <td class="coverage">238<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (orig$transformations == "mkin") {</pre> + <pre class="language-r"> if (parmname == "beta") parms.ini[parmname] = 10</pre> </td> </tr> <tr class="covered"> - <td class="num">64</td> - <td class="coverage">88<em>x</em></td> + <td class="num">393</td> + <td class="coverage">1014<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> degparm_names_transformed <- names(start_degparms)</pre> + <pre class="language-r"> if (parmname == "k1") parms.ini[parmname] = 0.1</pre> </td> </tr> <tr class="covered"> - <td class="num">65</td> - <td class="coverage">88<em>x</em></td> + <td class="num">394</td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> degparm_index <- which(names(orig_parms) %in% degparm_names_transformed)</pre> + <pre class="language-r"> if (parmname == "k2") parms.ini[parmname] = 0.01</pre> </td> </tr> <tr class="covered"> - <td class="num">66</td> - <td class="coverage">88<em>x</em></td> + <td class="num">395</td> + <td class="coverage">30<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> orig_parms[degparm_names_transformed] <- backtransform_odeparms(</pre> + <pre class="language-r"> if (parmname == "tb") parms.ini[parmname] = 5</pre> </td> </tr> <tr class="covered"> - <td class="num">67</td> - <td class="coverage">88<em>x</em></td> + <td class="num">396</td> + <td class="coverage">984<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> orig_parms[degparm_names_transformed],</pre> + <pre class="language-r"> if (parmname == "g") parms.ini[parmname] = 0.5</pre> </td> </tr> <tr class="covered"> - <td class="num">68</td> - <td class="coverage">88<em>x</em></td> + <td class="num">397</td> + <td class="coverage">153<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> orig$mmkin[[1]]$mkinmod,</pre> + <pre class="language-r"> if (parmname == "kmax") parms.ini[parmname] = 0.1</pre> </td> </tr> <tr class="covered"> - <td class="num">69</td> - <td class="coverage">88<em>x</em></td> + <td class="num">398</td> + <td class="coverage">153<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> transform_rates = orig$mmkin[[1]]$transform_rates,</pre> + <pre class="language-r"> if (parmname == "k0") parms.ini[parmname] = 0.0001</pre> </td> </tr> <tr class="covered"> - <td class="num">70</td> - <td class="coverage">88<em>x</em></td> + <td class="num">399</td> + <td class="coverage">153<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> transform_fractions = orig$mmkin[[1]]$transform_fractions)</pre> + <pre class="language-r"> if (parmname == "r") parms.ini[parmname] = 0.2</pre> </td> </tr> - <tr class="covered"> - <td class="num">71</td> - <td class="coverage">88<em>x</em></td> + <tr class="never"> + <td class="num">400</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> start_degparms <- backtransform_odeparms(start_degparms,</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> - <td class="num">72</td> - <td class="coverage">88<em>x</em></td> + <tr class="never"> + <td class="num">401</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> orig$mmkin[[1]]$mkinmod,</pre> + <pre class="language-r"> # Default values for formation fractions in case they are present</pre> </td> </tr> <tr class="covered"> - <td class="num">73</td> - <td class="coverage">88<em>x</em></td> + <td class="num">402</td> + <td class="coverage">8633<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> transform_rates = orig$mmkin[[1]]$transform_rates,</pre> + <pre class="language-r"> for (obs_var in obs_vars) {</pre> </td> </tr> <tr class="covered"> - <td class="num">74</td> - <td class="coverage">88<em>x</em></td> + <td class="num">403</td> + <td class="coverage">13865<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> transform_fractions = orig$mmkin[[1]]$transform_fractions)</pre> + <pre class="language-r"> origin <- mkinmod$map[[obs_var]][[1]]</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="num">404</td> + <td class="coverage">13865<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> f_names <- mkinmod$parms[grep(paste0("^f_", origin), mkinmod$parms)]</pre> </td> </tr> <tr class="covered"> - <td class="num">77</td> - <td class="coverage">88<em>x</em></td> + <td class="num">405</td> + <td class="coverage">13865<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> + <pre class="language-r"> if (length(f_names) > 0) {</pre> </td> </tr> <tr class="never"> - <td class="num">78</td> + <td class="num">406</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> + <pre class="language-r"> # We need to differentiate between default and specified fractions</pre> </td> </tr> - <tr class="covered"> - <td class="num">80</td> - <td class="coverage">88<em>x</em></td> + <tr class="never"> + <td class="num">407</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> t(apply(selected_parms[, degparm_names_transformed], 1, backtransform_odeparms,</pre> + <pre class="language-r"> # and set the unspecified to 1 - sum(specified)/n_unspecified</pre> </td> </tr> <tr class="covered"> - <td class="num">81</td> - <td class="coverage">88<em>x</em></td> + <td class="num">408</td> + <td class="coverage">3365<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> orig$mmkin[[1]]$mkinmod,</pre> + <pre class="language-r"> f_default_names <- intersect(f_names, defaultpar.names)</pre> </td> </tr> <tr class="covered"> - <td class="num">82</td> - <td class="coverage">88<em>x</em></td> + <td class="num">409</td> + <td class="coverage">3365<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> transform_rates = orig$mmkin[[1]]$transform_rates,</pre> + <pre class="language-r"> f_specified_names <- setdiff(f_names, defaultpar.names)</pre> </td> </tr> <tr class="covered"> - <td class="num">83</td> - <td class="coverage">88<em>x</em></td> + <td class="num">410</td> + <td class="coverage">3365<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> transform_fractions = orig$mmkin[[1]]$transform_fractions))</pre> + <pre class="language-r"> sum_f_specified = sum(parms.ini[f_specified_names])</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="num">411</td> + <td class="coverage">3365<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> if (sum_f_specified > 1) {</pre> </td> </tr> <tr class="covered"> - <td class="num">87</td> - <td class="coverage">176<em>x</em></td> + <td class="num">412</td> + <td class="coverage">104<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> start_errparms <- orig$so@model@error.init</pre> + <pre class="language-r"> stop("Starting values for the formation fractions originating from ",</pre> </td> </tr> <tr class="covered"> - <td class="num">88</td> - <td class="coverage">176<em>x</em></td> + <td class="num">413</td> + <td class="coverage">104<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> names(start_errparms) <- orig$so@model@name.sigma</pre> + <pre class="language-r"> origin, " sum up to more than 1.")</pre> </td> </tr> <tr class="never"> - <td class="num">89</td> + <td class="num">414</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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="num">415</td> + <td class="coverage">3260<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> start_omegaparms <- orig$so@model@omega.init</pre> + <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">91</td> + <td class="num">416</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> else {</pre> </td> </tr> <tr class="covered"> - <td class="num">92</td> - <td class="coverage">176<em>x</em></td> + <td class="num">417</td> + <td class="coverage">1<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> start_parms <- c(start_degparms, start_errparms)</pre> + <pre class="language-r"> n_unspecified = length(f_default_names)</pre> </td> </tr> <tr class="never"> - <td class="num">93</td> + <td class="num">418</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> + <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"> median = apply(selected_parms, 2, median)</pre> - </td> - </tr> - <tr class="never"> - <td class="num">98</td> - <td class="coverage"></td> + <td class="num">419</td> + <td class="coverage">3261<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> )</pre> + <pre class="language-r"> parms.ini[f_default_names] <- (1 - sum_f_specified) / n_unspecified</pre> </td> </tr> <tr class="never"> - <td class="num">99</td> + <td class="num">420</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">100</td> + <td class="num">421</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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">104</td> + <td class="num">422</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="num">423</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # Show starting parameters</pre> + <pre class="language-r"> # Set default for state.ini if appropriate</pre> </td> </tr> <tr class="covered"> - <td class="num">106</td> - <td class="coverage">176<em>x</em></td> + <td class="num">424</td> + <td class="coverage">8529<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> start_scaled_parms <- rep(NA_real_, length(orig_parms))</pre> + <pre class="language-r"> parent_name = names(mkinmod$spec)[[1]]</pre> </td> </tr> <tr class="covered"> - <td class="num">107</td> - <td class="coverage">176<em>x</em></td> + <td class="num">425</td> + <td class="coverage">8529<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> names(start_scaled_parms) <- names(orig_parms)</pre> + <pre class="language-r"> parent_time_0 = subset(observed, time == 0 & name == parent_name)$value</pre> </td> </tr> <tr class="covered"> - <td class="num">108</td> - <td class="coverage">176<em>x</em></td> + <td class="num">426</td> + <td class="coverage">8529<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> start_scaled_parms[names(start_parms)] <-</pre> + <pre class="language-r"> parent_time_0_mean = mean(parent_time_0, na.rm = TRUE)</pre> </td> </tr> <tr class="covered"> - <td class="num">109</td> - <td class="coverage">176<em>x</em></td> + <td class="num">427</td> + <td class="coverage">8529<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> start_parms / parm_scale[names(start_parms)]</pre> + <pre class="language-r"> if (is.na(parent_time_0_mean)) {</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="num">428</td> + <td class="coverage">2<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> state.ini_auto = c(100, rep(0, length(mkinmod$diffs) - 1))</pre> </td> </tr> <tr class="never"> - <td class="num">112</td> + <td class="num">429</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> + <pre class="language-r"> } else {</pre> </td> </tr> <tr class="covered"> - <td class="num">114</td> - <td class="coverage">176<em>x</em></td> + <td class="num">430</td> + <td class="coverage">8527<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> points(orig_scaled_parms, col = 2, cex = 2)</pre> + <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">115</td> + <td class="num">431</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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="num">432</td> + <td class="coverage">8529<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> abline(h = 1, lty = 2)</pre> + <pre class="language-r"> names(state.ini_auto) <- mod_vars</pre> </td> </tr> <tr class="never"> - <td class="num">117</td> + <td class="num">433</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="num">434</td> + <td class="coverage">8529<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> legend(lpos, inset = c(0.05, 0.05), bty = "n",</pre> + <pre class="language-r"> if (state.ini[1] == "auto") {</pre> </td> </tr> <tr class="covered"> - <td class="num">119</td> - <td class="coverage">176<em>x</em></td> + <td class="num">435</td> + <td class="coverage">8316<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> pch = 1, col = 3:1, lty = c(NA, NA, 1),</pre> + <pre class="language-r"> state.ini_used <- state.ini_auto</pre> </td> </tr> - <tr class="covered"> - <td class="num">120</td> - <td class="coverage">176<em>x</em></td> + <tr class="never"> + <td class="num">436</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> legend = c(</pre> + <pre class="language-r"> } else {</pre> </td> </tr> <tr class="covered"> - <td class="num">121</td> - <td class="coverage">176<em>x</em></td> + <td class="num">437</td> + <td class="coverage">213<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> "Original start",</pre> + <pre class="language-r"> state.ini_used <- state.ini_auto</pre> </td> </tr> <tr class="covered"> - <td class="num">122</td> - <td class="coverage">176<em>x</em></td> + <td class="num">438</td> + <td class="coverage">213<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> "Original results",</pre> + <pre class="language-r"> state.ini_good <- intersect(names(mkinmod$diffs), names(state.ini))</pre> </td> </tr> <tr class="covered"> - <td class="num">123</td> - <td class="coverage">176<em>x</em></td> + <td class="num">439</td> + <td class="coverage">213<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> "Multistart runs"))</pre> + <pre class="language-r"> state.ini_used[state.ini_good] <- state.ini[state.ini_good]</pre> </td> </tr> <tr class="never"> - <td class="num">124</td> + <td class="num">440</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">}</pre> + <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> + <tr class="covered"> + <td class="num">441</td> + <td class="coverage">8529<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">utils::globalVariables("ds")</pre> + <pre class="language-r"> state.ini <- state.ini_used</pre> </td> </tr> <tr class="never"> - <td class="num">2</td> + <td class="num">442</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="num">443</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> + <pre class="language-r"> # Name the inital state variable values if they are not named yet</pre> </td> </tr> - <tr class="never"> - <td class="num">4</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">444</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> if(is.null(names(state.ini))) names(state.ini) <- mod_vars</pre> </td> </tr> <tr class="never"> - <td class="num">5</td> + <td class="num">445</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> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">6</td> + <td class="num">446</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> + <pre class="language-r"> # Transform initial parameter values for fitting</pre> </td> </tr> - <tr class="never"> - <td class="num">7</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">447</td> + <td class="coverage">8529<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' in case plots get too large</pre> + <pre class="language-r"> transparms.ini <- transform_odeparms(parms.ini, mkinmod,</pre> </td> </tr> - <tr class="never"> - <td class="num">8</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">448</td> + <td class="coverage">8529<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @inheritParams plot.mkinfit</pre> + <pre class="language-r"> transform_rates = transform_rates,</pre> </td> </tr> - <tr class="never"> - <td class="num">9</td> - <td class="coverage"></td> + <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">#' @param standardized Should the residuals be standardized? Only takes effect if</pre> + <pre class="language-r"> transform_fractions = transform_fractions)</pre> </td> </tr> <tr class="never"> - <td class="num">10</td> + <td class="num">450</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' `resplot = "time"`.</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">11</td> + <td class="num">451</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> + <pre class="language-r"> # Parameters to be optimised:</pre> </td> </tr> <tr class="never"> - <td class="num">12</td> + <td class="num">452</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> + <pre class="language-r"> # Kinetic parameters in parms.ini whose names are not in fixed_parms</pre> </td> </tr> - <tr class="never"> - <td class="num">13</td> - <td class="coverage"></td> + <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">#' In case there is a covariate model, the behaviour depends on the value</pre> + <pre class="language-r"> parms.fixed <- parms.ini[fixed_parms]</pre> </td> </tr> - <tr class="never"> - <td class="num">14</td> - <td class="coverage"></td> + <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">#' of 'covariates'</pre> + <pre class="language-r"> parms.optim <- parms.ini[setdiff(names(parms.ini), fixed_parms)]</pre> </td> </tr> <tr class="never"> - <td class="num">15</td> + <td class="num">455</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> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> - <td class="num">16</td> - <td class="coverage"></td> + <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">#' any covariate models in the object. If given, it overrides 'covariate_quantiles'.</pre> + <pre class="language-r"> transparms.fixed <- transform_odeparms(parms.fixed, mkinmod,</pre> </td> </tr> - <tr class="never"> - <td class="num">17</td> - <td class="coverage"></td> + <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">#' Each line in the data frame will result in a line drawn for the population.</pre> + <pre class="language-r"> transform_rates = transform_rates,</pre> </td> </tr> - <tr class="never"> - <td class="num">18</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">458</td> + <td class="coverage">8529<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' Rownames are used in the legend to label the lines.</pre> + <pre class="language-r"> transform_fractions = transform_fractions)</pre> </td> </tr> - <tr class="never"> - <td class="num">19</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">459</td> + <td class="coverage">8529<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @param covariate_quantiles This argument only has an effect if the fitted</pre> + <pre class="language-r"> transparms.optim <- transform_odeparms(parms.optim, mkinmod,</pre> </td> </tr> - <tr class="never"> - <td class="num">20</td> - <td class="coverage"></td> + <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">#' object has covariate models. If so, the default is to show three population</pre> + <pre class="language-r"> transform_rates = transform_rates,</pre> </td> </tr> - <tr class="never"> - <td class="num">21</td> - <td class="coverage"></td> + <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">#' curves, for the 5th percentile, the 50th percentile and the 95th percentile</pre> + <pre class="language-r"> transform_fractions = transform_fractions)</pre> </td> </tr> <tr class="never"> - <td class="num">22</td> + <td class="num">462</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' of the covariate values used for fitting the model.</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">23</td> + <td class="num">463</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> + <pre class="language-r"> # Inital state variables in state.ini whose names are not in fixed_initials</pre> </td> </tr> - <tr class="never"> - <td class="num">24</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">464</td> + <td class="coverage">8529<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @param pred_over Named list of alternative predictions as obtained</pre> + <pre class="language-r"> state.ini.fixed <- state.ini[fixed_initials]</pre> </td> </tr> - <tr class="never"> - <td class="num">25</td> - <td class="coverage"></td> + <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">#' from [mkinpredict] with a compatible [mkinmod].</pre> + <pre class="language-r"> state.ini.optim <- state.ini[setdiff(names(state.ini), fixed_initials)]</pre> </td> </tr> <tr class="never"> - <td class="num">26</td> + <td class="num">466</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> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">27</td> + <td class="num">467</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' [mixed.mmkin] object</pre> + <pre class="language-r"> # Preserve names of state variables before renaming initial state variable</pre> </td> </tr> <tr class="never"> - <td class="num">28</td> + <td class="num">468</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> + <pre class="language-r"> # parameters</pre> </td> </tr> - <tr class="never"> - <td class="num">29</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">469</td> + <td class="coverage">8529<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' [mixed.mmkin] object</pre> + <pre class="language-r"> state.ini.optim.boxnames <- names(state.ini.optim)</pre> </td> </tr> - <tr class="never"> - <td class="num">30</td> - <td class="coverage"></td> + <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">#' @param default_log_parms Passed to [mean_degparms] in the case of an</pre> + <pre class="language-r"> state.ini.fixed.boxnames <- names(state.ini.fixed)</pre> </td> </tr> - <tr class="never"> - <td class="num">31</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">471</td> + <td class="coverage">8529<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' [mixed.mmkin] object</pre> + <pre class="language-r"> if(length(state.ini.optim) > 0) {</pre> </td> </tr> - <tr class="never"> - <td class="num">32</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">472</td> + <td class="coverage">8529<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @param rel.height.legend The relative height of the legend shown on top</pre> + <pre class="language-r"> names(state.ini.optim) <- paste(names(state.ini.optim), "0", sep="_")</pre> </td> </tr> <tr class="never"> - <td class="num">33</td> + <td class="num">473</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> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="never"> - <td class="num">34</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">474</td> + <td class="coverage">8529<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @param ymax Vector of maximum y axis values</pre> + <pre class="language-r"> if(length(state.ini.fixed) > 0) {</pre> </td> </tr> - <tr class="never"> - <td class="num">35</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">475</td> + <td class="coverage">4509<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @param ncol.legend Number of columns to use in the legend</pre> + <pre class="language-r"> names(state.ini.fixed) <- paste(names(state.ini.fixed), "0", sep="_")</pre> </td> </tr> <tr class="never"> - <td class="num">36</td> + <td class="num">476</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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">37</td> + <td class="num">477</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> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">38</td> + <td class="num">478</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' predicted values?</pre> + <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">39</td> + <td class="num">479</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> + <pre class="language-r"> # formula, the spectral decomposition of the matrix (fundamental system)</pre> </td> </tr> <tr class="never"> - <td class="num">40</td> + <td class="num">480</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' corresponding model prediction lines for the different datasets.</pre> + <pre class="language-r"> # or a numeric ode solver from the deSolve package</pre> </td> </tr> <tr class="never"> - <td class="num">41</td> + <td class="num">481</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> + <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">42</td> + <td class="num">482</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> + <pre class="language-r"> # is not set to FALSE</pre> </td> </tr> - <tr class="never"> - <td class="num">43</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">483</td> + <td class="coverage">8529<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @importFrom stats coefficients</pre> + <pre class="language-r"> solution_type = match.arg(solution_type)</pre> </td> </tr> - <tr class="never"> - <td class="num">44</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">484</td> + <td class="coverage">8529<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @return The function is called for its side effect.</pre> + <pre class="language-r"> if (solution_type == "analytical" && !is.function(mkinmod$deg_func))</pre> </td> </tr> - <tr class="never"> - <td class="num">45</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">485</td> + <td class="coverage">105<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @author Johannes Ranke</pre> + <pre class="language-r"> stop("Analytical solution not implemented for this model.")</pre> </td> </tr> - <tr class="never"> - <td class="num">46</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">486</td> + <td class="coverage">8424<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @examples</pre> + <pre class="language-r"> if (solution_type == "eigen" && !is.matrix(mkinmod$coefmat))</pre> </td> </tr> - <tr class="never"> - <td class="num">47</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">487</td> + <td class="coverage">104<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' ds <- lapply(experimental_data_for_UBA_2019[6:10],</pre> + <pre class="language-r"> stop("Eigenvalue based solution not possible, coefficient matrix not present.")</pre> </td> </tr> - <tr class="never"> - <td class="num">48</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">488</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' function(x) x$data[c("name", "time", "value")])</pre> + <pre class="language-r"> if (solution_type == "auto") {</pre> </td> </tr> - <tr class="never"> - <td class="num">49</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">489</td> + <td class="coverage">6190<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' names(ds) <- paste0("ds ", 6:10)</pre> + <pre class="language-r"> if (length(mkinmod$spec) == 1 || is.function(mkinmod$deg_func)) {</pre> </td> </tr> - <tr class="never"> - <td class="num">50</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">490</td> + <td class="coverage">5434<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' dfop_sfo <- mkinmod(parent = mkinsub("DFOP", "A1"),</pre> + <pre class="language-r"> solution_type = "analytical"</pre> </td> </tr> <tr class="never"> - <td class="num">51</td> + <td class="num">491</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' A1 = mkinsub("SFO"), quiet = TRUE)</pre> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="never"> - <td class="num">52</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">492</td> + <td class="coverage">756<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' \dontrun{</pre> + <pre class="language-r"> if (!is.null(mkinmod$cf) & use_compiled[1] != FALSE) {</pre> </td> </tr> - <tr class="never"> - <td class="num">53</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">493</td> + <td class="coverage">756<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' f <- mmkin(list("DFOP-SFO" = dfop_sfo), ds, quiet = TRUE)</pre> + <pre class="language-r"> solution_type = "deSolve"</pre> </td> </tr> <tr class="never"> - <td class="num">54</td> + <td class="num">494</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' plot(f[, 3:4], standardized = TRUE)</pre> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="never"> - <td class="num">55</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">495</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> if (is.matrix(mkinmod$coefmat)) {</pre> </td> </tr> - <tr class="never"> - <td class="num">56</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">496</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> + <pre class="language-r"> solution_type = "eigen"</pre> </td> </tr> - <tr class="never"> - <td class="num">57</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">497</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> + <pre class="language-r"> if (max(observed$value, na.rm = TRUE) < 0.1) {</pre> </td> </tr> - <tr class="never"> - <td class="num">58</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">498</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#' # It still takes 20 seconds to run</pre> + <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">59</td> + <td class="num">499</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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">60</td> + <td class="num">500</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' plot(f_nlme)</pre> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="never"> - <td class="num">61</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">501</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> solution_type = "deSolve"</pre> </td> </tr> <tr class="never"> - <td class="num">62</td> + <td class="num">502</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' f_saem <- saem(f, transformations = "saemix")</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">63</td> + <td class="num">503</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' plot(f_saem)</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">64</td> + <td class="num">504</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">65</td> + <td class="num">505</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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">66</td> + <td class="num">506</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' f_nlmix <- nlmix(f_obs)</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">67</td> + <td class="num">507</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' plot(f_nlmix)</pre> + <pre class="language-r"> # Get native symbol before iterations info for speed</pre> </td> </tr> - <tr class="never"> - <td class="num">68</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">508</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> use_symbols = FALSE</pre> </td> </tr> - <tr class="never"> - <td class="num">69</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">509</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' # We can overlay the two variants if we generate predictions</pre> + <pre class="language-r"> if (solution_type == "deSolve" & use_compiled[1] != FALSE) {</pre> </td> </tr> - <tr class="never"> - <td class="num">70</td> - <td class="coverage"></td> + <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">#' pred_nlme <- mkinpredict(dfop_sfo,</pre> + <pre class="language-r"> mkinmod[["symbols"]] <- try(</pre> </td> </tr> - <tr class="never"> - <td class="num">71</td> - <td class="coverage"></td> + <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">#' f_nlme$bparms.optim[-1],</pre> + <pre class="language-r"> deSolve::checkDLL(dllname = mkinmod$dll_info[["name"]],</pre> </td> </tr> - <tr class="never"> - <td class="num">72</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">512</td> + <td class="coverage">2144<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' c(parent = f_nlme$bparms.optim[[1]], A1 = 0),</pre> + <pre class="language-r"> func = "diffs", initfunc = "initpar",</pre> </td> </tr> - <tr class="never"> - <td class="num">73</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">513</td> + <td class="coverage">2144<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' seq(0, 180, by = 0.2))</pre> + <pre class="language-r"> jacfunc = NULL, nout = 0, outnames = NULL))</pre> </td> </tr> - <tr class="never"> - <td class="num">74</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">514</td> + <td class="coverage">2144<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' plot(f_saem, pred_over = list(nlme = pred_nlme))</pre> + <pre class="language-r"> if (!inherits(mkinmod[["symbols"]], "try-error")) {</pre> </td> </tr> - <tr class="never"> - <td class="num">75</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">515</td> + <td class="coverage">2144<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' }</pre> + <pre class="language-r"> use_symbols = TRUE</pre> </td> </tr> <tr class="never"> - <td class="num">76</td> + <td class="num">516</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">77</td> + <td class="num">517</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">plot.mixed.mmkin <- function(x,</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">78</td> + <td class="num">518</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> i = 1:ncol(x$mmkin),</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">79</td> + <td class="num">519</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> obs_vars = names(x$mkinmod$map),</pre> + <pre class="language-r"> # Get the error model and the algorithm for fitting</pre> </td> </tr> - <tr class="never"> - <td class="num">80</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">520</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> standardized = TRUE,</pre> + <pre class="language-r"> err_mod <- match.arg(error_model)</pre> </td> </tr> - <tr class="never"> - <td class="num">81</td> - <td class="coverage"></td> + <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"> covariates = NULL,</pre> + <pre class="language-r"> error_model_algorithm = match.arg(error_model_algorithm)</pre> </td> </tr> - <tr class="never"> - <td class="num">82</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">522</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> covariate_quantiles = c(0.5, 0.05, 0.95),</pre> + <pre class="language-r"> if (error_model_algorithm == "OLS") {</pre> </td> </tr> - <tr class="never"> - <td class="num">83</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">523</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> xlab = "Time",</pre> + <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">84</td> + <td class="num">524</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> xlim = range(x$data$time),</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="never"> - <td class="num">85</td> - <td class="coverage"></td> + <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"> resplot = c("predicted", "time"),</pre> + <pre class="language-r"> if (error_model_algorithm == "auto") {</pre> </td> </tr> - <tr class="never"> - <td class="num">86</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">526</td> + <td class="coverage">6692<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> pop_curves = "auto",</pre> + <pre class="language-r"> error_model_algorithm = switch(err_mod,</pre> </td> </tr> - <tr class="never"> - <td class="num">87</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">527</td> + <td class="coverage">6692<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> pred_over = NULL,</pre> + <pre class="language-r"> const = "OLS", obs = "d_3", tc = "d_3")</pre> </td> </tr> <tr class="never"> - <td class="num">88</td> + <td class="num">528</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> test_log_parms = FALSE,</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="never"> - <td class="num">89</td> - <td class="coverage"></td> + <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"> conf.level = 0.6,</pre> + <pre class="language-r"> errparm_names <- switch(err_mod,</pre> </td> </tr> - <tr class="never"> - <td class="num">90</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">530</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> default_log_parms = NA,</pre> + <pre class="language-r"> "const" = "sigma",</pre> </td> </tr> - <tr class="never"> - <td class="num">91</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">531</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ymax = "auto", maxabs = "auto",</pre> + <pre class="language-r"> "obs" = paste0("sigma_", obs_vars),</pre> </td> </tr> - <tr class="never"> - <td class="num">92</td> - <td class="coverage"></td> + <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"> ncol.legend = ifelse(length(i) <= 3, length(i) + 1, ifelse(length(i) <= 8, 3, 4)),</pre> + <pre class="language-r"> "tc" = c("sigma_low", "rsd_high"))</pre> </td> </tr> - <tr class="never"> - <td class="num">93</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">533</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> nrow.legend = ceiling((length(i) + 1) / ncol.legend),</pre> + <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">94</td> + <td class="num">534</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> rel.height.legend = 0.02 + 0.07 * nrow.legend,</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">95</td> + <td class="num">535</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> rel.height.bottom = 1.1,</pre> + <pre class="language-r"> # Define starting values for the error model</pre> </td> </tr> - <tr class="never"> - <td class="num">96</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">536</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> pch_ds = 1:length(i),</pre> + <pre class="language-r"> if (err.ini[1] != "auto") {</pre> </td> </tr> - <tr class="never"> - <td class="num">97</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">537</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> col_ds = pch_ds + 1,</pre> + <pre class="language-r"> if (!identical(names(err.ini), errparm_names)) {</pre> </td> </tr> - <tr class="never"> - <td class="num">98</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">538</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> lty_ds = col_ds,</pre> + <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">99</td> + <td class="num">539</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> frame = TRUE, ...</pre> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="never"> - <td class="num">100</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">540</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">)</pre> + <pre class="language-r"> errparms = err.ini</pre> </td> </tr> <tr class="never"> - <td class="num">101</td> + <td class="num">541</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">{</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">102</td> + <td class="num">542</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> + <pre class="language-r"> } else {</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="num">543</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> if (err_mod == "const") {</pre> </td> </tr> <tr class="covered"> - <td class="num">106</td> - <td class="coverage">283<em>x</em></td> + <td class="num">544</td> + <td class="coverage">6410<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> backtransform = TRUE</pre> + <pre class="language-r"> errparms = 3</pre> </td> </tr> <tr class="never"> - <td class="num">107</td> + <td class="num">545</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> + <pre class="language-r"> }</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="num">546</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r"> if (err_mod == "obs") {</pre> </td> </tr> <tr class="covered"> - <td class="num">112</td> - <td class="coverage">65<em>x</em></td> + <td class="num">547</td> + <td class="coverage">317<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> pop_curves <- TRUE</pre> + <pre class="language-r"> errparms = rep(3, length(obs_vars))</pre> </td> </tr> <tr class="never"> - <td class="num">113</td> + <td class="num">548</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="num">549</td> + <td class="coverage">8320<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> + <pre class="language-r"> if (err_mod == "tc") {</pre> </td> </tr> <tr class="covered"> - <td class="num">116</td> - <td class="coverage">65<em>x</em></td> + <td class="num">550</td> + <td class="coverage">1593<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> conf.level = conf.level, default_log_parms = default_log_parms)</pre> + <pre class="language-r"> errparms <- c(sigma_low = 0.1, rsd_high = 0.1)</pre> </td> </tr> <tr class="never"> - <td class="num">117</td> + <td class="num">551</td> <td class="coverage"></td> <td class="col-sm-12"> <pre class="language-r"> }</pre> </td> </tr> + <tr class="covered"> + <td class="num">552</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">118</td> + <td class="num">553</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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="num">554</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> degparms_tmp <- parms(x$mmkin, transformed = TRUE)</pre> + <pre class="language-r"> if (error_model_algorithm == "OLS") {</pre> </td> </tr> <tr class="covered"> - <td class="num">120</td> - <td class="coverage">65<em>x</em></td> + <td class="num">555</td> + <td class="coverage">6410<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> + <pre class="language-r"> errparms_optim <- NULL</pre> </td> </tr> - <tr class="covered"> - <td class="num">121</td> - <td class="coverage">65<em>x</em></td> + <tr class="never"> + <td class="num">556</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> residual_type = ifelse(standardized, "standardized", "residual")</pre> + <pre class="language-r"> } else {</pre> </td> </tr> <tr class="covered"> - <td class="num">122</td> - <td class="coverage">65<em>x</em></td> + <td class="num">557</td> + <td class="coverage">1910<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> residuals <- x$data[[residual_type]]</pre> + <pre class="language-r"> errparms_optim <- errparms</pre> </td> </tr> <tr class="never"> - <td class="num">123</td> + <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">124</td> + <td class="num">559</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> + <tr class="never"> + <td class="num">560</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (identical(pop_curves, "auto")) {</pre> + <pre class="language-r"> # Unique outtimes for model solution.</pre> </td> </tr> <tr class="covered"> - <td class="num">127</td> - <td class="coverage">65<em>x</em></td> + <td class="num">561</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> pop_curves <- TRUE</pre> + <pre class="language-r"> outtimes <- sort(unique(observed$time))</pre> </td> </tr> <tr class="never"> - <td class="num">128</td> + <td class="num">562</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> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">130</td> + <td class="num">563</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> # Define the objective function for optimisation, including (back)transformations</pre> </td> </tr> <tr class="covered"> - <td class="num">131</td> - <td class="coverage">65<em>x</em></td> + <td class="num">564</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> degparms_i <- coefficients(x)</pre> + <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="covered"> - <td class="num">132</td> - <td class="coverage">65<em>x</em></td> + <tr class="never"> + <td class="num">565</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> degparms_pop <- nlme::fixef(x)</pre> + <pre class="language-r"> {</pre> </td> </tr> <tr class="covered"> - <td class="num">133</td> - <td class="coverage">65<em>x</em></td> + <td class="num">566</td> + <td class="coverage">4086568<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> residuals <- residuals(x,</pre> + <pre class="language-r"> assign("calls", calls + 1, inherits = TRUE) # Increase the model solution counter</pre> </td> </tr> - <tr class="covered"> - <td class="num">134</td> - <td class="coverage">65<em>x</em></td> + <tr class="never"> + <td class="num">567</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> type = ifelse(standardized, "pearson", "response"))</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">135</td> + <td class="num">568</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> #browser()</pre> </td> </tr> <tr class="never"> - <td class="num">136</td> + <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">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> + <tr class="never"> + <td class="num">570</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> residual_type = ifelse(standardized, "standardized", "residual")</pre> + <pre class="language-r"> # Trace parameter values if requested and if we are actually optimising</pre> </td> </tr> <tr class="covered"> - <td class="num">144</td> - <td class="coverage">153<em>x</em></td> + <td class="num">571</td> + <td class="coverage">3224<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> residuals <- x$data[[residual_type]]</pre> + <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">145</td> + <td class="num">572</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> + <tr class="never"> + <td class="num">573</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (identical(pop_curves, "auto")) {</pre> + <pre class="language-r"> # Determine local parameter values for the cost estimation</pre> </td> </tr> <tr class="covered"> - <td class="num">147</td> - <td class="coverage">153<em>x</em></td> + <td class="num">574</td> + <td class="coverage">4086568<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (length(x$covariate_models) == 0) {</pre> + <pre class="language-r"> if (is.numeric(fixed_degparms)) {</pre> </td> </tr> <tr class="covered"> - <td class="num">148</td> - <td class="coverage">153<em>x</em></td> + <td class="num">575</td> + <td class="coverage">94746<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> degparms_pop <- x$so@results@fixed.effects</pre> + <pre class="language-r"> cost_degparms <- fixed_degparms</pre> </td> </tr> <tr class="covered"> - <td class="num">149</td> - <td class="coverage">153<em>x</em></td> + <td class="num">576</td> + <td class="coverage">94746<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> names(degparms_pop) <- degparms_i_names</pre> + <pre class="language-r"> cost_errparms <- P</pre> </td> </tr> <tr class="covered"> - <td class="num">150</td> - <td class="coverage">153<em>x</em></td> + <td class="num">577</td> + <td class="coverage">94746<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> pop_curves <- TRUE</pre> + <pre class="language-r"> degparms_fixed = TRUE</pre> </td> </tr> <tr class="never"> - <td class="num">151</td> + <td class="num">578</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> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="missed"> - <td class="num">157</td> - <td class="coverage">!</td> + <tr class="covered"> + <td class="num">579</td> + <td class="coverage">3991822<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ifelse(length(x$covariate_models) == 1,</pre> + <pre class="language-r"> degparms_fixed = FALSE</pre> </td> </tr> - <tr class="missed"> - <td class="num">158</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">580</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> "Covariate", "Covariates"),</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="missed"> - <td class="num">159</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">581</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> rownames(covariates))</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> - <td class="num">160</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">582</td> + <td class="coverage">4086568<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> if (is.numeric(fixed_errparms)) {</pre> </td> </tr> - <tr class="missed"> - <td class="num">161</td> - <td class="coverage">!</td> + <tr class="covered"> + <td class="num">583</td> + <td class="coverage">4725<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> degparms_pop <- parms(x, covariates = covariates)</pre> + <pre class="language-r"> cost_degparms <- P</pre> </td> </tr> - <tr class="missed"> - <td class="num">162</td> - <td class="coverage">!</td> + <tr class="covered"> + <td class="num">584</td> + <td class="coverage">4725<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> pop_curves <- TRUE</pre> + <pre class="language-r"> cost_errparms <- fixed_errparms</pre> </td> </tr> - <tr class="never"> - <td class="num">163</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">585</td> + <td class="coverage">4725<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> errparms_fixed = TRUE</pre> </td> </tr> <tr class="never"> - <td class="num">164</td> + <td class="num">586</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> + <tr class="covered"> + <td class="num">587</td> + <td class="coverage">4081843<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> pop_curves <- FALSE</pre> + <pre class="language-r"> errparms_fixed = FALSE</pre> </td> </tr> <tr class="never"> - <td class="num">166</td> + <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">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="num">589</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="num">590</td> + <td class="coverage">4086568<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (is.null(dim(degparms_pop))) {</pre> + <pre class="language-r"> if (OLS) {</pre> </td> </tr> <tr class="covered"> - <td class="num">172</td> - <td class="coverage">283<em>x</em></td> + <td class="num">591</td> + <td class="coverage">1063145<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> degparms_pop <- matrix(degparms_pop, ncol = 1,</pre> + <pre class="language-r"> cost_degparms <- P</pre> </td> </tr> <tr class="covered"> - <td class="num">173</td> - <td class="coverage">283<em>x</em></td> + <td class="num">592</td> + <td class="coverage">1063145<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> dimnames = list(names(degparms_pop), "Population"))</pre> + <pre class="language-r"> cost_errparms <- numeric(0)</pre> </td> </tr> <tr class="never"> - <td class="num">174</td> + <td class="num">593</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="num">594</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="num">595</td> + <td class="coverage">4086568<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> names(degparms_fixed) <- rownames(fit_1$fixed)</pre> + <pre class="language-r"> if (!OLS & !degparms_fixed & !errparms_fixed) {</pre> </td> </tr> <tr class="covered"> - <td class="num">179</td> - <td class="coverage">283<em>x</em></td> + <td class="num">596</td> + <td class="coverage">2923952<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> degparms_all <- cbind(as.matrix(degparms_i),</pre> + <pre class="language-r"> cost_degparms <- P[1:(length(P) - length(errparms))]</pre> </td> </tr> <tr class="covered"> - <td class="num">180</td> - <td class="coverage">283<em>x</em></td> + <td class="num">597</td> + <td class="coverage">2923952<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> matrix(rep(degparms_fixed, nrow(degparms_i)),</pre> + <pre class="language-r"> cost_errparms <- P[(length(cost_degparms) + 1):length(P)]</pre> </td> </tr> - <tr class="covered"> - <td class="num">181</td> - <td class="coverage">283<em>x</em></td> + <tr class="never"> + <td class="num">598</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> ncol = length(degparms_fixed),</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> - <td class="num">182</td> - <td class="coverage">283<em>x</em></td> + <tr class="never"> + <td class="num">599</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> nrow = nrow(degparms_i), byrow = TRUE))</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> - <td class="num">183</td> - <td class="coverage">283<em>x</em></td> + <tr class="never"> + <td class="num">600</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> degparms_all_names <- c(names(degparms_i), names(degparms_fixed))</pre> + <pre class="language-r"> # Initial states for t0</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="num">601</td> + <td class="coverage">4086568<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> if(length(state.ini.optim) > 0) {</pre> </td> </tr> <tr class="covered"> - <td class="num">186</td> - <td class="coverage">283<em>x</em></td> + <td class="num">602</td> + <td class="coverage">4086568<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> odeini_names <- grep("_0$", degparms_all_names, value = TRUE)</pre> + <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">187</td> - <td class="coverage">283<em>x</em></td> + <td class="num">603</td> + <td class="coverage">4086568<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> odeparms_names <- setdiff(degparms_all_names, odeini_names)</pre> + <pre class="language-r"> names(odeini) <- c(state.ini.optim.boxnames, state.ini.fixed.boxnames)</pre> </td> </tr> <tr class="never"> - <td class="num">188</td> + <td class="num">604</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="covered"> - <td class="num">189</td> - <td class="coverage">283<em>x</em></td> + <tr class="missed"> + <td class="num">605</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> observed <- cbind(x$data[c("ds", "name", "time", "value")],</pre> + <pre class="language-r"> odeini <- state.ini.fixed</pre> </td> </tr> - <tr class="covered"> - <td class="num">190</td> - <td class="coverage">283<em>x</em></td> + <tr class="missed"> + <td class="num">606</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> residual = residuals)</pre> + <pre class="language-r"> names(odeini) <- state.ini.fixed.boxnames</pre> </td> </tr> <tr class="never"> - <td class="num">191</td> + <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">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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">193</td> + <td class="num">608</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="num">609</td> + <td class="coverage">4086568<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> seq(xlim[1], xlim[2], length.out = 50))))</pre> + <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">196</td> + <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">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="num">611</td> + <td class="coverage">4086568<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (backtransform) {</pre> + <pre class="language-r"> if (trans == TRUE) {</pre> </td> </tr> <tr class="covered"> - <td class="num">201</td> - <td class="coverage">2620<em>x</em></td> + <td class="num">612</td> + <td class="coverage">2580794<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> odeparms <- backtransform_odeparms(odeparms_trans,</pre> + <pre class="language-r"> odeparms <- c(odeparms.optim, transparms.fixed)</pre> </td> </tr> <tr class="covered"> - <td class="num">202</td> - <td class="coverage">2620<em>x</em></td> + <td class="num">613</td> + <td class="coverage">2580794<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> x$mkinmod,</pre> + <pre class="language-r"> parms <- backtransform_odeparms(odeparms, mkinmod,</pre> </td> </tr> <tr class="covered"> - <td class="num">203</td> - <td class="coverage">2620<em>x</em></td> + <td class="num">614</td> + <td class="coverage">2580794<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> transform_rates = fit_1$transform_rates,</pre> + <pre class="language-r"> transform_rates = transform_rates,</pre> </td> </tr> <tr class="covered"> - <td class="num">204</td> - <td class="coverage">2620<em>x</em></td> + <td class="num">615</td> + <td class="coverage">2580794<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> transform_fractions = fit_1$transform_fractions)</pre> + <pre class="language-r"> transform_fractions = transform_fractions)</pre> </td> </tr> <tr class="never"> - <td class="num">205</td> + <td class="num">616</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="num">617</td> + <td class="coverage">1505774<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> odeparms <- odeparms_trans</pre> + <pre class="language-r"> parms <- c(odeparms.optim, parms.fixed)</pre> </td> </tr> <tr class="never"> - <td class="num">207</td> + <td class="num">618</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="num">619</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="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">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> + <pre class="language-r"> # Solve the system with current parameter values</pre> </td> </tr> <tr class="covered"> - <td class="num">213</td> - <td class="coverage">2945<em>x</em></td> + <td class="num">621</td> + <td class="coverage">4086568<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> outtimes, solution_type = solution_type,</pre> + <pre class="language-r"> if (solution_type == "analytical") {</pre> </td> </tr> <tr class="covered"> - <td class="num">214</td> - <td class="coverage">2945<em>x</em></td> + <td class="num">622</td> + <td class="coverage">2562380<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> atol = fit_1$atol, rtol = fit_1$rtol)</pre> + <pre class="language-r"> observed$predicted <- mkinmod$deg_func(observed, odeini, parms)</pre> </td> </tr> <tr class="never"> - <td class="num">215</td> + <td class="num">623</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> + <pre class="language-r"> } else {</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="num">624</td> + <td class="coverage">1524188<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> out <- mkinpredict(mkinmod, parms,</pre> </td> </tr> <tr class="covered"> - <td class="num">219</td> - <td class="coverage">283<em>x</em></td> + <td class="num">625</td> + <td class="coverage">1524188<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (pop_curves) {</pre> + <pre class="language-r"> odeini, outtimes,</pre> </td> </tr> <tr class="covered"> - <td class="num">220</td> - <td class="coverage">283<em>x</em></td> + <td class="num">626</td> + <td class="coverage">1524188<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> + <pre class="language-r"> solution_type = solution_type,</pre> </td> </tr> <tr class="covered"> - <td class="num">221</td> - <td class="coverage">283<em>x</em></td> + <td class="num">627</td> + <td class="coverage">1524188<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> + <pre class="language-r"> use_compiled = use_compiled,</pre> </td> </tr> <tr class="covered"> - <td class="num">222</td> - <td class="coverage">283<em>x</em></td> + <td class="num">628</td> + <td class="coverage">1524188<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> odeparms_pop_trans_i <- degparms_all_pop_i[odeparms_names]</pre> + <pre class="language-r"> use_symbols = use_symbols,</pre> </td> </tr> <tr class="covered"> - <td class="num">223</td> - <td class="coverage">283<em>x</em></td> + <td class="num">629</td> + <td class="coverage">1524188<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> + <pre class="language-r"> method.ode = method.ode,</pre> </td> </tr> <tr class="covered"> - <td class="num">224</td> - <td class="coverage">283<em>x</em></td> + <td class="num">630</td> + <td class="coverage">1524188<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (backtransform) {</pre> + <pre class="language-r"> atol = atol, rtol = rtol,</pre> </td> </tr> - <tr class="covered"> - <td class="num">225</td> - <td class="coverage">218<em>x</em></td> + <tr class="never"> + <td class="num">631</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> odeparms_pop_i <- backtransform_odeparms(odeparms_pop_trans_i,</pre> + <pre class="language-r"> ...)</pre> </td> </tr> - <tr class="covered"> - <td class="num">226</td> - <td class="coverage">218<em>x</em></td> + <tr class="never"> + <td class="num">632</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> x$mkinmod,</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">227</td> - <td class="coverage">218<em>x</em></td> + <td class="num">633</td> + <td class="coverage">1524188<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> transform_rates = fit_1$transform_rates,</pre> + <pre class="language-r"> observed_index <- cbind(as.character(observed$time), as.character(observed$name))</pre> </td> </tr> <tr class="covered"> - <td class="num">228</td> - <td class="coverage">218<em>x</em></td> + <td class="num">634</td> + <td class="coverage">1524188<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> transform_fractions = fit_1$transform_fractions)</pre> + <pre class="language-r"> observed$predicted <- out[observed_index]</pre> </td> </tr> <tr class="never"> - <td class="num">229</td> + <td class="num">635</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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">231</td> + <td class="num">636</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">232</td> + <td class="num">637</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> # Define standard deviation for each observation</pre> </td> </tr> <tr class="covered"> - <td class="num">233</td> - <td class="coverage">283<em>x</em></td> + <td class="num">638</td> + <td class="coverage">4086568<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> odeini <- degparms_all_pop_i[odeini_names]</pre> + <pre class="language-r"> if (err_mod == "const") {</pre> </td> </tr> <tr class="covered"> - <td class="num">234</td> - <td class="coverage">283<em>x</em></td> + <td class="num">639</td> + <td class="coverage">2789021<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> names(odeini) <- gsub("_0", "", odeini_names)</pre> + <pre class="language-r"> observed$std <- if (OLS) NA else cost_errparms["sigma"]</pre> </td> </tr> <tr class="never"> - <td class="num">235</td> + <td class="num">640</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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="num">641</td> + <td class="coverage">4086568<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> out <- mkinpredict(x$mkinmod, odeparms_pop_i, odeini,</pre> + <pre class="language-r"> if (err_mod == "obs") {</pre> </td> </tr> <tr class="covered"> - <td class="num">237</td> - <td class="coverage">283<em>x</em></td> + <td class="num">642</td> + <td class="coverage">366137<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> outtimes, solution_type = solution_type,</pre> + <pre class="language-r"> std_names <- paste0("sigma_", observed$name)</pre> </td> </tr> <tr class="covered"> - <td class="num">238</td> - <td class="coverage">283<em>x</em></td> + <td class="num">643</td> + <td class="coverage">366137<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> atol = fit_1$atol, rtol = fit_1$rtol)</pre> + <pre class="language-r"> observed$std <- cost_errparms[std_names]</pre> </td> </tr> <tr class="never"> - <td class="num">239</td> + <td class="num">644</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> })</pre> + <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="num">645</td> + <td class="coverage">4086568<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r"> if (err_mod == "tc") {</pre> </td> </tr> - <tr class="missed"> - <td class="num">243</td> - <td class="coverage">!</td> + <tr class="covered"> + <td class="num">646</td> + <td class="coverage">931410<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> pred_list_pop <- NULL</pre> + <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">244</td> + <td class="num">647</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">245</td> + <td class="num">648</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="num">649</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> + <pre class="language-r"> # Calculate model cost</pre> </td> </tr> <tr class="covered"> - <td class="num">248</td> - <td class="coverage">283<em>x</em></td> + <td class="num">650</td> + <td class="coverage">4086568<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> on.exit(par(oldpar, no.readonly = TRUE))</pre> + <pre class="language-r"> if (OLS) {</pre> </td> </tr> <tr class="never"> - <td class="num">249</td> + <td class="num">651</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> + <pre class="language-r"> # Cost is the sum of squared residuals</pre> </td> </tr> <tr class="covered"> - <td class="num">251</td> - <td class="coverage">283<em>x</em></td> + <td class="num">652</td> + <td class="coverage">1063145<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> n_plots = n_plot_rows * 2</pre> + <pre class="language-r"> cost <- with(observed, sum((value - predicted)^2))</pre> </td> </tr> <tr class="never"> - <td class="num">252</td> + <td class="num">653</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> } else {</pre> </td> </tr> <tr class="never"> - <td class="num">253</td> + <td class="num">654</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> + <pre class="language-r"> # Cost is the negative log-likelihood</pre> </td> </tr> <tr class="covered"> - <td class="num">254</td> - <td class="coverage">283<em>x</em></td> + <td class="num">655</td> + <td class="coverage">3023423<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> rel.heights <- if (n_plot_rows > 1) {</pre> + <pre class="language-r"> cost <- - with(observed,</pre> </td> </tr> <tr class="covered"> - <td class="num">255</td> - <td class="coverage">218<em>x</em></td> + <td class="num">656</td> + <td class="coverage">3023423<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> + <pre class="language-r"> sum(dnorm(x = value, mean = predicted, sd = std, log = TRUE)))</pre> </td> </tr> <tr class="never"> - <td class="num">256</td> + <td class="num">657</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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">258</td> + <td class="num">658</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">259</td> + <td class="num">659</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> + <pre class="language-r"> # We update the current cost and data during the optimisation, not</pre> </td> </tr> - <tr class="covered"> - <td class="num">261</td> - <td class="coverage">283<em>x</em></td> + <tr class="never"> + <td class="num">660</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> n_plot_rows + 1, 2, byrow = TRUE)</pre> + <pre class="language-r"> # during hessian calculations</pre> </td> </tr> <tr class="covered"> - <td class="num">262</td> - <td class="coverage">283<em>x</em></td> + <td class="num">661</td> + <td class="coverage">4086568<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> layout(layout_matrix, heights = rel.heights)</pre> + <pre class="language-r"> if (update_data) {</pre> </td> </tr> <tr class="never"> - <td class="num">263</td> + <td class="num">662</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="num">663</td> + <td class="coverage">1622188<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> + <pre class="language-r"> assign("current_data", observed, inherits = TRUE)</pre> </td> </tr> <tr class="never"> - <td class="num">265</td> + <td class="num">664</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="num">665</td> + <td class="coverage">1622188<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (pop_curves) {</pre> + <pre class="language-r"> if (cost < cost.current) {</pre> </td> </tr> <tr class="covered"> - <td class="num">270</td> - <td class="coverage">283<em>x</em></td> + <td class="num">666</td> + <td class="coverage">594930<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (is.null(covariates)) {</pre> + <pre class="language-r"> assign("cost.current", cost, inherits = TRUE)</pre> </td> </tr> <tr class="covered"> - <td class="num">271</td> - <td class="coverage">283<em>x</em></td> + <td class="num">667</td> + <td class="coverage">1768<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> lty_pop <- 1</pre> + <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">272</td> - <td class="coverage">283<em>x</em></td> + <td class="num">668</td> + <td class="coverage">1768<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> names(lty_pop) <- "Population"</pre> + <pre class="language-r"> " at call ", calls, ": ", signif(cost.current, 6), "\n")</pre> </td> </tr> <tr class="never"> - <td class="num">273</td> + <td class="num">669</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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">276</td> + <td class="num">670</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> + <tr class="covered"> + <td class="num">671</td> + <td class="coverage">4086415<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> lty_pop <- NULL</pre> + <pre class="language-r"> return(cost)</pre> </td> </tr> <tr class="never"> - <td class="num">279</td> + <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">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="num">673</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="num">674</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> lty = c(lty_pop, lty_over, lty_ds),</pre> + <pre class="language-r"> names_optim <- c(names(state.ini.optim),</pre> </td> </tr> <tr class="covered"> - <td class="num">286</td> - <td class="coverage">283<em>x</em></td> + <td class="num">675</td> + <td class="coverage">8320<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> + <pre class="language-r"> names(transparms.optim),</pre> </td> </tr> <tr class="covered"> - <td class="num">287</td> - <td class="coverage">283<em>x</em></td> + <td class="num">676</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> col = c(rep(1, n_pop_over), col_ds),</pre> + <pre class="language-r"> errparm_names_optim)</pre> </td> </tr> <tr class="covered"> - <td class="num">288</td> - <td class="coverage">283<em>x</em></td> + <td class="num">677</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> pch = c(rep(NA, n_pop_over), pch_ds))</pre> + <pre class="language-r"> n_optim <- length(names_optim)</pre> </td> </tr> <tr class="never"> - <td class="num">289</td> + <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">290</td> - <td class="coverage">283<em>x</em></td> + <tr class="never"> + <td class="num">679</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> resplot <- match.arg(resplot)</pre> + <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">291</td> + <td class="num">680</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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">292</td> + <td class="num">681</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # Loop plot rows</pre> + <pre class="language-r"> # and for optimised error model parameters</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="num">682</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> lower <- rep(-Inf, n_optim)</pre> </td> </tr> <tr class="covered"> - <td class="num">295</td> - <td class="coverage">501<em>x</em></td> + <td class="num">683</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> obs_var <- obs_vars[plot_row]</pre> + <pre class="language-r"> upper <- rep(Inf, n_optim)</pre> </td> </tr> <tr class="covered"> - <td class="num">296</td> - <td class="coverage">501<em>x</em></td> + <td class="num">684</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> observed_row <- subset(observed, name == obs_var)</pre> + <pre class="language-r"> names(lower) <- names(upper) <- names_optim</pre> </td> </tr> <tr class="never"> - <td class="num">297</td> + <td class="num">685</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="num">686</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> + <pre class="language-r"> # IORE exponents are not transformed, but need a lower bound</pre> </td> </tr> <tr class="covered"> - <td class="num">300</td> - <td class="coverage">501<em>x</em></td> + <td class="num">687</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ylim_row = c(0,</pre> + <pre class="language-r"> index_N <- grep("^N", names(lower))</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="num">688</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ylim_row = c(0, ymax[plot_row])</pre> + <pre class="language-r"> lower[index_N] <- 0</pre> </td> </tr> <tr class="never"> - <td class="num">304</td> + <td class="num">689</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> - <td class="num">305</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">690</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> if (!transform_rates) {</pre> </td> </tr> - <tr class="never"> - <td class="num">306</td> - <td class="coverage"></td> + <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"> # Margins for bottom row of plots when we have more than one row</pre> + <pre class="language-r"> index_k <- grep("^k_", names(lower))</pre> </td> </tr> - <tr class="never"> - <td class="num">307</td> - <td class="coverage"></td> + <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"> # This is the only row that needs to show the x axis legend</pre> + <pre class="language-r"> lower[index_k] <- 0</pre> </td> </tr> <tr class="covered"> - <td class="num">308</td> - <td class="coverage">501<em>x</em></td> + <td class="num">693</td> + <td class="coverage">553<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (plot_row == n_plot_rows) {</pre> + <pre class="language-r"> index_k__iore <- grep("^k__iore_", names(lower))</pre> </td> </tr> <tr class="covered"> - <td class="num">309</td> - <td class="coverage">283<em>x</em></td> + <td class="num">694</td> + <td class="coverage">553<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> + <pre class="language-r"> lower[index_k__iore] <- 0</pre> </td> </tr> - <tr class="never"> - <td class="num">310</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">695</td> + <td class="coverage">553<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <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">311</td> - <td class="coverage">218<em>x</em></td> + <td class="num">696</td> + <td class="coverage">553<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> + <pre class="language-r"> lower[other_rate_parms] <- 0</pre> </td> </tr> <tr class="never"> - <td class="num">312</td> + <td class="num">697</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">313</td> + <td class="num">698</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="num">699</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> plot(0, type = "n",</pre> + <pre class="language-r"> if (!transform_fractions) {</pre> </td> </tr> <tr class="covered"> - <td class="num">315</td> - <td class="coverage">501<em>x</em></td> + <td class="num">700</td> + <td class="coverage">306<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> xlim = xlim, ylim = ylim_row,</pre> + <pre class="language-r"> index_f <- grep("^f_", names(upper))</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="num">701</td> + <td class="coverage">306<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> lower[index_f] <- 0</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="num">702</td> + <td class="coverage">306<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> pred_frame <- as.data.frame(pred_over[[i_over]])</pre> + <pre class="language-r"> upper[index_f] <- 1</pre> </td> </tr> - <tr class="missed"> - <td class="num">321</td> - <td class="coverage">!</td> + <tr class="covered"> + <td class="num">703</td> + <td class="coverage">306<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> lines(pred_frame$time, pred_frame[[obs_var]],</pre> + <pre class="language-r"> other_fraction_parms <- intersect(c("g"), names(upper))</pre> </td> </tr> - <tr class="missed"> - <td class="num">322</td> - <td class="coverage">!</td> + <tr class="covered"> + <td class="num">704</td> + <td class="coverage">306<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> lwd = 2, lty = lty_over[i_over])</pre> + <pre class="language-r"> lower[other_fraction_parms] <- 0</pre> </td> </tr> - <tr class="never"> - <td class="num">323</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">705</td> + <td class="coverage">306<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> upper[other_fraction_parms] <- 1</pre> </td> </tr> <tr class="never"> - <td class="num">324</td> + <td class="num">706</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">325</td> + <td class="num">707</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="num">708</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> col = col_ds[ds_i], pch = pch_ds[ds_i])</pre> + <pre class="language-r"> if (err_mod == "const") {</pre> </td> </tr> <tr class="covered"> - <td class="num">329</td> - <td class="coverage">4915<em>x</em></td> + <td class="num">709</td> + <td class="coverage">6410<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> + <pre class="language-r"> if (error_model_algorithm != "OLS") {</pre> </td> </tr> - <tr class="covered"> - <td class="num">330</td> - <td class="coverage">4915<em>x</em></td> + <tr class="missed"> + <td class="num">710</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> col = col_ds[ds_i], lty = lty_ds[ds_i])</pre> + <pre class="language-r"> lower["sigma"] <- 0</pre> </td> </tr> <tr class="never"> - <td class="num">331</td> + <td class="num">711</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="num">712</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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="num">713</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (pop_curves) {</pre> + <pre class="language-r"> if (err_mod == "obs") {</pre> </td> </tr> <tr class="covered"> - <td class="num">334</td> - <td class="coverage">501<em>x</em></td> + <td class="num">714</td> + <td class="coverage">317<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> for (cov_i in seq_along(pred_list_pop)) {</pre> + <pre class="language-r"> index_sigma <- grep("^sigma_", names(lower))</pre> </td> </tr> <tr class="covered"> - <td class="num">335</td> - <td class="coverage">501<em>x</em></td> + <td class="num">715</td> + <td class="coverage">317<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cov_name <- names(pred_list_pop)[cov_i]</pre> + <pre class="language-r"> lower[index_sigma] <- 0</pre> </td> </tr> - <tr class="covered"> - <td class="num">336</td> - <td class="coverage">501<em>x</em></td> + <tr class="never"> + <td class="num">716</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> lines(</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="covered"> - <td class="num">337</td> - <td class="coverage">501<em>x</em></td> + <td class="num">717</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> pred_list_pop[[cov_i]][, "time"],</pre> + <pre class="language-r"> if (err_mod == "tc") {</pre> </td> </tr> <tr class="covered"> - <td class="num">338</td> - <td class="coverage">501<em>x</em></td> + <td class="num">718</td> + <td class="coverage">1593<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> pred_list_pop[[cov_i]][, obs_var],</pre> + <pre class="language-r"> lower["sigma_low"] <- 0</pre> </td> </tr> <tr class="covered"> - <td class="num">339</td> - <td class="coverage">501<em>x</em></td> + <td class="num">719</td> + <td class="coverage">1593<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> type = "l", lwd = 2, lty = lty_pop[cov_i])</pre> + <pre class="language-r"> lower["rsd_high"] <- 0</pre> </td> </tr> <tr class="never"> - <td class="num">340</td> + <td class="num">720</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">341</td> + <td class="num">721</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">342</td> + <td class="num">722</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> # Counter for cost function evaluations</pre> </td> </tr> <tr class="covered"> - <td class="num">343</td> - <td class="coverage">501<em>x</em></td> + <td class="num">723</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (identical(maxabs, "auto")) {</pre> + <pre class="language-r"> calls = 0</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="num">724</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> cost.current <- Inf</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="num">725</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ylab = if (standardized) "Standardized residual" else "Residual",</pre> + <pre class="language-r"> out_predicted <- NA</pre> </td> </tr> - <tr class="missed"> - <td class="num">351</td> - <td class="coverage">!</td> + <tr class="covered"> + <td class="num">726</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> frame = frame)</pre> + <pre class="language-r"> current_data <- NA</pre> </td> </tr> <tr class="never"> - <td class="num">352</td> + <td class="num">727</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="num">728</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> + <pre class="language-r"> # Show parameter names if tracing is requested</pre> </td> </tr> - <tr class="missed"> - <td class="num">357</td> - <td class="coverage">!</td> + <tr class="covered"> + <td class="num">729</td> + <td class="coverage">104<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> col = col_ds[ds_i], pch = pch_ds[ds_i])</pre> + <pre class="language-r"> if(trace_parms) cat(format(names_optim, width = 10), "\n")</pre> </td> </tr> <tr class="never"> - <td class="num">358</td> + <td class="num">730</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">359</td> + <td class="num">731</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> #browser()</pre> </td> </tr> <tr class="never"> - <td class="num">360</td> + <td class="num">732</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> + <tr class="never"> + <td class="num">733</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> plot(0, type = "n",</pre> + <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">363</td> - <td class="coverage">501<em>x</em></td> + <td class="num">734</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> xlim = c(0, max(pred_ds[[obs_var]])),</pre> + <pre class="language-r"> fit_time <- system.time({</pre> </td> </tr> <tr class="covered"> - <td class="num">364</td> - <td class="coverage">501<em>x</em></td> + <td class="num">735</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> xlab = "Predicted",</pre> + <pre class="language-r"> degparms <- c(state.ini.optim, transparms.optim)</pre> </td> </tr> <tr class="covered"> - <td class="num">365</td> - <td class="coverage">501<em>x</em></td> + <td class="num">736</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ylim = c(-1.2 * maxabs, 1.2 * maxabs),</pre> + <pre class="language-r"> n_degparms <- length(degparms)</pre> </td> </tr> <tr class="covered"> - <td class="num">366</td> - <td class="coverage">501<em>x</em></td> + <td class="num">737</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ylab = if (standardized) "Standardized residual" else "Residual",</pre> + <pre class="language-r"> degparms_index <- seq(1, n_degparms)</pre> </td> </tr> <tr class="covered"> - <td class="num">367</td> - <td class="coverage">501<em>x</em></td> + <td class="num">738</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> frame = frame)</pre> + <pre class="language-r"> errparms_index <- seq(n_degparms + 1, length.out = length(errparms))</pre> </td> </tr> <tr class="never"> - <td class="num">368</td> + <td class="num">739</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="num">740</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> abline(h = 0, lty = 2)</pre> + <pre class="language-r"> if (error_model_algorithm == "d_3") {</pre> </td> </tr> - <tr class="never"> - <td class="num">370</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">741</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> if (!quiet) message("Directly optimising the complete model")</pre> </td> </tr> <tr class="covered"> - <td class="num">371</td> - <td class="coverage">501<em>x</em></td> + <td class="num">742</td> + <td class="coverage">471<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> for (ds_i in seq_along(i)) {</pre> + <pre class="language-r"> parms.start <- c(degparms, errparms)</pre> </td> </tr> <tr class="covered"> - <td class="num">372</td> - <td class="coverage">4915<em>x</em></td> + <td class="num">743</td> + <td class="coverage">471<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> observed_row_ds <- merge(</pre> + <pre class="language-r"> fit_direct <- try(nlminb(parms.start, cost_function,</pre> </td> </tr> <tr class="covered"> - <td class="num">373</td> - <td class="coverage">4915<em>x</em></td> + <td class="num">744</td> + <td class="coverage">471<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> + <pre class="language-r"> lower = lower[names(parms.start)],</pre> </td> </tr> <tr class="covered"> - <td class="num">374</td> - <td class="coverage">4915<em>x</em></td> + <td class="num">745</td> + <td class="coverage">471<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> + <pre class="language-r"> upper = upper[names(parms.start)],</pre> </td> </tr> <tr class="covered"> - <td class="num">375</td> - <td class="coverage">4915<em>x</em></td> + <td class="num">746</td> + <td class="coverage">471<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> points(observed_row_ds[c(3, 2)],</pre> + <pre class="language-r"> control = control, ...))</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="num">747</td> + <td class="coverage">471<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> if (!inherits(fit_direct, "try-error")) {</pre> </td> </tr> - <tr class="never"> - <td class="num">379</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">748</td> + <td class="coverage">471<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> fit_direct$logLik <- - cost.current</pre> </td> </tr> - <tr class="never"> - <td class="num">380</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">749</td> + <td class="coverage">471<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">}</pre> + <pre class="language-r"> cost.current <- Inf # reset to avoid conflict with the OLS step</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> + <tr class="covered"> + <td class="num">750</td> + <td class="coverage">471<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' Summary method for class "mkinfit"</pre> + <pre class="language-r"> data_direct <- current_data # We need this later if it was better</pre> </td> </tr> - <tr class="never"> - <td class="num">2</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">751</td> + <td class="coverage">471<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> direct_failed = FALSE</pre> </td> </tr> <tr class="never"> - <td class="num">3</td> + <td class="num">752</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' Lists model equations, initial parameter values, optimised parameters with</pre> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="never"> - <td class="num">4</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">753</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> + <pre class="language-r"> direct_failed = TRUE</pre> </td> </tr> <tr class="never"> - <td class="num">5</td> + <td class="num">754</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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">6</td> + <td class="num">755</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> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="never"> - <td class="num">7</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">756</td> + <td class="coverage">8320<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' values.</pre> + <pre class="language-r"> if (error_model_algorithm != "direct") {</pre> </td> </tr> - <tr class="never"> - <td class="num">8</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">757</td> + <td class="coverage">104<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> if (!quiet) message("Ordinary least squares optimisation")</pre> </td> </tr> - <tr class="never"> - <td class="num">9</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">758</td> + <td class="coverage">7884<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @param object an object of class [mkinfit].</pre> + <pre class="language-r"> fit <- nlminb(degparms, cost_function, control = control,</pre> </td> </tr> - <tr class="never"> - <td class="num">10</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">759</td> + <td class="coverage">7884<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @param x an object of class \code{summary.mkinfit}.</pre> + <pre class="language-r"> lower = lower[names(degparms)],</pre> </td> </tr> - <tr class="never"> - <td class="num">11</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">760</td> + <td class="coverage">7884<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @param data logical, indicating whether the data should be included in the</pre> + <pre class="language-r"> upper = upper[names(degparms)], OLS = TRUE, ...)</pre> </td> </tr> - <tr class="never"> - <td class="num">12</td> - <td class="coverage"></td> + <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">#' summary.</pre> + <pre class="language-r"> degparms <- fit$par</pre> </td> </tr> <tr class="never"> - <td class="num">13</td> + <td class="num">762</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> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">14</td> + <td class="num">763</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' included.</pre> + <pre class="language-r"> # Get the maximum likelihood estimate for sigma at the optimum parameter values</pre> </td> </tr> - <tr class="never"> - <td class="num">15</td> - <td class="coverage"></td> + <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">#' @param alpha error level for confidence interval estimation from t</pre> + <pre class="language-r"> current_data$residual <- current_data$value - current_data$predicted</pre> </td> </tr> - <tr class="never"> - <td class="num">16</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">765</td> + <td class="coverage">7731<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' distribution</pre> + <pre class="language-r"> sigma_mle <- sqrt(sum(current_data$residual^2)/nrow(current_data))</pre> </td> </tr> <tr class="never"> - <td class="num">17</td> + <td class="num">766</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @param digits Number of digits to use for printing</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">18</td> + <td class="num">767</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> + <pre class="language-r"> # Use that estimate for the constant variance, or as first guess if err_mod = "obs"</pre> </td> </tr> - <tr class="never"> - <td class="num">19</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">768</td> + <td class="coverage">7731<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @importFrom stats qt pt cov2cor</pre> + <pre class="language-r"> if (err_mod != "tc") {</pre> </td> </tr> - <tr class="never"> - <td class="num">20</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">769</td> + <td class="coverage">6327<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @return The summary function returns a list with components, among others</pre> + <pre class="language-r"> errparms[names(errparms)] <- sigma_mle</pre> </td> </tr> <tr class="never"> - <td class="num">21</td> + <td class="num">770</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' \item{version, Rversion}{The mkin and R versions used}</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="never"> - <td class="num">22</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">771</td> + <td class="coverage">7731<em>x</em></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> + <pre class="language-r"> fit$par <- c(fit$par, errparms)</pre> </td> </tr> <tr class="never"> - <td class="num">23</td> + <td class="num">772</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' produced}</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> - <td class="num">24</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">773</td> + <td class="coverage">7731<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' \item{diffs}{The differential equations used in the model}</pre> + <pre class="language-r"> cost.current <- cost_function(c(degparms, errparms), OLS = FALSE)</pre> </td> </tr> - <tr class="never"> - <td class="num">25</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">774</td> + <td class="coverage">7731<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' \item{use_of_ff}{Was maximum or minimum use made of formation fractions}</pre> + <pre class="language-r"> fit$logLik <- - cost.current</pre> </td> </tr> <tr class="never"> - <td class="num">26</td> + <td class="num">775</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' \item{bpar}{Optimised and backtransformed</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="never"> - <td class="num">27</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">776</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' parameters}</pre> + <pre class="language-r"> if (error_model_algorithm %in% c("threestep", "fourstep", "d_3")) {</pre> </td> </tr> - <tr class="never"> - <td class="num">28</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">777</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#' \item{data}{The data (see Description above).}</pre> + <pre class="language-r"> if (!quiet) message("Optimising the error model")</pre> </td> </tr> - <tr class="never"> - <td class="num">29</td> - <td class="coverage"></td> + <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">#' \item{start}{The starting values and bounds, if applicable, for optimised</pre> + <pre class="language-r"> fit <- nlminb(errparms, cost_function, control = control,</pre> </td> </tr> - <tr class="never"> - <td class="num">30</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">779</td> + <td class="coverage">1096<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' parameters.}</pre> + <pre class="language-r"> lower = lower[names(errparms)],</pre> </td> </tr> - <tr class="never"> - <td class="num">31</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">780</td> + <td class="coverage">1096<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' \item{fixed}{The values of fixed parameters.}</pre> + <pre class="language-r"> upper = upper[names(errparms)],</pre> </td> </tr> - <tr class="never"> - <td class="num">32</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">781</td> + <td class="coverage">1096<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' \item{errmin }{The chi2 error levels for</pre> + <pre class="language-r"> fixed_degparms = degparms, ...)</pre> </td> </tr> - <tr class="never"> - <td class="num">33</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">782</td> + <td class="coverage">1096<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' each observed variable.}</pre> + <pre class="language-r"> errparms <- fit$par</pre> </td> </tr> <tr class="never"> - <td class="num">34</td> + <td class="num">783</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' \item{bparms.ode}{All backtransformed ODE</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="never"> - <td class="num">35</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">784</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' parameters, for use as starting parameters for related models.}</pre> + <pre class="language-r"> if (error_model_algorithm == "fourstep") {</pre> </td> </tr> - <tr class="never"> - <td class="num">36</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">785</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#' \item{errparms}{Error model parameters.}</pre> + <pre class="language-r"> if (!quiet) message("Optimising the degradation model")</pre> </td> </tr> - <tr class="never"> - <td class="num">37</td> - <td class="coverage"></td> + <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">#' \item{ff}{The estimated formation fractions derived from the fitted</pre> + <pre class="language-r"> fit <- nlminb(degparms, cost_function, control = control,</pre> </td> </tr> - <tr class="never"> - <td class="num">38</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">787</td> + <td class="coverage">189<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' model.}</pre> + <pre class="language-r"> lower = lower[names(degparms)],</pre> </td> </tr> - <tr class="never"> - <td class="num">39</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">788</td> + <td class="coverage">189<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' \item{distimes}{The DT50 and DT90 values for each observed variable.}</pre> + <pre class="language-r"> upper = upper[names(degparms)],</pre> </td> </tr> - <tr class="never"> - <td class="num">40</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">789</td> + <td class="coverage">189<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' \item{SFORB}{If applicable, eigenvalues and fractional eigenvector component</pre> + <pre class="language-r"> fixed_errparms = errparms, ...)</pre> </td> </tr> - <tr class="never"> - <td class="num">41</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">790</td> + <td class="coverage">189<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' g of SFORB systems in the model.}</pre> + <pre class="language-r"> degparms <- fit$par</pre> </td> </tr> <tr class="never"> - <td class="num">42</td> + <td class="num">791</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> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="never"> - <td class="num">43</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">792</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @author Johannes Ranke</pre> + <pre class="language-r"> if (error_model_algorithm %in%</pre> </td> </tr> - <tr class="never"> - <td class="num">44</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">793</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @references FOCUS (2006) \dQuote{Guidance Document on Estimating Persistence</pre> + <pre class="language-r"> c("direct", "twostep", "threestep", "fourstep", "d_3")) {</pre> </td> </tr> - <tr class="never"> - <td class="num">45</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">794</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> + <pre class="language-r"> if (!quiet) message("Optimising the complete model")</pre> </td> </tr> - <tr class="never"> - <td class="num">46</td> - <td class="coverage"></td> + <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">#' EU Registration} Report of the FOCUS Work Group on Degradation Kinetics,</pre> + <pre class="language-r"> parms.start <- c(degparms, errparms)</pre> </td> </tr> - <tr class="never"> - <td class="num">47</td> - <td class="coverage"></td> + <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">#' EC Document Reference Sanco/10058/2005 version 2.0, 434 pp,</pre> + <pre class="language-r"> fit <- nlminb(parms.start, cost_function,</pre> </td> </tr> - <tr class="never"> - <td class="num">48</td> - <td class="coverage"></td> + <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">#' \url{http://esdac.jrc.ec.europa.eu/projects/degradation-kinetics}</pre> + <pre class="language-r"> lower = lower[names(parms.start)],</pre> </td> </tr> - <tr class="never"> - <td class="num">49</td> - <td class="coverage"></td> + <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">#' @examples</pre> + <pre class="language-r"> upper = upper[names(parms.start)],</pre> </td> </tr> - <tr class="never"> - <td class="num">50</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">799</td> + <td class="coverage">1721<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> control = control, ...)</pre> </td> </tr> - <tr class="never"> - <td class="num">51</td> - <td class="coverage"></td> + <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">#' summary(mkinfit("SFO", FOCUS_2006_A, quiet = TRUE))</pre> + <pre class="language-r"> degparms <- fit$par[degparms_index]</pre> </td> </tr> - <tr class="never"> - <td class="num">52</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">801</td> + <td class="coverage">1721<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> errparms <- fit$par[errparms_index]</pre> </td> </tr> - <tr class="never"> - <td class="num">53</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">802</td> + <td class="coverage">1721<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <pre class="language-r"> fit$logLik <- - cost.current</pre> </td> </tr> <tr class="never"> - <td class="num">54</td> + <td class="num">803</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> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">55</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">804</td> + <td class="coverage">1721<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> param <- object$par</pre> + <pre class="language-r"> if (error_model_algorithm == "d_3") {</pre> </td> </tr> <tr class="covered"> - <td class="num">56</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">805</td> + <td class="coverage">471<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> pnames <- names(param)</pre> + <pre class="language-r"> d_3_messages = c(</pre> </td> </tr> <tr class="covered"> - <td class="num">57</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">806</td> + <td class="coverage">471<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> bpnames <- names(object$bparms.optim)</pre> + <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">58</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">807</td> + <td class="coverage">471<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> epnames <- names(object$errparms)</pre> + <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">59</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">808</td> + <td class="coverage">471<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> p <- length(param)</pre> + <pre class="language-r"> threestep = "Three-step fitting yielded a higher likelihood than direct fitting",</pre> </td> </tr> <tr class="covered"> - <td class="num">60</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">809</td> + <td class="coverage">471<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> mod_vars <- names(object$mkinmod$diffs)</pre> + <pre class="language-r"> direct = "Direct fitting yielded a higher likelihood than three-step fitting")</pre> </td> </tr> <tr class="covered"> - <td class="num">61</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">810</td> + <td class="coverage">471<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> covar <- try(solve(object$hessian), silent = TRUE)</pre> + <pre class="language-r"> if (direct_failed) {</pre> </td> </tr> - <tr class="covered"> - <td class="num">62</td> - <td class="coverage">52158<em>x</em></td> + <tr class="missed"> + <td class="num">811</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> covar_notrans <- try(solve(object$hessian_notrans), silent = TRUE)</pre> + <pre class="language-r"> if (!quiet) message(d_3_messages["direct_failed"])</pre> </td> </tr> - <tr class="covered"> - <td class="num">63</td> - <td class="coverage">52158<em>x</em></td> + <tr class="missed"> + <td class="num">812</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> rdf <- object$df.residual</pre> + <pre class="language-r"> fit$d_3_message <- d_3_messages["direct_failed"]</pre> </td> </tr> <tr class="never"> - <td class="num">64</td> + <td class="num">813</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> } else {</pre> </td> </tr> <tr class="covered"> - <td class="num">65</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">814</td> + <td class="coverage">471<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (!is.numeric(covar) | is.na(covar[1])) {</pre> + <pre class="language-r"> rel_diff <- abs((fit_direct$logLik - fit$logLik))/-mean(c(fit_direct$logLik, fit$logLik))</pre> </td> </tr> - <tr class="missed"> - <td class="num">66</td> - <td class="coverage">!</td> + <tr class="covered"> + <td class="num">815</td> + <td class="coverage">471<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> covar <- NULL</pre> + <pre class="language-r"> if (rel_diff < 0.0001) {</pre> </td> </tr> <tr class="missed"> - <td class="num">67</td> + <td class="num">816</td> <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> se <- lci <- uci <- rep(NA, p)</pre> + <pre class="language-r"> if (!quiet) message(d_3_messages["same"])</pre> </td> </tr> - <tr class="never"> - <td class="num">68</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">817</td> + <td class="coverage">240<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r"> fit$d_3_message <- d_3_messages["same"]</pre> </td> </tr> - <tr class="covered"> - <td class="num">69</td> - <td class="coverage">52158<em>x</em></td> + <tr class="never"> + <td class="num">818</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> rownames(covar) <- colnames(covar) <- pnames</pre> + <pre class="language-r"> } else {</pre> </td> </tr> <tr class="covered"> - <td class="num">70</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">819</td> + <td class="coverage">231<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> se <- sqrt(diag(covar))</pre> + <pre class="language-r"> if (fit$logLik > fit_direct$logLik) {</pre> </td> </tr> - <tr class="covered"> - <td class="num">71</td> - <td class="coverage">52158<em>x</em></td> + <tr class="missed"> + <td class="num">820</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> lci <- param + qt(alpha/2, rdf) * se</pre> + <pre class="language-r"> if (!quiet) message(d_3_messages["threestep"])</pre> </td> </tr> <tr class="covered"> - <td class="num">72</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">821</td> + <td class="coverage">15<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> uci <- param + qt(1-alpha/2, rdf) * se</pre> + <pre class="language-r"> fit$d_3_message <- d_3_messages["threestep"]</pre> </td> </tr> <tr class="never"> - <td class="num">73</td> + <td class="num">822</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="never"> - <td class="num">74</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">823</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> if (!quiet) message(d_3_messages["direct"])</pre> </td> </tr> <tr class="covered"> - <td class="num">75</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">824</td> + <td class="coverage">216<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> beparms.optim <- c(object$bparms.optim, object$par[epnames])</pre> + <pre class="language-r"> fit <- fit_direct</pre> </td> </tr> <tr class="covered"> - <td class="num">76</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">825</td> + <td class="coverage">216<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (!is.numeric(covar_notrans) | is.na(covar_notrans[1])) {</pre> + <pre class="language-r"> fit$d_3_message <- d_3_messages["direct"]</pre> </td> </tr> <tr class="covered"> - <td class="num">77</td> - <td class="coverage">88<em>x</em></td> + <td class="num">826</td> + <td class="coverage">216<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> covar_notrans <- NULL</pre> + <pre class="language-r"> degparms <- fit$par[degparms_index]</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="num">827</td> + <td class="coverage">216<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r"> errparms <- fit$par[errparms_index]</pre> </td> </tr> <tr class="covered"> - <td class="num">80</td> - <td class="coverage">52070<em>x</em></td> + <td class="num">828</td> + <td class="coverage">216<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> rownames(covar_notrans) <- colnames(covar_notrans) <- c(bpnames, epnames)</pre> + <pre class="language-r"> current_data <- data_direct</pre> </td> </tr> - <tr class="covered"> - <td class="num">81</td> - <td class="coverage">52070<em>x</em></td> + <tr class="never"> + <td class="num">829</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> se_notrans <- sqrt(diag(covar_notrans))</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> - <td class="num">82</td> - <td class="coverage">52070<em>x</em></td> + <tr class="never"> + <td class="num">830</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> tval <- beparms.optim / se_notrans</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> - <td class="num">83</td> - <td class="coverage">52070<em>x</em></td> + <tr class="never"> + <td class="num">831</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> pval <- pt(abs(tval), rdf, lower.tail = FALSE)</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">84</td> + <td class="num">832</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">85</td> + <td class="num">833</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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="num">834</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> names(se) <- pnames</pre> + <pre class="language-r"> if (err_mod != "const" & error_model_algorithm == "IRLS") {</pre> </td> </tr> - <tr class="never"> - <td class="num">87</td> - <td class="coverage"></td> + <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"></pre> + <pre class="language-r"> reweight.diff <- 1</pre> </td> </tr> <tr class="covered"> - <td class="num">88</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">836</td> + <td class="coverage">189<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> param <- cbind(param, se, lci, uci)</pre> + <pre class="language-r"> n.iter <- 0</pre> </td> </tr> <tr class="covered"> - <td class="num">89</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">837</td> + <td class="coverage">189<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> dimnames(param) <- list(pnames, c("Estimate", "Std. Error", "Lower", "Upper"))</pre> + <pre class="language-r"> errparms_last <- errparms</pre> </td> </tr> <tr class="never"> - <td class="num">90</td> + <td class="num">838</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="num">839</td> + <td class="coverage">189<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> bparam <- cbind(Estimate = beparms.optim, se_notrans,</pre> + <pre class="language-r"> while (reweight.diff > reweight.tol &</pre> </td> </tr> <tr class="covered"> - <td class="num">92</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">840</td> + <td class="coverage">189<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> "t value" = tval, "Pr(>t)" = pval, Lower = NA, Upper = NA)</pre> + <pre class="language-r"> n.iter < reweight.max.iter) {</pre> </td> </tr> <tr class="never"> - <td class="num">93</td> + <td class="num">841</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> + <tr class="missed"> + <td class="num">842</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> + <pre class="language-r"> if (!quiet) message("Optimising the error model")</pre> </td> </tr> <tr class="covered"> - <td class="num">96</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">843</td> + <td class="coverage">756<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> f_names_skip <- character(0)</pre> + <pre class="language-r"> fit <- nlminb(errparms, cost_function, control = control,</pre> </td> </tr> <tr class="covered"> - <td class="num">97</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">844</td> + <td class="coverage">756<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> + <pre class="language-r"> lower = lower[names(errparms)],</pre> </td> </tr> <tr class="covered"> - <td class="num">98</td> - <td class="coverage">70671<em>x</em></td> + <td class="num">845</td> + <td class="coverage">756<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> f_names <- grep(paste("^f", box, sep = "_"), pnames, value = TRUE)</pre> + <pre class="language-r"> upper = upper[names(errparms)],</pre> </td> </tr> <tr class="covered"> - <td class="num">99</td> - <td class="coverage">70671<em>x</em></td> + <td class="num">846</td> + <td class="coverage">756<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> n_paths <- length(f_names)</pre> + <pre class="language-r"> fixed_degparms = degparms, ...)</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="num">847</td> + <td class="coverage">756<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> errparms <- fit$par</pre> </td> </tr> <tr class="never"> - <td class="num">102</td> + <td class="num">848</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> + <tr class="missed"> + <td class="num">849</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> for (pname in pnames) {</pre> + <pre class="language-r"> if (!quiet) message("Optimising the degradation model")</pre> </td> </tr> <tr class="covered"> - <td class="num">104</td> - <td class="coverage">293621<em>x</em></td> + <td class="num">850</td> + <td class="coverage">756<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (!pname %in% f_names_skip) {</pre> + <pre class="language-r"> fit <- nlminb(degparms, cost_function, control = control,</pre> </td> </tr> <tr class="covered"> - <td class="num">105</td> - <td class="coverage">290217<em>x</em></td> + <td class="num">851</td> + <td class="coverage">756<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> par.lower <- param[pname, "Lower"]</pre> + <pre class="language-r"> lower = lower[names(degparms)],</pre> </td> </tr> <tr class="covered"> - <td class="num">106</td> - <td class="coverage">290217<em>x</em></td> + <td class="num">852</td> + <td class="coverage">756<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> par.upper <- param[pname, "Upper"]</pre> + <pre class="language-r"> upper = upper[names(degparms)],</pre> </td> </tr> <tr class="covered"> - <td class="num">107</td> - <td class="coverage">290217<em>x</em></td> + <td class="num">853</td> + <td class="coverage">756<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> names(par.lower) <- names(par.upper) <- pname</pre> + <pre class="language-r"> fixed_errparms = errparms, ...)</pre> </td> </tr> <tr class="covered"> - <td class="num">108</td> - <td class="coverage">290217<em>x</em></td> + <td class="num">854</td> + <td class="coverage">756<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> bpl <- backtransform_odeparms(par.lower, object$mkinmod,</pre> + <pre class="language-r"> degparms <- fit$par</pre> </td> </tr> - <tr class="covered"> - <td class="num">109</td> - <td class="coverage">290217<em>x</em></td> + <tr class="never"> + <td class="num">855</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$transform_rates,</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">110</td> - <td class="coverage">290217<em>x</em></td> + <td class="num">856</td> + <td class="coverage">756<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> object$transform_fractions)</pre> + <pre class="language-r"> reweight.diff <- dist(rbind(errparms, errparms_last))</pre> </td> </tr> <tr class="covered"> - <td class="num">111</td> - <td class="coverage">290217<em>x</em></td> + <td class="num">857</td> + <td class="coverage">756<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> bpu <- backtransform_odeparms(par.upper, object$mkinmod,</pre> + <pre class="language-r"> errparms_last <- errparms</pre> </td> </tr> - <tr class="covered"> - <td class="num">112</td> - <td class="coverage">290217<em>x</em></td> + <tr class="never"> + <td class="num">858</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$transform_rates,</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">113</td> - <td class="coverage">290217<em>x</em></td> + <td class="num">859</td> + <td class="coverage">756<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> object$transform_fractions)</pre> + <pre class="language-r"> fit$par <- c(fit$par, errparms)</pre> </td> </tr> <tr class="covered"> - <td class="num">114</td> - <td class="coverage">290217<em>x</em></td> + <td class="num">860</td> + <td class="coverage">756<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> bparam[names(bpl), "Lower"] <- bpl</pre> + <pre class="language-r"> cost.current <- cost_function(c(degparms, errparms), OLS = FALSE)</pre> </td> </tr> <tr class="covered"> - <td class="num">115</td> - <td class="coverage">290217<em>x</em></td> + <td class="num">861</td> + <td class="coverage">756<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> bparam[names(bpu), "Upper"] <- bpu</pre> + <pre class="language-r"> fit$logLik <- - cost.current</pre> </td> </tr> <tr class="never"> - <td class="num">116</td> + <td class="num">862</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">117</td> + <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">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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">119</td> + <td class="num">864</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="num">865</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> Rversion = paste(R.version$major, R.version$minor, sep="."),</pre> + <pre class="language-r"> dim_hessian <- length(c(degparms, errparms))</pre> </td> </tr> - <tr class="covered"> - <td class="num">123</td> - <td class="coverage">52158<em>x</em></td> + <tr class="never"> + <td class="num">866</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> date.fit = object$date,</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">124</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">867</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> date.summary = date(),</pre> + <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">125</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">868</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> solution_type = object$solution_type,</pre> + <pre class="language-r"> update_data = FALSE), silent = TRUE)</pre> </td> </tr> <tr class="covered"> - <td class="num">126</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">869</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> warnings = object$summary_warnings,</pre> + <pre class="language-r"> if (inherits(fit$hessian, "try-error")) {</pre> </td> </tr> - <tr class="covered"> - <td class="num">127</td> - <td class="coverage">52158<em>x</em></td> + <tr class="missed"> + <td class="num">870</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> use_of_ff = object$mkinmod$use_of_ff,</pre> + <pre class="language-r"> fit$hessian <- matrix(NA, nrow = dim_hessian, ncol = dim_hessian)</pre> </td> </tr> - <tr class="covered"> - <td class="num">128</td> - <td class="coverage">52158<em>x</em></td> + <tr class="never"> + <td class="num">871</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> error_model_algorithm = object$error_model_algorithm,</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="covered"> - <td class="num">129</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">872</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> df = c(p, rdf),</pre> + <pre class="language-r"> dimnames(fit$hessian) <- list(names(c(degparms, errparms)),</pre> </td> </tr> <tr class="covered"> - <td class="num">130</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">873</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> covar = covar,</pre> + <pre class="language-r"> names(c(degparms, errparms)))</pre> </td> </tr> - <tr class="covered"> - <td class="num">131</td> - <td class="coverage">52158<em>x</em></td> + <tr class="never"> + <td class="num">874</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> covar_notrans = covar_notrans,</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> - <td class="num">132</td> - <td class="coverage">52158<em>x</em></td> + <tr class="never"> + <td class="num">875</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> err_mod = object$err_mod,</pre> + <pre class="language-r"> # Backtransform parameters</pre> </td> </tr> <tr class="covered"> - <td class="num">133</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">876</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> niter = object$iterations,</pre> + <pre class="language-r"> bparms.optim = backtransform_odeparms(degparms, mkinmod,</pre> </td> </tr> <tr class="covered"> - <td class="num">134</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">877</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> calls = object$calls,</pre> + <pre class="language-r"> transform_rates = transform_rates,</pre> </td> </tr> <tr class="covered"> - <td class="num">135</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">878</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> time = object$time,</pre> + <pre class="language-r"> transform_fractions = transform_fractions)</pre> </td> </tr> <tr class="covered"> - <td class="num">136</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">879</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> par = param,</pre> + <pre class="language-r"> bparms.fixed = c(state.ini.fixed, parms.fixed)</pre> </td> </tr> <tr class="covered"> - <td class="num">137</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">880</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> bpar = bparam)</pre> + <pre class="language-r"> bparms.all = c(bparms.optim, parms.fixed)</pre> </td> </tr> <tr class="never"> - <td class="num">138</td> + <td class="num">881</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="num">882</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (ans$fit_version >= "0.9.49.6") {</pre> + <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">143</td> - <td class="coverage">52156<em>x</em></td> + <td class="num">883</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ans$AIC = AIC(object)</pre> + <pre class="language-r"> OLS = FALSE, trans = FALSE, update_data = FALSE), silent = TRUE)</pre> </td> </tr> <tr class="covered"> - <td class="num">144</td> - <td class="coverage">52156<em>x</em></td> + <td class="num">884</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ans$BIC = BIC(object)</pre> + <pre class="language-r"> if (inherits(fit$hessian_notrans, "try-error")) {</pre> </td> </tr> - <tr class="covered"> - <td class="num">145</td> - <td class="coverage">52156<em>x</em></td> + <tr class="missed"> + <td class="num">885</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> ans$logLik = logLik(object)</pre> + <pre class="language-r"> fit$hessian_notrans <- matrix(NA, nrow = dim_hessian, ncol = dim_hessian)</pre> </td> </tr> <tr class="never"> - <td class="num">146</td> + <td class="num">886</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="num">887</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if(data) ans$data <- object$data</pre> + <pre class="language-r"> dimnames(fit$hessian_notrans) <- list(names(c(bparms.optim, errparms)),</pre> </td> </tr> <tr class="covered"> - <td class="num">151</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">888</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ans$start <- object$start</pre> + <pre class="language-r"> names(c(bparms.optim, errparms)))</pre> </td> </tr> - <tr class="covered"> - <td class="num">152</td> - <td class="coverage">52158<em>x</em></td> + <tr class="never"> + <td class="num">889</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> ans$start_transformed <- object$start_transformed</pre> + <pre class="language-r"> })</pre> </td> </tr> <tr class="never"> - <td class="num">153</td> + <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">154</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">891</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ans$fixed <- object$fixed</pre> + <pre class="language-r"> fit$call <- call</pre> </td> </tr> <tr class="never"> - <td class="num">155</td> + <td class="num">892</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="num">893</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ans$errmin <- mkinerrmin(object, alpha = 0.05)</pre> + <pre class="language-r"> fit$error_model_algorithm <- error_model_algorithm</pre> </td> </tr> <tr class="never"> - <td class="num">157</td> + <td class="num">894</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="num">895</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (!is.null(ans$covar)){</pre> + <pre class="language-r"> if (fit$convergence != 0) {</pre> </td> </tr> <tr class="covered"> - <td class="num">160</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">896</td> + <td class="coverage">108<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> Corr <- cov2cor(ans$covar)</pre> + <pre class="language-r"> convergence_warning = paste0("Optimisation did not converge:\n", fit$message)</pre> </td> </tr> <tr class="covered"> - <td class="num">161</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">897</td> + <td class="coverage">108<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> rownames(Corr) <- colnames(Corr) <- rownames(ans$par)</pre> + <pre class="language-r"> summary_warnings <- c(summary_warnings, C = convergence_warning)</pre> </td> </tr> <tr class="covered"> - <td class="num">162</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">898</td> + <td class="coverage">108<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ans$Corr <- Corr</pre> + <pre class="language-r"> warning(convergence_warning)</pre> </td> </tr> <tr class="never"> - <td class="num">163</td> + <td class="num">899</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> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="never"> - <td class="num">165</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">900</td> + <td class="coverage">104<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> if(!quiet) message("Optimisation successfully terminated.\n")</pre> </td> </tr> <tr class="never"> - <td class="num">166</td> + <td class="num">901</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="num">902</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> + <tr class="never"> + <td class="num">903</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> ans$shapiro.p <- object$shapiro.p</pre> + <pre class="language-r"> # We need to return some more data for summary and plotting</pre> </td> </tr> <tr class="covered"> - <td class="num">170</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">904</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ep <- endpoints(object)</pre> + <pre class="language-r"> fit$solution_type <- solution_type</pre> </td> </tr> <tr class="covered"> - <td class="num">171</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">905</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (length(ep$ff) != 0)</pre> + <pre class="language-r"> fit$transform_rates <- transform_rates</pre> </td> </tr> <tr class="covered"> - <td class="num">172</td> - <td class="coverage">15612<em>x</em></td> + <td class="num">906</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ans$ff <- ep$ff</pre> + <pre class="language-r"> fit$transform_fractions <- transform_fractions</pre> </td> </tr> <tr class="covered"> - <td class="num">173</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">907</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (distimes) ans$distimes <- ep$distimes</pre> + <pre class="language-r"> fit$reweight.tol <- reweight.tol</pre> </td> </tr> <tr class="covered"> - <td class="num">174</td> - <td class="coverage">2442<em>x</em></td> + <td class="num">908</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (length(ep$SFORB) != 0) ans$SFORB <- ep$SFORB</pre> + <pre class="language-r"> fit$reweight.max.iter <- reweight.max.iter</pre> </td> </tr> <tr class="covered"> - <td class="num">175</td> - <td class="coverage">43972<em>x</em></td> + <td class="num">909</td> + <td class="coverage">8167<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> + <pre class="language-r"> fit$control <- control</pre> </td> </tr> <tr class="covered"> - <td class="num">176</td> - <td class="coverage">52158<em>x</em></td> + <td class="num">910</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> class(ans) <- "summary.mkinfit"</pre> + <pre class="language-r"> fit$calls <- calls</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="num">911</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">}</pre> + <pre class="language-r"> fit$time <- fit_time</pre> </td> </tr> <tr class="never"> - <td class="num">179</td> + <td class="num">912</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="num">913</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <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">182</td> + <td class="num">914</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> + <pre class="language-r"> # but without symbols because they could become invalid</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="num">915</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cat("R version: ", x$Rversion, "\n")</pre> + <pre class="language-r"> fit$symbols <- NULL</pre> </td> </tr> - <tr class="never"> - <td class="num">186</td> - <td class="coverage"></td> + <tr class="covered"> + <td class="num">916</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r"> fit$mkinmod <- mkinmod</pre> </td> </tr> <tr class="covered"> - <td class="num">187</td> - <td class="coverage">4<em>x</em></td> + <td class="num">917</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cat("mkin version used for fitting: ", x$fit_version, "\n")</pre> + <pre class="language-r"> fit$mkinmod$name <- mkinmod_name</pre> </td> </tr> <tr class="covered"> - <td class="num">188</td> - <td class="coverage">4<em>x</em></td> + <td class="num">918</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cat("R version used for fitting: ", x$fit_Rversion, "\n")</pre> + <pre class="language-r"> fit$obs_vars <- obs_vars</pre> </td> </tr> <tr class="never"> - <td class="num">189</td> + <td class="num">919</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">190</td> + <td class="num">920</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> + <pre class="language-r"> # Residual sum of squares as a function of the fitted parameters</pre> </td> </tr> <tr class="covered"> - <td class="num">192</td> - <td class="coverage">4<em>x</em></td> + <td class="num">921</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cat("Date of summary:", x$date.summary, "\n")</pre> + <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">193</td> + <td class="num">922</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> + <tr class="never"> + <td class="num">923</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> nice_diffs <- gsub("^(d.*) =", "\\1/dt =", x[["diffs"]])</pre> + <pre class="language-r"> # Log-likelihood with possibility to fix degparms or errparms</pre> </td> </tr> <tr class="covered"> - <td class="num">196</td> - <td class="coverage">4<em>x</em></td> + <td class="num">924</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> writeLines(strwrap(nice_diffs, exdent = 11))</pre> + <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">197</td> - <td class="coverage">4<em>x</em></td> + <td class="num">925</td> + <td class="coverage">547080<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> df <- x$df</pre> + <pre class="language-r"> - cost_function(P, trans = trans, fixed_degparms = fixed_degparms,</pre> </td> </tr> <tr class="covered"> - <td class="num">198</td> - <td class="coverage">4<em>x</em></td> + <td class="num">926</td> + <td class="coverage">547080<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> rdf <- df[2]</pre> + <pre class="language-r"> fixed_errparms = fixed_errparms, OLS = FALSE, update_data = FALSE)</pre> </td> </tr> <tr class="never"> - <td class="num">199</td> + <td class="num">927</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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">201</td> + <td class="num">928</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="num">929</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> + <pre class="language-r"> # Collect initial parameter values in three dataframes</pre> </td> </tr> <tr class="covered"> - <td class="num">206</td> - <td class="coverage">4<em>x</em></td> + <td class="num">930</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cat(switch(x$err_mod,</pre> + <pre class="language-r"> fit$start <- data.frame(value = c(state.ini.optim,</pre> </td> </tr> <tr class="covered"> - <td class="num">207</td> - <td class="coverage">4<em>x</em></td> + <td class="num">931</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> const = "Constant variance",</pre> + <pre class="language-r"> parms.optim, errparms_optim))</pre> </td> </tr> <tr class="covered"> - <td class="num">208</td> - <td class="coverage">4<em>x</em></td> + <td class="num">932</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> obs = "Variance unique to each observed variable",</pre> + <pre class="language-r"> fit$start$type = c(rep("state", length(state.ini.optim)),</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="num">933</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> rep("deparm", length(parms.optim)),</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="num">934</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> rep("error", length(errparms_optim)))</pre> </td> </tr> <tr class="never"> - <td class="num">214</td> + <td class="num">935</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="num">936</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nStarting values for parameters to be optimised:\n")</pre> + <pre class="language-r"> fit$start_transformed = data.frame(</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="num">937</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> value = c(state.ini.optim, transparms.optim, errparms_optim),</pre> </td> </tr> <tr class="covered"> - <td class="num">218</td> - <td class="coverage">4<em>x</em></td> + <td class="num">938</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nStarting values for the transformed parameters actually optimised:\n")</pre> + <pre class="language-r"> lower = lower,</pre> </td> </tr> <tr class="covered"> - <td class="num">219</td> - <td class="coverage">4<em>x</em></td> + <td class="num">939</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> print(x$start_transformed)</pre> + <pre class="language-r"> upper = upper)</pre> </td> </tr> <tr class="never"> - <td class="num">220</td> + <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">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="num">941</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if(length(x$fixed$value) == 0) cat("None\n")</pre> + <pre class="language-r"> fit$fixed <- data.frame(value = c(state.ini.fixed, parms.fixed))</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="num">942</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> fit$fixed$type = c(rep("state", length(state.ini.fixed)),</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="num">943</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> rep("deparm", length(parms.fixed)))</pre> </td> </tr> <tr class="never"> - <td class="num">232</td> + <td class="num">944</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="num">945</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (!is.null(x$AIC)) {</pre> + <pre class="language-r"> fit$data <- data.frame(time = current_data$time,</pre> </td> </tr> <tr class="covered"> - <td class="num">234</td> - <td class="coverage">4<em>x</em></td> + <td class="num">946</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nResults:\n\n")</pre> + <pre class="language-r"> variable = current_data$name,</pre> </td> </tr> <tr class="covered"> - <td class="num">235</td> - <td class="coverage">4<em>x</em></td> + <td class="num">947</td> + <td class="coverage">8167<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> + <pre class="language-r"> observed = current_data$value,</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="num">948</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> predicted = current_data$predicted)</pre> </td> </tr> <tr class="never"> - <td class="num">238</td> + <td class="num">949</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="num">950</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> print(signif(x$par, digits = digits))</pre> + <pre class="language-r"> fit$data$residual <- fit$data$observed - fit$data$predicted</pre> </td> </tr> <tr class="never"> - <td class="num">241</td> + <td class="num">951</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="num">952</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (x$calls > 0) {</pre> + <pre class="language-r"> fit$atol <- atol</pre> </td> </tr> <tr class="covered"> - <td class="num">243</td> - <td class="coverage">4<em>x</em></td> + <td class="num">953</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nParameter correlation:\n")</pre> + <pre class="language-r"> fit$rtol <- rtol</pre> </td> </tr> <tr class="covered"> - <td class="num">244</td> - <td class="coverage">4<em>x</em></td> + <td class="num">954</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (!is.null(x$covar)){</pre> + <pre class="language-r"> fit$err_mod <- err_mod</pre> </td> </tr> - <tr class="covered"> - <td class="num">245</td> - <td class="coverage">4<em>x</em></td> + <tr class="never"> + <td class="num">955</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> print(x$Corr, digits = digits, ...)</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">246</td> + <td class="num">956</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r"> # Return different sets of backtransformed parameters for summary and plotting</pre> </td> </tr> - <tr class="missed"> - <td class="num">247</td> - <td class="coverage">!</td> + <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"> cat("No covariance matrix")</pre> + <pre class="language-r"> fit$bparms.optim <- bparms.optim</pre> </td> </tr> - <tr class="never"> - <td class="num">248</td> - <td class="coverage"></td> + <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"> }</pre> + <pre class="language-r"> fit$bparms.fixed <- bparms.fixed</pre> </td> </tr> <tr class="never"> - <td class="num">249</td> + <td class="num">959</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">250</td> + <td class="num">960</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> # Return ode and state parameters for further fitting</pre> </td> </tr> <tr class="covered"> - <td class="num">251</td> - <td class="coverage">4<em>x</em></td> + <td class="num">961</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nBacktransformed parameters:\n")</pre> + <pre class="language-r"> fit$bparms.ode <- bparms.all[mkinmod$parms]</pre> </td> </tr> <tr class="covered"> - <td class="num">252</td> - <td class="coverage">4<em>x</em></td> + <td class="num">962</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cat("Confidence intervals for internally transformed parameters are asymmetric.\n")</pre> + <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">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="num">963</td> + <td class="coverage">8167<em>x</em></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> + <pre class="language-r"> state.ini.fixed)</pre> </td> </tr> - <tr class="missed"> - <td class="num">255</td> - <td class="coverage">!</td> + <tr class="covered"> + <td class="num">964</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> print(signif(x$bpar, digits = digits))</pre> + <pre class="language-r"> names(fit$bparms.state) <- gsub("_0$", "", names(fit$bparms.state))</pre> </td> </tr> <tr class="never"> - <td class="num">256</td> + <td class="num">965</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> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">258</td> - <td class="coverage">4<em>x</em></td> + <td class="num">966</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cat("for estimators of untransformed parameters.\n")</pre> + <pre class="language-r"> fit$errparms <- errparms</pre> </td> </tr> <tr class="covered"> - <td class="num">259</td> - <td class="coverage">4<em>x</em></td> + <td class="num">967</td> + <td class="coverage">8167<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> + <pre class="language-r"> fit$df.residual <- n_observed - length(c(degparms, errparms))</pre> </td> </tr> <tr class="never"> - <td class="num">260</td> + <td class="num">968</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">261</td> + <td class="num">969</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> + <pre class="language-r"> # Assign the class here so method dispatch works for residuals</pre> </td> </tr> <tr class="covered"> - <td class="num">264</td> - <td class="coverage">4<em>x</em></td> + <td class="num">970</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> print(x$errmin, digits=digits,...)</pre> + <pre class="language-r"> class(fit) <- c("mkinfit")</pre> </td> </tr> <tr class="never"> - <td class="num">265</td> + <td class="num">971</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="num">972</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> printSFORB <- !is.null(x$SFORB)</pre> + <pre class="language-r"> if (test_residuals) {</pre> </td> </tr> - <tr class="covered"> - <td class="num">267</td> - <td class="coverage">4<em>x</em></td> + <tr class="never"> + <td class="num">973</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if(printSFORB){</pre> + <pre class="language-r"> # Check for normal distribution of residuals</pre> </td> </tr> <tr class="covered"> - <td class="num">268</td> - <td class="coverage">1<em>x</em></td> + <td class="num">974</td> + <td class="coverage">153<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> + <pre class="language-r"> fit$shapiro.p <- shapiro.test(residuals(fit, standardized = TRUE))$p.value</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="num">975</td> + <td class="coverage">153<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> if (fit$shapiro.p < 0.05) {</pre> </td> </tr> <tr class="covered"> - <td class="num">272</td> - <td class="coverage">4<em>x</em></td> + <td class="num">976</td> + <td class="coverage">153<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> printff <- !is.null(x$ff)</pre> + <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">273</td> - <td class="coverage">4<em>x</em></td> + <td class="num">977</td> + <td class="coverage">153<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if(printff){</pre> + <pre class="language-r"> warning(shapiro_warning)</pre> </td> </tr> <tr class="covered"> - <td class="num">274</td> - <td class="coverage">3<em>x</em></td> + <td class="num">978</td> + <td class="coverage">153<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nResulting formation fractions:\n")</pre> + <pre class="language-r"> summary_warnings <- c(summary_warnings, S = shapiro_warning)</pre> </td> </tr> - <tr class="covered"> - <td class="num">275</td> - <td class="coverage">3<em>x</em></td> + <tr class="never"> + <td class="num">979</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> print(data.frame(ff = x$ff), digits=digits,...)</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">276</td> + <td class="num">980</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="num">981</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="num">982</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> fit$summary_warnings <- summary_warnings</pre> </td> </tr> <tr class="never"> - <td class="num">283</td> + <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">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="num">984</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (printdata){</pre> + <pre class="language-r"> fit$date <- date()</pre> </td> </tr> <tr class="covered"> - <td class="num">286</td> - <td class="coverage">4<em>x</em></td> + <td class="num">985</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nData:\n")</pre> + <pre class="language-r"> fit$version <- as.character(utils::packageVersion("mkin"))</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="num">986</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> fit$Rversion <- paste(R.version$major, R.version$minor, sep=".")</pre> </td> </tr> <tr class="never"> - <td class="num">289</td> + <td class="num">987</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="num">988</td> + <td class="coverage">8167<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> invisible(x)</pre> + <pre class="language-r"> return(fit)</pre> </td> </tr> <tr class="never"> - <td class="num">291</td> + <td class="num">989</td> <td class="coverage"></td> <td class="col-sm-12"> <pre class="language-r">}</pre> @@ -23607,126 +19454,126 @@ table.table-condensed { </tbody> </table> </div> - <div id="R/mkinfit.R" class="hidden"> + <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">utils::globalVariables(c("name", "time", "value"))</pre> + <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> + <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> + <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">#'</pre> + <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">#' This function maximises the likelihood of the observed data using the Port</pre> + <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">#' algorithm [stats::nlminb()], and the specified initial or fixed</pre> + <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">#' parameters and starting values. In each step of the optimisation, the</pre> + <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">#' kinetic model is solved using the function [mkinpredict()], except</pre> + <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">#' if an analytical solution is implemented, in which case the model is solved</pre> + <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">#' using the degradation function in the [mkinmod] object. The</pre> + <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">#' parameters of the selected error model are fitted simultaneously with the</pre> + <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">#' degradation model parameters, as both of them are arguments of the</pre> + <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">#' likelihood function.</pre> + <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">#'</pre> + <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">#' Per default, parameters in the kinetic models are internally transformed in</pre> + <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">#' order to better satisfy the assumption of a normal distribution of their</pre> + <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">#' estimators.</pre> + <pre class="language-r">#' [inline::cfunction()] and added to the resulting mkinmod object.</pre> </td> </tr> <tr class="never"> @@ -23740,609 +19587,609 @@ table.table-condensed { <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> + <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">#' model to be fitted to the data, or one of the shorthand names ("SFO",</pre> + <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">#' "FOMC", "DFOP", "HS", "SFORB", "IORE"). If a shorthand name is given, a</pre> + <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">#' parent only degradation model is generated for the variable with the</pre> + <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">#' highest value in \code{observed}.</pre> + <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">#' @param observed A dataframe with the observed data. The first column called</pre> + <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">#' "name" must contain the name of the observed variable for each data point.</pre> + <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">#' The second column must contain the times of observation, named "time".</pre> + <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">#' The third column must be named "value" and contain the observed values.</pre> + <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">#' Zero values in the "value" column will be removed, with a warning, in</pre> + <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">#' order to avoid problems with fitting the two-component error model. This</pre> + <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">#' is not expected to be a problem, because in general, values of zero are</pre> + <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">#' not observed in degradation data, because there is a lower limit of</pre> + <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">#' detection.</pre> + <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 parms.ini A named vector of initial values for the parameters,</pre> + <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">#' including parameters to be optimised and potentially also fixed parameters</pre> + <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">#' as indicated by \code{fixed_parms}. If set to "auto", initial values for</pre> + <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">#' rate constants are set to default values. Using parameter names that are</pre> + <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">#' not in the model gives an error.</pre> + <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">#'</pre> + <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">#' It is possible to only specify a subset of the parameters that the model</pre> + <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">#' needs. You can use the parameter lists "bparms.ode" from a previously</pre> + <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">#' fitted model, which contains the differential equation parameters from</pre> + <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">#' this model. This works nicely if the models are nested. An example is</pre> + <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">#' given below.</pre> + <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 state.ini A named vector of initial values for the state variables of</pre> + <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">#' the model. In case the observed variables are represented by more than one</pre> + <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">#' model variable, the names will differ from the names of the observed</pre> + <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">#' variables (see \code{map} component of [mkinmod]). The default</pre> + <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">#' is to set the initial value of the first model variable to the mean of the</pre> + <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">#' time zero values for the variable with the maximum observed value, and all</pre> + <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">#' others to 0. If this variable has no time zero observations, its initial</pre> + <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">#' value is set to 100.</pre> + <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">#' @param err.ini A named vector of initial values for the error model</pre> + <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">#' parameters to be optimised. If set to "auto", initial values are set to</pre> + <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">#' default values. Otherwise, inital values for all error model parameters</pre> + <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">#' must be given.</pre> + <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">#' @param fixed_parms The names of parameters that should not be optimised but</pre> + <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">#' rather kept at the values specified in \code{parms.ini}. Alternatively,</pre> + <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">#' a named numeric vector of parameters to be fixed, regardless of the values</pre> + <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">#' in parms.ini.</pre> + <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">#' @param fixed_initials The names of model variables for which the initial</pre> + <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">#' state at time 0 should be excluded from the optimisation. Defaults to all</pre> + <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">#' state variables except for the first one.</pre> + <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">#' @param from_max_mean If this is set to TRUE, and the model has only one</pre> + <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">#' observed variable, then data before the time of the maximum observed value</pre> + <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">#' (after averaging for each sampling time) are discarded, and this time is</pre> + <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">#' subtracted from all remaining time values, so the time of the maximum</pre> + <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">#' observed mean value is the new time zero.</pre> + <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">#' @param solution_type If set to "eigen", the solution of the system of</pre> + <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">#' differential equations is based on the spectral decomposition of the</pre> + <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">#' coefficient matrix in cases that this is possible. If set to "deSolve", a</pre> + <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">#' numerical [ode solver from package deSolve][deSolve::ode()] is used. If</pre> + <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">#' set to "analytical", an analytical solution of the model is used. This is</pre> + <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">#' only implemented for relatively simple degradation models. The default is</pre> + <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">#' "auto", which uses "analytical" if possible, otherwise "deSolve" if a</pre> + <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">#' compiler is present, and "eigen" if no compiler is present and the model</pre> + <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">#' can be expressed using eigenvalues and eigenvectors.</pre> + <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">#' @param method.ode The solution method passed via [mkinpredict()]</pre> + <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">#' to [deSolve::ode()] in case the solution type is "deSolve". The default</pre> + <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">#' "lsoda" is performant, but sometimes fails to converge.</pre> + <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">#' @param use_compiled If set to \code{FALSE}, no compiled version of the</pre> + <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">#' [mkinmod] model is used in the calls to [mkinpredict()] even if a compiled</pre> + <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">#' version is present.</pre> + <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">#' @param control A list of control arguments passed to [stats::nlminb()].</pre> + <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">#' @param transform_rates Boolean specifying if kinetic rate constants should</pre> + <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">#' be transformed in the model specification used in the fitting for better</pre> + <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">#' compliance with the assumption of normal distribution of the estimator. If</pre> + <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">#' TRUE, also alpha and beta parameters of the FOMC model are</pre> + <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">#' log-transformed, as well as k1 and k2 rate constants for the DFOP and HS</pre> + <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">#' models and the break point tb of the HS model. If FALSE, zero is used as</pre> + <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">#' a lower bound for the rates in the optimisation.</pre> + <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">#' @param transform_fractions Boolean specifying if formation fractions</pre> + <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">#' should be transformed in the model specification used in the fitting for</pre> + <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">#' better compliance with the assumption of normal distribution of the</pre> + <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">#' estimator. The default (TRUE) is to do transformations. If TRUE,</pre> + <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">#' the g parameter of the DFOP model is also transformed. Transformations</pre> + <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">#' are described in [transform_odeparms].</pre> + <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">#' @param quiet Suppress printing out the current value of the negative</pre> + <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">#' log-likelihood after each improvement?</pre> + <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">#' @param atol Absolute error tolerance, passed to [deSolve::ode()]. Default</pre> + <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">#' is 1e-8, which is lower than the default in the [deSolve::lsoda()]</pre> + <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">#' function which is used per default.</pre> + <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">#' @param rtol Absolute error tolerance, passed to [deSolve::ode()]. Default</pre> + <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">#' is 1e-10, much lower than in [deSolve::lsoda()].</pre> + <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">#' @param error_model If the error model is "const", a constant standard</pre> + <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">#' deviation is assumed.</pre> + <pre class="language-r">#' fit_sfo_sfo <- mkinfit(SFO_SFO, FOCUS_2006_D, quiet = TRUE, solution_type = "deSolve")</pre> </td> </tr> <tr class="never"> @@ -24356,133 +20203,133 @@ table.table-condensed { <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> + <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">#' own variance.</pre> + <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">#'</pre> + <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 the error model is "tc" (two-component error model), a two component</pre> + <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">#' error model similar to the one described by Rocke and Lorenzato (1995) is</pre> + <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">#' used for setting up the likelihood function. Note that this model</pre> + <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">#' deviates from the model by Rocke and Lorenzato, as their model implies</pre> + <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">#' that the errors follow a lognormal distribution for large values, not a</pre> + <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">#' normal distribution as assumed by this method.</pre> + <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">#' @param error_model_algorithm If "auto", the selected algorithm depends on</pre> + <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">#' the error model. If the error model is "const", unweighted nonlinear</pre> + <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">#' least squares fitting ("OLS") is selected. If the error model is "obs", or</pre> + <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">#' "tc", the "d_3" algorithm is selected.</pre> + <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">#'</pre> + <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">#' The algorithm "d_3" will directly minimize the negative log-likelihood</pre> + <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">#' and independently also use the three step algorithm described below.</pre> + <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">#' The fit with the higher likelihood is returned.</pre> + <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">#'</pre> + <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">#' The algorithm "direct" will directly minimize the negative log-likelihood.</pre> + <pre class="language-r">#' m1 = mkinsub("SFO"), verbose = TRUE)</pre> </td> </tr> <tr class="never"> @@ -24496,1148 +20343,1148 @@ table.table-condensed { <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> + <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">#' initial unweighted least squares optimisation step.</pre> + <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">#'</pre> + <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">#' The algorithm "threestep" starts with unweighted least squares, then</pre> + <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">#' optimizes only the error model using the degradation model parameters</pre> + <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">#' found, and then minimizes the negative log-likelihood with free</pre> + <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">#' degradation and error model parameters.</pre> + <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">#'</pre> + <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">#' The algorithm "fourstep" starts with unweighted least squares, then</pre> + <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">#' optimizes only the error model using the degradation model parameters</pre> + <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">#' found, then optimizes the degradation model again with fixed error model</pre> + <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">#' parameters, and finally minimizes the negative log-likelihood with free</pre> + <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">#' degradation and error model parameters.</pre> + <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">#'</pre> + <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">#' The algorithm "IRLS" (Iteratively Reweighted Least Squares) starts with</pre> + <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">#' unweighted least squares, and then iterates optimization of the error</pre> + <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">#' model parameters and subsequent optimization of the degradation model</pre> + <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">#' using those error model parameters, until the error model parameters</pre> + <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">#' converge.</pre> + <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">#' @param reweight.tol Tolerance for the convergence criterion calculated from</pre> + <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">#' the error model parameters in IRLS fits.</pre> + <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">#' @param reweight.max.iter Maximum number of iterations in IRLS fits.</pre> + <pre class="language-r">{</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">149</td> - <td class="coverage"></td> + <td class="coverage">4940<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @param trace_parms Should a trace of the parameter values be listed?</pre> + <pre class="language-r"> if (is.null(speclist)) spec <- list(...)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">150</td> - <td class="coverage"></td> + <td class="coverage">3905<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @param test_residuals Should the residuals be tested for normal distribution?</pre> + <pre class="language-r"> else spec <- speclist</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">151</td> - <td class="coverage"></td> + <td class="coverage">8845<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @param \dots Further arguments that will be passed on to</pre> + <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">#' [deSolve::ode()].</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">153</td> - <td class="coverage"></td> + <td class="coverage">8845<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @importFrom stats nlminb aggregate dist shapiro.test</pre> + <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="never"> + <tr class="covered"> <td class="num">154</td> - <td class="coverage"></td> + <td class="coverage">8845<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @return A list with "mkinfit" in the class attribute.</pre> + <pre class="language-r"> if (!is.null(dll_dir)) {</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">155</td> - <td class="coverage"></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> + <pre class="language-r"> if (!dir.exists(dll_dir)) stop(dll_dir, " does not exist")</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">156</td> - <td class="coverage"></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> + <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">#' numerical ODE solver. In this situation it may help to switch off the</pre> + <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">#' internal rate transformation.</pre> + <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">#' @author Johannes Ranke</pre> + <pre class="language-r"> # Check if any of the names of the observed variables contains any other</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">160</td> - <td class="coverage"></td> + <td class="coverage">8845<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @seealso [summary.mkinfit], [plot.mkinfit], [parms] and [lrtest].</pre> + <pre class="language-r"> for (obs_var in obs_vars) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">161</td> - <td class="coverage"></td> + <td class="coverage">104<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <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="never"> + <tr class="covered"> <td class="num">162</td> - <td class="coverage"></td> + <td class="coverage">104<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' Comparisons of models fitted to the same data can be made using</pre> + <pre class="language-r"> if (grepl("_to_", obs_var)) stop("Sorry, names of observed variables can not contain _to_")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">163</td> - <td class="coverage"></td> + <td class="coverage">104<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' \code{\link{AIC}} by virtue of the method \code{\link{logLik.mkinfit}}.</pre> + <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> + <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> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">166</td> - <td class="coverage"></td> + <td class="coverage">8533<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' \code{\link{mmkin}}.</pre> + <pre class="language-r"> if (!use_of_ff %in% c("min", "max"))</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">167</td> - <td class="coverage"></td> + <td class="coverage">104<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @references Rocke DM and Lorenzato S (1995) A two-component model</pre> + <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">#' for measurement error in analytical chemistry. *Technometrics* 37(2), 176-184.</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">169</td> - <td class="coverage"></td> + <td class="coverage">8429<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <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">#' Ranke J and Meinecke S (2019) Error Models for the Kinetic Evaluation of Chemical</pre> + <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">#' Degradation Data. *Environments* 6(12) 124</pre> + <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">#' \doi{10.3390/environments6120124}.</pre> + <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="never"> + <tr class="covered"> <td class="num">173</td> - <td class="coverage"></td> + <td class="coverage">8429<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @examples</pre> + <pre class="language-r"> if(spec[[1]]$type %in% c("FOMC", "IORE", "DFOP", "HS", "logistic")) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">174</td> - <td class="coverage"></td> + <td class="coverage">2280<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> mat = FALSE</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">175</td> - <td class="coverage"></td> + <td class="coverage">6149<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' # Use shorthand notation for parent only degradation</pre> + <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">#' fit <- mkinfit("FOMC", FOCUS_2006_C, quiet = TRUE)</pre> + <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">#' summary(fit)</pre> + <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> + <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">#' # One parent compound, one metabolite, both single first order.</pre> + <pre class="language-r"> # compartments to differential equations</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">180</td> - <td class="coverage"></td> + <td class="coverage">8429<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' # We remove zero values from FOCUS dataset D in order to avoid warnings</pre> + <pre class="language-r"> diffs <- vector()</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">181</td> - <td class="coverage"></td> + <td class="coverage">8429<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' FOCUS_D <- subset(FOCUS_2006_D, value != 0)</pre> + <pre class="language-r"> map <- list()</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">182</td> - <td class="coverage"></td> + <td class="coverage">8429<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' # Use mkinsub for convenience in model formulation. Pathway to sink included per default.</pre> + <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">#' SFO_SFO <- mkinmod(</pre> + <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">#' parent = mkinsub("SFO", "m1"),</pre> + <pre class="language-r"> # Check the type component of the compartment specification {{{</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">185</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#' m1 = mkinsub("SFO"))</pre> + <pre class="language-r"> if(is.null(spec[[varname]]$type)) stop(</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">186</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> "Every part of the model specification must be a list containing a type component")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">187</td> - <td class="coverage"></td> + <td class="coverage">104<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' # Fit the model quietly to the FOCUS example dataset D using defaults</pre> + <pre class="language-r"> if(!spec[[varname]]$type %in% c("SFO", "FOMC", "IORE", "DFOP", "HS", "SFORB", "logistic")) stop(</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">188</td> - <td class="coverage"></td> + <td class="coverage">104<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' fit <- mkinfit(SFO_SFO, FOCUS_D, quiet = TRUE)</pre> + <pre class="language-r"> "Available types are SFO, FOMC, IORE, DFOP, HS, SFORB and logistic only")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">189</td> - <td class="coverage"></td> + <td class="coverage">13150<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' plot_sep(fit)</pre> + <pre class="language-r"> if(spec[[varname]]$type %in% c("FOMC", "DFOP", "HS", "logistic") & match(varname, obs_vars) != 1) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">190</td> - <td class="coverage"></td> + <td class="coverage">104<em>x</em></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> + <pre class="language-r"> stop(paste("Types FOMC, DFOP, HS and logistic are only implemented for the first compartment,",</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">191</td> - <td class="coverage"></td> + <td class="coverage">104<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' fit.tc <- mkinfit(SFO_SFO, FOCUS_D, quiet = TRUE, error_model = "tc")</pre> + <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">#' # This avoids the warning, and the likelihood ratio test confirms it is preferable</pre> + <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">#' lrtest(fit.tc, fit)</pre> + <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">#' # We can also allow for different variances of parent and metabolite as error model</pre> + <pre class="language-r"> # New (sub)compartments (boxes) needed for the model type {{{</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">195</td> - <td class="coverage"></td> + <td class="coverage">13046<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' fit.obs <- mkinfit(SFO_SFO, FOCUS_D, quiet = TRUE, error_model = "obs")</pre> + <pre class="language-r"> new_boxes <- switch(spec[[varname]]$type,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">196</td> - <td class="coverage"></td> + <td class="coverage">13046<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' # The two-component error model has significantly higher likelihood</pre> + <pre class="language-r"> SFO = varname,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">197</td> - <td class="coverage"></td> + <td class="coverage">13046<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' lrtest(fit.obs, fit.tc)</pre> + <pre class="language-r"> FOMC = varname,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">198</td> - <td class="coverage"></td> + <td class="coverage">13046<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' parms(fit.tc)</pre> + <pre class="language-r"> IORE = varname,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">199</td> - <td class="coverage"></td> + <td class="coverage">13046<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' endpoints(fit.tc)</pre> + <pre class="language-r"> DFOP = varname,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">200</td> - <td class="coverage"></td> + <td class="coverage">13046<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> HS = varname,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">201</td> - <td class="coverage"></td> + <td class="coverage">13046<em>x</em></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> + <pre class="language-r"> logistic = varname,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">202</td> - <td class="coverage"></td> + <td class="coverage">13046<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' # have several alternative solution methods for the model. We skip</pre> + <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">#' # uncompiled deSolve, as it is so slow. More benchmarks are found in the</pre> + <pre class="language-r"> )</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">204</td> - <td class="coverage"></td> + <td class="coverage">13046<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' # benchmark vignette</pre> + <pre class="language-r"> map[[varname]] <- new_boxes</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">205</td> - <td class="coverage"></td> + <td class="coverage">13046<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' \dontrun{</pre> + <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">#' if(require(rbenchmark)) {</pre> + <pre class="language-r"> # Start a new differential equation for each new box {{{</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">207</td> - <td class="coverage"></td> + <td class="coverage">13046<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' benchmark(replications = 1, order = "relative", columns = c("test", "relative", "elapsed"),</pre> + <pre class="language-r"> new_diffs <- paste("d_", new_boxes, " =", sep = "")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">208</td> - <td class="coverage"></td> + <td class="coverage">13046<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' deSolve_compiled = mkinfit(SFO_SFO, FOCUS_D, quiet = TRUE, error_model = "tc",</pre> + <pre class="language-r"> names(new_diffs) <- new_boxes</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">209</td> - <td class="coverage"></td> + <td class="coverage">13046<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' solution_type = "deSolve", use_compiled = TRUE),</pre> + <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">#' eigen = mkinfit(SFO_SFO, FOCUS_D, quiet = TRUE, error_model = "tc",</pre> + <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">#' solution_type = "eigen"),</pre> + <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">#' analytical = mkinfit(SFO_SFO, FOCUS_D, quiet = TRUE, error_model = "tc",</pre> + <pre class="language-r"> # Create content of differential equations and build parameter list {{{</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">213</td> - <td class="coverage"></td> + <td class="coverage">8221<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' solution_type = "analytical"))</pre> + <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> + <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> + <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="never"> + <tr class="covered"> <td class="num">216</td> - <td class="coverage"></td> + <td class="coverage">12838<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <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">#' # Use stepwise fitting, using optimised parameters from parent only fit, FOMC-SFO</pre> + <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">#' \dontrun{</pre> + <pre class="language-r"> # specifying sink=FALSE</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">219</td> - <td class="coverage"></td> + <td class="coverage">4<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' FOMC_SFO <- mkinmod(</pre> + <pre class="language-r"> if(is.null(spec[[varname]]$sink)) spec[[varname]]$sink <- TRUE</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">220</td> - <td class="coverage"></td> + <td class="coverage">12838<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' parent = mkinsub("FOMC", "m1"),</pre> + <pre class="language-r"> if(spec[[varname]]$type %in% c("SFO", "IORE", "SFORB")) { # {{{ Add decline term</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">221</td> - <td class="coverage"></td> + <td class="coverage">10838<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' m1 = mkinsub("SFO"))</pre> + <pre class="language-r"> if (use_of_ff == "min") { # Minimum use of formation fractions</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">222</td> - <td class="coverage"></td> + <td class="coverage">1304<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' fit.FOMC_SFO <- mkinfit(FOMC_SFO, FOCUS_D, quiet = TRUE)</pre> + <pre class="language-r"> if(spec[[varname]]$type == "IORE" && length(spec[[varname]]$to) > 0) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">223</td> - <td class="coverage"></td> + <td class="coverage">104<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' # Again, we get a warning and try a more sophisticated error model</pre> + <pre class="language-r"> stop("Transformation reactions from compounds modelled with IORE\n",</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">224</td> - <td class="coverage"></td> + <td class="coverage">104<em>x</em></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> + <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">#' # This model has a higher likelihood, but not significantly so</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">226</td> - <td class="coverage"></td> + <td class="coverage">1200<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' lrtest(fit.tc, fit.FOMC_SFO.tc)</pre> + <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">#' # Also, the missing standard error for log_beta and the t-tests for alpha</pre> + <pre class="language-r"> # If sink is requested, add first-order/IORE sink term</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">228</td> - <td class="coverage"></td> + <td class="coverage">952<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' # and beta indicate overparameterisation</pre> + <pre class="language-r"> k_compound_sink <- paste("k", box_1, "sink", sep = "_")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">229</td> - <td class="coverage"></td> + <td class="coverage">952<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' summary(fit.FOMC_SFO.tc, data = FALSE)</pre> + <pre class="language-r"> if(spec[[varname]]$type == "IORE") {</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">230</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <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">#' # We can easily use starting parameters from the parent only fit (only for illustration)</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">232</td> - <td class="coverage"></td> + <td class="coverage">952<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' fit.FOMC = mkinfit("FOMC", FOCUS_2006_D, quiet = TRUE, error_model = "tc")</pre> + <pre class="language-r"> parms <- c(parms, k_compound_sink)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">233</td> - <td class="coverage"></td> + <td class="coverage">952<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' fit.FOMC_SFO <- mkinfit(FOMC_SFO, FOCUS_D, quiet = TRUE,</pre> + <pre class="language-r"> decline_term <- paste(k_compound_sink, "*", box_1)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">234</td> - <td class="coverage"></td> + <td class="coverage">952<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' parms.ini = fit.FOMC$bparms.ode, error_model = "tc")</pre> + <pre class="language-r"> if(spec[[varname]]$type == "IORE") {</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">235</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#' }</pre> + <pre class="language-r"> N <- paste("N", box_1, sep = "_")</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">236</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <pre class="language-r"> parms <- c(parms, N)</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">237</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">mkinfit <- function(mkinmod, observed,</pre> + <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"> parms.ini = "auto",</pre> + <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"> state.ini = "auto",</pre> + <pre class="language-r"> } else { # otherwise no decline term needed here</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">240</td> - <td class="coverage"></td> + <td class="coverage">248<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> err.ini = "auto",</pre> + <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"> fixed_parms = NULL,</pre> + <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"> fixed_initials = names(mkinmod$diffs)[-1],</pre> + <pre class="language-r"> } else { # Maximum use of formation fractions</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">243</td> - <td class="coverage"></td> + <td class="coverage">9534<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> from_max_mean = FALSE,</pre> + <pre class="language-r"> k_compound <- paste("k", box_1, sep = "_")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">244</td> - <td class="coverage"></td> + <td class="coverage">9534<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> solution_type = c("auto", "analytical", "eigen", "deSolve"),</pre> + <pre class="language-r"> if(spec[[varname]]$type == "IORE") {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">245</td> - <td class="coverage"></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> method.ode = "lsoda",</pre> + <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"> use_compiled = "auto",</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">247</td> - <td class="coverage"></td> + <td class="coverage">9534<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> control = list(eval.max = 300, iter.max = 200),</pre> + <pre class="language-r"> parms <- c(parms, k_compound)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">248</td> - <td class="coverage"></td> + <td class="coverage">9534<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> transform_rates = TRUE,</pre> + <pre class="language-r"> decline_term <- paste(k_compound, "*", box_1)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">249</td> - <td class="coverage"></td> + <td class="coverage">9534<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> transform_fractions = TRUE,</pre> + <pre class="language-r"> if(spec[[varname]]$type == "IORE") {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">250</td> - <td class="coverage"></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> quiet = FALSE,</pre> + <pre class="language-r"> N <- paste("N", box_1, sep = "_")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">251</td> - <td class="coverage"></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> atol = 1e-8, rtol = 1e-10,</pre> + <pre class="language-r"> parms <- c(parms, N)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">252</td> - <td class="coverage"></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> error_model = c("const", "obs", "tc"),</pre> + <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"> error_model_algorithm = c("auto", "d_3", "direct", "twostep", "threestep", "fourstep", "IRLS", "OLS"),</pre> + <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"> reweight.tol = 1e-8, reweight.max.iter = 10,</pre> + <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"> trace_parms = FALSE,</pre> + <pre class="language-r"> } #}}}</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">256</td> - <td class="coverage"></td> + <td class="coverage">12734<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> test_residuals = FALSE,</pre> + <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"> ...)</pre> + <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="never"> + <tr class="covered"> <td class="num">258</td> - <td class="coverage"></td> + <td class="coverage">381<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">{</pre> + <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">9202<em>x</em></td> + <td class="coverage">381<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> call <- match.call()</pre> + <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> + <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="coverage">12734<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> summary_warnings <- character()</pre> + <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"></pre> + <pre class="language-r"> # From p. 57 of the FOCUS kinetics report</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">263</td> - <td class="coverage"></td> + <td class="coverage">1283<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Derive the name used for the model</pre> + <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">9202<em>x</em></td> + <td class="coverage">1283<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (is.character(mkinmod)) {</pre> + <pre class="language-r"> parms <- c(parms, "k1", "k2", "g")</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">265</td> - <td class="coverage">4009<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> mkinmod_name <- mkinmod</pre> + <pre class="language-r"> } #}}}</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">266</td> - <td class="coverage"></td> + <td class="coverage">12734<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <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">5193<em>x</em></td> + <td class="coverage">12734<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (is.null(mkinmod$name)) {</pre> + <pre class="language-r"> if(spec[[varname]]$type == "HS") { # {{{ Add HS decline term</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">268</td> - <td class="coverage">5071<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> mkinmod_name <- deparse(substitute(mkinmod))</pre> + <pre class="language-r"> # From p. 55 of the FOCUS kinetics report</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">269</td> - <td class="coverage"></td> + <td class="coverage">30<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <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">18<em>x</em></td> + <td class="coverage">30<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> mkinmod_name <- mkinmod$name</pre> + <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> + <pre class="language-r"> } #}}}</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">272</td> - <td class="coverage"></td> + <td class="coverage">12734<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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"></pre> + <pre class="language-r"> # From p. 67 of the FOCUS kinetics report (2014)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">274</td> - <td class="coverage"></td> + <td class="coverage">306<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Check mkinmod and generate a model for the variable whith the highest value</pre> + <pre class="language-r"> decline_term <- paste("(k0 * kmax)/(k0 + (kmax - k0) * exp(-r * time)) *", box_1)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">275</td> - <td class="coverage"></td> + <td class="coverage">306<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # if a suitable string is given</pre> + <pre class="language-r"> parms <- c(parms, "kmax", "k0", "r")</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">276</td> - <td class="coverage">9098<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> parent_models_available = c("SFO", "FOMC", "DFOP", "HS", "SFORB", "IORE", "logistic")</pre> + <pre class="language-r"> } #}}}</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">277</td> - <td class="coverage">9098<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (!inherits(mkinmod, "mkinmod")) {</pre> + <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">4009<em>x</em></td> + <td class="coverage">12734<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> presumed_parent_name = observed[which.max(observed$value), "name"]</pre> + <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">4009<em>x</em></td> + <td class="coverage">12734<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (mkinmod[[1]] %in% parent_models_available) {</pre> + <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">3905<em>x</em></td> + <td class="coverage">25<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> speclist <- list(list(type = mkinmod, sink = TRUE))</pre> + <pre class="language-r"> box_2 = map[[varname]][[2]]</pre> </td> </tr> <tr class="covered"> <td class="num">281</td> - <td class="coverage">3905<em>x</em></td> + <td class="coverage">25<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> names(speclist) <- presumed_parent_name</pre> + <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">3905<em>x</em></td> + <td class="coverage">25<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> mkinmod <- mkinmod(speclist = speclist, use_of_ff = "max")</pre> + <pre class="language-r"> k_bound_free <- paste("k", varname, "bound", "free", sep = "_")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">283</td> - <td class="coverage"></td> + <td class="coverage">25<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <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">104<em>x</em></td> + <td class="coverage">25<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> + <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">104<em>x</em></td> + <td class="coverage">25<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> paste(parent_models_available, collapse = ", "))</pre> + <pre class="language-r"> k_bound_free, "*", box_2)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">286</td> - <td class="coverage"></td> + <td class="coverage">25<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> reversible_binding_term_2 <- paste("+", k_free_bound, "*", box_1, "-",</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">287</td> - <td class="coverage"></td> + <td class="coverage">25<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> k_bound_free, "*", box_2)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">288</td> - <td class="coverage"></td> + <td class="coverage">25<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> diffs[[box_1]] <- paste(diffs[[box_1]], reversible_binding_term_1)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">289</td> - <td class="coverage"></td> + <td class="coverage">25<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Get the names of the state variables in the model</pre> + <pre class="language-r"> diffs[[box_2]] <- paste(diffs[[box_2]], reversible_binding_term_2)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">290</td> - <td class="coverage">8994<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> mod_vars <- names(mkinmod$diffs)</pre> + <pre class="language-r"> } #}}}</pre> </td> </tr> <tr class="never"> @@ -25651,1162 +21498,1162 @@ table.table-condensed { <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> + <pre class="language-r"> # Transfer between compartments#{{{</pre> </td> </tr> <tr class="covered"> <td class="num">293</td> - <td class="coverage">8994<em>x</em></td> + <td class="coverage">12734<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> obs_vars <- names(mkinmod$spec)</pre> + <pre class="language-r"> to <- spec[[varname]]$to</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">294</td> - <td class="coverage"></td> + <td class="coverage">12734<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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"> # Subset observed data with names of observed data in the model and remove NA values</pre> + <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">8994<em>x</em></td> + <td class="coverage">4174<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> observed <- subset(observed, name %in% obs_vars)</pre> + <pre class="language-r"> origin_box <- box_1</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">297</td> - <td class="coverage">8994<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> observed <- subset(observed, !is.na(value))</pre> + <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> + <pre class="language-r"> # Number of targets</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">299</td> - <td class="coverage"></td> + <td class="coverage">4174<em>x</em></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> + <pre class="language-r"> n_targets = length(to)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">300</td> - <td class="coverage">8994<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (any(observed$value == 0)) {</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">301</td> - <td class="coverage">529<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> zero_warning <- "Observations with value of zero were removed from the data"</pre> + <pre class="language-r"> # Add transfer terms to listed compartments</pre> </td> </tr> <tr class="covered"> <td class="num">302</td> - <td class="coverage">529<em>x</em></td> + <td class="coverage">4174<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> summary_warnings <- c(summary_warnings, Z = zero_warning)</pre> + <pre class="language-r"> for (target in to) {</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">303</td> - <td class="coverage">529<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> warning(zero_warning)</pre> + <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">529<em>x</em></td> + <td class="coverage">4813<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> observed <- subset(observed, value != 0)</pre> + <pre class="language-r"> target_box <- switch(spec[[target]]$type,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">305</td> - <td class="coverage"></td> + <td class="coverage">4813<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> SFO = target,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">306</td> - <td class="coverage"></td> + <td class="coverage">4813<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> IORE = target,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">307</td> - <td class="coverage"></td> + <td class="coverage">4813<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Sort observed values for efficient analytical predictions</pre> + <pre class="language-r"> SFORB = paste(target, "free", sep = "_"))</pre> </td> </tr> <tr class="covered"> <td class="num">308</td> - <td class="coverage">8994<em>x</em></td> + <td class="coverage">4813<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> observed$name <- ordered(observed$name, levels = obs_vars)</pre> + <pre class="language-r"> if (use_of_ff == "min" && spec[[varname]]$type %in% c("SFO", "SFORB"))</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">309</td> - <td class="coverage">8994<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> observed <- observed[order(observed$name, observed$time), ]</pre> + <pre class="language-r"> {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">310</td> - <td class="coverage"></td> + <td class="coverage">601<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> k_from_to <- paste("k", origin_box, target_box, sep = "_")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">311</td> - <td class="coverage"></td> + <td class="coverage">601<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Obtain data for decline from maximum mean value if requested</pre> + <pre class="language-r"> parms <- c(parms, k_from_to)</pre> </td> </tr> <tr class="covered"> <td class="num">312</td> - <td class="coverage">8994<em>x</em></td> + <td class="coverage">601<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (from_max_mean) {</pre> + <pre class="language-r"> diffs[[origin_box]] <- paste(diffs[[origin_box]], "-",</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">313</td> - <td class="coverage"></td> + <td class="coverage">601<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # This is only used for simple decline models</pre> + <pre class="language-r"> k_from_to, "*", origin_box)</pre> </td> </tr> <tr class="covered"> <td class="num">314</td> - <td class="coverage">459<em>x</em></td> + <td class="coverage">601<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (length(obs_vars) > 1)</pre> + <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">153<em>x</em></td> + <td class="coverage">601<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> + <pre class="language-r"> k_from_to, "*", origin_box)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">316</td> - <td class="coverage">306<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> observed$name <- as.character(observed$name)</pre> + <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"></pre> + <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">306<em>x</em></td> + <td class="coverage">4212<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> means <- aggregate(value ~ time, data = observed, mean, na.rm=TRUE)</pre> + <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">306<em>x</em></td> + <td class="coverage">689<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> t_of_max <- means[which.max(means$value), "time"]</pre> + <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">306<em>x</em></td> + <td class="coverage">689<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> observed <- subset(observed, time >= t_of_max)</pre> + <pre class="language-r"> decline_term)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">321</td> - <td class="coverage">306<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> observed$time <- observed$time - t_of_max</pre> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">322</td> - <td class="coverage"></td> + <td class="coverage">3523<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> fraction_to_target = paste("f", origin_box, "to", target, sep = "_")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">323</td> - <td class="coverage"></td> + <td class="coverage">3523<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> parms <- c(parms, fraction_to_target)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">324</td> - <td class="coverage"></td> + <td class="coverage">3523<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Number observations used for fitting</pre> + <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">8841<em>x</em></td> + <td class="coverage">3523<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> n_observed <- nrow(observed)</pre> + <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> + <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> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">328</td> - <td class="coverage">8371<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (parms.ini[[1]] == "auto") parms.ini = vector()</pre> + <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> + <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> + <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"> # fixed_parms</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">332</td> - <td class="coverage">8841<em>x</em></td> + <td class="coverage">8117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (is.numeric(fixed_parms)) {</pre> + <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="covered"> + <tr class="never"> <td class="num">333</td> - <td class="coverage">3<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> fixed_parm_names <- names(fixed_parms)</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">334</td> - <td class="coverage">3<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> parms.ini[fixed_parm_names] <- fixed_parms</pre> + <pre class="language-r"> # Create coefficient matrix if possible #{{{</pre> </td> </tr> <tr class="covered"> <td class="num">335</td> - <td class="coverage">3<em>x</em></td> + <td class="coverage">8117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fixed_parms <- fixed_parm_names</pre> + <pre class="language-r"> if (mat) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">336</td> - <td class="coverage"></td> + <td class="coverage">5941<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> boxes <- names(diffs)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">337</td> - <td class="coverage"></td> + <td class="coverage">5941<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> n <- length(boxes)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">338</td> - <td class="coverage"></td> + <td class="coverage">5941<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Warn for inital parameter specifications that are not in the model</pre> + <pre class="language-r"> m <- matrix(nrow=n, ncol=n, dimnames=list(boxes, boxes))</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">339</td> - <td class="coverage">8841<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> wrongpar.names <- setdiff(names(parms.ini), mkinmod$parms)</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">340</td> - <td class="coverage">8841<em>x</em></td> + <td class="coverage">5941<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (length(wrongpar.names) > 0) {</pre> + <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">257<em>x</em></td> + <td class="coverage">600<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> warning("Initial parameter(s) ", paste(wrongpar.names, collapse = ", "),</pre> + <pre class="language-r"> for (from in boxes) {</pre> </td> </tr> <tr class="covered"> <td class="num">342</td> - <td class="coverage">257<em>x</em></td> + <td class="coverage">1201<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> " not used in the model")</pre> + <pre class="language-r"> for (to in boxes) {</pre> </td> </tr> <tr class="covered"> <td class="num">343</td> - <td class="coverage">257<em>x</em></td> + <td class="coverage">2405<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> parms.ini <- parms.ini[setdiff(names(parms.ini), wrongpar.names)]</pre> + <pre class="language-r"> if (from == to) { # diagonal elements</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">344</td> - <td class="coverage"></td> + <td class="coverage">1201<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> k.candidate = paste("k", from, c(boxes, "sink"), sep = "_")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">345</td> - <td class="coverage"></td> + <td class="coverage">1201<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> k.candidate = sub("free.*bound", "free_bound", k.candidate)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">346</td> - <td class="coverage"></td> + <td class="coverage">1201<em>x</em></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> + <pre class="language-r"> k.candidate = sub("bound.*free", "bound_free", k.candidate)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">347</td> - <td class="coverage"></td> + <td class="coverage">1201<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # fitted in the transformed way</pre> + <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">8841<em>x</em></td> + <td class="coverage">1201<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (mkinmod$use_of_ff == "max" & transform_fractions == FALSE) {</pre> + <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">410<em>x</em></td> + <td class="coverage">1201<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> + <pre class="language-r"> paste("-", k.effective, collapse = " "), "0")</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">350</td> - <td class="coverage">410<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> "transform_fractions = TRUE." )</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">351</td> - <td class="coverage">410<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> for (box in mod_vars) {</pre> + <pre class="language-r"> } else { # off-diagonal elements</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">352</td> - <td class="coverage"></td> + <td class="coverage">1204<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Stop if formation fractions are not transformed and we have no sink</pre> + <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">716<em>x</em></td> + <td class="coverage">1204<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (mkinmod$spec[[box]]$sink == FALSE) {</pre> + <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">104<em>x</em></td> + <td class="coverage">1<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> stop("If formation fractions are not transformed during the fitting, ",</pre> + <pre class="language-r"> k.candidate = paste("k", sub("_free$", "_free_bound", from), sep = "_")</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">355</td> - <td class="coverage">104<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> "it is not supported to turn off pathways to sink.\n ",</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="covered"> <td class="num">356</td> - <td class="coverage">104<em>x</em></td> + <td class="coverage">1204<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> "Consider turning on the transformation of formation fractions or ",</pre> + <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">104<em>x</em></td> + <td class="coverage">1<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> "setting up a model with use_of_ff = 'min'.\n")</pre> + <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> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">359</td> - <td class="coverage"></td> + <td class="coverage">1204<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> k.effective = intersect(model$parms, k.candidate)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">360</td> - <td class="coverage"></td> + <td class="coverage">1204<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> m[to, from] = ifelse(length(k.effective) > 0,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">361</td> - <td class="coverage"></td> + <td class="coverage">1204<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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"> # Do not allow fixing formation fractions if we are using the ilr transformation,</pre> + <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"> # this is not supported</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">364</td> - <td class="coverage">8737<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (transform_fractions == TRUE && length(fixed_parms) > 0) {</pre> + <pre class="language-r"> } # }}}</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">365</td> - <td class="coverage">107<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (any(grepl("^f_", fixed_parms))) {</pre> + <pre class="language-r"> } else { # {{{ Use formation fractions where possible</pre> </td> </tr> <tr class="covered"> <td class="num">366</td> - <td class="coverage">104<em>x</em></td> + <td class="coverage">5341<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> + <pre class="language-r"> for (from in boxes) {</pre> </td> </tr> <tr class="covered"> <td class="num">367</td> - <td class="coverage">104<em>x</em></td> + <td class="coverage">8074<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> "transformation.")</pre> + <pre class="language-r"> for (to in boxes) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">368</td> - <td class="coverage"></td> + <td class="coverage">15220<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> if (from == to) { # diagonal elements</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">369</td> - <td class="coverage"></td> + <td class="coverage">8074<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> k.candidate = paste("k", from, sep = "_")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">370</td> - <td class="coverage"></td> + <td class="coverage">8074<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> m[from,to] = ifelse(k.candidate %in% model$parms,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">371</td> - <td class="coverage"></td> + <td class="coverage">8074<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Set initial parameter values, including a small increment (salt)</pre> + <pre class="language-r"> paste("-", k.candidate), "0")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">372</td> - <td class="coverage"></td> + <td class="coverage">8074<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # to avoid linear dependencies (singular matrix) in Eigenvalue based solutions</pre> + <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">8633<em>x</em></td> + <td class="coverage">24<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> k_salt = 0</pre> + <pre class="language-r"> m[from,to] = paste(m[from,to], "-", paste("k", from, "bound", sep = "_"))</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">374</td> - <td class="coverage">8633<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> defaultpar.names <- setdiff(mkinmod$parms, names(parms.ini))</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="covered"> <td class="num">375</td> - <td class="coverage">8633<em>x</em></td> + <td class="coverage">8074<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> for (parmname in defaultpar.names) {</pre> + <pre class="language-r"> if(grepl("_bound", from)) { # add backtransfer to free compartment for SFORB</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">376</td> - <td class="coverage"></td> + <td class="coverage">24<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Default values for rate constants, depending on the parameterisation</pre> + <pre class="language-r"> m[from,to] = paste("- k", from, "free", sep = "_")</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">377</td> - <td class="coverage">20999<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (grepl("^k", parmname)) {</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="covered"> <td class="num">378</td> - <td class="coverage">15908<em>x</em></td> + <td class="coverage">8074<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> parms.ini[parmname] = 0.1 + k_salt</pre> + <pre class="language-r"> m[from,to] = m[from,to]</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">379</td> - <td class="coverage">15908<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> k_salt = k_salt + 1e-4</pre> + <pre class="language-r"> } else { # off-diagonal elements</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">380</td> - <td class="coverage"></td> + <td class="coverage">7146<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> f.candidate = paste("f", from, "to", to, sep = "_")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">381</td> - <td class="coverage"></td> + <td class="coverage">7146<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Default values for rate constants for reversible binding</pre> + <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">26<em>x</em></td> + <td class="coverage">7146<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (grepl("free_bound$", parmname)) parms.ini[parmname] = 0.1</pre> + <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">26<em>x</em></td> + <td class="coverage">7146<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (grepl("bound_free$", parmname)) parms.ini[parmname] = 0.02</pre> + <pre class="language-r"> k.candidate = sub("bound.*free", "bound_free", k.candidate)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">384</td> - <td class="coverage"></td> + <td class="coverage">7146<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Default values for IORE exponents</pre> + <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">176<em>x</em></td> + <td class="coverage">7146<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (grepl("^N", parmname)) parms.ini[parmname] = 1.1</pre> + <pre class="language-r"> paste(f.candidate, " * k_", from, sep = ""),</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">386</td> - <td class="coverage"></td> + <td class="coverage">7146<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Default values for the FOMC, DFOP and HS models</pre> + <pre class="language-r"> ifelse(k.candidate %in% model$parms, k.candidate, "0"))</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">387</td> - <td class="coverage">238<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (parmname == "alpha") parms.ini[parmname] = 1</pre> + <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">238<em>x</em></td> + <td class="coverage">7146<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (parmname == "beta") parms.ini[parmname] = 10</pre> + <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">1014<em>x</em></td> + <td class="coverage">689<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (parmname == "k1") parms.ini[parmname] = 0.1</pre> + <pre class="language-r"> m[to, from] = paste("k", from, sep = "_")</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">390</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (parmname == "k2") parms.ini[parmname] = 0.01</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">391</td> - <td class="coverage">30<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (parmname == "tb") parms.ini[parmname] = 5</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">392</td> - <td class="coverage">984<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (parmname == "g") parms.ini[parmname] = 0.5</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">393</td> - <td class="coverage">153<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (parmname == "kmax") parms.ini[parmname] = 0.1</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">394</td> - <td class="coverage">153<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (parmname == "k0") parms.ini[parmname] = 0.0001</pre> + <pre class="language-r"> } # }}}</pre> </td> </tr> <tr class="covered"> <td class="num">395</td> - <td class="coverage">153<em>x</em></td> + <td class="coverage">5941<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (parmname == "r") parms.ini[parmname] = 0.2</pre> + <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> + <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> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">398</td> - <td class="coverage">8633<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> for (obs_var in obs_vars) {</pre> + <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="covered"> + <tr class="never"> <td class="num">399</td> - <td class="coverage">13865<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> origin <- mkinmod$map[[obs_var]][[1]]</pre> + <pre class="language-r"> # and a compiler is available</pre> </td> </tr> <tr class="covered"> <td class="num">400</td> - <td class="coverage">13865<em>x</em></td> + <td class="coverage">8117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> f_names <- mkinmod$parms[grep(paste0("^f_", origin), mkinmod$parms)]</pre> + <pre class="language-r"> if (length(obs_vars) > 1 & pkgbuild::has_compiler()) {</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">401</td> - <td class="coverage">13865<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (length(f_names) > 0) {</pre> + <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"> # We need to differentiate between default and specified fractions</pre> + <pre class="language-r"> # Translate the R code for the derivatives to C code</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">403</td> - <td class="coverage"></td> + <td class="coverage">3728<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # and set the unspecified to 1 - sum(specified)/n_unspecified</pre> + <pre class="language-r"> diffs.C <- paste(diffs, collapse = ";\n")</pre> </td> </tr> <tr class="covered"> <td class="num">404</td> - <td class="coverage">3365<em>x</em></td> + <td class="coverage">3728<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> f_default_names <- intersect(f_names, defaultpar.names)</pre> + <pre class="language-r"> diffs.C <- paste0(diffs.C, ";")</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">405</td> - <td class="coverage">3365<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> f_specified_names <- setdiff(f_names, defaultpar.names)</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">406</td> - <td class="coverage">3365<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> sum_f_specified = sum(parms.ini[f_specified_names])</pre> + <pre class="language-r"> # HS</pre> </td> </tr> <tr class="covered"> <td class="num">407</td> - <td class="coverage">3365<em>x</em></td> + <td class="coverage">3728<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (sum_f_specified > 1) {</pre> + <pre class="language-r"> diffs.C <- gsub(HS_decline, "(time <= tb ? k1 : k2)", diffs.C, fixed = TRUE)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">408</td> - <td class="coverage">104<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> stop("Starting values for the formation fractions originating from ",</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">409</td> - <td class="coverage">104<em>x</em></td> + <td class="coverage">3728<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> origin, " sum up to more than 1.")</pre> + <pre class="language-r"> for (i in seq_along(diffs)) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">410</td> - <td class="coverage"></td> + <td class="coverage">8347<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> state_var <- names(diffs)[i]</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">411</td> - <td class="coverage">3260<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (mkinmod$spec[[obs_var]]$sink) n_unspecified = length(f_default_names) + 1</pre> + <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"> else {</pre> + <pre class="language-r"> # IORE</pre> </td> </tr> <tr class="covered"> <td class="num">413</td> - <td class="coverage">1<em>x</em></td> + <td class="coverage">8347<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> n_unspecified = length(f_default_names)</pre> + <pre class="language-r"> if (state_var %in% obs_vars) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">414</td> - <td class="coverage"></td> + <td class="coverage">8343<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> if (spec[[state_var]]$type == "IORE") {</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">415</td> - <td class="coverage">3261<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> parms.ini[f_default_names] <- (1 - sum_f_specified) / n_unspecified</pre> + <pre class="language-r"> diffs.C <- gsub(paste0(state_var, "^N_", state_var),</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">416</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> paste0("pow(y[", i - 1, "], N_", state_var, ")"),</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">417</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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> + <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> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">420</td> - <td class="coverage">8529<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> parent_name = names(mkinmod$spec)[[1]]</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">421</td> - <td class="coverage">8529<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> parent_time_0 = subset(observed, time == 0 & name == parent_name)$value</pre> + <pre class="language-r"> # Replace d_... terms by f[i-1]</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">422</td> - <td class="coverage">8529<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> parent_time_0_mean = mean(parent_time_0, na.rm = TRUE)</pre> + <pre class="language-r"> # First line</pre> </td> </tr> <tr class="covered"> <td class="num">423</td> - <td class="coverage">8529<em>x</em></td> + <td class="coverage">8347<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (is.na(parent_time_0_mean)) {</pre> + <pre class="language-r"> pattern <- paste0("^d_", state_var)</pre> </td> </tr> <tr class="covered"> <td class="num">424</td> - <td class="coverage">2<em>x</em></td> + <td class="coverage">8347<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> + <pre class="language-r"> replacement <- paste0("\nf[", i - 1, "]")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">425</td> - <td class="coverage"></td> + <td class="coverage">8347<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r"> diffs.C <- gsub(pattern, replacement, diffs.C)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">426</td> - <td class="coverage">8527<em>x</em></td> + <td class="coverage"></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> + <pre class="language-r"> # Other lines</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">427</td> - <td class="coverage"></td> + <td class="coverage">8347<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> pattern <- paste0("\\nd_", state_var)</pre> </td> </tr> <tr class="covered"> <td class="num">428</td> - <td class="coverage">8529<em>x</em></td> + <td class="coverage">8347<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> names(state.ini_auto) <- mod_vars</pre> + <pre class="language-r"> replacement <- paste0("\nf[", i - 1, "]")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">429</td> - <td class="coverage"></td> + <td class="coverage">8347<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> diffs.C <- gsub(pattern, replacement, diffs.C)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">430</td> - <td class="coverage">8529<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (state.ini[1] == "auto") {</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">431</td> - <td class="coverage">8316<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> state.ini_used <- state.ini_auto</pre> + <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"> } else {</pre> + <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">213<em>x</em></td> + <td class="coverage">8347<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> state.ini_used <- state.ini_auto</pre> + <pre class="language-r"> pattern <- paste0("\\* ", state_var)</pre> </td> </tr> <tr class="covered"> <td class="num">434</td> - <td class="coverage">213<em>x</em></td> + <td class="coverage">8347<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> state.ini_good <- intersect(names(mkinmod$diffs), names(state.ini))</pre> + <pre class="language-r"> replacement <- paste0("* y[", i - 1, "]")</pre> </td> </tr> <tr class="covered"> <td class="num">435</td> - <td class="coverage">213<em>x</em></td> + <td class="coverage">8347<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> + <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> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">437</td> - <td class="coverage">8529<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> state.ini <- state.ini_used</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">438</td> - <td class="coverage"></td> + <td class="coverage">3728<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> derivs_sig <- signature(n = "integer", t = "numeric", y = "numeric",</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">439</td> - <td class="coverage"></td> + <td class="coverage">3728<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Name the inital state variable values if they are not named yet</pre> + <pre class="language-r"> f = "numeric", rpar = "numeric", ipar = "integer")</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">440</td> - <td class="coverage">!</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> + <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"></pre> + <pre class="language-r"> # Declare the time variable in the body of the function if it is used</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">442</td> - <td class="coverage"></td> + <td class="coverage">3728<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Transform initial parameter values for fitting</pre> + <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">8529<em>x</em></td> + <td class="coverage">1060<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> transparms.ini <- transform_odeparms(parms.ini, mkinmod,</pre> + <pre class="language-r"> paste0("double time = *t;\n", diffs.C)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">444</td> - <td class="coverage">8529<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> transform_rates = transform_rates,</pre> + <pre class="language-r"> } else {</pre> </td> </tr> <tr class="covered"> <td class="num">445</td> - <td class="coverage">8529<em>x</em></td> + <td class="coverage">2668<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> transform_fractions = transform_fractions)</pre> + <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> + <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> + <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"> # Kinetic parameters in parms.ini whose names are not in fixed_parms</pre> + <pre class="language-r"> # Define the function initializing the parameters</pre> </td> </tr> <tr class="covered"> <td class="num">449</td> - <td class="coverage">8529<em>x</em></td> + <td class="coverage">3728<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> parms.fixed <- parms.ini[fixed_parms]</pre> + <pre class="language-r"> npar <- length(parms)</pre> </td> </tr> <tr class="covered"> <td class="num">450</td> - <td class="coverage">8529<em>x</em></td> + <td class="coverage">3728<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> parms.optim <- parms.ini[setdiff(names(parms.ini), fixed_parms)]</pre> + <pre class="language-r"> initpar_code <- paste0(</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">451</td> - <td class="coverage"></td> + <td class="coverage">3728<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> "static double parms [", npar, "];\n",</pre> </td> </tr> <tr class="covered"> <td class="num">452</td> - <td class="coverage">8529<em>x</em></td> + <td class="coverage">3728<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> transparms.fixed <- transform_odeparms(parms.fixed, mkinmod,</pre> + <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">8529<em>x</em></td> + <td class="coverage">3728<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> transform_rates = transform_rates,</pre> + <pre class="language-r"> "\n",</pre> </td> </tr> <tr class="covered"> <td class="num">454</td> - <td class="coverage">8529<em>x</em></td> + <td class="coverage">3728<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> transform_fractions = transform_fractions)</pre> + <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">8529<em>x</em></td> + <td class="coverage">3728<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> transparms.optim <- transform_odeparms(parms.optim, mkinmod,</pre> + <pre class="language-r"> " int N = ", npar, ";\n",</pre> </td> </tr> <tr class="covered"> <td class="num">456</td> - <td class="coverage">8529<em>x</em></td> + <td class="coverage">3728<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> transform_rates = transform_rates,</pre> + <pre class="language-r"> " odeparms(&N, parms);\n",</pre> </td> </tr> <tr class="covered"> <td class="num">457</td> - <td class="coverage">8529<em>x</em></td> + <td class="coverage">3728<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> transform_fractions = transform_fractions)</pre> + <pre class="language-r"> "}\n\n")</pre> </td> </tr> <tr class="never"> @@ -26820,3686 +22667,3320 @@ table.table-condensed { <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> + <pre class="language-r"> # Try to build a shared library</pre> </td> </tr> <tr class="covered"> <td class="num">460</td> - <td class="coverage">8529<em>x</em></td> + <td class="coverage">3728<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> state.ini.fixed <- state.ini[fixed_initials]</pre> + <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">8529<em>x</em></td> + <td class="coverage">3728<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> + <pre class="language-r"> otherdefs = initpar_code,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">462</td> - <td class="coverage"></td> + <td class="coverage">3728<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> verbose = verbose, name = "diffs",</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">463</td> - <td class="coverage"></td> + <td class="coverage">3728<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Preserve names of state variables before renaming initial state variable</pre> + <pre class="language-r"> convention = ".C", language = "C"),</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">464</td> - <td class="coverage"></td> + <td class="coverage">3728<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # parameters</pre> + <pre class="language-r"> silent = TRUE)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">465</td> - <td class="coverage">8529<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> state.ini.optim.boxnames <- names(state.ini.optim)</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">466</td> - <td class="coverage">8529<em>x</em></td> + <td class="coverage">3728<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> state.ini.fixed.boxnames <- names(state.ini.fixed)</pre> + <pre class="language-r"> if (!inherits(model$cf, "try-error")) {</pre> </td> </tr> <tr class="covered"> <td class="num">467</td> - <td class="coverage">8529<em>x</em></td> + <td class="coverage">495<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if(length(state.ini.optim) > 0) {</pre> + <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">8529<em>x</em></td> + <td class="coverage">3728<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> + <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"> }</pre> + <pre class="language-r"> # We suppress warnings, as we get a warning about a path "(embedding)" </pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">470</td> - <td class="coverage">8529<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if(length(state.ini.fixed) > 0) {</pre> + <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">4509<em>x</em></td> + <td class="coverage">247<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> + <pre class="language-r"> suppressWarnings(inline::moveDLL(model$cf, name, dll_dir,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">472</td> - <td class="coverage"></td> + <td class="coverage">247<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">474</td> - <td class="coverage"></td> + <td class="coverage">3728<em>x</em></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> + <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"> # formula, the spectral decomposition of the matrix (fundamental system)</pre> + <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"> # or a numeric ode solver from the deSolve package</pre> + <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"> # Prefer deSolve over eigen if a compiled model is present and use_compiled</pre> + <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"> # is not set to FALSE</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">479</td> - <td class="coverage">8529<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> solution_type = match.arg(solution_type)</pre> + <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">8529<em>x</em></td> + <td class="coverage">8117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (solution_type == "analytical" && !is.function(mkinmod$deg_func))</pre> + <pre class="language-r"> model$deg_func <- create_deg_func(spec, use_of_ff)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">481</td> - <td class="coverage">105<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> stop("Analytical solution not implemented for this model.")</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">482</td> - <td class="coverage">8424<em>x</em></td> + <td class="coverage">8117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (solution_type == "eigen" && !is.matrix(mkinmod$coefmat))</pre> + <pre class="language-r"> class(model) <- "mkinmod"</pre> </td> </tr> <tr class="covered"> <td class="num">483</td> - <td class="coverage">104<em>x</em></td> + <td class="coverage">8117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> stop("Eigenvalue based solution not possible, coefficient matrix not present.")</pre> + <pre class="language-r"> return(model)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">484</td> - <td class="coverage">8320<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (solution_type == "auto") {</pre> + <pre class="language-r">}</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">485</td> - <td class="coverage">6190<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (length(mkinmod$spec) == 1 || is.function(mkinmod$deg_func)) {</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">486</td> - <td class="coverage">5434<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> solution_type = "analytical"</pre> + <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"> } else {</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">488</td> - <td class="coverage">756<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (!is.null(mkinmod$cf) & use_compiled[1] != FALSE) {</pre> + <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="covered"> + <tr class="never"> <td class="num">489</td> - <td class="coverage">756<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> solution_type = "deSolve"</pre> + <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"> } else {</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">491</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (is.matrix(mkinmod$coefmat)) {</pre> + <pre class="language-r">#' @rdname mkinmod</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">492</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> solution_type = "eigen"</pre> + <pre class="language-r">#' @param x An \code{\link{mkinmod}} object.</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">493</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (max(observed$value, na.rm = TRUE) < 0.1) {</pre> + <pre class="language-r">#' @export</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">494</td> - <td class="coverage">!</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> + <pre class="language-r">print.mkinmod <- function(x, ...) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">495</td> - <td class="coverage"></td> + <td class="coverage">104<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> cat("<mkinmod> model generated with\n")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">496</td> - <td class="coverage"></td> + <td class="coverage">104<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r"> cat("Use of formation fractions $use_of_ff:", x$use_of_ff, "\n")</pre> </td> </tr> - <tr class="missed"> + <tr class="covered"> <td class="num">497</td> - <td class="coverage">!</td> + <td class="coverage">104<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> solution_type = "deSolve"</pre> + <pre class="language-r"> cat("Specification $spec:\n")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">498</td> - <td class="coverage"></td> + <td class="coverage">104<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> for (obs in names(x$spec)) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">499</td> - <td class="coverage"></td> + <td class="coverage">208<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> cat("$", obs, "\n", sep = "")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">500</td> - <td class="coverage"></td> + <td class="coverage">208<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> spl <- x$spec[[obs]]</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">501</td> - <td class="coverage"></td> + <td class="coverage">208<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> cat("$type:", spl$type)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">502</td> - <td class="coverage"></td> + <td class="coverage">104<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> if (!is.null(spl$to) && length(spl$to)) cat("; $to: ", paste(spl$to, collapse = ", "), sep = "")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">503</td> - <td class="coverage"></td> + <td class="coverage">208<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Get native symbol before iterations info for speed</pre> + <pre class="language-r"> cat("; $sink: ", spl$sink, sep = "")</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">504</td> - <td class="coverage">8320<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> use_symbols = FALSE</pre> + <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">8320<em>x</em></td> + <td class="coverage">208<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (solution_type == "deSolve" & use_compiled[1] != FALSE) {</pre> + <pre class="language-r"> cat("\n")</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">506</td> - <td class="coverage">2144<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> mkinmod[["symbols"]] <- try(</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="covered"> <td class="num">507</td> - <td class="coverage">2144<em>x</em></td> + <td class="coverage">104<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> deSolve::checkDLL(dllname = mkinmod$dll_info[["name"]],</pre> + <pre class="language-r"> if (is.matrix(x$coefmat)) cat("Coefficient matrix $coefmat available\n")</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">508</td> - <td class="coverage">2144<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> func = "diffs", initfunc = "initpar",</pre> + <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">2144<em>x</em></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> + <pre class="language-r"> cat("Differential equations:\n")</pre> </td> </tr> <tr class="covered"> <td class="num">510</td> - <td class="coverage">2144<em>x</em></td> + <td class="coverage">104<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (!inherits(mkinmod[["symbols"]], "try-error")) {</pre> + <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">2144<em>x</em></td> + <td class="coverage">104<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> use_symbols = TRUE</pre> + <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> + <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> + <pre class="language-r"># vim: set foldmethod=marker ts=2 sw=2 expandtab:</pre> </td> </tr> + </tbody> + </table> + </div> + <div id="R/parms.R" class="hidden"> + <table class="table-condensed"> + <tbody> <tr class="never"> - <td class="num">514</td> + <td class="num">1</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' Extract model parameters</pre> </td> </tr> <tr class="never"> - <td class="num">515</td> + <td class="num">2</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> + <pre class="language-r">#'</pre> </td> </tr> <tr class="never"> - <td class="num">520</td> + <td class="num">3</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> + <pre class="language-r">#' This function returns degradation model parameters as well as error</pre> </td> </tr> <tr class="never"> - <td class="num">524</td> + <td class="num">4</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> + <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">530</td> + <td class="num">5</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' without considering the error structure that was assumed for the fit.</pre> </td> </tr> <tr class="never"> - <td class="num">531</td> + <td class="num">6</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> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="missed"> - <td class="num">534</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">7</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> + <pre class="language-r">#' @param object A fitted model object.</pre> </td> </tr> <tr class="never"> - <td class="num">535</td> + <td class="num">8</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r">#' @param \dots Not used</pre> </td> </tr> - <tr class="missed"> - <td class="num">536</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> errparms = err.ini</pre> + <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">537</td> + <td class="num">10</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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">538</td> + <td class="num">11</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r">#' mmkin objects with more than one row).</pre> </td> </tr> - <tr class="covered"> - <td class="num">539</td> - <td class="coverage">8320<em>x</em></td> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (err_mod == "const") {</pre> + <pre class="language-r">#' @seealso [saem], [multistart]</pre> </td> </tr> - <tr class="covered"> - <td class="num">540</td> - <td class="coverage">6410<em>x</em></td> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> errparms = 3</pre> + <pre class="language-r">#' @examples</pre> </td> </tr> <tr class="never"> - <td class="num">541</td> + <td class="num">14</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">#' # mkinfit objects</pre> </td> </tr> - <tr class="covered"> - <td class="num">542</td> - <td class="coverage">8320<em>x</em></td> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (err_mod == "obs") {</pre> + <pre class="language-r">#' fit <- mkinfit("SFO", FOCUS_2006_C, quiet = TRUE)</pre> </td> </tr> - <tr class="covered"> - <td class="num">543</td> - <td class="coverage">317<em>x</em></td> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> errparms = rep(3, length(obs_vars))</pre> + <pre class="language-r">#' parms(fit)</pre> </td> </tr> <tr class="never"> - <td class="num">544</td> + <td class="num">17</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">#' parms(fit, transformed = TRUE)</pre> </td> </tr> - <tr class="covered"> - <td class="num">545</td> - <td class="coverage">8320<em>x</em></td> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (err_mod == "tc") {</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> - <td class="num">546</td> - <td class="coverage">1593<em>x</em></td> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> errparms <- c(sigma_low = 0.1, rsd_high = 0.1)</pre> + <pre class="language-r">#' # mmkin objects</pre> </td> </tr> <tr class="never"> - <td class="num">547</td> + <td class="num">20</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">#' ds <- lapply(experimental_data_for_UBA_2019[6:10],</pre> </td> </tr> - <tr class="covered"> - <td class="num">548</td> - <td class="coverage">8320<em>x</em></td> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> names(errparms) <- errparm_names</pre> + <pre class="language-r">#' function(x) subset(x$data[c("name", "time", "value")]))</pre> </td> </tr> <tr class="never"> - <td class="num">549</td> + <td class="num">22</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">#' names(ds) <- paste("Dataset", 6:10)</pre> </td> </tr> - <tr class="covered"> - <td class="num">550</td> - <td class="coverage">8320<em>x</em></td> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (error_model_algorithm == "OLS") {</pre> + <pre class="language-r">#' \dontrun{</pre> </td> </tr> - <tr class="covered"> - <td class="num">551</td> - <td class="coverage">6410<em>x</em></td> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> errparms_optim <- NULL</pre> + <pre class="language-r">#' fits <- mmkin(c("SFO", "FOMC", "DFOP"), ds, quiet = TRUE, cores = 1)</pre> </td> </tr> <tr class="never"> - <td class="num">552</td> + <td class="num">25</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r">#' parms(fits["SFO", ])</pre> </td> </tr> - <tr class="covered"> - <td class="num">553</td> - <td class="coverage">1910<em>x</em></td> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> errparms_optim <- errparms</pre> + <pre class="language-r">#' parms(fits[, 2])</pre> </td> </tr> <tr class="never"> - <td class="num">554</td> + <td class="num">27</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">#' parms(fits)</pre> </td> </tr> <tr class="never"> - <td class="num">555</td> + <td class="num">28</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' parms(fits, transformed = TRUE)</pre> </td> </tr> <tr class="never"> - <td class="num">556</td> + <td class="num">29</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # Unique outtimes for model solution.</pre> + <pre class="language-r">#' }</pre> </td> </tr> - <tr class="covered"> - <td class="num">557</td> - <td class="coverage">8320<em>x</em></td> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> outtimes <- sort(unique(observed$time))</pre> + <pre class="language-r">#' @export</pre> </td> </tr> <tr class="never"> - <td class="num">558</td> + <td class="num">31</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">parms <- function(object, ...)</pre> </td> </tr> <tr class="never"> - <td class="num">559</td> + <td class="num">32</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # Define the objective function for optimisation, including (back)transformations</pre> + <pre class="language-r">{</pre> </td> </tr> <tr class="covered"> - <td class="num">560</td> - <td class="coverage">8320<em>x</em></td> + <td class="num">33</td> + <td class="coverage">91384<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> + <pre class="language-r"> UseMethod("parms", object)</pre> </td> </tr> <tr class="never"> - <td class="num">561</td> + <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">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> + <pre class="language-r">}</pre> </td> </tr> <tr class="never"> - <td class="num">563</td> + <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">564</td> + <td class="num">36</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> #browser()</pre> + <pre class="language-r">#' @param transformed Should the parameters be returned as used internally</pre> </td> </tr> <tr class="never"> - <td class="num">565</td> + <td class="num">37</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' during the optimisation?</pre> </td> </tr> <tr class="never"> - <td class="num">566</td> + <td class="num">38</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> + <pre class="language-r">#' @param errparms Should the error model parameters be returned</pre> </td> </tr> <tr class="never"> - <td class="num">568</td> + <td class="num">39</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' in addition to the degradation parameters?</pre> </td> </tr> <tr class="never"> - <td class="num">569</td> + <td class="num">40</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> + <pre class="language-r">#' @rdname parms</pre> </td> </tr> <tr class="never"> - <td class="num">574</td> + <td class="num">41</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> + <pre class="language-r">#' @export</pre> </td> </tr> <tr class="never"> - <td class="num">576</td> + <td class="num">42</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">parms.mkinfit <- function(object, transformed = FALSE, errparms = TRUE, ...)</pre> </td> </tr> <tr class="never"> - <td class="num">577</td> + <td class="num">43</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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="num">44</td> + <td class="coverage">88039<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (is.numeric(fixed_errparms)) {</pre> + <pre class="language-r"> res <- if (transformed) object$par</pre> </td> </tr> <tr class="covered"> - <td class="num">579</td> - <td class="coverage">4725<em>x</em></td> + <td class="num">45</td> + <td class="coverage">88039<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cost_degparms <- P</pre> + <pre class="language-r"> else c(object$bparms.optim, object$errparms)</pre> </td> </tr> <tr class="covered"> - <td class="num">580</td> - <td class="coverage">4725<em>x</em></td> + <td class="num">46</td> + <td class="coverage">88039<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cost_errparms <- fixed_errparms</pre> + <pre class="language-r"> if (!errparms) {</pre> </td> </tr> <tr class="covered"> - <td class="num">581</td> - <td class="coverage">4725<em>x</em></td> + <td class="num">47</td> + <td class="coverage">3000<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> errparms_fixed = TRUE</pre> + <pre class="language-r"> res[setdiff(names(res), names(object$errparms))]</pre> </td> </tr> <tr class="never"> - <td class="num">582</td> + <td class="num">48</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="covered"> - <td class="num">583</td> - <td class="coverage">4081843<em>x</em></td> + <td class="num">49</td> + <td class="coverage">85039<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> errparms_fixed = FALSE</pre> + <pre class="language-r"> else return(res)</pre> </td> </tr> <tr class="never"> - <td class="num">584</td> + <td class="num">50</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">}</pre> </td> </tr> <tr class="never"> - <td class="num">585</td> + <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">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="num">52</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">#' @rdname parms</pre> </td> </tr> <tr class="never"> - <td class="num">590</td> + <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">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> + <pre class="language-r">#' @export</pre> </td> </tr> <tr class="never"> - <td class="num">594</td> + <td class="num">54</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">parms.mmkin <- function(object, transformed = FALSE, errparms = TRUE, ...)</pre> </td> </tr> <tr class="never"> - <td class="num">595</td> + <td class="num">55</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">{</pre> </td> </tr> - <tr class="never"> - <td class="num">596</td> - <td class="coverage"></td> + <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"> # Initial states for t0</pre> + <pre class="language-r"> if (nrow(object) == 1) {</pre> </td> </tr> <tr class="covered"> - <td class="num">597</td> - <td class="coverage">4086568<em>x</em></td> + <td class="num">57</td> + <td class="coverage">265<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if(length(state.ini.optim) > 0) {</pre> + <pre class="language-r"> res <- sapply(object, parms, transformed = transformed,</pre> </td> </tr> <tr class="covered"> - <td class="num">598</td> - <td class="coverage">4086568<em>x</em></td> + <td class="num">58</td> + <td class="coverage">265<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> + <pre class="language-r"> errparms = errparms, ...)</pre> </td> </tr> <tr class="covered"> - <td class="num">599</td> - <td class="coverage">4086568<em>x</em></td> + <td class="num">59</td> + <td class="coverage">265<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> + <pre class="language-r"> colnames(res) <- colnames(object)</pre> </td> </tr> <tr class="never"> - <td class="num">600</td> + <td class="num">60</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r"> } else {</pre> </td> </tr> <tr class="missed"> - <td class="num">601</td> + <td class="num">61</td> <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> odeini <- state.ini.fixed</pre> + <pre class="language-r"> res <- list()</pre> </td> </tr> <tr class="missed"> - <td class="num">602</td> + <td class="num">62</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> + <pre class="language-r"> for (i in 1:nrow(object)) {</pre> </td> </tr> - <tr class="never"> - <td class="num">604</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">63</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> res[[i]] <- parms(object[i, ], transformed = transformed,</pre> </td> </tr> - <tr class="covered"> - <td class="num">605</td> - <td class="coverage">4086568<em>x</em></td> + <tr class="missed"> + <td class="num">64</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> odeparms.optim <- cost_degparms[(length(state.ini.optim) + 1):length(cost_degparms)]</pre> + <pre class="language-r"> errparms = errparms, ...)</pre> </td> </tr> <tr class="never"> - <td class="num">606</td> + <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">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> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> - <td class="num">611</td> - <td class="coverage">2580794<em>x</em></td> + <tr class="missed"> + <td class="num">66</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> transform_fractions = transform_fractions)</pre> + <pre class="language-r"> names(res) <- rownames(object)</pre> </td> </tr> <tr class="never"> - <td class="num">612</td> + <td class="num">67</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="covered"> - <td class="num">613</td> - <td class="coverage">1505774<em>x</em></td> + <td class="num">68</td> + <td class="coverage">265<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> parms <- c(odeparms.optim, parms.fixed)</pre> + <pre class="language-r"> return(res)</pre> </td> </tr> <tr class="never"> - <td class="num">614</td> + <td class="num">69</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">}</pre> </td> </tr> <tr class="never"> - <td class="num">615</td> + <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">616</td> + <td class="num">71</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # Solve the system with current parameter values</pre> + <pre class="language-r">#' @param exclude_failed For [multistart] objects, should rows for failed fits</pre> </td> </tr> - <tr class="covered"> - <td class="num">617</td> - <td class="coverage">4086568<em>x</em></td> + <tr class="never"> + <td class="num">72</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (solution_type == "analytical") {</pre> + <pre class="language-r">#' be removed from the returned parameter matrix?</pre> </td> </tr> - <tr class="covered"> - <td class="num">618</td> - <td class="coverage">2562380<em>x</em></td> + <tr class="never"> + <td class="num">73</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> observed$predicted <- mkinmod$deg_func(observed, odeini, parms)</pre> + <pre class="language-r">#' @rdname parms</pre> </td> </tr> <tr class="never"> - <td class="num">619</td> + <td class="num">74</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r">#' @export</pre> </td> </tr> - <tr class="covered"> - <td class="num">620</td> - <td class="coverage">1524188<em>x</em></td> + <tr class="never"> + <td class="num">75</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> out <- mkinpredict(mkinmod, parms,</pre> + <pre class="language-r">parms.multistart <- function(object, exclude_failed = TRUE, ...) {</pre> </td> </tr> <tr class="covered"> - <td class="num">621</td> - <td class="coverage">1524188<em>x</em></td> + <td class="num">76</td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> odeini, outtimes,</pre> + <pre class="language-r"> res <- t(sapply(object, parms))</pre> </td> </tr> <tr class="covered"> - <td class="num">622</td> - <td class="coverage">1524188<em>x</em></td> + <td class="num">77</td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> solution_type = solution_type,</pre> + <pre class="language-r"> successful <- which(!is.na(res[, 1]))</pre> </td> </tr> <tr class="covered"> - <td class="num">623</td> - <td class="coverage">1524188<em>x</em></td> + <td class="num">78</td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> use_compiled = use_compiled,</pre> + <pre class="language-r"> first_success <- successful[1]</pre> </td> </tr> <tr class="covered"> - <td class="num">624</td> - <td class="coverage">1524188<em>x</em></td> + <td class="num">79</td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> use_symbols = use_symbols,</pre> + <pre class="language-r"> colnames(res) <- names(parms(object[[first_success]]))</pre> </td> </tr> - <tr class="covered"> - <td class="num">625</td> - <td class="coverage">1524188<em>x</em></td> + <tr class="missed"> + <td class="num">80</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> method.ode = method.ode,</pre> + <pre class="language-r"> if (exclude_failed[1]) res <- res[successful, ]</pre> </td> </tr> <tr class="covered"> - <td class="num">626</td> - <td class="coverage">1524188<em>x</em></td> + <td class="num">81</td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> atol = atol, rtol = rtol,</pre> + <pre class="language-r"> return(res)</pre> </td> </tr> <tr class="never"> - <td class="num">627</td> + <td class="num">82</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> ...)</pre> + <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">628</td> + <td class="num">1</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> + <pre class="language-r">utils::globalVariables(c("type", "variable", "observed"))</pre> </td> </tr> - <tr class="covered"> - <td class="num">630</td> - <td class="coverage">1524188<em>x</em></td> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> observed$predicted <- out[observed_index]</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">631</td> + <td class="num">3</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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">632</td> + <td class="num">4</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#'</pre> </td> </tr> <tr class="never"> - <td class="num">633</td> + <td class="num">5</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # Define standard deviation for each observation</pre> + <pre class="language-r">#' Solves the differential equations with the optimised and fixed parameters</pre> </td> </tr> - <tr class="covered"> - <td class="num">634</td> - <td class="coverage">4086568<em>x</em></td> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (err_mod == "const") {</pre> + <pre class="language-r">#' from a previous successful call to \code{\link{mkinfit}} and plots the</pre> </td> </tr> - <tr class="covered"> - <td class="num">635</td> - <td class="coverage">2789021<em>x</em></td> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> observed$std <- if (OLS) NA else cost_errparms["sigma"]</pre> + <pre class="language-r">#' observed data together with the solution of the fitted model.</pre> </td> </tr> <tr class="never"> - <td class="num">636</td> + <td class="num">8</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> - <td class="num">637</td> - <td class="coverage">4086568<em>x</em></td> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (err_mod == "obs") {</pre> + <pre class="language-r">#' If the current plot device is a \code{\link[tikzDevice]{tikz}} device, then</pre> </td> </tr> - <tr class="covered"> - <td class="num">638</td> - <td class="coverage">366137<em>x</em></td> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> std_names <- paste0("sigma_", observed$name)</pre> + <pre class="language-r">#' latex is being used for the formatting of the chi2 error level, if</pre> </td> </tr> - <tr class="covered"> - <td class="num">639</td> - <td class="coverage">366137<em>x</em></td> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> observed$std <- cost_errparms[std_names]</pre> + <pre class="language-r">#' \code{show_errmin = TRUE}.</pre> </td> </tr> <tr class="never"> - <td class="num">640</td> + <td class="num">12</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> - <td class="num">641</td> - <td class="coverage">4086568<em>x</em></td> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (err_mod == "tc") {</pre> + <pre class="language-r">#' @aliases plot.mkinfit plot_sep plot_res plot_err</pre> </td> </tr> - <tr class="covered"> - <td class="num">642</td> - <td class="coverage">931410<em>x</em></td> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></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> + <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">643</td> + <td class="num">15</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">#' method.</pre> </td> </tr> <tr class="never"> - <td class="num">644</td> + <td class="num">16</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' @param fit An object of class \code{\link{mkinfit}}.</pre> </td> </tr> <tr class="never"> - <td class="num">645</td> + <td class="num">17</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # Calculate model cost</pre> + <pre class="language-r">#' @param obs_vars A character vector of names of the observed variables for</pre> </td> </tr> - <tr class="covered"> - <td class="num">646</td> - <td class="coverage">4086568<em>x</em></td> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (OLS) {</pre> + <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">647</td> + <td class="num">19</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # Cost is the sum of squared residuals</pre> + <pre class="language-r">#' variables in the model.</pre> </td> </tr> - <tr class="covered"> - <td class="num">648</td> - <td class="coverage">1063145<em>x</em></td> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cost <- with(observed, sum((value - predicted)^2))</pre> + <pre class="language-r">#' @param xlab Label for the x axis.</pre> </td> </tr> <tr class="never"> - <td class="num">649</td> + <td class="num">21</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r">#' @param ylab Label for the y axis.</pre> </td> </tr> <tr class="never"> - <td class="num">650</td> + <td class="num">22</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # Cost is the negative log-likelihood</pre> + <pre class="language-r">#' @param xlim Plot range in x direction.</pre> </td> </tr> - <tr class="covered"> - <td class="num">651</td> - <td class="coverage">3023423<em>x</em></td> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cost <- - with(observed,</pre> + <pre class="language-r">#' @param ylim Plot range in y direction. If given as a list, plot ranges</pre> </td> </tr> - <tr class="covered"> - <td class="num">652</td> - <td class="coverage">3023423<em>x</em></td> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> sum(dnorm(x = value, mean = predicted, sd = std, log = TRUE)))</pre> + <pre class="language-r">#' for the different plot rows can be given for row layout.</pre> </td> </tr> <tr class="never"> - <td class="num">653</td> + <td class="num">25</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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">654</td> + <td class="num">26</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' corresponding model prediction lines.</pre> </td> </tr> <tr class="never"> - <td class="num">655</td> + <td class="num">27</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> + <pre class="language-r">#' @param pch_obs Symbols to be used for plotting the data.</pre> </td> </tr> <tr class="never"> - <td class="num">656</td> + <td class="num">28</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # during hessian calculations</pre> + <pre class="language-r">#' @param lty_obs Line types to be used for the model predictions.</pre> </td> </tr> - <tr class="covered"> - <td class="num">657</td> - <td class="coverage">4086568<em>x</em></td> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (update_data) {</pre> + <pre class="language-r">#' @param add Should the plot be added to an existing plot?</pre> </td> </tr> <tr class="never"> - <td class="num">658</td> + <td class="num">30</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' @param legend Should a legend be added to the plot?</pre> </td> </tr> - <tr class="covered"> - <td class="num">659</td> - <td class="coverage">1622188<em>x</em></td> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> assign("current_data", observed, inherits = TRUE)</pre> + <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">660</td> + <td class="num">32</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' fits is shown, the residual plot is in the lower third of the plot.</pre> </td> </tr> - <tr class="covered"> - <td class="num">661</td> - <td class="coverage">1622188<em>x</em></td> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (cost < cost.current) {</pre> + <pre class="language-r">#' Otherwise, i.e. if "sep_obs" is given, the residual plots will be located</pre> </td> </tr> - <tr class="covered"> - <td class="num">662</td> - <td class="coverage">594930<em>x</em></td> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> assign("cost.current", cost, inherits = TRUE)</pre> + <pre class="language-r">#' to the right of the plots of the fitted curves. If this is set to</pre> </td> </tr> - <tr class="covered"> - <td class="num">663</td> - <td class="coverage">1768<em>x</em></td> + <tr class="never"> + <td class="num">35</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (!quiet) message(ifelse(OLS, "Sum of squared residuals", "Negative log-likelihood"),</pre> + <pre class="language-r">#' 'standardized', a plot of the residuals divided by the standard deviation</pre> </td> </tr> - <tr class="covered"> - <td class="num">664</td> - <td class="coverage">1768<em>x</em></td> + <tr class="never"> + <td class="num">36</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> " at call ", calls, ": ", signif(cost.current, 6), "\n")</pre> + <pre class="language-r">#' given by the fitted error model will be shown.</pre> </td> </tr> <tr class="never"> - <td class="num">665</td> + <td class="num">37</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">#' @param standardized When calling 'plot_res', should the residuals be</pre> </td> </tr> <tr class="never"> - <td class="num">666</td> + <td class="num">38</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">#' standardized in the residual plot?</pre> </td> </tr> - <tr class="covered"> - <td class="num">667</td> - <td class="coverage">4086415<em>x</em></td> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> return(cost)</pre> + <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">668</td> + <td class="num">40</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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">669</td> + <td class="num">41</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' the plot. Otherwise, i.e. if "sep_obs" is given, the residual plots will</pre> </td> </tr> - <tr class="covered"> - <td class="num">670</td> - <td class="coverage">8320<em>x</em></td> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> names_optim <- c(names(state.ini.optim),</pre> + <pre class="language-r">#' be located to the right of the plots of the fitted curves.</pre> </td> </tr> - <tr class="covered"> - <td class="num">671</td> - <td class="coverage">8320<em>x</em></td> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> names(transparms.optim),</pre> + <pre class="language-r">#' @param maxabs Maximum absolute value of the residuals. This is used for the</pre> </td> </tr> - <tr class="covered"> - <td class="num">672</td> - <td class="coverage">8320<em>x</em></td> + <tr class="never"> + <td class="num">44</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> errparm_names_optim)</pre> + <pre class="language-r">#' scaling of the y axis and defaults to "auto".</pre> </td> </tr> - <tr class="covered"> - <td class="num">673</td> - <td class="coverage">8320<em>x</em></td> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> n_optim <- length(names_optim)</pre> + <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">674</td> + <td class="num">46</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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">675</td> + <td class="num">47</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> + <pre class="language-r">#' to, not below the plot of the fits.</pre> </td> </tr> <tr class="never"> - <td class="num">676</td> + <td class="num">48</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> + <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">677</td> + <td class="num">49</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # and for optimised error model parameters</pre> + <pre class="language-r">#' than two rows of plots are shown.</pre> </td> </tr> - <tr class="covered"> - <td class="num">678</td> - <td class="coverage">8320<em>x</em></td> + <tr class="never"> + <td class="num">50</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> lower <- rep(-Inf, n_optim)</pre> + <pre class="language-r">#' @param row_layout Should we use a row layout where the residual plot or the</pre> </td> </tr> - <tr class="covered"> - <td class="num">679</td> - <td class="coverage">8320<em>x</em></td> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> upper <- rep(Inf, n_optim)</pre> + <pre class="language-r">#' error model plot is shown to the right?</pre> </td> </tr> - <tr class="covered"> - <td class="num">680</td> - <td class="coverage">8320<em>x</em></td> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> names(lower) <- names(upper) <- names_optim</pre> + <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">681</td> + <td class="num">53</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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">682</td> + <td class="num">54</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> + <pre class="language-r">#' as the obs_var argument.</pre> </td> </tr> - <tr class="covered"> - <td class="num">683</td> - <td class="coverage">8320<em>x</em></td> + <tr class="never"> + <td class="num">55</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> index_N <- grep("^N", names(lower))</pre> + <pre class="language-r">#' @param inset Passed to \code{\link{legend}} if applicable.</pre> </td> </tr> - <tr class="covered"> - <td class="num">684</td> - <td class="coverage">8320<em>x</em></td> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> lower[index_N] <- 0</pre> + <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">685</td> + <td class="num">57</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' margin of the plot?</pre> </td> </tr> - <tr class="covered"> - <td class="num">686</td> - <td class="coverage">8320<em>x</em></td> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (!transform_rates) {</pre> + <pre class="language-r">#' @param errmin_digits The number of significant digits for rounding the FOCUS</pre> </td> </tr> - <tr class="covered"> - <td class="num">687</td> - <td class="coverage">553<em>x</em></td> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> index_k <- grep("^k_", names(lower))</pre> + <pre class="language-r">#' chi2 error percentage.</pre> </td> </tr> - <tr class="covered"> - <td class="num">688</td> - <td class="coverage">553<em>x</em></td> + <tr class="never"> + <td class="num">60</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> lower[index_k] <- 0</pre> + <pre class="language-r">#' @param frame Should a frame be drawn around the plots?</pre> </td> </tr> - <tr class="covered"> - <td class="num">689</td> - <td class="coverage">553<em>x</em></td> + <tr class="never"> + <td class="num">61</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> index_k__iore <- grep("^k__iore_", names(lower))</pre> + <pre class="language-r">#' @param \dots Further arguments passed to \code{\link{plot}}.</pre> </td> </tr> - <tr class="covered"> - <td class="num">690</td> - <td class="coverage">553<em>x</em></td> + <tr class="never"> + <td class="num">62</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> lower[index_k__iore] <- 0</pre> + <pre class="language-r">#' @import graphics</pre> </td> </tr> - <tr class="covered"> - <td class="num">691</td> - <td class="coverage">553<em>x</em></td> + <tr class="never"> + <td class="num">63</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> other_rate_parms <- intersect(c("alpha", "beta", "k1", "k2", "tb", "r"), names(lower))</pre> + <pre class="language-r">#' @importFrom grDevices dev.cur</pre> </td> </tr> - <tr class="covered"> - <td class="num">692</td> - <td class="coverage">553<em>x</em></td> + <tr class="never"> + <td class="num">64</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> lower[other_rate_parms] <- 0</pre> + <pre class="language-r">#' @return The function is called for its side effect.</pre> </td> </tr> <tr class="never"> - <td class="num">693</td> + <td class="num">65</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">#' @author Johannes Ranke</pre> </td> </tr> <tr class="never"> - <td class="num">694</td> + <td class="num">66</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' @examples</pre> </td> </tr> - <tr class="covered"> - <td class="num">695</td> - <td class="coverage">8320<em>x</em></td> + <tr class="never"> + <td class="num">67</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (!transform_fractions) {</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> - <td class="num">696</td> - <td class="coverage">306<em>x</em></td> + <tr class="never"> + <td class="num">68</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> index_f <- grep("^f_", names(upper))</pre> + <pre class="language-r">#' # One parent compound, one metabolite, both single first order, path from</pre> </td> </tr> - <tr class="covered"> - <td class="num">697</td> - <td class="coverage">306<em>x</em></td> + <tr class="never"> + <td class="num">69</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> lower[index_f] <- 0</pre> + <pre class="language-r">#' # parent to sink included</pre> </td> </tr> - <tr class="covered"> - <td class="num">698</td> - <td class="coverage">306<em>x</em></td> + <tr class="never"> + <td class="num">70</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> upper[index_f] <- 1</pre> + <pre class="language-r">#' \dontrun{</pre> </td> </tr> - <tr class="covered"> - <td class="num">699</td> - <td class="coverage">306<em>x</em></td> + <tr class="never"> + <td class="num">71</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> other_fraction_parms <- intersect(c("g"), names(upper))</pre> + <pre class="language-r">#' SFO_SFO <- mkinmod(parent = mkinsub("SFO", "m1", full = "Parent"),</pre> </td> </tr> - <tr class="covered"> - <td class="num">700</td> - <td class="coverage">306<em>x</em></td> + <tr class="never"> + <td class="num">72</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> lower[other_fraction_parms] <- 0</pre> + <pre class="language-r">#' m1 = mkinsub("SFO", full = "Metabolite M1" ))</pre> </td> </tr> - <tr class="covered"> - <td class="num">701</td> - <td class="coverage">306<em>x</em></td> + <tr class="never"> + <td class="num">73</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> upper[other_fraction_parms] <- 1</pre> + <pre class="language-r">#' fit <- mkinfit(SFO_SFO, FOCUS_2006_D, quiet = TRUE)</pre> </td> </tr> <tr class="never"> - <td class="num">702</td> + <td class="num">74</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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">703</td> + <td class="num">75</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' plot(fit)</pre> </td> </tr> - <tr class="covered"> - <td class="num">704</td> - <td class="coverage">8320<em>x</em></td> + <tr class="never"> + <td class="num">76</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (err_mod == "const") {</pre> + <pre class="language-r">#' plot_res(fit)</pre> </td> </tr> - <tr class="covered"> - <td class="num">705</td> - <td class="coverage">6410<em>x</em></td> + <tr class="never"> + <td class="num">77</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (error_model_algorithm != "OLS") {</pre> + <pre class="language-r">#' plot_res(fit, standardized = FALSE)</pre> </td> </tr> - <tr class="missed"> - <td class="num">706</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">78</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> lower["sigma"] <- 0</pre> + <pre class="language-r">#' plot_err(fit)</pre> </td> </tr> <tr class="never"> - <td class="num">707</td> + <td class="num">79</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">#'</pre> </td> </tr> <tr class="never"> - <td class="num">708</td> + <td class="num">80</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">#' # Show the observed variables separately, with residuals</pre> </td> </tr> - <tr class="covered"> - <td class="num">709</td> - <td class="coverage">8320<em>x</em></td> + <tr class="never"> + <td class="num">81</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (err_mod == "obs") {</pre> + <pre class="language-r">#' plot(fit, sep_obs = TRUE, show_residuals = TRUE, lpos = c("topright", "bottomright"),</pre> </td> </tr> - <tr class="covered"> - <td class="num">710</td> - <td class="coverage">317<em>x</em></td> + <tr class="never"> + <td class="num">82</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> index_sigma <- grep("^sigma_", names(lower))</pre> + <pre class="language-r">#' show_errmin = TRUE)</pre> </td> </tr> - <tr class="covered"> - <td class="num">711</td> - <td class="coverage">317<em>x</em></td> + <tr class="never"> + <td class="num">83</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> lower[index_sigma] <- 0</pre> + <pre class="language-r">#'</pre> </td> </tr> <tr class="never"> - <td class="num">712</td> + <td class="num">84</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">#' # The same can be obtained with less typing, using the convenience function plot_sep</pre> </td> </tr> - <tr class="covered"> - <td class="num">713</td> - <td class="coverage">8320<em>x</em></td> + <tr class="never"> + <td class="num">85</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (err_mod == "tc") {</pre> + <pre class="language-r">#' plot_sep(fit, lpos = c("topright", "bottomright"))</pre> </td> </tr> - <tr class="covered"> - <td class="num">714</td> - <td class="coverage">1593<em>x</em></td> + <tr class="never"> + <td class="num">86</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> lower["sigma_low"] <- 0</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> - <td class="num">715</td> - <td class="coverage">1593<em>x</em></td> + <tr class="never"> + <td class="num">87</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> lower["rsd_high"] <- 0</pre> + <pre class="language-r">#' # Show the observed variables separately, with the error model</pre> </td> </tr> <tr class="never"> - <td class="num">716</td> + <td class="num">88</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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">717</td> + <td class="num">89</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' show_errmin = TRUE)</pre> </td> </tr> <tr class="never"> - <td class="num">718</td> + <td class="num">90</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # Counter for cost function evaluations</pre> + <pre class="language-r">#' }</pre> </td> </tr> - <tr class="covered"> - <td class="num">719</td> - <td class="coverage">8320<em>x</em></td> + <tr class="never"> + <td class="num">91</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> calls = 0</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> - <td class="num">720</td> - <td class="coverage">8320<em>x</em></td> + <tr class="never"> + <td class="num">92</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cost.current <- Inf</pre> + <pre class="language-r">#' @export</pre> </td> </tr> - <tr class="covered"> - <td class="num">721</td> - <td class="coverage">8320<em>x</em></td> + <tr class="never"> + <td class="num">93</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> out_predicted <- NA</pre> + <pre class="language-r">plot.mkinfit <- function(x, fit = x,</pre> </td> </tr> - <tr class="covered"> - <td class="num">722</td> - <td class="coverage">8320<em>x</em></td> + <tr class="never"> + <td class="num">94</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> current_data <- NA</pre> + <pre class="language-r"> obs_vars = names(fit$mkinmod$map),</pre> </td> </tr> <tr class="never"> - <td class="num">723</td> + <td class="num">95</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> xlab = "Time", ylab = "Residue",</pre> </td> </tr> <tr class="never"> - <td class="num">724</td> + <td class="num">96</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # Show parameter names if tracing is requested</pre> + <pre class="language-r"> xlim = range(fit$data$time),</pre> </td> </tr> - <tr class="covered"> - <td class="num">725</td> - <td class="coverage">104<em>x</em></td> + <tr class="never"> + <td class="num">97</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if(trace_parms) cat(format(names_optim, width = 10), "\n")</pre> + <pre class="language-r"> ylim = "default",</pre> </td> </tr> <tr class="never"> - <td class="num">726</td> + <td class="num">98</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> col_obs = 1:length(obs_vars),</pre> </td> </tr> <tr class="never"> - <td class="num">727</td> + <td class="num">99</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> #browser()</pre> + <pre class="language-r"> pch_obs = col_obs,</pre> </td> </tr> <tr class="never"> - <td class="num">728</td> + <td class="num">100</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> lty_obs = rep(1, length(obs_vars)),</pre> </td> </tr> <tr class="never"> - <td class="num">729</td> + <td class="num">101</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> + <pre class="language-r"> add = FALSE, legend = !add,</pre> </td> </tr> - <tr class="covered"> - <td class="num">730</td> - <td class="coverage">8320<em>x</em></td> + <tr class="never"> + <td class="num">102</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> fit_time <- system.time({</pre> + <pre class="language-r"> show_residuals = FALSE,</pre> </td> </tr> - <tr class="covered"> - <td class="num">731</td> - <td class="coverage">8320<em>x</em></td> + <tr class="never"> + <td class="num">103</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> degparms <- c(state.ini.optim, transparms.optim)</pre> + <pre class="language-r"> show_errplot = FALSE,</pre> </td> </tr> - <tr class="covered"> - <td class="num">732</td> - <td class="coverage">8320<em>x</em></td> + <tr class="never"> + <td class="num">104</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> n_degparms <- length(degparms)</pre> + <pre class="language-r"> maxabs = "auto",</pre> </td> </tr> - <tr class="covered"> - <td class="num">733</td> - <td class="coverage">8320<em>x</em></td> + <tr class="never"> + <td class="num">105</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> degparms_index <- seq(1, n_degparms)</pre> + <pre class="language-r"> sep_obs = FALSE, rel.height.middle = 0.9,</pre> </td> </tr> - <tr class="covered"> - <td class="num">734</td> - <td class="coverage">8320<em>x</em></td> + <tr class="never"> + <td class="num">106</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> errparms_index <- seq(n_degparms + 1, length.out = length(errparms))</pre> + <pre class="language-r"> row_layout = FALSE,</pre> </td> </tr> <tr class="never"> - <td class="num">735</td> + <td class="num">107</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> lpos = "topright", inset = c(0.05, 0.05),</pre> </td> </tr> - <tr class="covered"> - <td class="num">736</td> - <td class="coverage">8320<em>x</em></td> + <tr class="never"> + <td class="num">108</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (error_model_algorithm == "d_3") {</pre> + <pre class="language-r"> show_errmin = FALSE, errmin_digits = 3,</pre> </td> </tr> - <tr class="missed"> - <td class="num">737</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">109</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (!quiet) message("Directly optimising the complete model")</pre> + <pre class="language-r"> frame = TRUE, ...)</pre> </td> </tr> - <tr class="covered"> - <td class="num">738</td> - <td class="coverage">471<em>x</em></td> + <tr class="never"> + <td class="num">110</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> parms.start <- c(degparms, errparms)</pre> + <pre class="language-r">{</pre> </td> </tr> <tr class="covered"> - <td class="num">739</td> - <td class="coverage">471<em>x</em></td> + <td class="num">111</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fit_direct <- try(nlminb(parms.start, cost_function,</pre> + <pre class="language-r"> if (identical(show_residuals, "standardized")) {</pre> </td> </tr> - <tr class="covered"> - <td class="num">740</td> - <td class="coverage">471<em>x</em></td> + <tr class="missed"> + <td class="num">112</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> lower = lower[names(parms.start)],</pre> + <pre class="language-r"> show_residuals <- TRUE</pre> </td> </tr> - <tr class="covered"> - <td class="num">741</td> - <td class="coverage">471<em>x</em></td> + <tr class="missed"> + <td class="num">113</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> upper = upper[names(parms.start)],</pre> + <pre class="language-r"> standardized <- TRUE</pre> </td> </tr> - <tr class="covered"> - <td class="num">742</td> - <td class="coverage">471<em>x</em></td> + <tr class="never"> + <td class="num">114</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> control = control, ...))</pre> + <pre class="language-r"> } else {</pre> </td> </tr> <tr class="covered"> - <td class="num">743</td> - <td class="coverage">471<em>x</em></td> + <td class="num">115</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (!inherits(fit_direct, "try-error")) {</pre> + <pre class="language-r"> standardized <- FALSE</pre> </td> </tr> - <tr class="covered"> - <td class="num">744</td> - <td class="coverage">471<em>x</em></td> + <tr class="never"> + <td class="num">116</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> fit_direct$logLik <- - cost.current</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> - <td class="num">745</td> - <td class="coverage">471<em>x</em></td> + <tr class="never"> + <td class="num">117</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cost.current <- Inf # reset to avoid conflict with the OLS step</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> - <td class="num">746</td> - <td class="coverage">471<em>x</em></td> + <tr class="missed"> + <td class="num">118</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> data_direct <- current_data # We need this later if it was better</pre> + <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="covered"> - <td class="num">747</td> - <td class="coverage">471<em>x</em></td> + <tr class="missed"> + <td class="num">119</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> direct_failed = FALSE</pre> + <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="never"> - <td class="num">748</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">120</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <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">749</td> + <td class="num">121</td> <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> direct_failed = TRUE</pre> + <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">750</td> + <td class="num">122</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">751</td> + <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">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> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">753</td> - <td class="coverage">104<em>x</em></td> + <td class="num">124</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (!quiet) message("Ordinary least squares optimisation")</pre> + <pre class="language-r"> solution_type = fit$solution_type</pre> </td> </tr> <tr class="covered"> - <td class="num">754</td> - <td class="coverage">7884<em>x</em></td> + <td class="num">125</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fit <- nlminb(degparms, cost_function, control = control,</pre> + <pre class="language-r"> parms.all <- c(fit$bparms.optim, fit$bparms.fixed)</pre> </td> </tr> - <tr class="covered"> - <td class="num">755</td> - <td class="coverage">7884<em>x</em></td> + <tr class="never"> + <td class="num">126</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> lower = lower[names(degparms)],</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">756</td> - <td class="coverage">7884<em>x</em></td> + <td class="num">127</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> upper = upper[names(degparms)], OLS = TRUE, ...)</pre> + <pre class="language-r"> ininames <- c(</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="num">128</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Get the maximum likelihood estimate for sigma at the optimum parameter values</pre> + <pre class="language-r"> rownames(subset(fit$start, type == "state")),</pre> </td> </tr> <tr class="covered"> - <td class="num">760</td> - <td class="coverage">7731<em>x</em></td> + <td class="num">129</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> current_data$residual <- current_data$value - current_data$predicted</pre> + <pre class="language-r"> rownames(subset(fit$fixed, type == "state")))</pre> </td> </tr> <tr class="covered"> - <td class="num">761</td> - <td class="coverage">7731<em>x</em></td> + <td class="num">130</td> + <td class="coverage">1503<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> + <pre class="language-r"> odeini <- parms.all[ininames]</pre> </td> </tr> <tr class="never"> - <td class="num">762</td> + <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">763</td> + <td class="num">132</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> + <pre class="language-r"> # Order initial state variables</pre> </td> </tr> <tr class="covered"> - <td class="num">764</td> - <td class="coverage">7731<em>x</em></td> + <td class="num">133</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (err_mod != "tc") {</pre> + <pre class="language-r"> names(odeini) <- sub("_0", "", names(odeini))</pre> </td> </tr> <tr class="covered"> - <td class="num">765</td> - <td class="coverage">6327<em>x</em></td> + <td class="num">134</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> errparms[names(errparms)] <- sigma_mle</pre> + <pre class="language-r"> odeini <- odeini[names(fit$mkinmod$diffs)]</pre> </td> </tr> <tr class="never"> - <td class="num">766</td> + <td class="num">135</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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="num">136</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fit$par <- c(fit$par, errparms)</pre> + <pre class="language-r"> outtimes <- seq(xlim[1], xlim[2], length.out=100)</pre> </td> </tr> <tr class="never"> - <td class="num">768</td> + <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">769</td> - <td class="coverage">7731<em>x</em></td> + <td class="num">138</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cost.current <- cost_function(c(degparms, errparms), OLS = FALSE)</pre> + <pre class="language-r"> odenames <- c(</pre> </td> </tr> <tr class="covered"> - <td class="num">770</td> - <td class="coverage">7731<em>x</em></td> + <td class="num">139</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fit$logLik <- - cost.current</pre> + <pre class="language-r"> rownames(subset(fit$start, type == "deparm")),</pre> </td> </tr> - <tr class="never"> - <td class="num">771</td> - <td class="coverage"></td> + <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"> }</pre> + <pre class="language-r"> rownames(subset(fit$fixed, type == "deparm")))</pre> </td> </tr> <tr class="covered"> - <td class="num">772</td> - <td class="coverage">8167<em>x</em></td> + <td class="num">141</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (error_model_algorithm %in% c("threestep", "fourstep", "d_3")) {</pre> + <pre class="language-r"> odeparms <- parms.all[odenames]</pre> </td> </tr> - <tr class="missed"> - <td class="num">773</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">142</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (!quiet) message("Optimising the error model")</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> - <td class="num">774</td> - <td class="coverage">1096<em>x</em></td> + <tr class="never"> + <td class="num">143</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> fit <- nlminb(errparms, cost_function, control = control,</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">775</td> - <td class="coverage">1096<em>x</em></td> + <td class="num">144</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> lower = lower[names(errparms)],</pre> + <pre class="language-r"> if (solution_type == "deSolve" & !is.null(fit$mkinmod$cf)) {</pre> </td> </tr> <tr class="covered"> - <td class="num">776</td> - <td class="coverage">1096<em>x</em></td> + <td class="num">145</td> + <td class="coverage">140<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> upper = upper[names(errparms)],</pre> + <pre class="language-r"> fit$mkinmod[["symbols"]] <- deSolve::checkDLL(dllname = fit$mkinmod$dll_info[["name"]],</pre> </td> </tr> <tr class="covered"> - <td class="num">777</td> - <td class="coverage">1096<em>x</em></td> + <td class="num">146</td> + <td class="coverage">140<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fixed_degparms = degparms, ...)</pre> + <pre class="language-r"> func = "diffs", initfunc = "initpar",</pre> </td> </tr> <tr class="covered"> - <td class="num">778</td> - <td class="coverage">1096<em>x</em></td> + <td class="num">147</td> + <td class="coverage">140<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> errparms <- fit$par</pre> + <pre class="language-r"> jacfunc = NULL, nout = 0, outnames = NULL)</pre> </td> </tr> <tr class="never"> - <td class="num">779</td> + <td class="num">148</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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="num">149</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (!quiet) message("Optimising the degradation model")</pre> + <pre class="language-r"> out <- mkinpredict(fit$mkinmod, odeparms, odeini, outtimes,</pre> </td> </tr> <tr class="covered"> - <td class="num">782</td> - <td class="coverage">189<em>x</em></td> + <td class="num">150</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fit <- nlminb(degparms, cost_function, control = control,</pre> + <pre class="language-r"> solution_type = solution_type, atol = fit$atol, rtol = fit$rtol)</pre> </td> </tr> - <tr class="covered"> - <td class="num">783</td> - <td class="coverage">189<em>x</em></td> + <tr class="never"> + <td class="num">151</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> lower = lower[names(degparms)],</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">784</td> - <td class="coverage">189<em>x</em></td> + <td class="num">152</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> upper = upper[names(degparms)],</pre> + <pre class="language-r"> out <- as.data.frame(out)</pre> </td> </tr> - <tr class="covered"> - <td class="num">785</td> - <td class="coverage">189<em>x</em></td> + <tr class="never"> + <td class="num">153</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> fixed_errparms = errparms, ...)</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">786</td> - <td class="coverage">189<em>x</em></td> + <td class="num">154</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> degparms <- fit$par</pre> + <pre class="language-r"> names(col_obs) <- names(pch_obs) <- names(lty_obs) <- obs_vars</pre> </td> </tr> <tr class="never"> - <td class="num">787</td> + <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">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> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> - <td class="num">789</td> - <td class="coverage">8167<em>x</em></td> + <tr class="never"> + <td class="num">156</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> c("direct", "twostep", "threestep", "fourstep", "d_3")) {</pre> + <pre class="language-r"> # Create a plot layout only if not to be added to an existing plot</pre> </td> </tr> - <tr class="missed"> - <td class="num">790</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">157</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (!quiet) message("Optimising the complete model")</pre> + <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">791</td> - <td class="coverage">1721<em>x</em></td> + <td class="num">158</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> parms.start <- c(degparms, errparms)</pre> + <pre class="language-r"> do_layout = FALSE</pre> </td> </tr> <tr class="covered"> - <td class="num">792</td> - <td class="coverage">1721<em>x</em></td> + <td class="num">159</td> + <td class="coverage">485<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fit <- nlminb(parms.start, cost_function,</pre> + <pre class="language-r"> if (show_residuals | sep_obs | show_errplot) do_layout = TRUE</pre> </td> </tr> <tr class="covered"> - <td class="num">793</td> - <td class="coverage">1721<em>x</em></td> + <td class="num">160</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> lower = lower[names(parms.start)],</pre> + <pre class="language-r"> n_plot_rows = if (sep_obs) length(obs_vars) else 1</pre> </td> </tr> - <tr class="covered"> - <td class="num">794</td> - <td class="coverage">1721<em>x</em></td> + <tr class="never"> + <td class="num">161</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> upper = upper[names(parms.start)],</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">795</td> - <td class="coverage">1721<em>x</em></td> + <td class="num">162</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> control = control, ...)</pre> + <pre class="language-r"> if (do_layout) {</pre> </td> </tr> - <tr class="covered"> - <td class="num">796</td> - <td class="coverage">1721<em>x</em></td> + <tr class="never"> + <td class="num">163</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> degparms <- fit$par[degparms_index]</pre> + <pre class="language-r"> # Layout should be restored afterwards</pre> </td> </tr> <tr class="covered"> - <td class="num">797</td> - <td class="coverage">1721<em>x</em></td> + <td class="num">164</td> + <td class="coverage">485<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> errparms <- fit$par[errparms_index]</pre> + <pre class="language-r"> oldpar <- par(no.readonly = TRUE)</pre> </td> </tr> <tr class="covered"> - <td class="num">798</td> - <td class="coverage">1721<em>x</em></td> + <td class="num">165</td> + <td class="coverage">485<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fit$logLik <- - cost.current</pre> + <pre class="language-r"> on.exit(par(oldpar, no.readonly = TRUE))</pre> </td> </tr> <tr class="never"> - <td class="num">799</td> + <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">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> + <tr class="never"> + <td class="num">167</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> direct_failed = "Direct fitting failed, results of three-step fitting are returned",</pre> + <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">803</td> - <td class="coverage">471<em>x</em></td> + <td class="num">168</td> + <td class="coverage">485<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> + <pre class="language-r"> if (sep_obs | row_layout) {</pre> </td> </tr> <tr class="covered"> - <td class="num">804</td> - <td class="coverage">471<em>x</em></td> + <td class="num">169</td> + <td class="coverage">415<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> + <pre class="language-r"> row_layout <- TRUE</pre> </td> </tr> <tr class="covered"> - <td class="num">805</td> - <td class="coverage">471<em>x</em></td> + <td class="num">170</td> + <td class="coverage">415<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> + <pre class="language-r"> n_plot_cols = if (show_residuals | show_errplot) 2 else 1</pre> </td> </tr> <tr class="covered"> - <td class="num">806</td> - <td class="coverage">471<em>x</em></td> + <td class="num">171</td> + <td class="coverage">415<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (direct_failed) {</pre> + <pre class="language-r"> n_plots = n_plot_rows * n_plot_cols</pre> </td> </tr> - <tr class="missed"> - <td class="num">807</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">172</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (!quiet) message(d_3_messages["direct_failed"])</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="missed"> - <td class="num">808</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">173</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> fit$d_3_message <- d_3_messages["direct_failed"]</pre> + <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">809</td> + <td class="num">174</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <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">810</td> - <td class="coverage">471<em>x</em></td> + <td class="num">175</td> + <td class="coverage">415<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> + <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">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="num">176</td> + <td class="coverage">415<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (!quiet) message(d_3_messages["same"])</pre> + <pre class="language-r"> else rep(1, n_plot_rows)</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="num">177</td> + <td class="coverage">415<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r"> layout_matrix = matrix(1:n_plots,</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="num">178</td> + <td class="coverage">415<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (!quiet) message(d_3_messages["threestep"])</pre> + <pre class="language-r"> n_plot_rows, n_plot_cols, byrow = TRUE)</pre> </td> </tr> <tr class="covered"> - <td class="num">817</td> - <td class="coverage">15<em>x</em></td> + <td class="num">179</td> + <td class="coverage">415<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fit$d_3_message <- d_3_messages["threestep"]</pre> + <pre class="language-r"> layout(layout_matrix, heights = rel.heights)</pre> </td> </tr> <tr class="never"> - <td class="num">818</td> + <td class="num">180</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> + <pre class="language-r"> } else { # else show residuals in the lower third to keep compatibility</pre> </td> </tr> <tr class="covered"> - <td class="num">823</td> - <td class="coverage">216<em>x</em></td> + <td class="num">181</td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> errparms <- fit$par[errparms_index]</pre> + <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">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="num">182</td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> par(mar = c(3, 4, 4, 2) + 0.1)</pre> </td> </tr> <tr class="never"> - <td class="num">826</td> + <td class="num">183</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">827</td> + <td class="num">184</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">828</td> + <td class="num">185</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">829</td> + <td class="num">186</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> # Replicate legend position argument if necessary</pre> </td> </tr> <tr class="covered"> - <td class="num">830</td> - <td class="coverage">8167<em>x</em></td> + <td class="num">187</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (err_mod != "const" & error_model_algorithm == "IRLS") {</pre> + <pre class="language-r"> if (length(lpos) == 1) lpos = rep(lpos, n_plot_rows)</pre> </td> </tr> - <tr class="covered"> - <td class="num">831</td> - <td class="coverage">189<em>x</em></td> + <tr class="never"> + <td class="num">188</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> reweight.diff <- 1</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> - <td class="num">832</td> - <td class="coverage">189<em>x</em></td> + <tr class="never"> + <td class="num">189</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> n.iter <- 0</pre> + <pre class="language-r"> # Loop over plot rows</pre> </td> </tr> <tr class="covered"> - <td class="num">833</td> - <td class="coverage">189<em>x</em></td> + <td class="num">190</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> errparms_last <- errparms</pre> + <pre class="language-r"> for (plot_row in 1:n_plot_rows) {</pre> </td> </tr> <tr class="never"> - <td class="num">834</td> + <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">835</td> - <td class="coverage">189<em>x</em></td> + <td class="num">192</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> while (reweight.diff > reweight.tol &</pre> + <pre class="language-r"> row_obs_vars = if (sep_obs) obs_vars[plot_row] else obs_vars</pre> </td> </tr> - <tr class="covered"> - <td class="num">836</td> - <td class="coverage">189<em>x</em></td> + <tr class="never"> + <td class="num">193</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> n.iter < reweight.max.iter) {</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">837</td> + <td class="num">194</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> # Set ylim to sensible default, or to the specified value</pre> </td> </tr> - <tr class="missed"> - <td class="num">838</td> - <td class="coverage">!</td> + <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 (!quiet) message("Optimising the error model")</pre> + <pre class="language-r"> if (is.list(ylim)) {</pre> </td> </tr> - <tr class="covered"> - <td class="num">839</td> - <td class="coverage">756<em>x</em></td> + <tr class="missed"> + <td class="num">196</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> fit <- nlminb(errparms, cost_function, control = control,</pre> + <pre class="language-r"> ylim_row <- ylim[[plot_row]]</pre> </td> </tr> - <tr class="covered"> - <td class="num">840</td> - <td class="coverage">756<em>x</em></td> + <tr class="never"> + <td class="num">197</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> lower = lower[names(errparms)],</pre> + <pre class="language-r"> } else {</pre> </td> </tr> <tr class="covered"> - <td class="num">841</td> - <td class="coverage">756<em>x</em></td> + <td class="num">198</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> upper = upper[names(errparms)],</pre> + <pre class="language-r"> if (ylim[[1]] == "default") {</pre> </td> </tr> <tr class="covered"> - <td class="num">842</td> - <td class="coverage">756<em>x</em></td> + <td class="num">199</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fixed_degparms = degparms, ...)</pre> + <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">843</td> - <td class="coverage">756<em>x</em></td> + <td class="num">200</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> errparms <- fit$par</pre> + <pre class="language-r"> unlist(out[row_obs_vars])), na.rm = TRUE))</pre> </td> </tr> <tr class="never"> - <td class="num">844</td> + <td class="num">201</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> } else {</pre> </td> </tr> <tr class="missed"> - <td class="num">845</td> + <td class="num">202</td> <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> if (!quiet) message("Optimising the degradation model")</pre> + <pre class="language-r"> ylim_row = ylim</pre> </td> </tr> - <tr class="covered"> - <td class="num">846</td> - <td class="coverage">756<em>x</em></td> + <tr class="never"> + <td class="num">203</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> fit <- nlminb(degparms, cost_function, control = control,</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> - <td class="num">847</td> - <td class="coverage">756<em>x</em></td> + <tr class="never"> + <td class="num">204</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> lower = lower[names(degparms)],</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> - <td class="num">848</td> - <td class="coverage">756<em>x</em></td> + <tr class="never"> + <td class="num">205</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> upper = upper[names(degparms)],</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">849</td> - <td class="coverage">756<em>x</em></td> + <td class="num">206</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fixed_errparms = errparms, ...)</pre> + <pre class="language-r"> if (row_layout) {</pre> </td> </tr> - <tr class="covered"> - <td class="num">850</td> - <td class="coverage">756<em>x</em></td> + <tr class="never"> + <td class="num">207</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> degparms <- fit$par</pre> + <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">851</td> + <td class="num">208</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> # Reduce bottom margin by 2.1 - hides x axis legend</pre> </td> </tr> <tr class="covered"> - <td class="num">852</td> - <td class="coverage">756<em>x</em></td> + <td class="num">209</td> + <td class="coverage">415<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> reweight.diff <- dist(rbind(errparms, errparms_last))</pre> + <pre class="language-r"> if (plot_row == 1 & n_plot_rows > 1) {</pre> </td> </tr> - <tr class="covered"> - <td class="num">853</td> - <td class="coverage">756<em>x</em></td> + <tr class="missed"> + <td class="num">210</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> errparms_last <- errparms</pre> + <pre class="language-r"> par(mar = c(3.0, 4.1, 4.1, 2.1))</pre> </td> </tr> <tr class="never"> - <td class="num">854</td> + <td class="num">211</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> - <td class="num">855</td> - <td class="coverage">756<em>x</em></td> + <tr class="never"> + <td class="num">212</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> fit$par <- c(fit$par, errparms)</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> - <td class="num">856</td> - <td class="coverage">756<em>x</em></td> + <tr class="never"> + <td class="num">213</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cost.current <- cost_function(c(degparms, errparms), OLS = FALSE)</pre> + <pre class="language-r"> # Margins for middle rows of plots, if any</pre> </td> </tr> <tr class="covered"> - <td class="num">857</td> - <td class="coverage">756<em>x</em></td> + <td class="num">214</td> + <td class="coverage">415<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fit$logLik <- - cost.current</pre> + <pre class="language-r"> if (plot_row > 1 & plot_row < n_plot_rows) {</pre> </td> </tr> <tr class="never"> - <td class="num">858</td> + <td class="num">215</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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">859</td> + <td class="num">216</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> # reduced plot height, therefore we need rel.height.middle in the layout</pre> </td> </tr> - <tr class="never"> - <td class="num">860</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">217</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> par(mar = c(3.0, 4.1, 2.1, 2.1))</pre> </td> </tr> - <tr class="covered"> - <td class="num">861</td> - <td class="coverage">8167<em>x</em></td> + <tr class="never"> + <td class="num">218</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> dim_hessian <- length(c(degparms, errparms))</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">862</td> + <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">863</td> - <td class="coverage">8167<em>x</em></td> + <tr class="never"> + <td class="num">220</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> fit$hessian <- try(numDeriv::hessian(cost_function, c(degparms, errparms), OLS = FALSE,</pre> + <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">864</td> - <td class="coverage">8167<em>x</em></td> + <td class="num">221</td> + <td class="coverage">415<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> update_data = FALSE), silent = TRUE)</pre> + <pre class="language-r"> if (plot_row == n_plot_rows & n_plot_rows > 1) {</pre> </td> </tr> - <tr class="covered"> - <td class="num">865</td> - <td class="coverage">8167<em>x</em></td> + <tr class="never"> + <td class="num">222</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (inherits(fit$hessian, "try-error")) {</pre> + <pre class="language-r"> # Restore bottom margin for last plot to show x axis legend</pre> </td> </tr> <tr class="missed"> - <td class="num">866</td> + <td class="num">223</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> + <pre class="language-r"> par(mar = c(5.1, 4.1, 2.1, 2.1))</pre> </td> </tr> <tr class="never"> - <td class="num">867</td> + <td class="num">224</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> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> - <td class="num">869</td> - <td class="coverage">8167<em>x</em></td> + <tr class="never"> + <td class="num">225</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> names(c(degparms, errparms)))</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">870</td> + <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">871</td> + <td class="num">227</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # Backtransform parameters</pre> + <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">872</td> - <td class="coverage">8167<em>x</em></td> + <td class="num">228</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> bparms.optim = backtransform_odeparms(degparms, mkinmod,</pre> + <pre class="language-r"> if (add == FALSE) {</pre> </td> </tr> <tr class="covered"> - <td class="num">873</td> - <td class="coverage">8167<em>x</em></td> + <td class="num">229</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> transform_rates = transform_rates,</pre> + <pre class="language-r"> plot(0, type="n",</pre> </td> </tr> <tr class="covered"> - <td class="num">874</td> - <td class="coverage">8167<em>x</em></td> + <td class="num">230</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> transform_fractions = transform_fractions)</pre> + <pre class="language-r"> xlim = xlim, ylim = ylim_row,</pre> </td> </tr> <tr class="covered"> - <td class="num">875</td> - <td class="coverage">8167<em>x</em></td> + <td class="num">231</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> bparms.fixed = c(state.ini.fixed, parms.fixed)</pre> + <pre class="language-r"> xlab = xlab, ylab = ylab, frame = frame, ...)</pre> </td> </tr> - <tr class="covered"> - <td class="num">876</td> - <td class="coverage">8167<em>x</em></td> + <tr class="never"> + <td class="num">232</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> bparms.all = c(bparms.optim, parms.fixed)</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">877</td> + <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">878</td> - <td class="coverage">8167<em>x</em></td> + <tr class="never"> + <td class="num">234</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> fit$hessian_notrans <- try(numDeriv::hessian(cost_function, c(bparms.optim, errparms),</pre> + <pre class="language-r"> # Plot the data</pre> </td> </tr> <tr class="covered"> - <td class="num">879</td> - <td class="coverage">8167<em>x</em></td> + <td class="num">235</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> OLS = FALSE, trans = FALSE, update_data = FALSE), silent = TRUE)</pre> + <pre class="language-r"> for (obs_var in row_obs_vars) {</pre> </td> </tr> <tr class="covered"> - <td class="num">880</td> - <td class="coverage">8167<em>x</em></td> + <td class="num">236</td> + <td class="coverage">1708<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (inherits(fit$hessian_notrans, "try-error")) {</pre> + <pre class="language-r"> points(subset(fit$data, variable == obs_var, c(time, observed)),</pre> </td> </tr> - <tr class="missed"> - <td class="num">881</td> - <td class="coverage">!</td> + <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"> fit$hessian_notrans <- matrix(NA, nrow = dim_hessian, ncol = dim_hessian)</pre> + <pre class="language-r"> pch = pch_obs[obs_var], col = col_obs[obs_var])</pre> </td> </tr> <tr class="never"> - <td class="num">882</td> + <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">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="num">239</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> })</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">886</td> + <td class="num">240</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> # Plot the model output</pre> </td> </tr> <tr class="covered"> - <td class="num">887</td> - <td class="coverage">8167<em>x</em></td> + <td class="num">241</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fit$call <- call</pre> + <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">888</td> + <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">889</td> - <td class="coverage">8167<em>x</em></td> + <td class="num">243</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fit$error_model_algorithm <- error_model_algorithm</pre> + <pre class="language-r"> if (legend == TRUE) {</pre> </td> </tr> <tr class="never"> - <td class="num">890</td> + <td class="num">244</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> # Get full names from model definition if they are available</pre> </td> </tr> <tr class="covered"> - <td class="num">891</td> - <td class="coverage">8167<em>x</em></td> + <td class="num">245</td> + <td class="coverage">695<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (fit$convergence != 0) {</pre> + <pre class="language-r"> legend_names = lapply(row_obs_vars, function(x) {</pre> </td> </tr> <tr class="covered"> - <td class="num">892</td> - <td class="coverage">108<em>x</em></td> + <td class="num">246</td> + <td class="coverage">900<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> convergence_warning = paste0("Optimisation did not converge:\n", fit$message)</pre> + <pre class="language-r"> if (!is.null(fit$mkinmod$spec[[x]]$full_name))</pre> </td> </tr> <tr class="covered"> - <td class="num">893</td> - <td class="coverage">108<em>x</em></td> + <td class="num">247</td> + <td class="coverage">410<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> summary_warnings <- c(summary_warnings, C = convergence_warning)</pre> + <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">894</td> - <td class="coverage">108<em>x</em></td> + <td class="num">249</td> + <td class="coverage">490<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> warning(convergence_warning)</pre> + <pre class="language-r"> else x</pre> </td> </tr> <tr class="never"> - <td class="num">895</td> + <td class="num">250</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r"> })</pre> </td> </tr> <tr class="covered"> - <td class="num">896</td> - <td class="coverage">104<em>x</em></td> + <td class="num">251</td> + <td class="coverage">695<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if(!quiet) message("Optimisation successfully terminated.\n")</pre> + <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">897</td> + <td class="num">253</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">898</td> + <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">899</td> + <td class="num">255</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> + <pre class="language-r"> # Show chi2 error value if requested</pre> </td> </tr> <tr class="covered"> - <td class="num">900</td> - <td class="coverage">8167<em>x</em></td> + <td class="num">256</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fit$solution_type <- solution_type</pre> + <pre class="language-r"> if (show_errmin) {</pre> </td> </tr> <tr class="covered"> - <td class="num">901</td> - <td class="coverage">8167<em>x</em></td> + <td class="num">257</td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fit$transform_rates <- transform_rates</pre> + <pre class="language-r"> if (length(row_obs_vars) == 1) {</pre> </td> </tr> <tr class="covered"> - <td class="num">902</td> - <td class="coverage">8167<em>x</em></td> + <td class="num">258</td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fit$transform_fractions <- transform_fractions</pre> + <pre class="language-r"> errmin_var = row_obs_vars</pre> </td> </tr> - <tr class="covered"> - <td class="num">903</td> - <td class="coverage">8167<em>x</em></td> + <tr class="never"> + <td class="num">259</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> fit$reweight.tol <- reweight.tol</pre> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="covered"> - <td class="num">904</td> - <td class="coverage">8167<em>x</em></td> + <tr class="missed"> + <td class="num">260</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> fit$reweight.max.iter <- reweight.max.iter</pre> + <pre class="language-r"> errmin_var = "All data"</pre> </td> </tr> - <tr class="covered"> - <td class="num">905</td> - <td class="coverage">8167<em>x</em></td> + <tr class="missed"> + <td class="num">261</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> fit$control <- control</pre> + <pre class="language-r"> if (length(row_obs_vars) != length(fit$mkinmod$map)) {</pre> </td> </tr> - <tr class="covered"> - <td class="num">906</td> - <td class="coverage">8167<em>x</em></td> + <tr class="missed"> + <td class="num">262</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> fit$calls <- calls</pre> + <pre class="language-r"> warning("Showing chi2 error level for all data, but only ",</pre> </td> </tr> - <tr class="covered"> - <td class="num">907</td> - <td class="coverage">8167<em>x</em></td> + <tr class="missed"> + <td class="num">263</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> fit$time <- fit_time</pre> + <pre class="language-r"> row_obs_vars, " were selected for plotting")</pre> </td> </tr> <tr class="never"> - <td class="num">908</td> + <td class="num">264</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">909</td> + <td class="num">265</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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">910</td> + <td class="num">266</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # but without symbols because they could become invalid</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">911</td> - <td class="coverage">8167<em>x</em></td> + <td class="num">267</td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fit$symbols <- NULL</pre> + <pre class="language-r"> chi2 <- signif(100 * mkinerrmin(fit)[errmin_var, "err.min"], errmin_digits)</pre> </td> </tr> - <tr class="covered"> - <td class="num">912</td> - <td class="coverage">8167<em>x</em></td> + <tr class="never"> + <td class="num">268</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> fit$mkinmod <- mkinmod</pre> + <pre class="language-r"> # Use LateX if the current plotting device is tikz</pre> </td> </tr> <tr class="covered"> - <td class="num">913</td> - <td class="coverage">8167<em>x</em></td> + <td class="num">269</td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fit$mkinmod$name <- mkinmod_name</pre> + <pre class="language-r"> if (names(dev.cur()) == "tikz output") {</pre> </td> </tr> - <tr class="covered"> - <td class="num">914</td> - <td class="coverage">8167<em>x</em></td> + <tr class="missed"> + <td class="num">270</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> fit$obs_vars <- obs_vars</pre> + <pre class="language-r"> chi2_text <- paste0("$\\chi^2$ error level = ", chi2, "\\%")</pre> </td> </tr> <tr class="never"> - <td class="num">915</td> + <td class="num">271</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="never"> - <td class="num">916</td> - <td class="coverage"></td> + <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"> # Residual sum of squares as a function of the fitted parameters</pre> + <pre class="language-r"> chi2_perc <- paste0(chi2, "%")</pre> </td> </tr> <tr class="covered"> - <td class="num">917</td> - <td class="coverage">8167<em>x</em></td> + <td class="num">273</td> + <td class="coverage">70<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> + <pre class="language-r"> chi2_text <- bquote(chi^2 ~ "error level" == .(chi2_perc))</pre> </td> </tr> <tr class="never"> - <td class="num">918</td> + <td class="num">274</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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">919</td> + <td class="num">276</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # Log-likelihood with possibility to fix degparms or errparms</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> - <td class="num">920</td> - <td class="coverage">8167<em>x</em></td> + <tr class="never"> + <td class="num">277</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> fit$ll <- function(P, fixed_degparms = FALSE, fixed_errparms = FALSE, trans = FALSE) {</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">921</td> - <td class="coverage">547080<em>x</em></td> + <td class="num">278</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> - cost_function(P, trans = trans, fixed_degparms = fixed_degparms,</pre> + <pre class="language-r"> if (do_layout & !row_layout) {</pre> </td> </tr> <tr class="covered"> - <td class="num">922</td> - <td class="coverage">547080<em>x</em></td> + <td class="num">279</td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fixed_errparms = fixed_errparms, OLS = FALSE, update_data = FALSE)</pre> + <pre class="language-r"> par(mar = c(5, 4, 0, 2) + 0.1)</pre> </td> </tr> <tr class="never"> - <td class="num">923</td> + <td class="num">280</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">924</td> + <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">925</td> + <td class="num">282</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # Collect initial parameter values in three dataframes</pre> + <pre class="language-r"> # Show residuals if requested</pre> </td> </tr> <tr class="covered"> - <td class="num">926</td> - <td class="coverage">8167<em>x</em></td> + <td class="num">283</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fit$start <- data.frame(value = c(state.ini.optim,</pre> + <pre class="language-r"> if (show_residuals) {</pre> </td> </tr> <tr class="covered"> - <td class="num">927</td> - <td class="coverage">8167<em>x</em></td> + <td class="num">284</td> + <td class="coverage">280<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> parms.optim, errparms_optim))</pre> + <pre class="language-r"> mkinresplot(fit, obs_vars = row_obs_vars, standardized = standardized,</pre> </td> </tr> <tr class="covered"> - <td class="num">928</td> - <td class="coverage">8167<em>x</em></td> + <td class="num">285</td> + <td class="coverage">280<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fit$start$type = c(rep("state", length(state.ini.optim)),</pre> + <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">929</td> - <td class="coverage">8167<em>x</em></td> + <td class="num">286</td> + <td class="coverage">280<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> rep("deparm", length(parms.optim)),</pre> + <pre class="language-r"> legend = FALSE, frame = frame, xlab = xlab, xlim = xlim, maxabs = maxabs)</pre> </td> </tr> - <tr class="covered"> - <td class="num">930</td> - <td class="coverage">8167<em>x</em></td> + <tr class="never"> + <td class="num">287</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> rep("error", length(errparms_optim)))</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">931</td> + <td class="num">288</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> + <tr class="never"> + <td class="num">289</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> lower = lower,</pre> + <pre class="language-r"> # Show error model plot if requested</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="num">290</td> + <td class="coverage">1503<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> if (show_errplot) {</pre> </td> </tr> <tr class="covered"> - <td class="num">937</td> - <td class="coverage">8167<em>x</em></td> + <td class="num">291</td> + <td class="coverage">205<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> + <pre class="language-r"> mkinerrplot(fit, obs_vars = row_obs_vars,</pre> </td> </tr> <tr class="covered"> - <td class="num">938</td> - <td class="coverage">8167<em>x</em></td> + <td class="num">292</td> + <td class="coverage">205<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fit$fixed$type = c(rep("state", length(state.ini.fixed)),</pre> + <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">939</td> - <td class="coverage">8167<em>x</em></td> + <td class="num">293</td> + <td class="coverage">205<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> rep("deparm", length(parms.fixed)))</pre> + <pre class="language-r"> legend = FALSE, frame = frame)</pre> </td> </tr> <tr class="never"> - <td class="num">940</td> + <td class="num">294</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> - <td class="num">941</td> - <td class="coverage">8167<em>x</em></td> + <tr class="never"> + <td class="num">295</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> fit$data <- data.frame(time = current_data$time,</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> - <td class="num">942</td> - <td class="coverage">8167<em>x</em></td> + <tr class="never"> + <td class="num">296</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> variable = current_data$name,</pre> + <pre class="language-r">}</pre> </td> </tr> - <tr class="covered"> - <td class="num">943</td> - <td class="coverage">8167<em>x</em></td> + <tr class="never"> + <td class="num">297</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> observed = current_data$value,</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> - <td class="num">944</td> - <td class="coverage">8167<em>x</em></td> + <tr class="never"> + <td class="num">298</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> predicted = current_data$predicted)</pre> + <pre class="language-r">#' @rdname plot.mkinfit</pre> </td> </tr> <tr class="never"> - <td class="num">945</td> + <td class="num">299</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' @export</pre> </td> </tr> - <tr class="covered"> - <td class="num">946</td> - <td class="coverage">8167<em>x</em></td> + <tr class="never"> + <td class="num">300</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> fit$data$residual <- fit$data$observed - fit$data$predicted</pre> + <pre class="language-r">plot_sep <- function(fit, show_errmin = TRUE,</pre> </td> </tr> <tr class="never"> - <td class="num">947</td> + <td class="num">301</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> show_residuals = ifelse(identical(fit$err_mod, "const"), TRUE, "standardized"), ...) {</pre> </td> </tr> <tr class="covered"> - <td class="num">948</td> - <td class="coverage">8167<em>x</em></td> + <td class="num">302</td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fit$atol <- atol</pre> + <pre class="language-r"> plot.mkinfit(fit, sep_obs = TRUE, show_residuals = show_residuals,</pre> </td> </tr> <tr class="covered"> - <td class="num">949</td> - <td class="coverage">8167<em>x</em></td> + <td class="num">303</td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fit$rtol <- rtol</pre> + <pre class="language-r"> show_errmin = show_errmin, ...)</pre> </td> </tr> - <tr class="covered"> - <td class="num">950</td> - <td class="coverage">8167<em>x</em></td> + <tr class="never"> + <td class="num">304</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> fit$err_mod <- err_mod</pre> + <pre class="language-r">}</pre> </td> </tr> <tr class="never"> - <td class="num">951</td> + <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">952</td> + <td class="num">306</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> + <pre class="language-r">#' @rdname plot.mkinfit</pre> </td> </tr> - <tr class="covered"> - <td class="num">953</td> - <td class="coverage">8167<em>x</em></td> + <tr class="never"> + <td class="num">307</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> fit$bparms.optim <- bparms.optim</pre> + <pre class="language-r">#' @export</pre> </td> </tr> - <tr class="covered"> - <td class="num">954</td> - <td class="coverage">8167<em>x</em></td> + <tr class="never"> + <td class="num">308</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> fit$bparms.fixed <- bparms.fixed</pre> + <pre class="language-r">plot_res <- function(fit, sep_obs = FALSE, show_errmin = sep_obs,</pre> </td> </tr> <tr class="never"> - <td class="num">955</td> + <td class="num">309</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> standardized = ifelse(identical(fit$err_mod, "const"), FALSE, TRUE), ...)</pre> </td> </tr> <tr class="never"> - <td class="num">956</td> + <td class="num">310</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # Return ode and state parameters for further fitting</pre> + <pre class="language-r">{</pre> </td> </tr> <tr class="covered"> - <td class="num">957</td> - <td class="coverage">8167<em>x</em></td> + <td class="num">311</td> + <td class="coverage">140<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fit$bparms.ode <- bparms.all[mkinmod$parms]</pre> + <pre class="language-r"> plot.mkinfit(fit, sep_obs = sep_obs, show_errmin = show_errmin,</pre> </td> </tr> <tr class="covered"> - <td class="num">958</td> - <td class="coverage">8167<em>x</em></td> + <td class="num">312</td> + <td class="coverage">140<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> + <pre class="language-r"> show_residuals = ifelse(standardized, "standardized", TRUE),</pre> </td> </tr> <tr class="covered"> - <td class="num">959</td> - <td class="coverage">8167<em>x</em></td> + <td class="num">313</td> + <td class="coverage">140<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> state.ini.fixed)</pre> + <pre class="language-r"> row_layout = TRUE, ...)</pre> </td> </tr> - <tr class="covered"> - <td class="num">960</td> - <td class="coverage">8167<em>x</em></td> + <tr class="never"> + <td class="num">314</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> names(fit$bparms.state) <- gsub("_0$", "", names(fit$bparms.state))</pre> + <pre class="language-r">}</pre> </td> </tr> <tr class="never"> - <td class="num">961</td> + <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">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> + <tr class="never"> + <td class="num">316</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> fit$df.residual <- n_observed - length(c(degparms, errparms))</pre> + <pre class="language-r">#' @rdname plot.mkinfit</pre> </td> </tr> <tr class="never"> - <td class="num">964</td> + <td class="num">317</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' @export</pre> </td> </tr> <tr class="never"> - <td class="num">965</td> + <td class="num">318</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> + <pre class="language-r">plot_err <- function(fit, sep_obs = FALSE, show_errmin = sep_obs, ...) {</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="num">319</td> + <td class="coverage">205<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> plot.mkinfit(fit, sep_obs = sep_obs, show_errmin = show_errmin,</pre> </td> </tr> <tr class="covered"> - <td class="num">968</td> - <td class="coverage">8167<em>x</em></td> + <td class="num">320</td> + <td class="coverage">205<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (test_residuals) {</pre> + <pre class="language-r"> show_errplot = TRUE, row_layout = TRUE, ...)</pre> </td> </tr> <tr class="never"> - <td class="num">969</td> + <td class="num">321</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> + <pre class="language-r">}</pre> </td> </tr> - <tr class="covered"> - <td class="num">971</td> - <td class="coverage">153<em>x</em></td> + <tr class="never"> + <td class="num">322</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (fit$shapiro.p < 0.05) {</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> - <td class="num">972</td> - <td class="coverage">153<em>x</em></td> + <tr class="never"> + <td class="num">323</td> + <td class="coverage"></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> + <pre class="language-r">#' Plot the observed data and the fitted model of an mkinfit object</pre> </td> </tr> - <tr class="covered"> - <td class="num">973</td> - <td class="coverage">153<em>x</em></td> + <tr class="never"> + <td class="num">324</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> warning(shapiro_warning)</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> - <td class="num">974</td> - <td class="coverage">153<em>x</em></td> + <tr class="never"> + <td class="num">325</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> summary_warnings <- c(summary_warnings, S = shapiro_warning)</pre> + <pre class="language-r">#' Deprecated function. It now only calls the plot method</pre> </td> </tr> <tr class="never"> - <td class="num">975</td> + <td class="num">326</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">#' \code{\link{plot.mkinfit}}.</pre> </td> </tr> <tr class="never"> - <td class="num">976</td> + <td class="num">327</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">#'</pre> </td> </tr> <tr class="never"> - <td class="num">977</td> + <td class="num">328</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' @param fit an object of class \code{\link{mkinfit}}.</pre> </td> </tr> - <tr class="covered"> - <td class="num">978</td> - <td class="coverage">8167<em>x</em></td> + <tr class="never"> + <td class="num">329</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> fit$summary_warnings <- summary_warnings</pre> + <pre class="language-r">#' @param \dots further arguments passed to \code{\link{plot.mkinfit}}.</pre> </td> </tr> <tr class="never"> - <td class="num">979</td> + <td class="num">330</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' @return The function is called for its side effect.</pre> </td> </tr> - <tr class="covered"> - <td class="num">980</td> - <td class="coverage">8167<em>x</em></td> + <tr class="never"> + <td class="num">331</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> fit$date <- date()</pre> + <pre class="language-r">#' @author Johannes Ranke</pre> </td> </tr> - <tr class="covered"> - <td class="num">981</td> - <td class="coverage">8167<em>x</em></td> + <tr class="never"> + <td class="num">332</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> fit$version <- as.character(utils::packageVersion("mkin"))</pre> + <pre class="language-r">#' @export</pre> </td> </tr> - <tr class="covered"> - <td class="num">982</td> - <td class="coverage">8167<em>x</em></td> + <tr class="never"> + <td class="num">333</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> fit$Rversion <- paste(R.version$major, R.version$minor, sep=".")</pre> + <pre class="language-r">mkinplot <- function(fit, ...)</pre> </td> </tr> <tr class="never"> - <td class="num">983</td> + <td class="num">334</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">{</pre> </td> </tr> - <tr class="covered"> - <td class="num">984</td> - <td class="coverage">8167<em>x</em></td> + <tr class="missed"> + <td class="num">335</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> return(fit)</pre> + <pre class="language-r"> plot(fit, ...)</pre> </td> </tr> <tr class="never"> - <td class="num">985</td> + <td class="num">336</td> <td class="coverage"></td> <td class="col-sm-12"> <pre class="language-r">}</pre> @@ -31690,553 +27171,553 @@ table.table-condensed { </tbody> </table> </div> - <div id="R/plot.mkinfit.R" class="hidden"> + <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">utils::globalVariables(c("type", "variable", "observed"))</pre> + <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> + <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> + <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">#'</pre> + <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">#' Solves the differential equations with the optimised and fixed parameters</pre> + <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">#' from a previous successful call to \code{\link{mkinfit}} and plots the</pre> + <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">#' observed data together with the solution of the fitted model.</pre> + <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">#'</pre> + <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">#' If the current plot device is a \code{\link[tikzDevice]{tikz}} device, then</pre> + <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">#' latex is being used for the formatting of the chi2 error level, if</pre> + <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">#' \code{show_errmin = TRUE}.</pre> + <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">#'</pre> + <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">#' @aliases plot.mkinfit plot_sep plot_res plot_err</pre> + <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">#' @param x Alias for fit introduced for compatibility with the generic S3</pre> + <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">#' method.</pre> + <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">#' @param fit An object of class \code{\link{mkinfit}}.</pre> + <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">#' @param obs_vars A character vector of names of the observed variables for</pre> + <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">#' which the data and the model should be plotted. Defauls to all observed</pre> + <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">#' variables in the model.</pre> + <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">#' @param xlab Label for the x axis.</pre> + <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">#' @param ylab Label for the y axis.</pre> + <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">#' @param xlim Plot range in x direction.</pre> + <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">#' @param ylim Plot range in y direction. If given as a list, plot ranges</pre> + <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">#' for the different plot rows can be given for row layout.</pre> + <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">#' @param col_obs Colors used for plotting the observed data and the</pre> + <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">#' corresponding model prediction lines.</pre> + <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">#' @param pch_obs Symbols to be used for plotting the data.</pre> + <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">#' @param lty_obs Line types to be used for the model predictions.</pre> + <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">#' @param add Should the plot be added to an existing plot?</pre> + <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">#' @param legend Should a legend be added to the plot?</pre> + <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">#' @param show_residuals Should residuals be shown? If only one plot of the</pre> + <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">#' fits is shown, the residual plot is in the lower third of the plot.</pre> + <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">#' Otherwise, i.e. if "sep_obs" is given, the residual plots will be located</pre> + <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">#' to the right of the plots of the fitted curves. If this is set to</pre> + <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">#' 'standardized', a plot of the residuals divided by the standard deviation</pre> + <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">#' given by the fitted error model will be shown.</pre> + <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">#' @param standardized When calling 'plot_res', should the residuals be</pre> + <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">#' standardized in the residual plot?</pre> + <pre class="language-r">nafta <- function(ds, title = NA, quiet = FALSE, ...) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">39</td> - <td class="coverage"></td> + <td class="coverage">264<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @param show_errplot Should squared residuals and the error model be shown?</pre> + <pre class="language-r"> if (length(levels(ds$name)) > 1) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">40</td> - <td class="coverage"></td> + <td class="coverage">88<em>x</em></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> + <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">#' the plot. Otherwise, i.e. if "sep_obs" is given, the residual plots will</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">42</td> - <td class="coverage"></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' be located to the right of the plots of the fitted curves.</pre> + <pre class="language-r"> n <- nrow(subset(ds, !is.na(value)))</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">43</td> - <td class="coverage"></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @param maxabs Maximum absolute value of the residuals. This is used for the</pre> + <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">#' scaling of the y axis and defaults to "auto".</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">45</td> - <td class="coverage"></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @param sep_obs Should the observed variables be shown in separate subplots?</pre> + <pre class="language-r"> result <- list(title = title, data = ds)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">46</td> - <td class="coverage"></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' If yes, residual plots requested by "show_residuals" will be shown next</pre> + <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">#' to, not below the plot of the fits.</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">48</td> - <td class="coverage"></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @param rel.height.middle The relative height of the middle plot, if more</pre> + <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">#' than two rows of plots are shown.</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">50</td> - <td class="coverage"></td> + <td class="coverage">176<em>x</em></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> + <pre class="language-r"> result$distimes <- matrix(NA, nrow = 3, ncol = 3,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">51</td> - <td class="coverage"></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' error model plot is shown to the right?</pre> + <pre class="language-r"> dimnames = list(models, c("DT50", "DT90", "DT50_rep")))</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">52</td> - <td class="coverage"></td> + <td class="coverage">176<em>x</em></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> + <pre class="language-r"> result$distimes["SFO", ] <- distimes[[1]][c(1, 2, 1)]</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">53</td> - <td class="coverage"></td> + <td class="coverage">176<em>x</em></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> + <pre class="language-r"> result$distimes["IORE", ] <- distimes[[2]][c(1, 2, 3)]</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">54</td> - <td class="coverage"></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' as the obs_var argument.</pre> + <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">#' @param inset Passed to \code{\link{legend}} if applicable.</pre> + <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">#' @param show_errmin Should the FOCUS chi2 error value be shown in the upper</pre> + <pre class="language-r"> # Get parameters with statistics</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">57</td> - <td class="coverage"></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' margin of the plot?</pre> + <pre class="language-r"> result$parameters <- lapply(result$mmkin, function(x) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">58</td> - <td class="coverage"></td> + <td class="coverage">528<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @param errmin_digits The number of significant digits for rounding the FOCUS</pre> + <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">#' chi2 error percentage.</pre> + <pre class="language-r"> })</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">60</td> - <td class="coverage"></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @param frame Should a frame be drawn around the plots?</pre> + <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">#' @param \dots Further arguments passed to \code{\link{plot}}.</pre> + <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">#' @import graphics</pre> + <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">#' @importFrom grDevices dev.cur</pre> + <pre class="language-r"> # confidence region of the SSR for the IORE model</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">64</td> - <td class="coverage"></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @return The function is called for its side effect.</pre> + <pre class="language-r"> result$S <- sapply(result$mmkin, function(x) sum(x$data$residual^2))</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">65</td> - <td class="coverage"></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @author Johannes Ranke</pre> + <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">#' @examples</pre> + <pre class="language-r"> # Equation (3) on p. 3</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">67</td> - <td class="coverage"></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> p <- 3</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">68</td> - <td class="coverage"></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' # One parent compound, one metabolite, both single first order, path from</pre> + <pre class="language-r"> result$S["IORE"]</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">69</td> - <td class="coverage"></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' # parent to sink included</pre> + <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">#' \dontrun{</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">71</td> - <td class="coverage"></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' SFO_SFO <- mkinmod(parent = mkinsub("SFO", "m1", full = "Parent"),</pre> + <pre class="language-r"> result$t_rep <- .evaluate_nafta_results(result$S, result$S_c,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">72</td> - <td class="coverage"></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' m1 = mkinsub("SFO", full = "Metabolite M1" ))</pre> + <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">#' fit <- mkinfit(SFO_SFO, FOCUS_2006_D, quiet = TRUE)</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">74</td> - <td class="coverage"></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' fit <- mkinfit(SFO_SFO, FOCUS_2006_D, quiet = TRUE, error_model = "tc")</pre> + <pre class="language-r"> class(result) <- "nafta"</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">75</td> - <td class="coverage"></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' plot(fit)</pre> + <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">#' plot_res(fit)</pre> + <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">#' plot_res(fit, standardized = FALSE)</pre> + <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_err(fit)</pre> + <pre class="language-r">#' Plot the results of the three models used in the NAFTA scheme.</pre> </td> </tr> <tr class="never"> @@ -32250,301 +27731,301 @@ table.table-condensed { <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> + <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">#' plot(fit, sep_obs = TRUE, show_residuals = TRUE, lpos = c("topright", "bottomright"),</pre> + <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">#' show_errmin = TRUE)</pre> + <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> + <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">#' # The same can be obtained with less typing, using the convenience function plot_sep</pre> + <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">#' plot_sep(fit, lpos = c("topright", "bottomright"))</pre> + <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">#'</pre> + <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">#' # Show the observed variables separately, with the error model</pre> + <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">#' plot(fit, sep_obs = TRUE, show_errplot = TRUE, lpos = c("topright", "bottomright"),</pre> + <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">#' show_errmin = TRUE)</pre> + <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">#' }</pre> + <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">#'</pre> + <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">#' @export</pre> + <pre class="language-r">plot.nafta <- function(x, legend = FALSE, main = "auto", ...) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">93</td> - <td class="coverage"></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">plot.mkinfit <- function(x, fit = x,</pre> + <pre class="language-r"> if (main == "auto") {</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">94</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> obs_vars = names(fit$mkinmod$map),</pre> + <pre class="language-r"> if (is.na(x$title)) main = ""</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">95</td> - <td class="coverage"></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> xlab = "Time", ylab = "Residue",</pre> + <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"> xlim = range(fit$data$time),</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">97</td> - <td class="coverage"></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ylim = "default",</pre> + <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"> col_obs = 1:length(obs_vars),</pre> + <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"> pch_obs = col_obs,</pre> + <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"> lty_obs = rep(1, length(obs_vars)),</pre> + <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"> add = FALSE, legend = !add,</pre> + <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"> show_residuals = FALSE,</pre> + <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"> show_errplot = FALSE,</pre> + <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"> maxabs = "auto",</pre> + <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"> sep_obs = FALSE, rel.height.middle = 0.9,</pre> + <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"> row_layout = FALSE,</pre> + <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"> lpos = "topright", inset = c(0.05, 0.05),</pre> + <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"> show_errmin = FALSE, errmin_digits = 3,</pre> + <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"> frame = TRUE, ...)</pre> + <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">{</pre> + <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">1503<em>x</em></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (identical(show_residuals, "standardized")) {</pre> + <pre class="language-r"> cat("Sums of squares:\n")</pre> </td> </tr> - <tr class="missed"> + <tr class="covered"> <td class="num">112</td> - <td class="coverage">!</td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> show_residuals <- TRUE</pre> + <pre class="language-r"> print(x$S)</pre> </td> </tr> - <tr class="missed"> + <tr class="covered"> <td class="num">113</td> - <td class="coverage">!</td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> standardized <- TRUE</pre> + <pre class="language-r"> cat("\nCritical sum of squares for checking the SFO model:\n")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">114</td> - <td class="coverage"></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r"> print(x$S_c)</pre> </td> </tr> <tr class="covered"> <td class="num">115</td> - <td class="coverage">1503<em>x</em></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> standardized <- FALSE</pre> + <pre class="language-r"> cat("\nParameters:\n")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">116</td> - <td class="coverage"></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> print(x$parameters, digits = digits)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">117</td> - <td class="coverage"></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> t_rep <- .evaluate_nafta_results(x$S, x$S_c, x$distimes, quiet = quiet)</pre> </td> </tr> - <tr class="missed"> + <tr class="covered"> <td class="num">118</td> - <td class="coverage">!</td> + <td class="coverage">176<em>x</em></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> + <pre class="language-r"> cat("\nDTx values:\n")</pre> </td> </tr> - <tr class="missed"> + <tr class="covered"> <td class="num">119</td> - <td class="coverage">!</td> + <td class="coverage">176<em>x</em></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> + <pre class="language-r"> print(signif(x$distimes, digits = digits))</pre> </td> </tr> - <tr class="missed"> + <tr class="covered"> <td class="num">120</td> - <td class="coverage">!</td> + <td class="coverage">176<em>x</em></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> + <pre class="language-r"> cat("\nRepresentative half-life:\n")</pre> </td> </tr> - <tr class="missed"> + <tr class="covered"> <td class="num">121</td> - <td class="coverage">!</td> + <td class="coverage">176<em>x</em></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> + <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> + <pre class="language-r">}</pre> </td> </tr> <tr class="never"> @@ -32554,1492 +28035,2254 @@ table.table-condensed { <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">124</td> - <td class="coverage">1503<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> solution_type = fit$solution_type</pre> + <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">1503<em>x</em></td> + <td class="coverage">352<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> parms.all <- c(fit$bparms.optim, fit$bparms.fixed)</pre> + <pre class="language-r"> t_SFO <- distimes["IORE", "DT50"]</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">126</td> - <td class="coverage"></td> + <td class="coverage">352<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> t_IORE <- distimes["IORE", "DT50_rep"]</pre> </td> </tr> <tr class="covered"> <td class="num">127</td> - <td class="coverage">1503<em>x</em></td> + <td class="coverage">352<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ininames <- c(</pre> + <pre class="language-r"> t_DFOP2 <- distimes["DFOP", "DT50_rep"]</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">128</td> - <td class="coverage">1503<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> rownames(subset(fit$start, type == "state")),</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">129</td> - <td class="coverage">1503<em>x</em></td> + <td class="coverage">352<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> rownames(subset(fit$fixed, type == "state")))</pre> + <pre class="language-r"> if (S["SFO"] < S_c) {</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">130</td> - <td class="coverage">1503<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> odeini <- parms.all[ininames]</pre> + <pre class="language-r"> if (!quiet) {</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">131</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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"> # Order initial state variables</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">133</td> - <td class="coverage">1503<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> names(odeini) <- sub("_0", "", names(odeini))</pre> + <pre class="language-r"> t_rep <- t_SFO</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">134</td> - <td class="coverage">1503<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> odeini <- odeini[names(fit$mkinmod$diffs)]</pre> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">135</td> - <td class="coverage"></td> + <td class="coverage">352<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> if (!quiet) {</pre> </td> </tr> <tr class="covered"> <td class="num">136</td> - <td class="coverage">1503<em>x</em></td> + <td class="coverage">88<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> outtimes <- seq(xlim[1], xlim[2], length.out=100)</pre> + <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> + <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="coverage">352<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> odenames <- c(</pre> + <pre class="language-r"> if (t_IORE < t_DFOP2) {</pre> </td> </tr> <tr class="covered"> <td class="num">139</td> - <td class="coverage">1503<em>x</em></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> rownames(subset(fit$start, type == "deparm")),</pre> + <pre class="language-r"> if (!quiet) {</pre> </td> </tr> <tr class="covered"> <td class="num">140</td> - <td class="coverage">1503<em>x</em></td> + <td class="coverage">88<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> rownames(subset(fit$fixed, type == "deparm")))</pre> + <pre class="language-r"> message("The half-life obtained from the IORE model may be used")</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">141</td> - <td class="coverage">1503<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> odeparms <- parms.all[odenames]</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">142</td> - <td class="coverage"></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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"></pre> + <pre class="language-r"> } else {</pre> </td> </tr> <tr class="covered"> <td class="num">144</td> - <td class="coverage">1503<em>x</em></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (solution_type == "deSolve" & !is.null(fit$mkinmod$cf)) {</pre> + <pre class="language-r"> if (!quiet) {</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">145</td> - <td class="coverage">140<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> fit$mkinmod[["symbols"]] <- deSolve::checkDLL(dllname = fit$mkinmod$dll_info[["name"]],</pre> + <pre class="language-r"> message("The representative half-life of the IORE model is longer than the one corresponding")</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">146</td> - <td class="coverage">140<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> func = "diffs", initfunc = "initpar",</pre> + <pre class="language-r"> message("to the terminal degradation rate found with the DFOP model.")</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">147</td> - <td class="coverage">140<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> jacfunc = NULL, nout = 0, outnames = NULL)</pre> + <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> + <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="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> out <- mkinpredict(fit$mkinmod, odeparms, odeini, outtimes,</pre> + <pre class="language-r"> t_rep <- t_DFOP2</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">150</td> - <td class="coverage">1503<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> solution_type = solution_type, atol = fit$atol, rtol = fit$rtol)</pre> + <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> + <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="coverage">352<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> out <- as.data.frame(out)</pre> + <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> + <pre class="language-r">}</pre> </td> </tr> - <tr class="covered"> - <td class="num">154</td> - <td class="coverage">1503<em>x</em></td> + </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"> names(col_obs) <- names(pch_obs) <- names(lty_obs) <- obs_vars</pre> + <pre class="language-r">#' Summary method for class "mkinfit"</pre> </td> </tr> <tr class="never"> - <td class="num">155</td> + <td class="num">2</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#'</pre> </td> </tr> <tr class="never"> - <td class="num">156</td> + <td class="num">3</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> + <pre class="language-r">#' Lists model equations, initial parameter values, optimised parameters with</pre> </td> </tr> <tr class="never"> - <td class="num">157</td> + <td class="num">4</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> + <pre class="language-r">#' some uncertainty statistics, the chi2 error levels calculated according to</pre> </td> </tr> - <tr class="covered"> - <td class="num">158</td> - <td class="coverage">1503<em>x</em></td> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> do_layout = FALSE</pre> + <pre class="language-r">#' FOCUS guidance (2006) as defined therein, formation fractions, DT50 values</pre> </td> </tr> - <tr class="covered"> - <td class="num">159</td> - <td class="coverage">485<em>x</em></td> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (show_residuals | sep_obs | show_errplot) do_layout = TRUE</pre> + <pre class="language-r">#' and optionally the data, consisting of observed, predicted and residual</pre> </td> </tr> - <tr class="covered"> - <td class="num">160</td> - <td class="coverage">1503<em>x</em></td> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> n_plot_rows = if (sep_obs) length(obs_vars) else 1</pre> + <pre class="language-r">#' values.</pre> </td> </tr> <tr class="never"> - <td class="num">161</td> + <td class="num">8</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> - <td class="num">162</td> - <td class="coverage">1503<em>x</em></td> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (do_layout) {</pre> + <pre class="language-r">#' @param object an object of class [mkinfit].</pre> </td> </tr> <tr class="never"> - <td class="num">163</td> + <td class="num">10</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # Layout should be restored afterwards</pre> + <pre class="language-r">#' @param x an object of class \code{summary.mkinfit}.</pre> </td> </tr> - <tr class="covered"> - <td class="num">164</td> - <td class="coverage">485<em>x</em></td> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> oldpar <- par(no.readonly = TRUE)</pre> + <pre class="language-r">#' @param data logical, indicating whether the data should be included in the</pre> </td> </tr> - <tr class="covered"> - <td class="num">165</td> - <td class="coverage">485<em>x</em></td> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> on.exit(par(oldpar, no.readonly = TRUE))</pre> + <pre class="language-r">#' summary.</pre> </td> </tr> <tr class="never"> - <td class="num">166</td> + <td class="num">13</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' @param distimes logical, indicating whether DT50 and DT90 values should be</pre> </td> </tr> <tr class="never"> - <td class="num">167</td> + <td class="num">14</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> + <pre class="language-r">#' included.</pre> </td> </tr> - <tr class="covered"> - <td class="num">168</td> - <td class="coverage">485<em>x</em></td> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (sep_obs | row_layout) {</pre> + <pre class="language-r">#' @param alpha error level for confidence interval estimation from t</pre> </td> </tr> - <tr class="covered"> - <td class="num">169</td> - <td class="coverage">415<em>x</em></td> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> row_layout <- TRUE</pre> + <pre class="language-r">#' distribution</pre> </td> </tr> - <tr class="covered"> - <td class="num">170</td> - <td class="coverage">415<em>x</em></td> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> n_plot_cols = if (show_residuals | show_errplot) 2 else 1</pre> + <pre class="language-r">#' @param digits Number of digits to use for printing</pre> </td> </tr> - <tr class="covered"> - <td class="num">171</td> - <td class="coverage">415<em>x</em></td> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> n_plots = n_plot_rows * n_plot_cols</pre> + <pre class="language-r">#' @param \dots optional arguments passed to methods like \code{print}.</pre> </td> </tr> <tr class="never"> - <td class="num">172</td> + <td class="num">19</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' @importFrom stats qt pt cov2cor</pre> </td> </tr> <tr class="never"> - <td class="num">173</td> + <td class="num">20</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> + <pre class="language-r">#' @return The summary function returns a list with components, among others</pre> </td> </tr> <tr class="never"> - <td class="num">174</td> + <td class="num">21</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> + <pre class="language-r">#' \item{version, Rversion}{The mkin and R versions used}</pre> </td> </tr> - <tr class="covered"> - <td class="num">175</td> - <td class="coverage">415<em>x</em></td> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></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> + <pre class="language-r">#' \item{date.fit, date.summary}{The dates where the fit and the summary were</pre> </td> </tr> - <tr class="covered"> - <td class="num">176</td> - <td class="coverage">415<em>x</em></td> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> else rep(1, n_plot_rows)</pre> + <pre class="language-r">#' produced}</pre> </td> </tr> - <tr class="covered"> - <td class="num">177</td> - <td class="coverage">415<em>x</em></td> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> layout_matrix = matrix(1:n_plots,</pre> + <pre class="language-r">#' \item{diffs}{The differential equations used in the model}</pre> </td> </tr> - <tr class="covered"> - <td class="num">178</td> - <td class="coverage">415<em>x</em></td> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> n_plot_rows, n_plot_cols, byrow = TRUE)</pre> + <pre class="language-r">#' \item{use_of_ff}{Was maximum or minimum use made of formation fractions}</pre> </td> </tr> - <tr class="covered"> - <td class="num">179</td> - <td class="coverage">415<em>x</em></td> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> layout(layout_matrix, heights = rel.heights)</pre> + <pre class="language-r">#' \item{bpar}{Optimised and backtransformed</pre> </td> </tr> <tr class="never"> - <td class="num">180</td> + <td class="num">27</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> + <pre class="language-r">#' parameters}</pre> </td> </tr> - <tr class="covered"> - <td class="num">181</td> - <td class="coverage">70<em>x</em></td> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> layout(matrix(c(1, 2), 2, 1), heights = c(2, 1.3))</pre> + <pre class="language-r">#' \item{data}{The data (see Description above).}</pre> </td> </tr> - <tr class="covered"> - <td class="num">182</td> - <td class="coverage">70<em>x</em></td> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> par(mar = c(3, 4, 4, 2) + 0.1)</pre> + <pre class="language-r">#' \item{start}{The starting values and bounds, if applicable, for optimised</pre> </td> </tr> <tr class="never"> - <td class="num">183</td> + <td class="num">30</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">#' parameters.}</pre> </td> </tr> <tr class="never"> - <td class="num">184</td> + <td class="num">31</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">#' \item{fixed}{The values of fixed parameters.}</pre> </td> </tr> <tr class="never"> - <td class="num">185</td> + <td class="num">32</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' \item{errmin }{The chi2 error levels for</pre> </td> </tr> <tr class="never"> - <td class="num">186</td> + <td class="num">33</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # Replicate legend position argument if necessary</pre> + <pre class="language-r">#' each observed variable.}</pre> </td> </tr> - <tr class="covered"> - <td class="num">187</td> - <td class="coverage">1503<em>x</em></td> + <tr class="never"> + <td class="num">34</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (length(lpos) == 1) lpos = rep(lpos, n_plot_rows)</pre> + <pre class="language-r">#' \item{bparms.ode}{All backtransformed ODE</pre> </td> </tr> <tr class="never"> - <td class="num">188</td> + <td class="num">35</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' parameters, for use as starting parameters for related models.}</pre> </td> </tr> <tr class="never"> - <td class="num">189</td> + <td class="num">36</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # Loop over plot rows</pre> + <pre class="language-r">#' \item{errparms}{Error model parameters.}</pre> </td> </tr> - <tr class="covered"> - <td class="num">190</td> - <td class="coverage">1503<em>x</em></td> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> for (plot_row in 1:n_plot_rows) {</pre> + <pre class="language-r">#' \item{ff}{The estimated formation fractions derived from the fitted</pre> </td> </tr> <tr class="never"> - <td class="num">191</td> + <td class="num">38</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' model.}</pre> </td> </tr> - <tr class="covered"> - <td class="num">192</td> - <td class="coverage">1503<em>x</em></td> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> row_obs_vars = if (sep_obs) obs_vars[plot_row] else obs_vars</pre> + <pre class="language-r">#' \item{distimes}{The DT50 and DT90 values for each observed variable.}</pre> </td> </tr> <tr class="never"> - <td class="num">193</td> + <td class="num">40</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' \item{SFORB}{If applicable, eigenvalues and fractional eigenvector component</pre> </td> </tr> <tr class="never"> - <td class="num">194</td> + <td class="num">41</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> + <pre class="language-r">#' g of SFORB systems in the model.}</pre> </td> </tr> - <tr class="covered"> - <td class="num">195</td> - <td class="coverage">1503<em>x</em></td> + <tr class="never"> + <td class="num">42</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (is.list(ylim)) {</pre> + <pre class="language-r">#' The print method is called for its side effect, i.e. printing the summary.</pre> </td> </tr> - <tr class="missed"> - <td class="num">196</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> ylim_row <- ylim[[plot_row]]</pre> + <pre class="language-r">#' @author Johannes Ranke</pre> </td> </tr> <tr class="never"> - <td class="num">197</td> + <td class="num">44</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r">#' @references FOCUS (2006) \dQuote{Guidance Document on Estimating Persistence</pre> </td> </tr> - <tr class="covered"> - <td class="num">198</td> - <td class="coverage">1503<em>x</em></td> + <tr class="never"> + <td class="num">45</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (ylim[[1]] == "default") {</pre> + <pre class="language-r">#' and Degradation Kinetics from Environmental Fate Studies on Pesticides in</pre> </td> </tr> - <tr class="covered"> - <td class="num">199</td> - <td class="coverage">1503<em>x</em></td> + <tr class="never"> + <td class="num">46</td> + <td class="coverage"></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> + <pre class="language-r">#' EU Registration} Report of the FOCUS Work Group on Degradation Kinetics,</pre> </td> </tr> - <tr class="covered"> - <td class="num">200</td> - <td class="coverage">1503<em>x</em></td> + <tr class="never"> + <td class="num">47</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> unlist(out[row_obs_vars])), na.rm = TRUE))</pre> + <pre class="language-r">#' EC Document Reference Sanco/10058/2005 version 2.0, 434 pp,</pre> </td> </tr> <tr class="never"> - <td class="num">201</td> + <td class="num">48</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r">#' \url{http://esdac.jrc.ec.europa.eu/projects/degradation-kinetics}</pre> </td> </tr> - <tr class="missed"> - <td class="num">202</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> ylim_row = ylim</pre> + <pre class="language-r">#' @examples</pre> </td> </tr> <tr class="never"> - <td class="num">203</td> + <td class="num">50</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">#'</pre> </td> </tr> <tr class="never"> - <td class="num">204</td> + <td class="num">51</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">#' summary(mkinfit("SFO", FOCUS_2006_A, quiet = TRUE))</pre> </td> </tr> <tr class="never"> - <td class="num">205</td> + <td class="num">52</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> - <td class="num">206</td> - <td class="coverage">1503<em>x</em></td> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (row_layout) {</pre> + <pre class="language-r">#' @export</pre> </td> </tr> <tr class="never"> - <td class="num">207</td> + <td class="num">54</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> + <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">208</td> + <td class="num">64</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> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">209</td> - <td class="coverage">415<em>x</em></td> + <td class="num">65</td> + <td class="coverage">52158<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (plot_row == 1 & n_plot_rows > 1) {</pre> + <pre class="language-r"> if (!is.numeric(covar) | is.na(covar[1])) {</pre> </td> </tr> <tr class="missed"> - <td class="num">210</td> + <td class="num">66</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> + <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">211</td> + <td class="num">68</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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">212</td> + <td class="num">73</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">213</td> + <td class="num">74</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # Margins for middle rows of plots, if any</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">214</td> - <td class="coverage">415<em>x</em></td> + <td class="num">75</td> + <td class="coverage">52158<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (plot_row > 1 & plot_row < n_plot_rows) {</pre> + <pre class="language-r"> beparms.optim <- c(object$bparms.optim, object$par[epnames])</pre> </td> </tr> - <tr class="never"> - <td class="num">215</td> - <td class="coverage"></td> + <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"> # Reduce top margin by 2 after the first plot as we have no main title,</pre> + <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">216</td> + <td class="num">79</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> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="missed"> - <td class="num">217</td> - <td class="coverage">!</td> + <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"> par(mar = c(3.0, 4.1, 2.1, 2.1))</pre> + <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">218</td> + <td class="num">84</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">219</td> + <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">220</td> + <td class="num">87</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> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">221</td> - <td class="coverage">415<em>x</em></td> + <td class="num">88</td> + <td class="coverage">52158<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (plot_row == n_plot_rows & n_plot_rows > 1) {</pre> + <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">222</td> + <td class="num">90</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> + <pre class="language-r"></pre> </td> </tr> - <tr class="missed"> - <td class="num">223</td> - <td class="coverage">!</td> + <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"> par(mar = c(5.1, 4.1, 2.1, 2.1))</pre> + <pre class="language-r"> bparam <- cbind(Estimate = beparms.optim, se_notrans,</pre> </td> </tr> - <tr class="never"> - <td class="num">224</td> - <td class="coverage"></td> + <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"> }</pre> + <pre class="language-r"> "t value" = tval, "Pr(>t)" = pval, Lower = NA, Upper = NA)</pre> </td> </tr> <tr class="never"> - <td class="num">225</td> + <td class="num">93</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">226</td> + <td class="num">94</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> # Transform boundaries of CI for one parameter at a time,</pre> </td> </tr> <tr class="never"> - <td class="num">227</td> + <td class="num">95</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> + <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">228</td> - <td class="coverage">1503<em>x</em></td> + <td class="num">96</td> + <td class="coverage">52158<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (add == FALSE) {</pre> + <pre class="language-r"> f_names_skip <- character(0)</pre> </td> </tr> <tr class="covered"> - <td class="num">229</td> - <td class="coverage">1503<em>x</em></td> + <td class="num">97</td> + <td class="coverage">52158<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> plot(0, type="n",</pre> + <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">230</td> - <td class="coverage">1503<em>x</em></td> + <td class="num">98</td> + <td class="coverage">70671<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> xlim = xlim, ylim = ylim_row,</pre> + <pre class="language-r"> f_names <- grep(paste("^f", box, sep = "_"), pnames, value = TRUE)</pre> </td> </tr> <tr class="covered"> - <td class="num">231</td> - <td class="coverage">1503<em>x</em></td> + <td class="num">99</td> + <td class="coverage">70671<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> xlab = xlab, ylab = ylab, frame = frame, ...)</pre> + <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">232</td> + <td class="num">101</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">233</td> + <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">234</td> - <td class="coverage"></td> + <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"> # Plot the data</pre> + <pre class="language-r"> for (pname in pnames) {</pre> </td> </tr> <tr class="covered"> - <td class="num">235</td> - <td class="coverage">1503<em>x</em></td> + <td class="num">104</td> + <td class="coverage">293621<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> for (obs_var in row_obs_vars) {</pre> + <pre class="language-r"> if (!pname %in% f_names_skip) {</pre> </td> </tr> <tr class="covered"> - <td class="num">236</td> - <td class="coverage">1708<em>x</em></td> + <td class="num">105</td> + <td class="coverage">290217<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> points(subset(fit$data, variable == obs_var, c(time, observed)),</pre> + <pre class="language-r"> par.lower <- param[pname, "Lower"]</pre> </td> </tr> <tr class="covered"> - <td class="num">237</td> - <td class="coverage">1708<em>x</em></td> + <td class="num">106</td> + <td class="coverage">290217<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> pch = pch_obs[obs_var], col = col_obs[obs_var])</pre> + <pre class="language-r"> par.upper <- param[pname, "Upper"]</pre> </td> </tr> - <tr class="never"> - <td class="num">238</td> - <td class="coverage"></td> + <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"> }</pre> + <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">239</td> + <td class="num">116</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">240</td> + <td class="num">117</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # Plot the model output</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="covered"> - <td class="num">241</td> - <td class="coverage">1503<em>x</em></td> + <td class="num">118</td> + <td class="coverage">52158<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> + <pre class="language-r"> bparam[epnames, c("Lower", "Upper")] <- param[epnames, c("Lower", "Upper")]</pre> </td> </tr> <tr class="never"> - <td class="num">242</td> + <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">243</td> - <td class="coverage">1503<em>x</em></td> + <td class="num">120</td> + <td class="coverage">52158<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (legend == TRUE) {</pre> + <pre class="language-r"> ans <- list(</pre> </td> </tr> - <tr class="never"> - <td class="num">244</td> - <td class="coverage"></td> + <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"> # Get full names from model definition if they are available</pre> + <pre class="language-r"> version = as.character(utils::packageVersion("mkin")),</pre> </td> </tr> <tr class="covered"> - <td class="num">245</td> - <td class="coverage">695<em>x</em></td> + <td class="num">122</td> + <td class="coverage">52158<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> legend_names = lapply(row_obs_vars, function(x) {</pre> + <pre class="language-r"> Rversion = paste(R.version$major, R.version$minor, sep="."),</pre> </td> </tr> <tr class="covered"> - <td class="num">246</td> - <td class="coverage">900<em>x</em></td> + <td class="num">123</td> + <td class="coverage">52158<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (!is.null(fit$mkinmod$spec[[x]]$full_name))</pre> + <pre class="language-r"> date.fit = object$date,</pre> </td> </tr> <tr class="covered"> - <td class="num">247</td> - <td class="coverage">410<em>x</em></td> + <td class="num">124</td> + <td class="coverage">52158<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (is.na(fit$mkinmod$spec[[x]]$full_name)) x</pre> + <pre class="language-r"> date.summary = date(),</pre> </td> </tr> - <tr class="missed"> - <td class="num">248</td> - <td class="coverage">!</td> + <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"> else fit$mkinmod$spec[[x]]$full_name</pre> + <pre class="language-r"> solution_type = object$solution_type,</pre> </td> </tr> <tr class="covered"> - <td class="num">249</td> - <td class="coverage">490<em>x</em></td> + <td class="num">126</td> + <td class="coverage">52158<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> else x</pre> + <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">250</td> + <td class="num">138</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> })</pre> + <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="num">139</td> + <td class="coverage">52158<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> legend(lpos[plot_row], inset= inset, legend = legend_names,</pre> + <pre class="language-r"> if (!is.null(object$version)) {</pre> </td> </tr> <tr class="covered"> - <td class="num">252</td> - <td class="coverage">695<em>x</em></td> + <td class="num">140</td> + <td class="coverage">52158<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> + <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">253</td> + <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">254</td> + <td class="num">147</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">255</td> + <td class="num">148</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # Show chi2 error value if requested</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">256</td> - <td class="coverage">1503<em>x</em></td> + <td class="num">149</td> + <td class="coverage">52158<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (show_errmin) {</pre> + <pre class="language-r"> ans$diffs <- object$mkinmod$diffs</pre> </td> </tr> <tr class="covered"> - <td class="num">257</td> - <td class="coverage">70<em>x</em></td> + <td class="num">150</td> + <td class="coverage">52158<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (length(row_obs_vars) == 1) {</pre> + <pre class="language-r"> if(data) ans$data <- object$data</pre> </td> </tr> <tr class="covered"> - <td class="num">258</td> - <td class="coverage">70<em>x</em></td> + <td class="num">151</td> + <td class="coverage">52158<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> errmin_var = row_obs_vars</pre> + <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">259</td> + <td class="num">153</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="missed"> - <td class="num">260</td> - <td class="coverage">!</td> + <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"> errmin_var = "All data"</pre> + <pre class="language-r"> ans$fixed <- object$fixed</pre> </td> </tr> - <tr class="missed"> - <td class="num">261</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">155</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (length(row_obs_vars) != length(fit$mkinmod$map)) {</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="missed"> - <td class="num">262</td> - <td class="coverage">!</td> + <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"> warning("Showing chi2 error level for all data, but only ",</pre> + <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">263</td> + <td class="num">164</td> <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> row_obs_vars, " were selected for plotting")</pre> + <pre class="language-r"> warning("Could not calculate correlation; no covariance matrix")</pre> </td> </tr> <tr class="never"> - <td class="num">264</td> + <td class="num">165</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">265</td> + <td class="num">166</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">266</td> + <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">267</td> - <td class="coverage">70<em>x</em></td> + <td class="num">168</td> + <td class="coverage">52158<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> + <pre class="language-r"> ans$bparms.ode <- object$bparms.ode</pre> </td> </tr> - <tr class="never"> - <td class="num">268</td> - <td class="coverage"></td> + <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"> # Use LateX if the current plotting device is tikz</pre> + <pre class="language-r"> ans$shapiro.p <- object$shapiro.p</pre> </td> </tr> <tr class="covered"> - <td class="num">269</td> - <td class="coverage">70<em>x</em></td> + <td class="num">170</td> + <td class="coverage">52158<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (names(dev.cur()) == "tikz output") {</pre> + <pre class="language-r"> ep <- endpoints(object)</pre> </td> </tr> - <tr class="missed"> - <td class="num">270</td> - <td class="coverage">!</td> + <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"> chi2_text <- paste0("$\\chi^2$ error level = ", chi2, "\\%")</pre> + <pre class="language-r"> if (length(ep$ff) != 0)</pre> </td> </tr> - <tr class="never"> - <td class="num">271</td> - <td class="coverage"></td> + <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"> } else {</pre> + <pre class="language-r"> ans$ff <- ep$ff</pre> </td> </tr> <tr class="covered"> - <td class="num">272</td> - <td class="coverage">70<em>x</em></td> + <td class="num">173</td> + <td class="coverage">52158<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> chi2_perc <- paste0(chi2, "%")</pre> + <pre class="language-r"> if (distimes) ans$distimes <- ep$distimes</pre> </td> </tr> <tr class="covered"> - <td class="num">273</td> - <td class="coverage">70<em>x</em></td> + <td class="num">174</td> + <td class="coverage">2442<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> chi2_text <- bquote(chi^2 ~ "error level" == .(chi2_perc))</pre> + <pre class="language-r"> if (length(ep$SFORB) != 0) ans$SFORB <- ep$SFORB</pre> </td> </tr> - <tr class="never"> - <td class="num">274</td> - <td class="coverage"></td> + <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"> }</pre> + <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">275</td> - <td class="coverage">70<em>x</em></td> + <td class="num">176</td> + <td class="coverage">52158<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> mtext(chi2_text, cex = 0.7, line = 0.4)</pre> + <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">276</td> + <td class="num">178</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">}</pre> </td> </tr> <tr class="never"> - <td class="num">277</td> + <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">278</td> - <td class="coverage">1503<em>x</em></td> + <td class="num">183</td> + <td class="coverage">4<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (do_layout & !row_layout) {</pre> + <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">279</td> - <td class="coverage">70<em>x</em></td> + <td class="num">187</td> + <td class="coverage">4<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> par(mar = c(5, 4, 0, 2) + 0.1)</pre> + <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">280</td> + <td class="num">189</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">281</td> + <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">282</td> + <td class="num">193</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # Show residuals if requested</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">283</td> - <td class="coverage">1503<em>x</em></td> + <td class="num">194</td> + <td class="coverage">4<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (show_residuals) {</pre> + <pre class="language-r"> cat("\nEquations:\n")</pre> </td> </tr> <tr class="covered"> - <td class="num">284</td> - <td class="coverage">280<em>x</em></td> + <td class="num">195</td> + <td class="coverage">4<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> mkinresplot(fit, obs_vars = row_obs_vars, standardized = standardized,</pre> + <pre class="language-r"> nice_diffs <- gsub("^(d.*) =", "\\1/dt =", x[["diffs"]])</pre> </td> </tr> <tr class="covered"> - <td class="num">285</td> - <td class="coverage">280<em>x</em></td> + <td class="num">196</td> + <td class="coverage">4<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> + <pre class="language-r"> writeLines(strwrap(nice_diffs, exdent = 11))</pre> </td> </tr> <tr class="covered"> - <td class="num">286</td> - <td class="coverage">280<em>x</em></td> + <td class="num">197</td> + <td class="coverage">4<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> legend = FALSE, frame = frame, xlab = xlab, xlim = xlim, maxabs = maxabs)</pre> + <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">287</td> + <td class="num">199</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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">288</td> + <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">289</td> + <td class="num">203</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # Show error model plot if requested</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">290</td> - <td class="coverage">1503<em>x</em></td> + <td class="num">204</td> + <td class="coverage">4<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (show_errplot) {</pre> + <pre class="language-r"> if (!is.null(x$err_mod)) {</pre> </td> </tr> <tr class="covered"> - <td class="num">291</td> - <td class="coverage">205<em>x</em></td> + <td class="num">205</td> + <td class="coverage">4<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> mkinerrplot(fit, obs_vars = row_obs_vars,</pre> + <pre class="language-r"> cat("\nError model: ")</pre> </td> </tr> <tr class="covered"> - <td class="num">292</td> - <td class="coverage">205<em>x</em></td> + <td class="num">206</td> + <td class="coverage">4<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> + <pre class="language-r"> cat(switch(x$err_mod,</pre> </td> </tr> <tr class="covered"> - <td class="num">293</td> - <td class="coverage">205<em>x</em></td> + <td class="num">207</td> + <td class="coverage">4<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> legend = FALSE, frame = frame)</pre> + <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">294</td> + <td class="num">210</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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">295</td> + <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">296</td> + <td class="num">214</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">}</pre> + <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">297</td> + <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">298</td> + <td class="num">220</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @rdname plot.mkinfit</pre> + <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">299</td> + <td class="num">224</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">300</td> + <td class="num">225</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">plot_sep <- function(fit, show_errmin = TRUE,</pre> + <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">301</td> + <td class="num">227</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> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">302</td> - <td class="coverage">70<em>x</em></td> + <td class="num">228</td> + <td class="coverage">4<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> plot.mkinfit(fit, sep_obs = TRUE, show_residuals = show_residuals,</pre> + <pre class="language-r"> if (length(x$warnings) > 0) {</pre> </td> </tr> - <tr class="covered"> - <td class="num">303</td> - <td class="coverage">70<em>x</em></td> + <tr class="missed"> + <td class="num">229</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> show_errmin = show_errmin, ...)</pre> + <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">304</td> + <td class="num">231</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">}</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">305</td> + <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">306</td> - <td class="coverage"></td> + <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">#' @rdname plot.mkinfit</pre> + <pre class="language-r"> if (!is.null(x$AIC)) {</pre> </td> </tr> - <tr class="never"> - <td class="num">307</td> - <td class="coverage"></td> + <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">#' @export</pre> + <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">308</td> + <td class="num">237</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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">309</td> + <td class="num">238</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> standardized = ifelse(identical(fit$err_mod, "const"), FALSE, TRUE), ...)</pre> + <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">310</td> + <td class="num">241</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">{</pre> + <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="num">242</td> + <td class="coverage">4<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> + <pre class="language-r"> if (x$calls > 0) {</pre> </td> </tr> <tr class="covered"> - <td class="num">312</td> - <td class="coverage">140<em>x</em></td> + <td class="num">243</td> + <td class="coverage">4<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> show_residuals = ifelse(standardized, "standardized", TRUE),</pre> + <pre class="language-r"> cat("\nParameter correlation:\n")</pre> </td> </tr> <tr class="covered"> - <td class="num">313</td> - <td class="coverage">140<em>x</em></td> + <td class="num">244</td> + <td class="coverage">4<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> row_layout = TRUE, ...)</pre> + <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">314</td> + <td class="num">246</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">}</pre> + <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">315</td> + <td class="num">248</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">316</td> + <td class="num">249</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @rdname plot.mkinfit</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">317</td> + <td class="num">250</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <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">318</td> + <td class="num">256</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> + <pre class="language-r"> } else {</pre> </td> </tr> <tr class="covered"> - <td class="num">319</td> - <td class="coverage">205<em>x</em></td> + <td class="num">257</td> + <td class="coverage">4<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> + <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">320</td> - <td class="coverage">205<em>x</em></td> + <td class="num">258</td> + <td class="coverage">4<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> show_errplot = TRUE, row_layout = TRUE, ...)</pre> + <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">321</td> + <td class="num">260</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">}</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">322</td> + <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">323</td> - <td class="coverage"></td> + <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">#' Plot the observed data and the fitted model of an mkinfit object</pre> + <pre class="language-r"> cat("\nFOCUS Chi2 error levels in percent:\n")</pre> </td> </tr> - <tr class="never"> - <td class="num">324</td> - <td class="coverage"></td> + <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">#'</pre> + <pre class="language-r"> x$errmin$err.min <- 100 * x$errmin$err.min</pre> </td> </tr> - <tr class="never"> - <td class="num">325</td> - <td class="coverage"></td> + <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">#' Deprecated function. It now only calls the plot method</pre> + <pre class="language-r"> print(x$errmin, digits=digits,...)</pre> </td> </tr> <tr class="never"> - <td class="num">326</td> + <td class="num">265</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' \code{\link{plot.mkinfit}}.</pre> + <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">327</td> + <td class="num">270</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">328</td> + <td class="num">271</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @param fit an object of class \code{\link{mkinfit}}.</pre> + <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">329</td> + <td class="num">276</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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">330</td> + <td class="num">277</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @return The function is called for its side effect.</pre> + <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">331</td> + <td class="num">282</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @author Johannes Ranke</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">332</td> + <td class="num">283</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <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">333</td> + <td class="num">288</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">mkinplot <- function(fit, ...)</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">334</td> + <td class="num">289</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">{</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="missed"> - <td class="num">335</td> - <td class="coverage">!</td> + <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"> plot(fit, ...)</pre> + <pre class="language-r"> invisible(x)</pre> </td> </tr> <tr class="never"> - <td class="num">336</td> + <td class="num">291</td> <td class="coverage"></td> <td class="col-sm-12"> <pre class="language-r">}</pre> @@ -34775,3880 +31018,3769 @@ table.table-condensed { </tbody> </table> </div> - <div id="R/parms.R" class="hidden"> + <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">#' Extract model parameters</pre> + <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> + <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> + <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">#' model parameters per default, in order to avoid working with a fitted model</pre> + <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">#' without considering the error structure that was assumed for the fit.</pre> + <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">#'</pre> + <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">#' @param object A fitted model object.</pre> + <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">#' @param \dots Not used</pre> + <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">#' @return Depending on the object, a numeric vector of fitted model parameters,</pre> + <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">#' a matrix (e.g. for mmkin row objects), or a list of matrices (e.g. for</pre> + <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">#' mmkin objects with more than one row).</pre> + <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">#' @seealso [saem], [multistart]</pre> + <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">#' @examples</pre> + <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">#' # mkinfit objects</pre> + <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">#' fit <- mkinfit("SFO", FOCUS_2006_C, quiet = TRUE)</pre> + <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">#' parms(fit)</pre> + <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">#' parms(fit, transformed = TRUE)</pre> + <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">#'</pre> + <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">#' # mmkin objects</pre> + <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">#' ds <- lapply(experimental_data_for_UBA_2019[6:10],</pre> + <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">#' function(x) subset(x$data[c("name", "time", "value")]))</pre> + <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">#' names(ds) <- paste("Dataset", 6:10)</pre> + <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">#' \dontrun{</pre> + <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">#' fits <- mmkin(c("SFO", "FOMC", "DFOP"), ds, quiet = TRUE, cores = 1)</pre> + <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">#' parms(fits["SFO", ])</pre> + <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">#' parms(fits[, 2])</pre> + <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">#' parms(fits)</pre> + <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">#' parms(fits, transformed = TRUE)</pre> + <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">#' }</pre> + <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">#' @export</pre> + <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">parms <- function(object, ...)</pre> + <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">{</pre> + <pre class="language-r">#' @param rel.height.legend The relative height of the legend shown on top</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">33</td> - <td class="coverage">91384<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> UseMethod("parms", object)</pre> + <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">}</pre> + <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"></pre> + <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 transformed Should the parameters be returned as used internally</pre> + <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">#' during the optimisation?</pre> + <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">#' @param errparms Should the error model parameters be returned</pre> + <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">#' in addition to the degradation parameters?</pre> + <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">#' @rdname parms</pre> + <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">#' @export</pre> + <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">parms.mkinfit <- function(object, transformed = FALSE, errparms = TRUE, ...)</pre> + <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">{</pre> + <pre class="language-r">#' @importFrom stats coefficients</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">44</td> - <td class="coverage">88039<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> res <- if (transformed) object$par</pre> + <pre class="language-r">#' @return The function is called for its side effect.</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">45</td> - <td class="coverage">88039<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> else c(object$bparms.optim, object$errparms)</pre> + <pre class="language-r">#' @author Johannes Ranke</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">46</td> - <td class="coverage">88039<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (!errparms) {</pre> + <pre class="language-r">#' @examples</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">47</td> - <td class="coverage">3000<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> res[setdiff(names(res), names(object$errparms))]</pre> + <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"> }</pre> + <pre class="language-r">#' function(x) x$data[c("name", "time", "value")])</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">49</td> - <td class="coverage">85039<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> else return(res)</pre> + <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">}</pre> + <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"></pre> + <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">#' @rdname parms</pre> + <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">#' @export</pre> + <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">parms.mmkin <- function(object, transformed = FALSE, errparms = TRUE, ...)</pre> + <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> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">56</td> - <td class="coverage">265<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (nrow(object) == 1) {</pre> + <pre class="language-r">#' # For this fit we need to increase pnlsMaxiter, and we increase the</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">57</td> - <td class="coverage">265<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> res <- sapply(object, parms, transformed = transformed,</pre> + <pre class="language-r">#' # tolerance in order to speed up the fit for this example evaluation</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">58</td> - <td class="coverage">265<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> errparms = errparms, ...)</pre> + <pre class="language-r">#' # It still takes 20 seconds to run</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">59</td> - <td class="coverage">265<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> colnames(res) <- colnames(object)</pre> + <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"> } else {</pre> + <pre class="language-r">#' plot(f_nlme)</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">61</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> res <- list()</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">62</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> for (i in 1:nrow(object)) {</pre> + <pre class="language-r">#' f_saem <- saem(f, transformations = "saemix")</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">63</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> res[[i]] <- parms(object[i, ], transformed = transformed,</pre> + <pre class="language-r">#' plot(f_saem)</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">64</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> errparms = errparms, ...)</pre> + <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> + <pre class="language-r">#' f_obs <- mmkin(list("DFOP-SFO" = dfop_sfo), ds, quiet = TRUE, error_model = "obs")</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">66</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> names(res) <- rownames(object)</pre> + <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"> }</pre> + <pre class="language-r">#' plot(f_nlmix)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">68</td> - <td class="coverage">265<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> return(res)</pre> + <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> + <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"></pre> + <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">#' @param exclude_failed For [multistart] objects, should rows for failed fits</pre> + <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">#' be removed from the returned parameter matrix?</pre> + <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">#' @rdname parms</pre> + <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">#' @export</pre> + <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">parms.multistart <- function(object, exclude_failed = TRUE, ...) {</pre> + <pre class="language-r">#' }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">76</td> - <td class="coverage">176<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> res <- t(sapply(object, parms))</pre> + <pre class="language-r">#' @export</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">77</td> - <td class="coverage">176<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> successful <- which(!is.na(res[, 1]))</pre> + <pre class="language-r">plot.mixed.mmkin <- function(x,</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">78</td> - <td class="coverage">176<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> first_success <- successful[1]</pre> + <pre class="language-r"> i = 1:ncol(x$mmkin),</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">79</td> - <td class="coverage">176<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> colnames(res) <- names(parms(object[[first_success]]))</pre> + <pre class="language-r"> obs_vars = names(x$mkinmod$map),</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">80</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (exclude_failed[1]) res <- res[successful, ]</pre> + <pre class="language-r"> standardized = TRUE,</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">81</td> - <td class="coverage">176<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> return(res)</pre> + <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">}</pre> + <pre class="language-r"> covariate_quantiles = c(0.5, 0.05, 0.95),</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="num">83</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> + <pre class="language-r"> xlab = "Time",</pre> </td> </tr> <tr class="never"> - <td class="num">2</td> + <td class="num">84</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' more datasets</pre> + <pre class="language-r"> xlim = range(x$data$time),</pre> </td> </tr> <tr class="never"> - <td class="num">3</td> + <td class="num">85</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> resplot = c("predicted", "time"),</pre> </td> </tr> <tr class="never"> - <td class="num">4</td> + <td class="num">86</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> + <pre class="language-r"> pop_curves = "auto",</pre> </td> </tr> <tr class="never"> - <td class="num">5</td> + <td class="num">87</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' datasets specified in its first two arguments.</pre> + <pre class="language-r"> pred_over = NULL,</pre> </td> </tr> <tr class="never"> - <td class="num">6</td> + <td class="num">88</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> test_log_parms = FALSE,</pre> </td> </tr> <tr class="never"> - <td class="num">7</td> + <td class="num">89</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> + <pre class="language-r"> conf.level = 0.6,</pre> </td> </tr> <tr class="never"> - <td class="num">8</td> + <td class="num">90</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> + <pre class="language-r"> default_log_parms = NA,</pre> </td> </tr> <tr class="never"> - <td class="num">9</td> + <td class="num">91</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' list of \code{\link{mkinmod}} objects.</pre> + <pre class="language-r"> ymax = "auto", maxabs = "auto",</pre> </td> </tr> <tr class="never"> - <td class="num">10</td> + <td class="num">92</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> + <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">11</td> + <td class="num">93</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' data for \code{\link{mkinfit}}.</pre> + <pre class="language-r"> nrow.legend = ceiling((length(i) + 1) / ncol.legend),</pre> </td> </tr> <tr class="never"> - <td class="num">12</td> + <td class="num">94</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> + <pre class="language-r"> rel.height.legend = 0.02 + 0.07 * nrow.legend,</pre> </td> </tr> <tr class="never"> - <td class="num">13</td> + <td class="num">95</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> + <pre class="language-r"> rel.height.bottom = 1.1,</pre> </td> </tr> <tr class="never"> - <td class="num">14</td> + <td class="num">96</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> + <pre class="language-r"> pch_ds = c(1:25, 33, 35:38, 40:41, 47:57, 60:90)[1:length(i)],</pre> </td> </tr> <tr class="never"> - <td class="num">15</td> + <td class="num">97</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> + <pre class="language-r"> col_ds = pch_ds + 1,</pre> </td> </tr> <tr class="never"> - <td class="num">16</td> + <td class="num">98</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> + <pre class="language-r"> lty_ds = col_ds,</pre> </td> </tr> <tr class="never"> - <td class="num">17</td> + <td class="num">99</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' the default is 1.</pre> + <pre class="language-r"> frame = TRUE, ...</pre> </td> </tr> <tr class="never"> - <td class="num">18</td> + <td class="num">100</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> + <pre class="language-r">)</pre> </td> </tr> <tr class="never"> - <td class="num">19</td> + <td class="num">101</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' for parallel execution.</pre> + <pre class="language-r">{</pre> </td> </tr> <tr class="never"> - <td class="num">20</td> + <td class="num">102</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> + <pre class="language-r"> # Prepare parameters and data</pre> </td> </tr> - <tr class="never"> - <td class="num">21</td> - <td class="coverage"></td> + <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">#' @importFrom parallel mclapply parLapply detectCores</pre> + <pre class="language-r"> fit_1 <- x$mmkin[[1]]</pre> </td> </tr> - <tr class="never"> - <td class="num">22</td> - <td class="coverage"></td> + <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">#' @return A two-dimensional \code{\link{array}} of \code{\link{mkinfit}}</pre> + <pre class="language-r"> ds_names <- colnames(x$mmkin)</pre> </td> </tr> <tr class="never"> - <td class="num">23</td> + <td class="num">105</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> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> - <td class="num">24</td> - <td class="coverage"></td> + <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">#' first index (row index) and the dataset names for the second index (column</pre> + <pre class="language-r"> backtransform = TRUE</pre> </td> </tr> <tr class="never"> - <td class="num">25</td> + <td class="num">107</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' index).</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> - <td class="num">26</td> - <td class="coverage"></td> + <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">#' @author Johannes Ranke</pre> + <pre class="language-r"> if (identical(class(x), "mixed.mmkin")) {</pre> </td> </tr> - <tr class="never"> - <td class="num">27</td> - <td class="coverage"></td> + <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">#' @seealso \code{\link{[.mmkin}} for subsetting, \code{\link{plot.mmkin}} for</pre> + <pre class="language-r"> if (identical(pop_curves, "auto")) {</pre> </td> </tr> - <tr class="never"> - <td class="num">28</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">110</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#' plotting.</pre> + <pre class="language-r"> pop_curves <- FALSE</pre> </td> </tr> <tr class="never"> - <td class="num">29</td> + <td class="num">111</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @keywords optimize</pre> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="never"> - <td class="num">30</td> - <td class="coverage"></td> + <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">#' @examples</pre> + <pre class="language-r"> pop_curves <- TRUE</pre> </td> </tr> <tr class="never"> - <td class="num">31</td> + <td class="num">113</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="never"> - <td class="num">32</td> - <td class="coverage"></td> + <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">#' \dontrun{</pre> + <pre class="language-r"> if (pop_curves) {</pre> </td> </tr> - <tr class="never"> - <td class="num">33</td> - <td class="coverage"></td> + <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">#' m_synth_SFO_lin <- mkinmod(parent = mkinsub("SFO", "M1"),</pre> + <pre class="language-r"> degparms_pop <- mean_degparms(x$mmkin, test_log_parms = test_log_parms,</pre> </td> </tr> - <tr class="never"> - <td class="num">34</td> - <td class="coverage"></td> + <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">#' M1 = mkinsub("SFO", "M2"),</pre> + <pre class="language-r"> conf.level = conf.level, default_log_parms = default_log_parms)</pre> </td> </tr> <tr class="never"> - <td class="num">35</td> + <td class="num">117</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' M2 = mkinsub("SFO"), use_of_ff = "max")</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">36</td> + <td class="num">118</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> - <td class="num">37</td> - <td class="coverage"></td> + <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">#' m_synth_FOMC_lin <- mkinmod(parent = mkinsub("FOMC", "M1"),</pre> + <pre class="language-r"> degparms_tmp <- parms(x$mmkin, transformed = TRUE)</pre> </td> </tr> - <tr class="never"> - <td class="num">38</td> - <td class="coverage"></td> + <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">#' M1 = mkinsub("SFO", "M2"),</pre> + <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="never"> - <td class="num">39</td> - <td class="coverage"></td> + <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">#' M2 = mkinsub("SFO"), use_of_ff = "max")</pre> + <pre class="language-r"> residual_type = ifelse(standardized, "standardized", "residual")</pre> </td> </tr> - <tr class="never"> - <td class="num">40</td> - <td class="coverage"></td> + <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">#'</pre> + <pre class="language-r"> residuals <- x$data[[residual_type]]</pre> </td> </tr> <tr class="never"> - <td class="num">41</td> + <td class="num">123</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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">42</td> + <td class="num">124</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> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> - <td class="num">43</td> - <td class="coverage"></td> + <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">#' names(datasets) <- paste("Dataset", 1:3)</pre> + <pre class="language-r"> if (inherits(x, "nlme.mmkin")) {</pre> </td> </tr> - <tr class="never"> - <td class="num">44</td> - <td class="coverage"></td> + <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">#'</pre> + <pre class="language-r"> if (identical(pop_curves, "auto")) {</pre> </td> </tr> - <tr class="never"> - <td class="num">45</td> - <td class="coverage"></td> + <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">#' time_default <- system.time(fits.0 <- mmkin(models, datasets, quiet = TRUE))</pre> + <pre class="language-r"> pop_curves <- TRUE</pre> </td> </tr> <tr class="never"> - <td class="num">46</td> + <td class="num">128</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> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="never"> - <td class="num">47</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">129</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> pop_curves <- FALSE</pre> </td> </tr> <tr class="never"> - <td class="num">48</td> + <td class="num">130</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' time_default</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="never"> - <td class="num">49</td> - <td class="coverage"></td> + <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">#' time_1</pre> + <pre class="language-r"> degparms_i <- coefficients(x)</pre> </td> </tr> - <tr class="never"> - <td class="num">50</td> - <td class="coverage"></td> + <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">#'</pre> + <pre class="language-r"> degparms_pop <- nlme::fixef(x)</pre> </td> </tr> - <tr class="never"> - <td class="num">51</td> - <td class="coverage"></td> + <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">#' endpoints(fits.0[["SFO_lin", 2]])</pre> + <pre class="language-r"> residuals <- residuals(x,</pre> </td> </tr> - <tr class="never"> - <td class="num">52</td> - <td class="coverage"></td> + <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">#'</pre> + <pre class="language-r"> type = ifelse(standardized, "pearson", "response"))</pre> </td> </tr> <tr class="never"> - <td class="num">53</td> + <td class="num">135</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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">54</td> + <td class="num">136</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' plot(fits.0[1, ])</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> - <td class="num">55</td> - <td class="coverage"></td> + <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">#' plot(fits.0[1, ], obs_var = c("M1", "M2"))</pre> + <pre class="language-r"> if (inherits(x, "saem.mmkin")) {</pre> </td> </tr> - <tr class="never"> - <td class="num">56</td> - <td class="coverage"></td> + <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">#' plot(fits.0[, 1])</pre> + <pre class="language-r"> if (x$transformations == "saemix") backtransform = FALSE</pre> </td> </tr> - <tr class="never"> - <td class="num">57</td> - <td class="coverage"></td> + <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">#' # Use double brackets to extract a single mkinfit object, which will be plotted</pre> + <pre class="language-r"> psi <- saemix::psi(x$so)</pre> </td> </tr> - <tr class="never"> - <td class="num">58</td> - <td class="coverage"></td> + <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">#' # by plot.mkinfit and can be plotted using plot_sep</pre> + <pre class="language-r"> rownames(psi) <- x$saemix_ds_order</pre> </td> </tr> - <tr class="never"> - <td class="num">59</td> - <td class="coverage"></td> + <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">#' plot(fits.0[[1, 1]], sep_obs = TRUE, show_residuals = TRUE, show_errmin = TRUE)</pre> + <pre class="language-r"> degparms_i <- psi[ds_names, ]</pre> </td> </tr> - <tr class="never"> - <td class="num">60</td> - <td class="coverage"></td> + <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">#' plot_sep(fits.0[[1, 1]])</pre> + <pre class="language-r"> degparms_i_names <- colnames(degparms_i)</pre> </td> </tr> - <tr class="never"> - <td class="num">61</td> - <td class="coverage"></td> + <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">#' # Plotting with mmkin (single brackets, extracting an mmkin object) does not</pre> + <pre class="language-r"> residual_type = ifelse(standardized, "standardized", "residual")</pre> </td> </tr> - <tr class="never"> - <td class="num">62</td> - <td class="coverage"></td> + <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">#' # allow to plot the observed variables separately</pre> + <pre class="language-r"> residuals <- x$data[[residual_type]]</pre> </td> </tr> <tr class="never"> - <td class="num">63</td> + <td class="num">145</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' plot(fits.0[1, 1])</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> - <td class="num">64</td> - <td class="coverage"></td> + <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">#'</pre> + <pre class="language-r"> if (identical(pop_curves, "auto")) {</pre> </td> </tr> - <tr class="never"> - <td class="num">65</td> - <td class="coverage"></td> + <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">#' # On Windows, we can use multiple cores by making a cluster first</pre> + <pre class="language-r"> if (length(x$covariate_models) == 0) {</pre> </td> </tr> - <tr class="never"> - <td class="num">66</td> - <td class="coverage"></td> + <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">#' cl <- parallel::makePSOCKcluster(12)</pre> + <pre class="language-r"> degparms_pop <- x$so@results@fixed.effects</pre> </td> </tr> - <tr class="never"> - <td class="num">67</td> - <td class="coverage"></td> + <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">#' f <- mmkin(c("SFO", "FOMC", "DFOP"),</pre> + <pre class="language-r"> names(degparms_pop) <- degparms_i_names</pre> </td> </tr> - <tr class="never"> - <td class="num">68</td> - <td class="coverage"></td> + <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">#' list(A = FOCUS_2006_A, B = FOCUS_2006_B, C = FOCUS_2006_C, D = FOCUS_2006_D),</pre> + <pre class="language-r"> pop_curves <- TRUE</pre> </td> </tr> <tr class="never"> - <td class="num">69</td> + <td class="num">151</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' cluster = cl, quiet = TRUE)</pre> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="never"> - <td class="num">70</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">152</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#' print(f)</pre> + <pre class="language-r"> if (is.null(covariates)) {</pre> </td> </tr> - <tr class="never"> - <td class="num">71</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">153</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> + <pre class="language-r"> covariates = as.data.frame(</pre> </td> </tr> - <tr class="never"> - <td class="num">72</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">154</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> + <pre class="language-r"> apply(x$covariates, 2, quantile,</pre> </td> </tr> - <tr class="never"> - <td class="num">73</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">155</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#' parallel::stopCluster(cl)</pre> + <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">74</td> + <td class="num">160</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' }</pre> + <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">75</td> + <td class="num">163</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">76</td> + <td class="num">164</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @export mmkin</pre> + <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">77</td> + <td class="num">166</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">mmkin <- function(models = c("SFO", "FOMC", "DFOP"), datasets,</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">78</td> + <td class="num">167</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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">79</td> + <td class="num">168</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">{</pre> + <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="num">169</td> + <td class="coverage">283<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> call <- match.call()</pre> + <pre class="language-r"> if (pop_curves) {</pre> </td> </tr> - <tr class="covered"> - <td class="num">81</td> - <td class="coverage">4032<em>x</em></td> + <tr class="never"> + <td class="num">170</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> parent_models_available = c("SFO", "FOMC", "DFOP", "HS", "SFORB", "IORE", "logistic")</pre> + <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">82</td> - <td class="coverage">4032<em>x</em></td> + <td class="num">171</td> + <td class="coverage">283<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> n.m <- length(models)</pre> + <pre class="language-r"> if (is.null(dim(degparms_pop))) {</pre> </td> </tr> <tr class="covered"> - <td class="num">83</td> - <td class="coverage">4032<em>x</em></td> + <td class="num">172</td> + <td class="coverage">283<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> n.d <- length(datasets)</pre> + <pre class="language-r"> degparms_pop <- matrix(degparms_pop, ncol = 1,</pre> </td> </tr> <tr class="covered"> - <td class="num">84</td> - <td class="coverage">4032<em>x</em></td> + <td class="num">173</td> + <td class="coverage">283<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> n.fits <- n.m * n.d</pre> + <pre class="language-r"> dimnames = list(names(degparms_pop), "Population"))</pre> </td> </tr> - <tr class="covered"> - <td class="num">85</td> - <td class="coverage">4032<em>x</em></td> + <tr class="never"> + <td class="num">174</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> fit_indices <- matrix(1:n.fits, ncol = n.d)</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">86</td> + <td class="num">175</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">87</td> + <td class="num">176</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # Check models and define their names</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">88</td> - <td class="coverage">4032<em>x</em></td> + <td class="num">177</td> + <td class="coverage">283<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (!all(sapply(models, function(x) inherits(x, "mkinmod")))) {</pre> + <pre class="language-r"> degparms_fixed <- fit_1$fixed$value</pre> </td> </tr> <tr class="covered"> - <td class="num">89</td> - <td class="coverage">2323<em>x</em></td> + <td class="num">178</td> + <td class="coverage">283<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (!all(models %in% parent_models_available)) {</pre> + <pre class="language-r"> names(degparms_fixed) <- rownames(fit_1$fixed)</pre> </td> </tr> <tr class="covered"> - <td class="num">90</td> - <td class="coverage">50<em>x</em></td> + <td class="num">179</td> + <td class="coverage">283<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> + <pre class="language-r"> degparms_all <- cbind(as.matrix(degparms_i),</pre> </td> </tr> <tr class="covered"> - <td class="num">91</td> - <td class="coverage">50<em>x</em></td> + <td class="num">180</td> + <td class="coverage">283<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> paste(parent_models_available, collapse = ", "))</pre> + <pre class="language-r"> matrix(rep(degparms_fixed, nrow(degparms_i)),</pre> </td> </tr> - <tr class="never"> - <td class="num">92</td> - <td class="coverage"></td> + <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"> } else {</pre> + <pre class="language-r"> ncol = length(degparms_fixed),</pre> </td> </tr> <tr class="covered"> - <td class="num">93</td> - <td class="coverage">2273<em>x</em></td> + <td class="num">182</td> + <td class="coverage">283<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> names(models) <- models</pre> + <pre class="language-r"> nrow = nrow(degparms_i), byrow = TRUE))</pre> </td> </tr> - <tr class="never"> - <td class="num">94</td> - <td class="coverage"></td> + <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"> }</pre> + <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">95</td> + <td class="num">185</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">96</td> - <td class="coverage">1087<em>x</em></td> + <td class="num">186</td> + <td class="coverage">283<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> + <pre class="language-r"> odeini_names <- grep("_0$", degparms_all_names, value = TRUE)</pre> </td> </tr> - <tr class="never"> - <td class="num">97</td> - <td class="coverage"></td> + <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"> }</pre> + <pre class="language-r"> odeparms_names <- setdiff(degparms_all_names, odeini_names)</pre> </td> </tr> <tr class="never"> - <td class="num">98</td> + <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">99</td> - <td class="coverage"></td> + <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"> # Check datasets and define their names</pre> + <pre class="language-r"> observed <- cbind(x$data[c("ds", "name", "time", "value")],</pre> </td> </tr> <tr class="covered"> - <td class="num">100</td> - <td class="coverage">1575<em>x</em></td> + <td class="num">190</td> + <td class="coverage">283<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> + <pre class="language-r"> residual = residuals)</pre> </td> </tr> <tr class="never"> - <td class="num">101</td> + <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">102</td> + <td class="num">193</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # Define names for fit index</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">103</td> - <td class="coverage">3982<em>x</em></td> + <td class="num">194</td> + <td class="coverage">283<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> dimnames(fit_indices) <- list(model = names(models),</pre> + <pre class="language-r"> outtimes <- sort(unique(c(x$data$time,</pre> </td> </tr> <tr class="covered"> - <td class="num">104</td> - <td class="coverage">3982<em>x</em></td> + <td class="num">195</td> + <td class="coverage">283<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> dataset = names(datasets))</pre> + <pre class="language-r"> seq(xlim[1], xlim[2], length.out = 50))))</pre> </td> </tr> <tr class="never"> - <td class="num">105</td> + <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">106</td> - <td class="coverage"></td> + <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"></pre> + <pre class="language-r"> pred_list <- lapply(i, function(ds_i) {</pre> </td> </tr> <tr class="covered"> - <td class="num">107</td> - <td class="coverage">3982<em>x</em></td> + <td class="num">198</td> + <td class="coverage">2945<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fit_function <- function(fit_index) {</pre> + <pre class="language-r"> odeparms_trans <- degparms_all[ds_i, odeparms_names]</pre> </td> </tr> <tr class="covered"> - <td class="num">108</td> - <td class="coverage">793<em>x</em></td> + <td class="num">199</td> + <td class="coverage">2945<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> w <- which(fit_indices == fit_index, arr.ind = TRUE)</pre> + <pre class="language-r"> names(odeparms_trans) <- odeparms_names # needed if only one odeparm</pre> </td> </tr> <tr class="covered"> - <td class="num">109</td> - <td class="coverage">793<em>x</em></td> + <td class="num">200</td> + <td class="coverage">2945<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> model_index <- w[1]</pre> + <pre class="language-r"> if (backtransform) {</pre> </td> </tr> <tr class="covered"> - <td class="num">110</td> - <td class="coverage">793<em>x</em></td> + <td class="num">201</td> + <td class="coverage">2620<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> dataset_index <- w[2]</pre> + <pre class="language-r"> odeparms <- backtransform_odeparms(odeparms_trans,</pre> </td> </tr> <tr class="covered"> - <td class="num">111</td> - <td class="coverage">793<em>x</em></td> + <td class="num">202</td> + <td class="coverage">2620<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> res <- try(mkinfit(models[[model_index]], datasets[[dataset_index]], ...))</pre> + <pre class="language-r"> x$mkinmod,</pre> </td> </tr> <tr class="covered"> - <td class="num">112</td> - <td class="coverage">793<em>x</em></td> + <td class="num">203</td> + <td class="coverage">2620<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> + <pre class="language-r"> transform_rates = fit_1$transform_rates,</pre> </td> </tr> <tr class="covered"> - <td class="num">113</td> - <td class="coverage">793<em>x</em></td> + <td class="num">204</td> + <td class="coverage">2620<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> return(res)</pre> + <pre class="language-r"> transform_fractions = fit_1$transform_fractions)</pre> </td> </tr> <tr class="never"> - <td class="num">114</td> + <td class="num">205</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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">115</td> + <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">116</td> - <td class="coverage">3982<em>x</em></td> + <td class="num">209</td> + <td class="coverage">2945<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fit_time <- system.time({</pre> + <pre class="language-r"> odeini <- degparms_all[ds_i, odeini_names]</pre> </td> </tr> <tr class="covered"> - <td class="num">117</td> - <td class="coverage">3982<em>x</em></td> + <td class="num">210</td> + <td class="coverage">2945<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (is.null(cluster)) {</pre> + <pre class="language-r"> names(odeini) <- gsub("_0", "", odeini_names)</pre> </td> </tr> - <tr class="covered"> - <td class="num">118</td> - <td class="coverage">2154<em>x</em></td> + <tr class="never"> + <td class="num">211</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> results <- parallel::mclapply(as.list(1:n.fits), fit_function,</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">119</td> - <td class="coverage">2154<em>x</em></td> + <td class="num">212</td> + <td class="coverage">2945<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> mc.cores = cores, mc.preschedule = FALSE)</pre> + <pre class="language-r"> out <- mkinpredict(x$mkinmod, odeparms, odeini,</pre> </td> </tr> - <tr class="never"> - <td class="num">120</td> - <td class="coverage"></td> + <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"> } else {</pre> + <pre class="language-r"> outtimes, solution_type = solution_type,</pre> </td> </tr> <tr class="covered"> - <td class="num">121</td> - <td class="coverage">1828<em>x</em></td> + <td class="num">214</td> + <td class="coverage">2945<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> + <pre class="language-r"> atol = fit_1$atol, rtol = fit_1$rtol)</pre> </td> </tr> <tr class="never"> - <td class="num">122</td> + <td class="num">215</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> })</pre> </td> </tr> - <tr class="never"> - <td class="num">123</td> - <td class="coverage"></td> + <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"> })</pre> + <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">124</td> + <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">125</td> - <td class="coverage">3798<em>x</em></td> + <td class="num">219</td> + <td class="coverage">283<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> attributes(results) <- attributes(fit_indices)</pre> + <pre class="language-r"> if (pop_curves) {</pre> </td> </tr> <tr class="covered"> - <td class="num">126</td> - <td class="coverage">3798<em>x</em></td> + <td class="num">220</td> + <td class="coverage">283<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> attr(results, "call") <- call</pre> + <pre class="language-r"> pred_list_pop <- lapply(1:ncol(degparms_pop), function(cov_i) {</pre> </td> </tr> <tr class="covered"> - <td class="num">127</td> - <td class="coverage">3798<em>x</em></td> + <td class="num">221</td> + <td class="coverage">283<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> attr(results, "time") <- fit_time</pre> + <pre class="language-r"> degparms_all_pop_i <- c(degparms_pop[, cov_i], degparms_fixed)</pre> </td> </tr> <tr class="covered"> - <td class="num">128</td> - <td class="coverage">3798<em>x</em></td> + <td class="num">222</td> + <td class="coverage">283<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> class(results) <- "mmkin"</pre> + <pre class="language-r"> odeparms_pop_trans_i <- degparms_all_pop_i[odeparms_names]</pre> </td> </tr> <tr class="covered"> - <td class="num">129</td> - <td class="coverage">3798<em>x</em></td> + <td class="num">223</td> + <td class="coverage">283<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> return(results)</pre> + <pre class="language-r"> names(odeparms_pop_trans_i) <- odeparms_names # needed if only one odeparm</pre> </td> </tr> - <tr class="never"> - <td class="num">130</td> - <td class="coverage"></td> + <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">}</pre> + <pre class="language-r"> if (backtransform) {</pre> </td> </tr> - <tr class="never"> - <td class="num">131</td> - <td class="coverage"></td> + <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"></pre> + <pre class="language-r"> odeparms_pop_i <- backtransform_odeparms(odeparms_pop_trans_i,</pre> </td> </tr> - <tr class="never"> - <td class="num">132</td> - <td class="coverage"></td> + <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">#' Subsetting method for mmkin objects</pre> + <pre class="language-r"> x$mkinmod,</pre> </td> </tr> - <tr class="never"> - <td class="num">133</td> - <td class="coverage"></td> + <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">#'</pre> + <pre class="language-r"> transform_rates = fit_1$transform_rates,</pre> </td> </tr> - <tr class="never"> - <td class="num">134</td> - <td class="coverage"></td> + <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">#' @param x An \code{\link{mmkin} object}</pre> + <pre class="language-r"> transform_fractions = fit_1$transform_fractions)</pre> </td> </tr> <tr class="never"> - <td class="num">135</td> + <td class="num">229</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> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="never"> - <td class="num">136</td> - <td class="coverage"></td> + <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">#' @param j Column index selecting the fits to specific datasets</pre> + <pre class="language-r"> odeparms_pop_i <- odeparms_pop_trans_i</pre> </td> </tr> <tr class="never"> - <td class="num">137</td> + <td class="num">231</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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">138</td> + <td class="num">232</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> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> - <td class="num">139</td> - <td class="coverage"></td> + <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">#' either a list of mkinfit objects or a single mkinfit object.</pre> + <pre class="language-r"> odeini <- degparms_all_pop_i[odeini_names]</pre> </td> </tr> - <tr class="never"> - <td class="num">140</td> - <td class="coverage"></td> + <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">#' @return An object of class \code{\link{mmkin}}.</pre> + <pre class="language-r"> names(odeini) <- gsub("_0", "", odeini_names)</pre> </td> </tr> <tr class="never"> - <td class="num">141</td> + <td class="num">235</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @author Johannes Ranke</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> - <td class="num">142</td> - <td class="coverage"></td> + <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">#' @rdname Extract.mmkin</pre> + <pre class="language-r"> out <- mkinpredict(x$mkinmod, odeparms_pop_i, odeini,</pre> </td> </tr> - <tr class="never"> - <td class="num">143</td> - <td class="coverage"></td> + <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">#' @examples</pre> + <pre class="language-r"> outtimes, solution_type = solution_type,</pre> </td> </tr> - <tr class="never"> - <td class="num">144</td> - <td class="coverage"></td> + <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">#'</pre> + <pre class="language-r"> atol = fit_1$atol, rtol = fit_1$rtol)</pre> </td> </tr> <tr class="never"> - <td class="num">145</td> + <td class="num">239</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> + <pre class="language-r"> })</pre> </td> </tr> - <tr class="never"> - <td class="num">146</td> - <td class="coverage"></td> + <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">#' fits <- mmkin(c("SFO", "FOMC"), list(B = FOCUS_2006_B, C = FOCUS_2006_C),</pre> + <pre class="language-r"> names(pred_list_pop) <- colnames(degparms_pop)</pre> </td> </tr> <tr class="never"> - <td class="num">147</td> + <td class="num">241</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' cores = 1, quiet = TRUE)</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">148</td> + <td class="num">242</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' fits["FOMC", ]</pre> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="never"> - <td class="num">149</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">243</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#' fits[, "B"]</pre> + <pre class="language-r"> pred_list_pop <- NULL</pre> </td> </tr> <tr class="never"> - <td class="num">150</td> + <td class="num">244</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' fits["SFO", "B"]</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">151</td> + <td class="num">245</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">152</td> + <td class="num">246</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' head(</pre> + <pre class="language-r"> # Start of graphical section</pre> </td> </tr> - <tr class="never"> - <td class="num">153</td> - <td class="coverage"></td> + <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">#' # This extracts an mkinfit object with lots of components</pre> + <pre class="language-r"> oldpar <- par(no.readonly = TRUE)</pre> </td> </tr> - <tr class="never"> - <td class="num">154</td> - <td class="coverage"></td> + <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">#' fits[["FOMC", "B"]]</pre> + <pre class="language-r"> on.exit(par(oldpar, no.readonly = TRUE))</pre> </td> </tr> <tr class="never"> - <td class="num">155</td> + <td class="num">249</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' )</pre> + <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">156</td> + <td class="num">252</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">157</td> + <td class="num">253</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">`[.mmkin` <- function(x, i, j, ..., drop = FALSE) {</pre> + <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">158</td> - <td class="coverage">2760<em>x</em></td> + <td class="num">254</td> + <td class="coverage">283<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> class(x) <- NULL</pre> + <pre class="language-r"> rel.heights <- if (n_plot_rows > 1) {</pre> </td> </tr> <tr class="covered"> - <td class="num">159</td> - <td class="coverage">2760<em>x</em></td> + <td class="num">255</td> + <td class="coverage">218<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> x_sub <- x[i, j, drop = drop]</pre> + <pre class="language-r"> c(rel.height.legend, c(rep(1, n_plot_rows - 1), rel.height.bottom))</pre> </td> </tr> - <tr class="covered"> - <td class="num">160</td> - <td class="coverage">2760<em>x</em></td> + <tr class="never"> + <td class="num">256</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (!drop) class(x_sub) <- "mmkin"</pre> + <pre class="language-r"> } else {</pre> </td> </tr> <tr class="covered"> - <td class="num">161</td> - <td class="coverage">2760<em>x</em></td> + <td class="num">257</td> + <td class="coverage">65<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> return(x_sub)</pre> + <pre class="language-r"> c(rel.height.legend, 1)</pre> </td> </tr> <tr class="never"> - <td class="num">162</td> + <td class="num">258</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">}</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">163</td> + <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">164</td> - <td class="coverage"></td> + <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">#' Print method for mmkin objects</pre> + <pre class="language-r"> layout_matrix = matrix(c(1, 1, 2:(n_plots + 1)),</pre> </td> </tr> - <tr class="never"> - <td class="num">165</td> - <td class="coverage"></td> + <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">#'</pre> + <pre class="language-r"> n_plot_rows + 1, 2, byrow = TRUE)</pre> </td> </tr> - <tr class="never"> - <td class="num">166</td> - <td class="coverage"></td> + <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">#' @param x An [mmkin] object.</pre> + <pre class="language-r"> layout(layout_matrix, heights = rel.heights)</pre> </td> </tr> <tr class="never"> - <td class="num">167</td> + <td class="num">263</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @param \dots Not used.</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> - <td class="num">168</td> - <td class="coverage"></td> + <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">#' @rdname mmkin</pre> + <pre class="language-r"> par(mar = c(0.1, 2.1, 0.1, 2.1))</pre> </td> </tr> <tr class="never"> - <td class="num">169</td> + <td class="num">265</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">170</td> + <td class="num">266</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">print.mmkin <- function(x, ...) {</pre> + <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">171</td> - <td class="coverage">375<em>x</em></td> + <td class="num">268</td> + <td class="coverage">283<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cat("<mmkin> object\n")</pre> + <pre class="language-r"> else lty_over <- NULL</pre> </td> </tr> <tr class="covered"> - <td class="num">172</td> - <td class="coverage">375<em>x</em></td> + <td class="num">269</td> + <td class="coverage">283<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cat("Status of individual fits:\n\n")</pre> + <pre class="language-r"> if (pop_curves) {</pre> </td> </tr> <tr class="covered"> - <td class="num">173</td> - <td class="coverage">375<em>x</em></td> + <td class="num">270</td> + <td class="coverage">283<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> print(status(x))</pre> + <pre class="language-r"> if (is.null(covariates)) {</pre> </td> </tr> - <tr class="never"> - <td class="num">174</td> - <td class="coverage"></td> + <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">}</pre> + <pre class="language-r"> lty_pop <- 1</pre> </td> </tr> - <tr class="never"> - <td class="num">175</td> - <td class="coverage"></td> + <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"></pre> + <pre class="language-r"> names(lty_pop) <- "Population"</pre> </td> </tr> <tr class="never"> - <td class="num">176</td> + <td class="num">273</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <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">177</td> + <td class="num">276</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">update.mmkin <- function(object, ..., evaluate = TRUE)</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">178</td> + <td class="num">277</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">{</pre> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="covered"> - <td class="num">179</td> - <td class="coverage">256<em>x</em></td> + <tr class="missed"> + <td class="num">278</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> call <- attr(object, "call")</pre> + <pre class="language-r"> lty_pop <- NULL</pre> </td> </tr> <tr class="never"> - <td class="num">180</td> + <td class="num">279</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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="num">280</td> + <td class="coverage">283<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> update_arguments <- match.call(expand.dots = FALSE)$...</pre> + <pre class="language-r"> n_pop_over <- length(lty_pop) + length(lty_over)</pre> </td> </tr> <tr class="never"> - <td class="num">182</td> + <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">183</td> - <td class="coverage">256<em>x</em></td> + <td class="num">282</td> + <td class="coverage">283<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (length(update_arguments) > 0) {</pre> + <pre class="language-r"> plot(0, type = "n", axes = FALSE, ann = FALSE)</pre> </td> </tr> <tr class="covered"> - <td class="num">184</td> - <td class="coverage">256<em>x</em></td> + <td class="num">283</td> + <td class="coverage">283<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> + <pre class="language-r"> legend("center", bty = "n", ncol = ncol.legend,</pre> </td> </tr> - <tr class="never"> - <td class="num">185</td> - <td class="coverage"></td> + <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"> }</pre> + <pre class="language-r"> legend = c(names(lty_pop), names(pred_over), ds_names[i]),</pre> </td> </tr> - <tr class="never"> - <td class="num">186</td> - <td class="coverage"></td> + <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"></pre> + <pre class="language-r"> lty = c(lty_pop, lty_over, lty_ds),</pre> </td> </tr> <tr class="covered"> - <td class="num">187</td> - <td class="coverage">256<em>x</em></td> + <td class="num">286</td> + <td class="coverage">283<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> for (a in names(update_arguments)[update_arguments_in_call]) {</pre> + <pre class="language-r"> lwd = c(rep(2, n_pop_over), rep(1, length(i))),</pre> </td> </tr> <tr class="covered"> - <td class="num">188</td> - <td class="coverage">115<em>x</em></td> + <td class="num">287</td> + <td class="coverage">283<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> call[[a]] <- update_arguments[[a]]</pre> + <pre class="language-r"> col = c(rep(1, n_pop_over), col_ds),</pre> </td> </tr> - <tr class="never"> - <td class="num">189</td> - <td class="coverage"></td> + <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"> }</pre> + <pre class="language-r"> pch = c(rep(NA, n_pop_over), pch_ds))</pre> </td> </tr> <tr class="never"> - <td class="num">190</td> + <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">191</td> - <td class="coverage">256<em>x</em></td> + <td class="num">290</td> + <td class="coverage">283<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> update_arguments_not_in_call <- !update_arguments_in_call</pre> + <pre class="language-r"> resplot <- match.arg(resplot)</pre> </td> </tr> - <tr class="covered"> - <td class="num">192</td> - <td class="coverage">256<em>x</em></td> + <tr class="never"> + <td class="num">291</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if(any(update_arguments_not_in_call)) {</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> - <td class="num">193</td> - <td class="coverage">206<em>x</em></td> + <tr class="never"> + <td class="num">292</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> + <pre class="language-r"> # Loop plot rows</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="num">293</td> + <td class="coverage">283<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> for (plot_row in 1:n_plot_rows) {</pre> </td> </tr> <tr class="never"> - <td class="num">196</td> + <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">197</td> - <td class="coverage">256<em>x</em></td> + <td class="num">295</td> + <td class="coverage">501<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if(evaluate) eval(call, parent.frame())</pre> + <pre class="language-r"> obs_var <- obs_vars[plot_row]</pre> </td> </tr> - <tr class="missed"> - <td class="num">198</td> - <td class="coverage">!</td> + <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"> else call</pre> + <pre class="language-r"> observed_row <- subset(observed, name == obs_var)</pre> </td> </tr> <tr class="never"> - <td class="num">199</td> + <td class="num">297</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">}</pre> + <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="num">298</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' Produce predictions from a kinetic model using specific parameters</pre> + <pre class="language-r"> # Set ylim to sensible default, or use ymax</pre> </td> </tr> - <tr class="never"> - <td class="num">2</td> - <td class="coverage"></td> + <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">#'</pre> + <pre class="language-r"> if (identical(ymax, "auto")) {</pre> </td> </tr> - <tr class="never"> - <td class="num">3</td> - <td class="coverage"></td> + <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">#' This function produces a time series for all the observed variables in a</pre> + <pre class="language-r"> ylim_row = c(0,</pre> </td> </tr> - <tr class="never"> - <td class="num">4</td> - <td class="coverage"></td> + <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">#' kinetic model as specified by [mkinmod], using a specific set of</pre> + <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">5</td> + <td class="num">302</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' kinetic parameters and initial values for the state variables.</pre> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="never"> - <td class="num">6</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">303</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> ylim_row = c(0, ymax[plot_row])</pre> </td> </tr> <tr class="never"> - <td class="num">7</td> + <td class="num">304</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @aliases mkinpredict mkinpredict.mkinmod mkinpredict.mkinfit</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">8</td> + <td class="num">305</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> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">9</td> + <td class="num">306</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> + <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">10</td> + <td class="num">307</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' the prediction.</pre> + <pre class="language-r"> # This is the only row that needs to show the x axis legend</pre> </td> </tr> - <tr class="never"> - <td class="num">11</td> - <td class="coverage"></td> + <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">#' @param odeparms A numeric vector specifying the parameters used in the</pre> + <pre class="language-r"> if (plot_row == n_plot_rows) {</pre> </td> </tr> - <tr class="never"> - <td class="num">12</td> - <td class="coverage"></td> + <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">#' kinetic model, which is generally defined as a set of ordinary differential</pre> + <pre class="language-r"> par(mar = c(5.1, 4.1, 1.1, 2.1))</pre> </td> </tr> <tr class="never"> - <td class="num">13</td> + <td class="num">310</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' equations.</pre> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="never"> - <td class="num">14</td> - <td class="coverage"></td> + <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">#' @param odeini A numeric vector containing the initial values of the state</pre> + <pre class="language-r"> par(mar = c(3.0, 4.1, 1.1, 2.1))</pre> </td> </tr> <tr class="never"> - <td class="num">15</td> + <td class="num">312</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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">16</td> + <td class="num">313</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> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> - <td class="num">17</td> - <td class="coverage"></td> + <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">#' @param outtimes A numeric vector specifying the time points for which model</pre> + <pre class="language-r"> plot(0, type = "n",</pre> </td> </tr> - <tr class="never"> - <td class="num">18</td> - <td class="coverage"></td> + <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">#' predictions should be generated.</pre> + <pre class="language-r"> xlim = xlim, ylim = ylim_row,</pre> </td> </tr> - <tr class="never"> - <td class="num">19</td> - <td class="coverage"></td> + <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">#' @param solution_type The method that should be used for producing the</pre> + <pre class="language-r"> xlab = xlab, ylab = paste("Residues", obs_var), frame = frame)</pre> </td> </tr> <tr class="never"> - <td class="num">20</td> + <td class="num">317</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> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> - <td class="num">21</td> - <td class="coverage"></td> + <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">#' observed variable, and usually "deSolve" in the case of several observed</pre> + <pre class="language-r"> if (!is.null(pred_over)) {</pre> </td> </tr> - <tr class="never"> - <td class="num">22</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">319</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> + <pre class="language-r"> for (i_over in seq_along(pred_over)) {</pre> </td> </tr> - <tr class="never"> - <td class="num">23</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">320</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> + <pre class="language-r"> pred_frame <- as.data.frame(pred_over[[i_over]])</pre> </td> </tr> - <tr class="never"> - <td class="num">24</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">321</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#' parent compound.</pre> + <pre class="language-r"> lines(pred_frame$time, pred_frame[[obs_var]],</pre> </td> </tr> - <tr class="never"> - <td class="num">25</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">322</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> + <pre class="language-r"> lwd = 2, lty = lty_over[i_over])</pre> </td> </tr> <tr class="never"> - <td class="num">26</td> + <td class="num">323</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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">27</td> + <td class="num">324</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' When using compiled code, only lsoda is supported.</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">28</td> + <td class="num">325</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> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> - <td class="num">29</td> - <td class="coverage"></td> + <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">#' [mkinmod] model is used, even if is present.</pre> + <pre class="language-r"> for (ds_i in seq_along(i)) {</pre> </td> </tr> - <tr class="never"> - <td class="num">30</td> - <td class="coverage"></td> + <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">#' @param use_symbols If set to \code{TRUE} (default), symbol info present in</pre> + <pre class="language-r"> points(subset(observed_row, ds == ds_names[ds_i], c("time", "value")),</pre> </td> </tr> - <tr class="never"> - <td class="num">31</td> - <td class="coverage"></td> + <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">#' the [mkinmod] object is used if available for accessing compiled code</pre> + <pre class="language-r"> col = col_ds[ds_i], pch = pch_ds[ds_i])</pre> </td> </tr> - <tr class="never"> - <td class="num">32</td> - <td class="coverage"></td> + <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">#' @param atol Absolute error tolerance, passed to the ode solver.</pre> + <pre class="language-r"> lines(subset(pred_ds, ds == ds_names[ds_i], c("time", obs_var)),</pre> </td> </tr> - <tr class="never"> - <td class="num">33</td> - <td class="coverage"></td> + <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">#' @param rtol Absolute error tolerance, passed to the ode solver.</pre> + <pre class="language-r"> col = col_ds[ds_i], lty = lty_ds[ds_i])</pre> </td> </tr> <tr class="never"> - <td class="num">34</td> + <td class="num">331</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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">35</td> + <td class="num">332</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> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> - <td class="num">36</td> - <td class="coverage"></td> + <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">#' the observed variables (default) or for all state variables (if set to</pre> + <pre class="language-r"> if (pop_curves) {</pre> </td> </tr> - <tr class="never"> - <td class="num">37</td> - <td class="coverage"></td> + <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">#' FALSE). Setting this to FALSE has no effect for analytical solutions,</pre> + <pre class="language-r"> for (cov_i in seq_along(pred_list_pop)) {</pre> </td> </tr> - <tr class="never"> - <td class="num">38</td> - <td class="coverage"></td> + <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">#' as these always return mapped output.</pre> + <pre class="language-r"> cov_name <- names(pred_list_pop)[cov_i]</pre> </td> </tr> - <tr class="never"> - <td class="num">39</td> - <td class="coverage"></td> + <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">#' @param na_stop Should it be an error if [ode] returns NaN values</pre> + <pre class="language-r"> lines(</pre> </td> </tr> - <tr class="never"> - <td class="num">40</td> - <td class="coverage"></td> + <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">#' @param \dots Further arguments passed to the ode solver in case such a</pre> + <pre class="language-r"> pred_list_pop[[cov_i]][, "time"],</pre> </td> </tr> - <tr class="never"> - <td class="num">41</td> - <td class="coverage"></td> + <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">#' solver is used.</pre> + <pre class="language-r"> pred_list_pop[[cov_i]][, obs_var],</pre> </td> </tr> - <tr class="never"> - <td class="num">42</td> - <td class="coverage"></td> + <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">#' @return A matrix with the numeric solution in wide format</pre> + <pre class="language-r"> type = "l", lwd = 2, lty = lty_pop[cov_i])</pre> </td> </tr> <tr class="never"> - <td class="num">43</td> + <td class="num">340</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @author Johannes Ranke</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">44</td> + <td class="num">341</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @examples</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">45</td> + <td class="num">342</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> - <td class="num">46</td> - <td class="coverage"></td> + <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">#' SFO <- mkinmod(degradinol = mkinsub("SFO"))</pre> + <pre class="language-r"> if (identical(maxabs, "auto")) {</pre> </td> </tr> - <tr class="never"> - <td class="num">47</td> - <td class="coverage"></td> + <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">#' # Compare solution types</pre> + <pre class="language-r"> maxabs = max(abs(observed_row$residual), na.rm = TRUE)</pre> </td> </tr> <tr class="never"> - <td class="num">48</td> + <td class="num">345</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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">49</td> + <td class="num">346</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' solution_type = "analytical")</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> - <td class="num">50</td> - <td class="coverage"></td> + <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">#' mkinpredict(SFO, c(k_degradinol = 0.3), c(degradinol = 100), 0:20,</pre> + <pre class="language-r"> if (identical(resplot, "time")) {</pre> </td> </tr> - <tr class="never"> - <td class="num">51</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">348</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#' solution_type = "deSolve")</pre> + <pre class="language-r"> plot(0, type = "n", xlim = xlim, xlab = "Time",</pre> </td> </tr> - <tr class="never"> - <td class="num">52</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">349</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> + <pre class="language-r"> ylim = c(-1.2 * maxabs, 1.2 * maxabs),</pre> </td> </tr> - <tr class="never"> - <td class="num">53</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">350</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#' solution_type = "deSolve", use_compiled = FALSE)</pre> + <pre class="language-r"> ylab = if (standardized) "Standardized residual" else "Residual",</pre> </td> </tr> - <tr class="never"> - <td class="num">54</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">351</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> + <pre class="language-r"> frame = frame)</pre> </td> </tr> <tr class="never"> - <td class="num">55</td> + <td class="num">352</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' solution_type = "eigen")</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> - <td class="num">56</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">353</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> abline(h = 0, lty = 2)</pre> </td> </tr> <tr class="never"> - <td class="num">57</td> + <td class="num">354</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' # Compare integration methods to analytical solution</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> - <td class="num">58</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">355</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> + <pre class="language-r"> for (ds_i in seq_along(i)) {</pre> </td> </tr> - <tr class="never"> - <td class="num">59</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">356</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#' solution_type = "analytical")[21,]</pre> + <pre class="language-r"> points(subset(observed_row, ds == ds_names[ds_i], c("time", "residual")),</pre> </td> </tr> - <tr class="never"> - <td class="num">60</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">357</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> + <pre class="language-r"> col = col_ds[ds_i], pch = pch_ds[ds_i])</pre> </td> </tr> <tr class="never"> - <td class="num">61</td> + <td class="num">358</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' method = "lsoda", use_compiled = FALSE)[21,]</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">62</td> + <td class="num">359</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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">63</td> + <td class="num">360</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' method = "ode45", use_compiled = FALSE)[21,]</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> - <td class="num">64</td> - <td class="coverage"></td> + <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">#' mkinpredict(SFO, c(k_degradinol = 0.3), c(degradinol = 100), 0:20,</pre> + <pre class="language-r"> if (identical(resplot, "predicted")) {</pre> </td> </tr> - <tr class="never"> - <td class="num">65</td> - <td class="coverage"></td> + <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">#' method = "rk4", use_compiled = FALSE)[21,]</pre> + <pre class="language-r"> plot(0, type = "n",</pre> </td> </tr> - <tr class="never"> - <td class="num">66</td> - <td class="coverage"></td> + <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">#' # rk4 is not as precise here</pre> + <pre class="language-r"> xlim = c(0, max(pred_ds[[obs_var]])),</pre> </td> </tr> - <tr class="never"> - <td class="num">67</td> - <td class="coverage"></td> + <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">#'</pre> + <pre class="language-r"> xlab = "Predicted",</pre> </td> </tr> - <tr class="never"> - <td class="num">68</td> - <td class="coverage"></td> + <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">#' # The number of output times used to make a lot of difference until the</pre> + <pre class="language-r"> ylim = c(-1.2 * maxabs, 1.2 * maxabs),</pre> </td> </tr> - <tr class="never"> - <td class="num">69</td> - <td class="coverage"></td> + <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">#' # default for atol was adjusted</pre> + <pre class="language-r"> ylab = if (standardized) "Standardized residual" else "Residual",</pre> </td> </tr> - <tr class="never"> - <td class="num">70</td> - <td class="coverage"></td> + <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">#' mkinpredict(SFO, c(k_degradinol = 0.3), c(degradinol = 100),</pre> + <pre class="language-r"> frame = frame)</pre> </td> </tr> <tr class="never"> - <td class="num">71</td> + <td class="num">368</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' seq(0, 20, by = 0.1))[201,]</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> - <td class="num">72</td> - <td class="coverage"></td> + <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">#' mkinpredict(SFO, c(k_degradinol = 0.3), c(degradinol = 100),</pre> + <pre class="language-r"> abline(h = 0, lty = 2)</pre> </td> </tr> <tr class="never"> - <td class="num">73</td> + <td class="num">370</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' seq(0, 20, by = 0.01))[2001,]</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> - <td class="num">74</td> - <td class="coverage"></td> + <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">#'</pre> + <pre class="language-r"> for (ds_i in seq_along(i)) {</pre> </td> </tr> - <tr class="never"> - <td class="num">75</td> - <td class="coverage"></td> + <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">#' # Comparison of the performance of solution types</pre> + <pre class="language-r"> observed_row_ds <- merge(</pre> </td> </tr> - <tr class="never"> - <td class="num">76</td> - <td class="coverage"></td> + <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">#' SFO_SFO = mkinmod(parent = list(type = "SFO", to = "m1"),</pre> + <pre class="language-r"> subset(observed_row, ds == ds_names[ds_i], c("time", "residual")),</pre> </td> </tr> - <tr class="never"> - <td class="num">77</td> - <td class="coverage"></td> + <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">#' m1 = list(type = "SFO"), use_of_ff = "max")</pre> + <pre class="language-r"> subset(pred_ds, ds == ds_names[ds_i], c("time", obs_var)))</pre> </td> </tr> - <tr class="never"> - <td class="num">78</td> - <td class="coverage"></td> + <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">#' if(require(rbenchmark)) {</pre> + <pre class="language-r"> points(observed_row_ds[c(3, 2)],</pre> </td> </tr> - <tr class="never"> - <td class="num">79</td> - <td class="coverage"></td> + <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">#' benchmark(replications = 10, order = "relative", columns = c("test", "relative", "elapsed"),</pre> + <pre class="language-r"> col = col_ds[ds_i], pch = pch_ds[ds_i])</pre> </td> </tr> <tr class="never"> - <td class="num">80</td> + <td class="num">377</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' eigen = mkinpredict(SFO_SFO,</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">81</td> + <td class="num">378</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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">82</td> + <td class="num">379</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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">83</td> + <td class="num">380</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' solution_type = "eigen")[201,],</pre> + <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">84</td> + <td class="num">1</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' deSolve_compiled = mkinpredict(SFO_SFO,</pre> + <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">85</td> + <td class="num">2</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> + <pre class="language-r">#' of an mmkin object</pre> </td> </tr> <tr class="never"> - <td class="num">86</td> + <td class="num">3</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> + <pre class="language-r">#'</pre> </td> </tr> <tr class="never"> - <td class="num">87</td> + <td class="num">4</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' solution_type = "deSolve")[201,],</pre> + <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">88</td> + <td class="num">5</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' deSolve = mkinpredict(SFO_SFO,</pre> + <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">89</td> + <td class="num">6</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> + <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">90</td> + <td class="num">7</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> + <pre class="language-r">#'</pre> </td> </tr> <tr class="never"> - <td class="num">91</td> + <td class="num">8</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' solution_type = "deSolve", use_compiled = FALSE)[201,],</pre> + <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">92</td> + <td class="num">9</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' analytical = mkinpredict(SFO_SFO,</pre> + <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">93</td> + <td class="num">10</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> + <pre class="language-r">#'</pre> </td> </tr> <tr class="never"> - <td class="num">94</td> + <td class="num">11</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> + <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">95</td> + <td class="num">12</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' solution_type = "analytical", use_compiled = FALSE)[201,])</pre> + <pre class="language-r">#' column.</pre> </td> </tr> <tr class="never"> - <td class="num">96</td> + <td class="num">13</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' }</pre> + <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">97</td> + <td class="num">14</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <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">98</td> + <td class="num">15</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' \dontrun{</pre> + <pre class="language-r">#' @param resplot Should the residuals plotted against time, using</pre> </td> </tr> <tr class="never"> - <td class="num">99</td> + <td class="num">16</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' # Predict from a fitted model</pre> + <pre class="language-r">#' \code{\link{mkinresplot}}, or as squared residuals against predicted</pre> </td> </tr> <tr class="never"> - <td class="num">100</td> + <td class="num">17</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' f <- mkinfit(SFO_SFO, FOCUS_2006_C, quiet = TRUE)</pre> + <pre class="language-r">#' values, with the error model, using \code{\link{mkinerrplot}}.</pre> </td> </tr> <tr class="never"> - <td class="num">101</td> + <td class="num">18</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> + <pre class="language-r">#' @param ylab Label for the y axis.</pre> </td> </tr> <tr class="never"> - <td class="num">102</td> + <td class="num">19</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' head(mkinpredict(f))</pre> + <pre class="language-r">#' @param standardized Should the residuals be standardized? This option</pre> </td> </tr> <tr class="never"> - <td class="num">103</td> + <td class="num">20</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' }</pre> + <pre class="language-r">#' is passed to \code{\link{mkinresplot}}, it only takes effect if</pre> </td> </tr> <tr class="never"> - <td class="num">104</td> + <td class="num">21</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r">#' `resplot = "time"`.</pre> </td> </tr> <tr class="never"> - <td class="num">105</td> + <td class="num">22</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <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">106</td> + <td class="num">23</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">mkinpredict <- function(x, odeparms, odeini, outtimes, ...)</pre> + <pre class="language-r">#' to the left?</pre> </td> </tr> <tr class="never"> - <td class="num">107</td> + <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">108</td> - <td class="coverage">47544878<em>x</em></td> - <td class="col-sm-12"> - <pre class="language-r"> UseMethod("mkinpredict", x)</pre> + <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">109</td> + <td class="num">25</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">}</pre> + <pre class="language-r">#' be shown.</pre> </td> </tr> <tr class="never"> - <td class="num">110</td> + <td class="num">26</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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">111</td> + <td class="num">27</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @rdname mkinpredict</pre> + <pre class="language-r">#' chi2 error percentage.</pre> </td> </tr> <tr class="never"> - <td class="num">112</td> + <td class="num">28</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <pre class="language-r">#' @param cex Passed to the plot functions and \code{\link{mtext}}.</pre> </td> </tr> <tr class="never"> - <td class="num">113</td> + <td class="num">29</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">mkinpredict.mkinmod <- function(x,</pre> + <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">114</td> + <td class="num">30</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> odeparms = c(k_parent_sink = 0.1),</pre> + <pre class="language-r">#' than two rows of plots are shown.</pre> </td> </tr> <tr class="never"> - <td class="num">115</td> + <td class="num">31</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> odeini = c(parent = 100),</pre> + <pre class="language-r">#' @param ymax Maximum y axis value for \code{\link{plot.mkinfit}}.</pre> </td> </tr> <tr class="never"> - <td class="num">116</td> + <td class="num">32</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> outtimes = seq(0, 120, by = 0.1),</pre> + <pre class="language-r">#' @param \dots Further arguments passed to \code{\link{plot.mkinfit}} and</pre> </td> </tr> <tr class="never"> - <td class="num">117</td> + <td class="num">33</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> solution_type = "deSolve",</pre> + <pre class="language-r">#' \code{\link{mkinresplot}}.</pre> </td> </tr> <tr class="never"> - <td class="num">118</td> + <td class="num">34</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> use_compiled = "auto",</pre> + <pre class="language-r">#' @return The function is called for its side effect.</pre> </td> </tr> <tr class="never"> - <td class="num">119</td> + <td class="num">35</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> use_symbols = FALSE,</pre> + <pre class="language-r">#' @author Johannes Ranke</pre> </td> </tr> <tr class="never"> - <td class="num">120</td> + <td class="num">36</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> + <pre class="language-r">#' @examples</pre> </td> </tr> <tr class="never"> - <td class="num">121</td> + <td class="num">37</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> map_output = TRUE,</pre> + <pre class="language-r">#'</pre> </td> </tr> <tr class="never"> - <td class="num">122</td> + <td class="num">38</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> na_stop = TRUE,</pre> + <pre class="language-r">#' \dontrun{</pre> </td> </tr> <tr class="never"> - <td class="num">123</td> + <td class="num">39</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> ...)</pre> + <pre class="language-r">#' # Only use one core not to offend CRAN checks</pre> </td> </tr> <tr class="never"> - <td class="num">124</td> + <td class="num">40</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">{</pre> + <pre class="language-r">#' fits <- mmkin(c("FOMC", "HS"),</pre> </td> </tr> <tr class="never"> - <td class="num">125</td> + <td class="num">41</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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">126</td> + <td class="num">42</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> + <pre class="language-r">#' cores = 1, quiet = TRUE, error_model = "tc")</pre> </td> </tr> <tr class="never"> - <td class="num">129</td> + <td class="num">43</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' plot(fits[, "FOCUS C"])</pre> </td> </tr> <tr class="never"> - <td class="num">130</td> + <td class="num">44</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> + <pre class="language-r">#' plot(fits["FOMC", ])</pre> </td> </tr> <tr class="never"> - <td class="num">133</td> + <td class="num">45</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">#' plot(fits["FOMC", ], show_errmin = FALSE)</pre> </td> </tr> <tr class="never"> - <td class="num">134</td> + <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">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> + <pre class="language-r">#'</pre> </td> </tr> <tr class="never"> - <td class="num">138</td> + <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">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> + <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">140</td> + <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">141</td> - <td class="coverage">47544878<em>x</em></td> - <td class="col-sm-12"> - <pre class="language-r"> if (solution_type == "analytical") {</pre> + <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">142</td> + <td class="num">49</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> + <pre class="language-r">#' # generated by pkgdown, as far as I know).</pre> </td> </tr> <tr class="never"> - <td class="num">143</td> + <td class="num">50</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> + <pre class="language-r">#' plot(fits["FOMC", "FOCUS C"]) # same as plot(fits[1, 2])</pre> </td> </tr> - <tr class="covered"> - <td class="num">145</td> - <td class="coverage">1843695<em>x</em></td> + <tr class="never"> + <td class="num">51</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> data.frame(name = rep(obs_vars, each = length(outtimes)),</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> - <td class="num">146</td> - <td class="coverage">1843695<em>x</em></td> + <tr class="never"> + <td class="num">52</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> time = rep(outtimes, length(obs_vars)))</pre> + <pre class="language-r">#' # Show the error models</pre> </td> </tr> - <tr class="covered"> - <td class="num">147</td> - <td class="coverage">1843695<em>x</em></td> + <tr class="never"> + <td class="num">53</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> pseudo_observed$predicted <- x$deg_func(pseudo_observed, odeini, odeparms)</pre> + <pre class="language-r">#' plot(fits["FOMC", ], resplot = "errmod")</pre> </td> </tr> - <tr class="covered"> - <td class="num">148</td> - <td class="coverage">1843695<em>x</em></td> + <tr class="never"> + <td class="num">54</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> for (obs_var in obs_vars) {</pre> + <pre class="language-r">#' }</pre> </td> </tr> - <tr class="covered"> - <td class="num">149</td> - <td class="coverage">2431585<em>x</em></td> + <tr class="never"> + <td class="num">55</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> out_obs[, obs_var] <- pseudo_observed[pseudo_observed$name == obs_var, "predicted"]</pre> + <pre class="language-r">#'</pre> </td> </tr> <tr class="never"> - <td class="num">150</td> + <td class="num">56</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">#' @export</pre> </td> </tr> <tr class="never"> - <td class="num">151</td> + <td class="num">57</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> + <pre class="language-r">plot.mmkin <- function(x, main = "auto", legends = 1,</pre> </td> </tr> <tr class="never"> - <td class="num">152</td> + <td class="num">58</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # analytical solutions is always mapped to observed variables</pre> + <pre class="language-r"> resplot = c("time", "errmod"),</pre> </td> </tr> - <tr class="covered"> - <td class="num">153</td> - <td class="coverage">1843695<em>x</em></td> + <tr class="never"> + <td class="num">59</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> return(out_obs)</pre> + <pre class="language-r"> ylab = "Residue",</pre> </td> </tr> <tr class="never"> - <td class="num">154</td> + <td class="num">60</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> standardized = FALSE,</pre> </td> </tr> <tr class="never"> - <td class="num">155</td> + <td class="num">61</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> show_errmin = TRUE,</pre> </td> </tr> - <tr class="covered"> - <td class="num">156</td> - <td class="coverage">45701183<em>x</em></td> + <tr class="never"> + <td class="num">62</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (solution_type == "eigen") {</pre> + <pre class="language-r"> errmin_var = "All data", errmin_digits = 3,</pre> </td> </tr> - <tr class="covered"> - <td class="num">157</td> - <td class="coverage">97082<em>x</em></td> + <tr class="never"> + <td class="num">63</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> evalparse <- function(string) {</pre> + <pre class="language-r"> cex = 0.7, rel.height.middle = 0.9,</pre> </td> </tr> - <tr class="covered"> - <td class="num">158</td> - <td class="coverage">392283<em>x</em></td> + <tr class="never"> + <td class="num">64</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> eval(parse(text=string), as.list(c(odeparms, odeini)))</pre> + <pre class="language-r"> ymax = "auto", ...)</pre> </td> </tr> <tr class="never"> - <td class="num">159</td> + <td class="num">65</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">{</pre> </td> </tr> <tr class="never"> - <td class="num">160</td> + <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">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="num">67</td> + <td class="coverage">316<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> nrow = length(mod_vars))</pre> + <pre class="language-r"> oldpar <- par(no.readonly = TRUE)</pre> </td> </tr> <tr class="covered"> - <td class="num">163</td> - <td class="coverage">97082<em>x</em></td> + <td class="num">68</td> + <td class="coverage">316<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> e <- eigen(coefmat.num)</pre> + <pre class="language-r"> on.exit(par(oldpar, no.readonly = TRUE))</pre> </td> </tr> - <tr class="covered"> - <td class="num">164</td> - <td class="coverage">97082<em>x</em></td> + <tr class="never"> + <td class="num">69</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> c <- solve(e$vectors, odeini)</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">165</td> - <td class="coverage">97082<em>x</em></td> + <td class="num">70</td> + <td class="coverage">316<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> f.out <- function(t) {</pre> + <pre class="language-r"> n.m <- nrow(x)</pre> </td> </tr> <tr class="covered"> - <td class="num">166</td> - <td class="coverage">1085040<em>x</em></td> + <td class="num">71</td> + <td class="coverage">316<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> + <pre class="language-r"> n.d <- ncol(x)</pre> </td> </tr> <tr class="never"> - <td class="num">167</td> + <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">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> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">170</td> - <td class="coverage">97082<em>x</em></td> + <td class="num">73</td> + <td class="coverage">316<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> out <- cbind(outtimes, t(o))</pre> + <pre class="language-r"> resplot <- match.arg(resplot)</pre> </td> </tr> - <tr class="covered"> - <td class="num">171</td> - <td class="coverage">97082<em>x</em></td> + <tr class="never"> + <td class="num">74</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> colnames(out) <- c("time", mod_vars)</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">172</td> + <td class="num">75</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> # We can handle either a row (different models, same dataset)</pre> </td> </tr> <tr class="never"> - <td class="num">173</td> + <td class="num">76</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> # or a column (same model, different datasets)</pre> </td> </tr> - <tr class="covered"> - <td class="num">174</td> - <td class="coverage">45701183<em>x</em></td> + <tr class="missed"> + <td class="num">77</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> if (solution_type == "deSolve") {</pre> + <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="covered"> - <td class="num">175</td> - <td class="coverage">45604101<em>x</em></td> + <tr class="missed"> + <td class="num">78</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> if (!is.null(x$cf) & use_compiled[1] != FALSE) {</pre> + <pre class="language-r"> if (n.m == 1 & n.d == 1) loop_over = "none"</pre> </td> </tr> - <tr class="never"> - <td class="num">176</td> - <td class="coverage"></td> + <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"></pre> + <pre class="language-r"> if (n.m > 1) loop_over <- "models"</pre> </td> </tr> <tr class="covered"> - <td class="num">177</td> - <td class="coverage">45603235<em>x</em></td> + <td class="num">80</td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (!is.null(x$symbols) & use_symbols) {</pre> + <pre class="language-r"> if (n.d > 1) loop_over <- "datasets"</pre> </td> </tr> <tr class="covered"> - <td class="num">178</td> - <td class="coverage">1427314<em>x</em></td> + <td class="num">81</td> + <td class="coverage">316<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> lsoda_func <- x$symbols</pre> + <pre class="language-r"> n.fits <- length(x)</pre> </td> </tr> <tr class="never"> - <td class="num">179</td> + <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">180</td> - <td class="coverage">44175921<em>x</em></td> - <td class="col-sm-12"> - <pre class="language-r"> lsoda_func <- "diffs"</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">181</td> + <td class="num">83</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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">182</td> + <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">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> + <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">188</td> - <td class="coverage">45603235<em>x</em></td> + <td class="num">85</td> + <td class="coverage">316<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> dllname = x$dll_info[["name"]],</pre> + <pre class="language-r"> if (main == "auto") {</pre> </td> </tr> <tr class="covered"> - <td class="num">189</td> - <td class="coverage">45603235<em>x</em></td> + <td class="num">86</td> + <td class="coverage">140<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> parms = odeparms[x$parms], # Order matters when using compiled models</pre> + <pre class="language-r"> main = switch(loop_over,</pre> </td> </tr> <tr class="covered"> - <td class="num">190</td> - <td class="coverage">45603235<em>x</em></td> + <td class="num">87</td> + <td class="coverage">140<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> atol = atol,</pre> + <pre class="language-r"> none = paste(rownames(x), colnames(x)),</pre> </td> </tr> <tr class="covered"> - <td class="num">191</td> - <td class="coverage">45603235<em>x</em></td> + <td class="num">88</td> + <td class="coverage">140<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> rtol = rtol,</pre> + <pre class="language-r"> models = colnames(x),</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="num">89</td> + <td class="coverage">140<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ...</pre> + <pre class="language-r"> datasets = rownames(x))</pre> </td> </tr> <tr class="never"> - <td class="num">194</td> + <td class="num">90</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> )</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">195</td> + <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">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="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">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> + <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">199</td> + <td class="num">93</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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">200</td> - <td class="coverage">145229<em>x</em></td> + <td class="num">94</td> + <td class="coverage">316<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> time <- t</pre> + <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">201</td> - <td class="coverage">145229<em>x</em></td> + <td class="num">95</td> + <td class="coverage">316<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> diffs <- vector()</pre> + <pre class="language-r"> else rep(1, n.fits)</pre> </td> </tr> <tr class="covered"> - <td class="num">202</td> - <td class="coverage">145229<em>x</em></td> + <td class="num">96</td> + <td class="coverage">316<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> for (box in names(x$diffs))</pre> + <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">203</td> + <td class="num">97</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> {</pre> + <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="num">98</td> + <td class="coverage">316<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> diffname <- paste("d", box, sep="_")</pre> + <pre class="language-r"> par(cex = cex)</pre> </td> </tr> - <tr class="covered"> - <td class="num">205</td> - <td class="coverage">145229<em>x</em></td> + <tr class="never"> + <td class="num">99</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> diffs[diffname] <- with(as.list(c(time, state, parms)),</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">206</td> - <td class="coverage">145229<em>x</em></td> + <td class="num">100</td> + <td class="coverage">316<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> eval(parse(text=x$diffs[[box]])))</pre> + <pre class="language-r"> for (i.fit in 1:n.fits) {</pre> </td> </tr> <tr class="never"> - <td class="num">207</td> + <td class="num">101</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> - <td class="num">208</td> - <td class="coverage">145229<em>x</em></td> + <tr class="never"> + <td class="num">102</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> return(list(c(diffs)))</pre> + <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">209</td> + <td class="num">103</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> # Reduce bottom margin by 2.1 - hides x axis legend</pre> </td> </tr> <tr class="covered"> - <td class="num">210</td> - <td class="coverage">866<em>x</em></td> + <td class="num">104</td> + <td class="coverage">948<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> out <- deSolve::ode(</pre> + <pre class="language-r"> if (i.fit == 1 & n.fits > 1) {</pre> </td> </tr> <tr class="covered"> - <td class="num">211</td> - <td class="coverage">866<em>x</em></td> + <td class="num">105</td> + <td class="coverage">316<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> y = odeini,</pre> + <pre class="language-r"> par(mar = c(3.0, 4.1, 4.1, 2.1))</pre> </td> </tr> - <tr class="covered"> - <td class="num">212</td> - <td class="coverage">866<em>x</em></td> + <tr class="never"> + <td class="num">106</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> times = outtimes,</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> - <td class="num">213</td> - <td class="coverage">866<em>x</em></td> + <tr class="never"> + <td class="num">107</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> func = mkindiff,</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> - <td class="num">214</td> - <td class="coverage">866<em>x</em></td> + <tr class="never"> + <td class="num">108</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> parms = odeparms,</pre> + <pre class="language-r"> # Margins for middle rows of plots, if any</pre> </td> </tr> <tr class="covered"> - <td class="num">215</td> - <td class="coverage">866<em>x</em></td> + <td class="num">109</td> + <td class="coverage">948<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> method = method.ode,</pre> + <pre class="language-r"> if (i.fit > 1 & i.fit < n.fits) {</pre> </td> </tr> - <tr class="covered"> - <td class="num">216</td> - <td class="coverage">866<em>x</em></td> + <tr class="never"> + <td class="num">110</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> atol = atol,</pre> + <pre class="language-r"> # Reduce top margin by 2 after the first plot as we have no main title,</pre> </td> </tr> - <tr class="covered"> - <td class="num">217</td> - <td class="coverage">866<em>x</em></td> + <tr class="never"> + <td class="num">111</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> rtol = rtol,</pre> + <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">218</td> - <td class="coverage">866<em>x</em></td> + <td class="num">112</td> + <td class="coverage">316<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> maxsteps = maxsteps,</pre> + <pre class="language-r"> par(mar = c(3.0, 4.1, 2.1, 2.1))</pre> </td> </tr> <tr class="never"> - <td class="num">219</td> + <td class="num">113</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> ...</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">220</td> + <td class="num">114</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> )</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">221</td> + <td class="num">115</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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">222</td> - <td class="coverage">45604101<em>x</em></td> + <td class="num">116</td> + <td class="coverage">948<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> n_out_na <- sum(is.na(out))</pre> + <pre class="language-r"> if (i.fit == n.fits & n.fits > 1) {</pre> </td> </tr> - <tr class="covered"> - <td class="num">223</td> - <td class="coverage">45604101<em>x</em></td> + <tr class="never"> + <td class="num">117</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (n_out_na > 0 & na_stop) {</pre> + <pre class="language-r"> # Restore bottom margin for last plot to show x axis legend</pre> </td> </tr> - <tr class="missed"> - <td class="num">224</td> - <td class="coverage">!</td> + <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"> cat("odeini:\n")</pre> + <pre class="language-r"> par(mar = c(5.1, 4.1, 2.1, 2.1))</pre> </td> </tr> - <tr class="missed"> - <td class="num">225</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">119</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> print(odeini)</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="missed"> - <td class="num">226</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">120</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("odeparms:\n")</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="missed"> - <td class="num">227</td> - <td class="coverage">!</td> + <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"> print(odeparms)</pre> + <pre class="language-r"> fit <- x[[i.fit]]</pre> </td> </tr> - <tr class="missed"> - <td class="num">228</td> - <td class="coverage">!</td> + <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"> cat("out:\n")</pre> + <pre class="language-r"> if (ymax == "auto") {</pre> </td> </tr> - <tr class="missed"> - <td class="num">229</td> - <td class="coverage">!</td> + <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"> print(out)</pre> + <pre class="language-r"> plot(fit, legend = legends == i.fit, ylab = ylab, ...)</pre> </td> </tr> - <tr class="missed"> - <td class="num">230</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">124</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> + <pre class="language-r"> } else {</pre> </td> </tr> <tr class="missed"> - <td class="num">231</td> + <td class="num">125</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> + <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">232</td> + <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">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="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">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="num">128</td> + <td class="coverage">948<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> available <- c(TRUE, rep(FALSE, length(outtimes) - 1))</pre> + <pre class="language-r"> title(main, outer = TRUE, line = -2)</pre> </td> </tr> <tr class="never"> - <td class="num">240</td> + <td class="num">129</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r"></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="num">130</td> + <td class="coverage">948<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> fit_name <- switch(loop_over,</pre> </td> </tr> <tr class="covered"> - <td class="num">243</td> - <td class="coverage">45701183<em>x</em></td> + <td class="num">131</td> + <td class="coverage">948<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> for (var in names(x$map)) {</pre> + <pre class="language-r"> models = rownames(x)[i.fit],</pre> </td> </tr> <tr class="covered"> - <td class="num">244</td> - <td class="coverage">93237433<em>x</em></td> + <td class="num">132</td> + <td class="coverage">948<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if((length(x$map[[var]]) == 1)) {</pre> + <pre class="language-r"> datasets = colnames(x)[i.fit],</pre> </td> </tr> <tr class="covered"> - <td class="num">245</td> - <td class="coverage">93235081<em>x</em></td> + <td class="num">133</td> + <td class="coverage">948<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> out_obs[available, var] <- out[available, var]</pre> + <pre class="language-r"> none = "")</pre> </td> </tr> <tr class="never"> - <td class="num">246</td> + <td class="num">134</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">247</td> - <td class="coverage">2352<em>x</em></td> + <td class="num">135</td> + <td class="coverage">948<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> out_obs[available, var] <- out[available, x$map[[var]][1]] +</pre> + <pre class="language-r"> if (show_errmin) {</pre> </td> </tr> <tr class="covered"> - <td class="num">248</td> - <td class="coverage">2352<em>x</em></td> + <td class="num">136</td> + <td class="coverage">948<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> out[available, x$map[[var]][2]]</pre> + <pre class="language-r"> chi2 <- signif(100 * mkinerrmin(fit)[errmin_var, "err.min"], errmin_digits)</pre> </td> </tr> <tr class="never"> - <td class="num">249</td> + <td class="num">137</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">250</td> + <td class="num">138</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> # Use LateX if the current plotting device is tikz</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="num">139</td> + <td class="coverage">948<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> dimnames(out) <- list(time = as.character(outtimes), c("time", mod_vars))</pre> + <pre class="language-r"> if (names(dev.cur()) == "tikz output") {</pre> </td> </tr> <tr class="missed"> - <td class="num">254</td> + <td class="num">140</td> <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> return(out)</pre> + <pre class="language-r"> chi2_text <- paste0(fit_name, " $\\chi^2$ error level = ", chi2, "\\%")</pre> </td> </tr> <tr class="never"> - <td class="num">255</td> + <td class="num">141</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="never"> - <td class="num">256</td> - <td class="coverage"></td> + <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">}</pre> + <pre class="language-r"> chi2_perc <- paste0(chi2, "%")</pre> </td> </tr> - <tr class="never"> - <td class="num">257</td> - <td class="coverage"></td> + <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"></pre> + <pre class="language-r"> chi2_text <- bquote(.(fit_name) ~ chi^2 ~ "error level" == .(chi2_perc))</pre> </td> </tr> <tr class="never"> - <td class="num">258</td> + <td class="num">144</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @rdname mkinpredict</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="never"> - <td class="num">259</td> - <td class="coverage"></td> + <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">#' @export</pre> + <pre class="language-r"> mtext(chi2_text, cex = cex, line = 0.4)</pre> </td> </tr> <tr class="never"> - <td class="num">260</td> + <td class="num">146</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">mkinpredict.mkinfit <- function(x,</pre> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="never"> - <td class="num">261</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">147</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> odeparms = x$bparms.ode,</pre> + <pre class="language-r"> mtext(fit_name, cex = cex, line = 0.4)</pre> </td> </tr> <tr class="never"> - <td class="num">262</td> + <td class="num">148</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> odeini = x$bparms.state,</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">263</td> + <td class="num">149</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> outtimes = seq(0, 120, by = 0.1),</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> - <td class="num">264</td> - <td class="coverage"></td> + <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"> solution_type = "deSolve",</pre> + <pre class="language-r"> if (resplot == "time") {</pre> </td> </tr> - <tr class="never"> - <td class="num">265</td> - <td class="coverage"></td> + <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"> use_compiled = "auto",</pre> + <pre class="language-r"> mkinresplot(fit, legend = FALSE, standardized = standardized, ...)</pre> </td> </tr> <tr class="never"> - <td class="num">266</td> + <td class="num">152</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> method.ode = "lsoda", atol = 1e-8, rtol = 1e-10,</pre> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="never"> - <td class="num">267</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">153</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> map_output = TRUE, ...)</pre> + <pre class="language-r"> mkinerrplot(fit, legend = FALSE, ...)</pre> </td> </tr> <tr class="never"> - <td class="num">268</td> + <td class="num">154</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">{</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="missed"> - <td class="num">269</td> - <td class="coverage">!</td> + <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"> mkinpredict(x$mkinmod, odeparms, odeini, outtimes, solution_type, use_compiled,</pre> + <pre class="language-r"> mtext(paste(fit_name, "residuals"), cex = cex, line = 0.4)</pre> </td> </tr> - <tr class="missed"> - <td class="num">270</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">156</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> method.ode, atol, rtol, map_output, ...)</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">271</td> + <td class="num">157</td> <td class="coverage"></td> <td class="col-sm-12"> <pre class="language-r">}</pre> @@ -40580,455 +36712,455 @@ table.table-condensed { </tbody> </table> </div> - <div id="R/nlme.R" class="hidden"> + <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">#' Helper functions to create nlme models from mmkin row objects</pre> + <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> + <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> + <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">#' an mmkin row object. An mmkin row object is essentially a list of mkinfit</pre> + <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">#' objects that have been obtained by fitting the same model to a list of</pre> + <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">#' datasets. They are used internally by the [nlme.mmkin()] method.</pre> + <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">#'</pre> + <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">#' @param object An mmkin row object containing several fits of the same model to different datasets</pre> + <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">#' @import nlme</pre> + <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">#' @rdname nlme</pre> + <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">#' @seealso \code{\link{nlme.mmkin}}</pre> + <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">#' @examples</pre> + <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">#' sampling_times = c(0, 1, 3, 7, 14, 28, 60, 90, 120)</pre> + <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">#' m_SFO <- mkinmod(parent = mkinsub("SFO"))</pre> + <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">#' d_SFO_1 <- mkinpredict(m_SFO,</pre> + <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">#' c(k_parent = 0.1),</pre> + <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">#' c(parent = 98), sampling_times)</pre> + <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">#' d_SFO_1_long <- mkin_wide_to_long(d_SFO_1, time = "time")</pre> + <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">#' d_SFO_2 <- mkinpredict(m_SFO,</pre> + <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">#' c(k_parent = 0.05),</pre> + <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">#' c(parent = 102), sampling_times)</pre> + <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">#' d_SFO_2_long <- mkin_wide_to_long(d_SFO_2, time = "time")</pre> + <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">#' d_SFO_3 <- mkinpredict(m_SFO,</pre> + <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">#' c(k_parent = 0.02),</pre> + <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">#' c(parent = 103), sampling_times)</pre> + <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">#' d_SFO_3_long <- mkin_wide_to_long(d_SFO_3, time = "time")</pre> + <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">#'</pre> + <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">#' d1 <- add_err(d_SFO_1, function(value) 3, n = 1)</pre> + <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">#' d2 <- add_err(d_SFO_2, function(value) 2, n = 1)</pre> + <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">#' d3 <- add_err(d_SFO_3, function(value) 4, n = 1)</pre> + <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">#' ds <- c(d1 = d1, d2 = d2, d3 = d3)</pre> + <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">#'</pre> + <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">#' f <- mmkin("SFO", ds, cores = 1, quiet = TRUE)</pre> + <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">#' mean_dp <- mean_degparms(f)</pre> + <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">#' grouped_data <- nlme_data(f)</pre> + <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">#' nlme_f <- nlme_function(f)</pre> + <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">#' # These assignments are necessary for these objects to be</pre> + <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">#' # visible to nlme and augPred when evaluation is done by</pre> + <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">#' # pkgdown to generate the html docs.</pre> + <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">#' assign("nlme_f", nlme_f, globalenv())</pre> + <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">#' assign("grouped_data", grouped_data, globalenv())</pre> + <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">#'</pre> + <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">#' library(nlme)</pre> + <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">#' m_nlme <- nlme(value ~ nlme_f(name, time, parent_0, log_k_parent_sink),</pre> + <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">#' data = grouped_data,</pre> + <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">#' fixed = parent_0 + log_k_parent_sink ~ 1,</pre> + <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">#' random = pdDiag(parent_0 + log_k_parent_sink ~ 1),</pre> + <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">#' start = mean_dp)</pre> + <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">#' summary(m_nlme)</pre> + <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">#' plot(augPred(m_nlme, level = 0:1), layout = c(3, 1))</pre> + <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">#' # augPred does not work on fits with more than one state</pre> + <pre class="language-r">{</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">52</td> - <td class="coverage"></td> + <td class="coverage">1228<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' # variable</pre> + <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> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">54</td> - <td class="coverage"></td> + <td class="coverage">1228<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' # The procedure is greatly simplified by the nlme.mmkin function</pre> + <pre class="language-r"> if (length(obs_vars) > 0){</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">55</td> - <td class="coverage"></td> + <td class="coverage">1228<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' f_nlme <- nlme(f)</pre> + <pre class="language-r"> obs_vars <- intersect(obs_vars_all, obs_vars)</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">56</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#' plot(f_nlme)</pre> + <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">#' @return A function that can be used with nlme</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">58</td> - <td class="coverage"></td> + <td class="coverage">1228<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <pre class="language-r"> if (standardized) {</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">59</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">nlme_function <- function(object) {</pre> + <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"> if (nrow(object) > 1) stop("Only row objects allowed")</pre> + <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"></pre> + <pre class="language-r"> } else {</pre> </td> </tr> <tr class="covered"> <td class="num">62</td> - <td class="coverage">1168<em>x</em></td> + <td class="coverage">1228<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> mkin_model <- object[[1]]$mkinmod</pre> + <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> + <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="coverage">1228<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> degparm_names <- names(mean_degparms(object))</pre> + <pre class="language-r"> res <- subset(object$data, variable %in% obs_vars)[res_col]</pre> </td> </tr> <tr class="never"> @@ -41038,151 +37170,151 @@ table.table-condensed { <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">66</td> - <td class="coverage"></td> + <td class="coverage">1228<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Inspired by https://stackoverflow.com/a/12983961/3805440</pre> + <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"> # and https://stackoverflow.com/a/26280789/3805440</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">68</td> - <td class="coverage">1168<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> model_function_alist <- replicate(length(degparm_names) + 2, substitute())</pre> + <pre class="language-r"> # Set colors and symbols</pre> </td> </tr> <tr class="covered"> <td class="num">69</td> - <td class="coverage">1168<em>x</em></td> + <td class="coverage">1228<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> names(model_function_alist) <- c("name", "time", degparm_names)</pre> + <pre class="language-r"> if (col_obs[1] == "auto") {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">70</td> - <td class="coverage"></td> + <td class="coverage">948<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> col_obs <- 1:length(obs_vars)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">71</td> - <td class="coverage">1168<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> model_function_body <- quote({</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">72</td> - <td class="coverage">252739<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> arg_frame <- as.data.frame(as.list((environment())), stringsAsFactors = FALSE)</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">73</td> - <td class="coverage">252739<em>x</em></td> + <td class="coverage">1228<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> res_frame <- arg_frame[1:2]</pre> + <pre class="language-r"> if (pch_obs[1] == "auto") {</pre> </td> </tr> <tr class="covered"> <td class="num">74</td> - <td class="coverage">252739<em>x</em></td> + <td class="coverage">948<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> parm_frame <- arg_frame[-(1:2)]</pre> + <pre class="language-r"> pch_obs <- 1:length(obs_vars)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">75</td> - <td class="coverage">252739<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> parms_unique <- unique(parm_frame)</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">76</td> - <td class="coverage"></td> + <td class="coverage">1228<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> names(col_obs) <- names(pch_obs) <- obs_vars</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">77</td> - <td class="coverage">252739<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> n_unique <- nrow(parms_unique)</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">78</td> - <td class="coverage"></td> + <td class="coverage">1228<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> plot(0, type = "n", frame = frame,</pre> </td> </tr> <tr class="covered"> <td class="num">79</td> - <td class="coverage">252739<em>x</em></td> + <td class="coverage">1228<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> times_ds <- list()</pre> + <pre class="language-r"> xlab = xlab, ylab = ylab,</pre> </td> </tr> <tr class="covered"> <td class="num">80</td> - <td class="coverage">252739<em>x</em></td> + <td class="coverage">1228<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> names_ds <- list()</pre> + <pre class="language-r"> xlim = xlim,</pre> </td> </tr> <tr class="covered"> <td class="num">81</td> - <td class="coverage">252739<em>x</em></td> + <td class="coverage">1228<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> for (i in 1:n_unique) {</pre> + <pre class="language-r"> ylim = c(-1.2 * maxabs, 1.2 * maxabs), ...)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">82</td> - <td class="coverage">2342789<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> times_ds[[i]] <-</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">83</td> - <td class="coverage">2342789<em>x</em></td> + <td class="coverage">1228<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> + <pre class="language-r"> for(obs_var in obs_vars){</pre> </td> </tr> <tr class="covered"> <td class="num">84</td> - <td class="coverage">2342789<em>x</em></td> + <td class="coverage">1298<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> names_ds[[i]] <-</pre> + <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">2342789<em>x</em></td> + <td class="coverage">1298<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> + <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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> @@ -41194,405 +37326,467 @@ table.table-condensed { </tr> <tr class="covered"> <td class="num">88</td> - <td class="coverage">252739<em>x</em></td> + <td class="coverage">1228<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> res_list <- lapply(1:n_unique, function(x) {</pre> + <pre class="language-r"> abline(h = 0, lty = 2)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">89</td> - <td class="coverage">2342789<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> transparms_optim <- unlist(parms_unique[x, , drop = TRUE])</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">90</td> - <td class="coverage">2342789<em>x</em></td> + <td class="coverage">1228<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> parms_fixed <- object[[1]]$bparms.fixed</pre> + <pre class="language-r"> if (legend == TRUE) {</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">91</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> legend(lpos, inset = c(0.05, 0.05), legend = obs_vars,</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">92</td> - <td class="coverage">2342789<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> odeini_optim_parm_names <- grep('_0$', names(transparms_optim), value = TRUE)</pre> + <pre class="language-r"> col = col_obs[obs_vars], pch = pch_obs[obs_vars])</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">93</td> - <td class="coverage">2342789<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> odeini_optim <- transparms_optim[odeini_optim_parm_names]</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">94</td> - <td class="coverage">2342789<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> names(odeini_optim) <- gsub('_0$', '', odeini_optim_parm_names)</pre> + <pre class="language-r">}</pre> </td> </tr> - <tr class="covered"> - <td class="num">95</td> - <td class="coverage">2342789<em>x</em></td> + </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"> odeini_fixed_parm_names <- grep('_0$', names(parms_fixed), value = TRUE)</pre> + <pre class="language-r">#' Hierarchical kinetics template</pre> </td> </tr> - <tr class="covered"> - <td class="num">96</td> - <td class="coverage">2342789<em>x</em></td> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> odeini_fixed <- parms_fixed[odeini_fixed_parm_names]</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> - <td class="num">97</td> - <td class="coverage">2342789<em>x</em></td> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> names(odeini_fixed) <- gsub('_0$', '', odeini_fixed_parm_names)</pre> + <pre class="language-r">#' R markdown format for setting up hierarchical kinetics based on a template</pre> </td> </tr> - <tr class="covered"> - <td class="num">98</td> - <td class="coverage">2342789<em>x</em></td> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> odeini <- c(odeini_optim, odeini_fixed)[names(mkin_model$diffs)]</pre> + <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">99</td> + <td class="num">5</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' Chunk options are adapted. Echoing R code from code chunks and caching are</pre> </td> </tr> - <tr class="covered"> - <td class="num">100</td> - <td class="coverage">2342789<em>x</em></td> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> ode_transparms_optim_names <- setdiff(names(transparms_optim), odeini_optim_parm_names)</pre> + <pre class="language-r">#' turned on per default. character for prepending output from code chunks is</pre> </td> </tr> - <tr class="covered"> - <td class="num">101</td> - <td class="coverage">2342789<em>x</em></td> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> odeparms_optim <- backtransform_odeparms(transparms_optim[ode_transparms_optim_names], mkin_model,</pre> + <pre class="language-r">#' set to the empty string, code tidying is off, figure alignment defaults to</pre> </td> </tr> - <tr class="covered"> - <td class="num">102</td> - <td class="coverage">2342789<em>x</em></td> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> transform_rates = object[[1]]$transform_rates,</pre> + <pre class="language-r">#' centering, and positioning of figures is set to "H", which means that</pre> </td> </tr> - <tr class="covered"> - <td class="num">103</td> - <td class="coverage">2342789<em>x</em></td> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> transform_fractions = object[[1]]$transform_fractions)</pre> + <pre class="language-r">#' figures will not move around in the document, but stay where the user</pre> </td> </tr> - <tr class="covered"> - <td class="num">104</td> - <td class="coverage">2342789<em>x</em></td> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> odeparms_fixed_names <- setdiff(names(parms_fixed), odeini_fixed_parm_names)</pre> + <pre class="language-r">#' includes them.</pre> </td> </tr> - <tr class="covered"> - <td class="num">105</td> - <td class="coverage">2342789<em>x</em></td> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> odeparms_fixed <- parms_fixed[odeparms_fixed_names]</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> - <td class="num">106</td> - <td class="coverage">2342789<em>x</em></td> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> odeparms <- c(odeparms_optim, odeparms_fixed)</pre> + <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">107</td> + <td class="num">13</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' package 'float'. In addition, the LaTeX package 'listing' is used in the</pre> </td> </tr> - <tr class="covered"> - <td class="num">108</td> - <td class="coverage">2342789<em>x</em></td> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> out_wide <- mkinpredict(mkin_model,</pre> + <pre class="language-r">#' template for showing model fit summaries in the Appendix. This means that</pre> </td> </tr> - <tr class="covered"> - <td class="num">109</td> - <td class="coverage">2342789<em>x</em></td> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> odeparms = odeparms, odeini = odeini,</pre> + <pre class="language-r">#' the LaTeX packages 'float' and 'listing' need to be installed in the TeX</pre> </td> </tr> - <tr class="covered"> - <td class="num">110</td> - <td class="coverage">2342789<em>x</em></td> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> solution_type = object[[1]]$solution_type,</pre> + <pre class="language-r">#' distribution used.</pre> </td> </tr> - <tr class="covered"> - <td class="num">111</td> - <td class="coverage">2342789<em>x</em></td> + <tr class="never"> + <td class="num">17</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> outtimes = sort(unique(times_ds[[x]])))</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> - <td class="num">112</td> - <td class="coverage">2342789<em>x</em></td> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> out_array <- out_wide[, -1, drop = FALSE]</pre> + <pre class="language-r">#' On Windows, the easiest way to achieve this (if no TeX distribution</pre> </td> </tr> - <tr class="covered"> - <td class="num">113</td> - <td class="coverage">2342789<em>x</em></td> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> rownames(out_array) <- as.character(unique(times_ds[[x]]))</pre> + <pre class="language-r">#' is present before) is to install the 'tinytex' R package, to run</pre> </td> </tr> - <tr class="covered"> - <td class="num">114</td> - <td class="coverage">2342789<em>x</em></td> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> out_times <- as.character(times_ds[[x]])</pre> + <pre class="language-r">#' 'tinytex::install_tinytex()' to get the basic tiny Tex distribution,</pre> </td> </tr> - <tr class="covered"> - <td class="num">115</td> - <td class="coverage">2342789<em>x</em></td> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> out_names <- as.character(names_ds[[x]])</pre> + <pre class="language-r">#' and then to run 'tinytex::tlmgr_install(c("float", "listing"))'.</pre> </td> </tr> - <tr class="covered"> - <td class="num">116</td> - <td class="coverage">2342789<em>x</em></td> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> out_values <- mapply(function(times, names) out_array[times, names],</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> - <td class="num">117</td> - <td class="coverage">2342789<em>x</em></td> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> out_times, out_names)</pre> + <pre class="language-r">#' @inheritParams rmarkdown::pdf_document</pre> </td> </tr> - <tr class="covered"> - <td class="num">118</td> - <td class="coverage">2342789<em>x</em></td> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> return(as.numeric(out_values))</pre> + <pre class="language-r">#' @param ... Arguments to \code{rmarkdown::pdf_document}</pre> </td> </tr> <tr class="never"> - <td class="num">119</td> + <td class="num">25</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> })</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> - <td class="num">120</td> - <td class="coverage">252739<em>x</em></td> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> res <- unlist(res_list)</pre> + <pre class="language-r">#' @return R Markdown output format to pass to</pre> </td> </tr> - <tr class="covered"> - <td class="num">121</td> - <td class="coverage">252739<em>x</em></td> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> return(res)</pre> + <pre class="language-r">#' \code{\link[rmarkdown:render]{render}}</pre> </td> </tr> <tr class="never"> - <td class="num">122</td> + <td class="num">28</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> })</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> - <td class="num">123</td> - <td class="coverage">1168<em>x</em></td> + <tr class="never"> + <td class="num">29</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> model_function <- as.function(c(model_function_alist, model_function_body))</pre> + <pre class="language-r">#' @examples</pre> </td> </tr> - <tr class="covered"> - <td class="num">124</td> - <td class="coverage">1168<em>x</em></td> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> return(model_function)</pre> + <pre class="language-r">#'</pre> </td> </tr> <tr class="never"> - <td class="num">125</td> + <td class="num">31</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">}</pre> + <pre class="language-r">#' \dontrun{</pre> </td> </tr> <tr class="never"> - <td class="num">126</td> + <td class="num">32</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' library(rmarkdown)</pre> </td> </tr> <tr class="never"> - <td class="num">127</td> + <td class="num">33</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @rdname nlme</pre> + <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">128</td> + <td class="num">34</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @importFrom rlang !!!</pre> + <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">129</td> + <td class="num">35</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @return A \code{\link{groupedData}} object</pre> + <pre class="language-r">#' #draft("example_analysis.rmd", template = "hierarchical_kinetics", package = "mkin")</pre> </td> </tr> <tr class="never"> - <td class="num">130</td> + <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">131</td> + <td class="num">39</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">nlme_data <- function(object) {</pre> + <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">132</td> + <td class="num">41</td> <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> if (nrow(object) > 1) stop("Only row objects allowed")</pre> + <pre class="language-r"> if (getRversion() < "4.1.0")</pre> </td> </tr> - <tr class="covered"> - <td class="num">133</td> - <td class="coverage">5677<em>x</em></td> + <tr class="missed"> + <td class="num">42</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> ds_names <- colnames(object)</pre> + <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">134</td> + <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">135</td> - <td class="coverage">5677<em>x</em></td> + <tr class="missed"> + <td class="num">44</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> ds_list <- lapply(object, function(x) x$data[c("time", "variable", "observed")])</pre> + <pre class="language-r"> if (!requireNamespace("knitr")) stop("Please install the knitr package to use this template")</pre> </td> </tr> - <tr class="covered"> - <td class="num">136</td> - <td class="coverage">5677<em>x</em></td> + <tr class="missed"> + <td class="num">45</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> names(ds_list) <- ds_names</pre> + <pre class="language-r"> if (!requireNamespace("rmarkdown")) stop("Please install the rmarkdown package to use this template")</pre> </td> </tr> - <tr class="covered"> - <td class="num">137</td> - <td class="coverage">5677<em>x</em></td> + <tr class="missed"> + <td class="num">46</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> ds_nlme <- vctrs::vec_rbind(!!!ds_list, .names_to = "ds")</pre> + <pre class="language-r"> knitr::opts_chunk$set(cache = TRUE, comment = "", tidy = FALSE, echo = TRUE)</pre> </td> </tr> - <tr class="covered"> - <td class="num">138</td> - <td class="coverage">5677<em>x</em></td> + <tr class="missed"> + <td class="num">47</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> ds_nlme$variable <- as.character(ds_nlme$variable)</pre> + <pre class="language-r"> knitr::opts_chunk$set(fig.align = "center", fig.pos = "H")</pre> </td> </tr> - <tr class="covered"> - <td class="num">139</td> - <td class="coverage">5677<em>x</em></td> + <tr class="missed"> + <td class="num">48</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> ds_nlme$ds <- ordered(ds_nlme$ds, levels = unique(ds_nlme$ds))</pre> + <pre class="language-r"> options(knitr.kable.NA = "")</pre> </td> </tr> - <tr class="covered"> - <td class="num">140</td> - <td class="coverage">5677<em>x</em></td> + <tr class="never"> + <td class="num">49</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> ds_nlme_renamed <- data.frame(ds = ds_nlme$ds, name = ds_nlme$variable,</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> - <td class="num">141</td> - <td class="coverage">5677<em>x</em></td> + <tr class="missed"> + <td class="num">50</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> time = ds_nlme$time, value = ds_nlme$observed,</pre> + <pre class="language-r"> fmt <- rmarkdown::pdf_document(...,</pre> </td> </tr> - <tr class="covered"> - <td class="num">142</td> - <td class="coverage">5677<em>x</em></td> + <tr class="missed"> + <td class="num">51</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> stringsAsFactors = FALSE)</pre> + <pre class="language-r"> keep_tex = keep_tex,</pre> </td> </tr> - <tr class="covered"> - <td class="num">143</td> - <td class="coverage">5677<em>x</em></td> + <tr class="missed"> + <td class="num">52</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> ds_nlme_grouped <- groupedData(value ~ time | ds, ds_nlme_renamed, order.groups = FALSE)</pre> + <pre class="language-r"> toc = TRUE,</pre> </td> </tr> - <tr class="covered"> - <td class="num">144</td> - <td class="coverage">5677<em>x</em></td> + <tr class="missed"> + <td class="num">53</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> return(ds_nlme_grouped)</pre> + <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">145</td> + <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> @@ -41601,91 +37795,91 @@ table.table-condensed { </tbody> </table> </div> - <div id="R/transform_odeparms.R" class="hidden"> + <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">#' Functions to transform and backtransform kinetic parameters for fitting</pre> + <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> + <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> + <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">#' restricted values to the full scale of real numbers. For kinetic rate</pre> + <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">#' constants and other parameters that can only take on positive values, a</pre> + <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">#' simple log transformation is used. For compositional parameters, such as the</pre> + <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">#' formations fractions that should always sum up to 1 and can not be negative,</pre> + <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">#' the [ilr] transformation is used.</pre> + <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">#'</pre> + <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">#' The transformation of sets of formation fractions is fragile, as it supposes</pre> + <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">#' the same ordering of the components in forward and backward transformation.</pre> + <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">#' This is no problem for the internal use in [mkinfit].</pre> + <pre class="language-r">#' Retrieve a degradation function from the mmkin namespace</pre> </td> </tr> <tr class="never"> @@ -41699,504 +37893,504 @@ table.table-condensed { <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> + <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">#' equations.</pre> + <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">#' @param transparms Transformed parameters of kinetic models as used in the</pre> + <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">#' fitting procedure.</pre> + <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">#' @param mkinmod The kinetic model of class [mkinmod], containing</pre> + <pre class="language-r">get_deg_func <- function() {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">19</td> - <td class="coverage"></td> + <td class="coverage">217279<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' the names of the model variables that are needed for grouping the</pre> + <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">#' formation fractions before [ilr] transformation, the parameter</pre> + <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">#' names and the information if the pathway to sink is included in the model.</pre> + <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">#' @param transform_rates Boolean specifying if kinetic rate constants should</pre> + <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">#' be transformed in the model specification used in the fitting for better</pre> + <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">#' compliance with the assumption of normal distribution of the estimator. If</pre> + <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">#' TRUE, also alpha and beta parameters of the FOMC model are</pre> + <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">#' log-transformed, as well as k1 and k2 rate constants for the DFOP and HS</pre> + <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">#' models and the break point tb of the HS model.</pre> + <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">#' @param transform_fractions Boolean specifying if formation fractions</pre> + <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">#' constants should be transformed in the model specification used in the</pre> + <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">#' fitting for better compliance with the assumption of normal distribution</pre> + <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">#' of the estimator. The default (TRUE) is to do transformations.</pre> + <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">#' The g parameter of the DFOP model is also seen as a fraction.</pre> + <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">#' If a single fraction is transformed (g parameter of DFOP or only a single</pre> + <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">#' target variable e.g. a single metabolite plus a pathway to sink), a</pre> + <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">#' logistic transformation is used [stats::qlogis()]. In other cases, i.e. if</pre> + <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">#' two or more formation fractions need to be transformed whose sum cannot</pre> + <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">#' exceed one, the [ilr] transformation is used.</pre> + <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">#' @return A vector of transformed or backtransformed parameters</pre> + <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">#' @importFrom stats plogis qlogis</pre> + <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">#' @author Johannes Ranke</pre> + <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">#' @examples</pre> + <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">#'</pre> + <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">#' SFO_SFO <- mkinmod(</pre> + <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">#' parent = list(type = "SFO", to = "m1", sink = TRUE),</pre> + <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">#' m1 = list(type = "SFO"), use_of_ff = "min")</pre> + <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">#'</pre> + <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">#' # Fit the model to the FOCUS example dataset D using defaults</pre> + <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">#' FOCUS_D <- subset(FOCUS_2006_D, value != 0) # remove zero values to avoid warning</pre> + <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">#' fit <- mkinfit(SFO_SFO, FOCUS_D, quiet = TRUE)</pre> + <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">#' fit.s <- summary(fit)</pre> + <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">#' # Transformed and backtransformed parameters</pre> + <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">#' print(fit.s$par, 3)</pre> + <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">#' print(fit.s$bpar, 3)</pre> + <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">#'</pre> + <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">#' \dontrun{</pre> + <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">#' # Compare to the version without transforming rate parameters (does not work</pre> + <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">#' # with analytical solution, we get NA values for m1 in predictions)</pre> + <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">#' fit.2 <- mkinfit(SFO_SFO, FOCUS_D, transform_rates = FALSE,</pre> + <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">#' solution_type = "deSolve", quiet = TRUE)</pre> + <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">#' fit.2.s <- summary(fit.2)</pre> + <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">#' print(fit.2.s$par, 3)</pre> + <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">#' print(fit.2.s$bpar, 3)</pre> + <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> + <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">#'</pre> + <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">#' initials <- fit$start$value</pre> + <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">#' names(initials) <- rownames(fit$start)</pre> + <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">#' transformed <- fit$start_transformed$value</pre> + <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">#' names(transformed) <- rownames(fit$start_transformed)</pre> + <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">#' transform_odeparms(initials, SFO_SFO)</pre> + <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">#' backtransform_odeparms(transformed, SFO_SFO)</pre> + <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">#'</pre> + <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">#' \dontrun{</pre> + <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">#' # The case of formation fractions (this is now the default)</pre> + <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">#' SFO_SFO.ff <- mkinmod(</pre> + <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">#' parent = list(type = "SFO", to = "m1", sink = TRUE),</pre> + <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">#' m1 = list(type = "SFO"),</pre> + <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">#' use_of_ff = "max")</pre> + <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">#'</pre> + <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">#' fit.ff <- mkinfit(SFO_SFO.ff, FOCUS_D, quiet = TRUE)</pre> + <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">#' fit.ff.s <- summary(fit.ff)</pre> + <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">#' print(fit.ff.s$par, 3)</pre> + <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">#' print(fit.ff.s$bpar, 3)</pre> + <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">#' initials <- c("f_parent_to_m1" = 0.5)</pre> + <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">#' transformed <- transform_odeparms(initials, SFO_SFO.ff)</pre> + <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">#' backtransform_odeparms(transformed, SFO_SFO.ff)</pre> + <pre class="language-r">#' ds_2, quiet = TRUE)</pre> </td> </tr> <tr class="never"> @@ -42210,42 +38404,42 @@ table.table-condensed { <td class="num">87</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' # And without sink</pre> + <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">#' SFO_SFO.ff.2 <- mkinmod(</pre> + <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">#' parent = list(type = "SFO", to = "m1", sink = FALSE),</pre> + <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">#' m1 = list(type = "SFO"),</pre> + <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">#' use_of_ff = "max")</pre> + <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">#'</pre> + <pre class="language-r">#' #plot(f_nlme_sfo_sfo_ff)</pre> </td> </tr> <tr class="never"> @@ -42259,742 +38453,742 @@ table.table-condensed { <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> + <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">#' fit.ff.2.s <- summary(fit.ff.2)</pre> + <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">#' print(fit.ff.2.s$par, 3)</pre> + <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">#' print(fit.ff.2.s$bpar, 3)</pre> + <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> + <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> + <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">#' @export transform_odeparms</pre> + <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">transform_odeparms <- function(parms, mkinmod,</pre> + <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"> transform_rates = TRUE, transform_fractions = TRUE)</pre> + <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> + <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"> # We need the model specification for the names of the model</pre> + <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"> # variables and the information on the sink</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">106</td> - <td class="coverage">25587<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> spec = mkinmod$spec</pre> + <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"></pre> + <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"> # Set up container for transformed parameters</pre> + <pre class="language-r">#' # but need tweeking of control values and sometimes do not converge</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">109</td> - <td class="coverage">25587<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> transparms <- numeric(0)</pre> + <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> + <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"> # Do not transform initial values for state variables</pre> + <pre class="language-r">#' f_nlme_sfo_tc <- nlme(f_tc["SFO", ])</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">112</td> - <td class="coverage">25587<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> state.ini.optim <- parms[grep("_0$", names(parms))]</pre> + <pre class="language-r">#' f_nlme_dfop_tc <- nlme(f_tc["DFOP", ])</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">113</td> - <td class="coverage">25587<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> transparms[names(state.ini.optim)] <- state.ini.optim</pre> + <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"></pre> + <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"> # Log transformation for rate constants if requested</pre> + <pre class="language-r">#' }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">116</td> - <td class="coverage">25587<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> k <- parms[grep("^k_", names(parms))]</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">117</td> - <td class="coverage">25587<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> k__iore <- parms[grep("^k__iore_", names(parms))]</pre> + <pre class="language-r">#' f_2_obs <- update(f_2, error_model = "obs")</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">118</td> - <td class="coverage">25587<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> k <- c(k, k__iore)</pre> + <pre class="language-r">#' f_nlme_sfo_sfo_obs <- nlme(f_2_obs["SFO-SFO", ])</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">119</td> - <td class="coverage">25587<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (length(k) > 0) {</pre> + <pre class="language-r">#' print(f_nlme_sfo_sfo_obs)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">120</td> - <td class="coverage">15485<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if(transform_rates) {</pre> + <pre class="language-r">#' f_nlme_dfop_sfo_obs <- nlme(f_2_obs["DFOP-SFO", ],</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">121</td> - <td class="coverage">14379<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> transparms[paste0("log_", names(k))] <- log(k)</pre> + <pre class="language-r">#' control = list(pnlsMaxIter = 120, tolerance = 5e-4))</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">122</td> - <td class="coverage">1106<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> } else transparms[names(k)] <- k</pre> + <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> + <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"></pre> + <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"> # Do not transform exponents in IORE models</pre> + <pre class="language-r">#' # f_nlme_dfop_sfo_tc <- nlme(f_2_tc["DFOP-SFO", ],</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">126</td> - <td class="coverage">25587<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> N <- parms[grep("^N", names(parms))]</pre> + <pre class="language-r">#' # control = list(pnlsMaxIter = 120, tolerance = 5e-4)) # Error in X[, fmap[[nm]]] <- gradnm</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">127</td> - <td class="coverage">25587<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> transparms[names(N)] <- N</pre> + <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> + <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"> # Go through state variables and transform formation fractions if requested</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">130</td> - <td class="coverage">25587<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> mod_vars = names(spec)</pre> + <pre class="language-r">#' }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">131</td> - <td class="coverage">25587<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> for (box in mod_vars) {</pre> + <pre class="language-r">nlme.mmkin <- function(model, data = "auto",</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">132</td> - <td class="coverage">41283<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> f <- parms[grep(paste("^f", box, sep = "_"), names(parms))]</pre> + <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"></pre> + <pre class="language-r"> function(el) eval(parse(text = paste(el, 1, sep = "~")))),</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">134</td> - <td class="coverage">41283<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (length(f) > 0) {</pre> + <pre class="language-r"> random = pdDiag(fixed),</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">135</td> - <td class="coverage">6522<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if(transform_fractions) {</pre> + <pre class="language-r"> groups,</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">136</td> - <td class="coverage">5910<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (spec[[box]]$sink) {</pre> + <pre class="language-r"> start = mean_degparms(model, random = TRUE, test_log_parms = TRUE),</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">137</td> - <td class="coverage">5908<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (length(f) == 1) {</pre> + <pre class="language-r"> correlation = NULL, weights = NULL,</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">138</td> - <td class="coverage">5894<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> trans_f_name <- paste("f", box, "qlogis", sep = "_")</pre> + <pre class="language-r"> subset, method = c("ML", "REML"),</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">139</td> - <td class="coverage">5894<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> transparms[trans_f_name] <- qlogis(f)</pre> + <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"> } else {</pre> + <pre class="language-r"> control = list(), verbose= FALSE)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">141</td> - <td class="coverage">14<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> trans_f <- ilr(c(f, 1 - sum(f)))</pre> + <pre class="language-r">{</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">142</td> - <td class="coverage">14<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> trans_f_names <- paste("f", box, "ilr", 1:length(trans_f), sep = "_")</pre> + <pre class="language-r"> if (nrow(model) > 1) stop("Only row objects allowed")</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">143</td> - <td class="coverage">14<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> transparms[trans_f_names] <- trans_f</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">144</td> - <td class="coverage"></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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"> } else {</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">146</td> - <td class="coverage">2<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (length(f) > 1) {</pre> + <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">2<em>x</em></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> trans_f <- ilr(f)</pre> + <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">2<em>x</em></td> + <td class="coverage">1013<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> + <pre class="language-r"> c("data"))))) {</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">149</td> - <td class="coverage">2<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> transparms[trans_f_names] <- trans_f</pre> + <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> + <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> + <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> + <pre class="language-r"> # Get native symbol info for speed</pre> </td> </tr> <tr class="covered"> <td class="num">153</td> - <td class="coverage">612<em>x</em></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> transparms[names(f)] <- f</pre> + <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"> }</pre> + <pre class="language-r"> # The mkinmod stored in the first fit will be used by nlme</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">155</td> - <td class="coverage"></td> + <td class="coverage">189<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> model[[1]]$mkinmod$symbols <- deSolve::checkDLL(</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">156</td> - <td class="coverage"></td> + <td class="coverage">189<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> dllname = model[[1]]$mkinmod$dll_info[["name"]],</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">157</td> - <td class="coverage"></td> + <td class="coverage">189<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> func = "diffs", initfunc = "initpar",</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">158</td> - <td class="coverage"></td> + <td class="coverage">189<em>x</em></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> + <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"> # and HS parameter tb as well as logistic model parameters kmax, k0 and r if</pre> + <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"> # transformation of rates is requested</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">161</td> - <td class="coverage">25587<em>x</em></td> + <td class="coverage">1013<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> + <pre class="language-r"> deg_func <- nlme_function(model)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">162</td> - <td class="coverage">204696<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (!is.na(parms[pname])) {</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">163</td> - <td class="coverage">6006<em>x</em></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (transform_rates) {</pre> + <pre class="language-r"> assign("deg_func", deg_func, getFromNamespace(".nlme_env", "mkin"))</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">164</td> - <td class="coverage">6006<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> transparms[paste0("log_", pname)] <- log(parms[pname])</pre> + <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"> } else {</pre> + <pre class="language-r"> # For the formula, get the degradation function from the mkin namespace</pre> </td> </tr> - <tr class="missed"> + <tr class="covered"> <td class="num">166</td> - <td class="coverage">!</td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> transparms[pname] <- parms[pname]</pre> + <pre class="language-r"> this_model_text <- paste0("value ~ mkin::get_deg_func()(",</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">167</td> - <td class="coverage"></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> paste(names(formals(deg_func)), collapse = ", "), ")")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">168</td> - <td class="coverage"></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">170</td> - <td class="coverage"></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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"> # DFOP parameter g is treated as a fraction</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">172</td> - <td class="coverage">25587<em>x</em></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (!is.na(parms["g"])) {</pre> + <pre class="language-r"> thisCall[["data"]] <- nlme_data(model)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">173</td> - <td class="coverage">1978<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> g <- parms["g"]</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">174</td> - <td class="coverage">1978<em>x</em></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (transform_fractions) {</pre> + <pre class="language-r"> thisCall[["start"]] <- start</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">175</td> - <td class="coverage">1978<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> transparms["g_qlogis"] <- qlogis(g)</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">176</td> - <td class="coverage"></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r"> thisCall[["fixed"]] <- fixed</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">177</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> transparms["g"] <- g</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">178</td> - <td class="coverage"></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">180</td> - <td class="coverage"></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> error_model <- model[[1]]$err_mod</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">181</td> - <td class="coverage">25587<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> return(transparms)</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">182</td> - <td class="coverage"></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">}</pre> + <pre class="language-r"> if (missing(weights)) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">183</td> - <td class="coverage"></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> thisCall[["weights"]] <- switch(error_model,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">184</td> - <td class="coverage"></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @rdname transform_odeparms</pre> + <pre class="language-r"> const = NULL,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">185</td> - <td class="coverage"></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @export backtransform_odeparms</pre> + <pre class="language-r"> obs = varIdent(form = ~ 1 | name),</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">186</td> - <td class="coverage"></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">backtransform_odeparms <- function(transparms, mkinmod,</pre> + <pre class="language-r"> tc = varConstProp())</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">187</td> - <td class="coverage"></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> transform_rates = TRUE,</pre> + <pre class="language-r"> sigma <- switch(error_model,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">188</td> - <td class="coverage"></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> transform_fractions = TRUE)</pre> + <pre class="language-r"> tc = 1,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">189</td> - <td class="coverage"></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">{</pre> + <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"> # We need the model specification for the names of the model</pre> + <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"> # variables and the information on the sink</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">192</td> - <td class="coverage">49214214<em>x</em></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> spec = mkinmod$spec</pre> + <pre class="language-r"> control <- thisCall[["control"]]</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">193</td> - <td class="coverage"></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> if (error_model == "tc") {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">194</td> - <td class="coverage"></td> + <td class="coverage">928<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Set up container for backtransformed parameters</pre> + <pre class="language-r"> control$sigma = 1</pre> </td> </tr> <tr class="covered"> <td class="num">195</td> - <td class="coverage">49214214<em>x</em></td> + <td class="coverage">928<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> parms <- numeric(0)</pre> + <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> + <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> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">198</td> - <td class="coverage">49214214<em>x</em></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> state.ini.optim <- transparms[grep("_0$", names(transparms))]</pre> + <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">49214214<em>x</em></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> parms[names(state.ini.optim)] <- state.ini.optim</pre> + <pre class="language-r"> val$time <- fit_time</pre> </td> </tr> <tr class="never"> @@ -43004,948 +39198,871 @@ table.table-condensed { <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">201</td> - <td class="coverage"></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Exponential transformation for rate constants</pre> + <pre class="language-r"> val$mkinmod <- model[[1]]$mkinmod</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">202</td> - <td class="coverage">49214214<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if(transform_rates) {</pre> + <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">49140623<em>x</em></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> trans_k <- transparms[grep("^log_k_", names(transparms))]</pre> + <pre class="language-r"> val$mkinmod$symbols <- NULL</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">204</td> - <td class="coverage">49140623<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> trans_k__iore <- transparms[grep("^log_k__iore_", names(transparms))]</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">205</td> - <td class="coverage">49140623<em>x</em></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> trans_k = c(trans_k, trans_k__iore)</pre> + <pre class="language-r"> val$data <- thisCall[["data"]]</pre> </td> </tr> <tr class="covered"> <td class="num">206</td> - <td class="coverage">49140623<em>x</em></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (length(trans_k) > 0) {</pre> + <pre class="language-r"> val$mmkin <- model</pre> </td> </tr> <tr class="covered"> <td class="num">207</td> - <td class="coverage">47598103<em>x</em></td> + <td class="coverage">824<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> k_names <- gsub("^log_k", "k", names(trans_k))</pre> + <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">47598103<em>x</em></td> + <td class="coverage">189<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> parms[k_names] <- exp(trans_k)</pre> + <pre class="language-r"> else val$mean_dp_start <- start</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">209</td> - <td class="coverage"></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> val$transform_rates <- model[[1]]$transform_rates</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">210</td> - <td class="coverage"></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <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">73591<em>x</em></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> trans_k <- transparms[grep("^k_", names(transparms))]</pre> + <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">73591<em>x</em></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> parms[names(trans_k)] <- trans_k</pre> + <pre class="language-r"> val$err_mode <- error_model</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">213</td> - <td class="coverage">73591<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> trans_k__iore <- transparms[grep("^k__iore_", names(transparms))]</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">214</td> - <td class="coverage">73591<em>x</em></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> parms[names(trans_k__iore)] <- trans_k__iore</pre> + <pre class="language-r"> val$bparms.optim <- backtransform_odeparms(val$coefficients$fixed,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">215</td> - <td class="coverage"></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> val$mkinmod,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">216</td> - <td class="coverage"></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> transform_rates = val$transform_rates,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">217</td> - <td class="coverage"></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Do not transform exponents in IORE models</pre> + <pre class="language-r"> transform_fractions = val$transform_fractions)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">218</td> - <td class="coverage">49214214<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> N <- transparms[grep("^N", names(transparms))]</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">219</td> - <td class="coverage">49214214<em>x</em></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> parms[names(N)] <- N</pre> + <pre class="language-r"> val$bparms.fixed <- model[[1]]$bparms.fixed</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">220</td> - <td class="coverage"></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> val$date.fit <- date()</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">221</td> - <td class="coverage"></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Go through state variables and apply inverse transformations to formation fractions</pre> + <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">49214214<em>x</em></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> mod_vars = names(spec)</pre> + <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">49214214<em>x</em></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> for (box in mod_vars) {</pre> + <pre class="language-r"> val$Rversion <- paste(R.version$major, R.version$minor, sep=".")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">224</td> - <td class="coverage"></td> + <td class="coverage">1013<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Get the names as used in the model</pre> + <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">97593385<em>x</em></td> + <td class="coverage">1013<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> + <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> + <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> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">228</td> - <td class="coverage">97593385<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> trans_f = transparms[grep(paste("^f", box, sep = "_"), names(transparms))]</pre> + <pre class="language-r">#' @export</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">229</td> - <td class="coverage">97593385<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (length(trans_f) > 0) {</pre> + <pre class="language-r">#' @rdname nlme.mmkin</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">230</td> - <td class="coverage">46632823<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if(transform_fractions) {</pre> + <pre class="language-r">#' @param x An nlme.mmkin object to print</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">231</td> - <td class="coverage">46588453<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (any(grepl("qlogis", names(trans_f)))) {</pre> + <pre class="language-r">#' @param digits Number of digits to use for printing</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">232</td> - <td class="coverage">46059152<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> f_tmp <- plogis(trans_f)</pre> + <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">46059152<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> parms[f_names] <- f_tmp</pre> + <pre class="language-r"> cat( "Kinetic nonlinear mixed-effects model fit by " )</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">234</td> - <td class="coverage"></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <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">529301<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> f_tmp <- invilr(trans_f)</pre> + <pre class="language-r"> cat("\nStructural model:\n")</pre> </td> </tr> <tr class="covered"> <td class="num">236</td> - <td class="coverage">529301<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (spec[[box]]$sink) {</pre> + <pre class="language-r"> diffs <- x$mmkin[[1]]$mkinmod$diffs</pre> </td> </tr> <tr class="covered"> <td class="num">237</td> - <td class="coverage">528393<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> parms[f_names] <- f_tmp[1:length(f_tmp)-1]</pre> + <pre class="language-r"> nice_diffs <- gsub("^(d.*) =", "\\1/dt =", diffs)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">238</td> - <td class="coverage"></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r"> writeLines(strwrap(nice_diffs, exdent = 11))</pre> </td> </tr> <tr class="covered"> <td class="num">239</td> - <td class="coverage">908<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> parms[f_names] <- f_tmp</pre> + <pre class="language-r"> cat("\nData:\n")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">240</td> - <td class="coverage"></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> cat(nrow(x$data), "observations of",</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">241</td> - <td class="coverage"></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> length(unique(x$data$name)), "variable(s) grouped in",</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">242</td> - <td class="coverage"></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <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">44370<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> parms[names(trans_f)] <- trans_f</pre> + <pre class="language-r"> cat("\nLog-", if(x$method == "REML") "restricted-" else "",</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">244</td> - <td class="coverage"></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> "likelihood: ", format(x$logLik, digits = digits), "\n", sep = "")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">245</td> - <td class="coverage"></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> fixF <- x$call$fixed</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">246</td> - <td class="coverage"></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> cat("\nFixed effects:\n",</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">247</td> - <td class="coverage"></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> deparse(</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">248</td> - <td class="coverage"></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Transform parameters also for FOMC, DFOP, HS and logistic models</pre> + <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">49214214<em>x</em></td> + <td class="coverage">117<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> + <pre class="language-r"> x$call$fixed</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">250</td> - <td class="coverage">393713712<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (transform_rates) {</pre> + <pre class="language-r"> else</pre> </td> </tr> <tr class="covered"> <td class="num">251</td> - <td class="coverage">393124984<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> pname_trans = paste0("log_", pname)</pre> + <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">393124984<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (!is.na(transparms[pname_trans])) {</pre> + <pre class="language-r"> print(fixef(x), digits = digits, ...)</pre> </td> </tr> <tr class="covered"> <td class="num">253</td> - <td class="coverage">4306142<em>x</em></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> parms[pname] <- exp(transparms[pname_trans])</pre> + <pre class="language-r"> cat("\n")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">254</td> - <td class="coverage"></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> print(summary(x$modelStruct), sigma = x$sigma, digits = digits, ...)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">255</td> - <td class="coverage"></td> + <td class="coverage">117<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r"> invisible(x)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">256</td> - <td class="coverage">588728<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (!is.na(transparms[pname])) {</pre> + <pre class="language-r">}</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">257</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> parms[pname] <- transparms[pname]</pre> + <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> + <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"> }</pre> + <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"> }</pre> + <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"></pre> + <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"> # DFOP parameter g is now transformed using qlogis</pre> + <pre class="language-r">update.nlme.mmkin <- function(object, ...) {</pre> </td> </tr> <tr class="covered"> <td class="num">263</td> - <td class="coverage">49214214<em>x</em></td> + <td class="coverage">85<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (!is.na(transparms["g_qlogis"])) {</pre> + <pre class="language-r"> res <- NextMethod()</pre> </td> </tr> <tr class="covered"> <td class="num">264</td> - <td class="coverage">2034008<em>x</em></td> + <td class="coverage">85<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> g_qlogis <- transparms["g_qlogis"]</pre> + <pre class="language-r"> res$mmkin <- object$mmkin</pre> </td> </tr> <tr class="covered"> <td class="num">265</td> - <td class="coverage">2034008<em>x</em></td> + <td class="coverage">85<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> parms["g"] <- plogis(g_qlogis)</pre> + <pre class="language-r"> class(res) <- c("nlme.mmkin", "nlme", "lme")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">266</td> - <td class="coverage"></td> + <td class="coverage">85<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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"> # 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"> + <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">#' Hierarchical kinetics template</pre> + <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> + <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> + <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">#' provided with the mkin package. This format is based on [rmarkdown::pdf_document].</pre> + <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">#' Chunk options are adapted. Echoing R code from code chunks and caching are</pre> + <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">#' turned on per default. character for prepending output from code chunks is</pre> + <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">#' set to the empty string, code tidying is off, figure alignment defaults to</pre> + <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">#' centering, and positioning of figures is set to "H", which means that</pre> + <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">#' figures will not move around in the document, but stay where the user</pre> + <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">#' includes them.</pre> + <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> + <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> + <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">#' package 'float'. In addition, the LaTeX package 'listing' is used in the</pre> + <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">#' template for showing model fit summaries in the Appendix. This means that</pre> + <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">#' the LaTeX packages 'float' and 'listing' need to be installed in the TeX</pre> + <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">#' distribution used.</pre> + <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">#'</pre> + <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">#' On Windows, the easiest way to achieve this (if no TeX distribution</pre> + <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">#' is present before) is to install the 'tinytex' R package, to run</pre> + <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">#' 'tinytex::install_tinytex()' to get the basic tiny Tex distribution,</pre> + <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">#' and then to run 'tinytex::tlmgr_install(c("float", "listing"))'.</pre> + <pre class="language-r">mkinparplot <- function(object) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">22</td> - <td class="coverage"></td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> state.optim = rownames(subset(object$start, type == "state"))</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">23</td> - <td class="coverage"></td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @inheritParams rmarkdown::pdf_document</pre> + <pre class="language-r"> deparms.optim = rownames(subset(object$start, type == "deparm"))</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">24</td> - <td class="coverage"></td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @param ... Arguments to \code{rmarkdown::pdf_document}</pre> + <pre class="language-r"> fractions.optim = grep("^f_", deparms.optim, value = TRUE)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">25</td> - <td class="coverage"></td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> N.optim = grep("^N_", deparms.optim, value = TRUE)</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">26</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#' @return R Markdown output format to pass to</pre> + <pre class="language-r"> if ("g" %in% deparms.optim) fractions.optim <- c("g", fractions.optim)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">27</td> - <td class="coverage"></td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' \code{\link[rmarkdown:render]{render}}</pre> + <pre class="language-r"> rates.optim.unsorted = setdiff(deparms.optim, union(fractions.optim, N.optim))</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">28</td> - <td class="coverage"></td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> rates.optim <- rownames(object$start[rates.optim.unsorted, ])</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">29</td> - <td class="coverage"></td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @examples</pre> + <pre class="language-r"> n.plot <- c(state.optim = length(state.optim),</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">30</td> - <td class="coverage"></td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> rates.optim = length(rates.optim),</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">31</td> - <td class="coverage"></td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' \dontrun{</pre> + <pre class="language-r"> N.optim = length(N.optim),</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">32</td> - <td class="coverage"></td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' library(rmarkdown)</pre> + <pre class="language-r"> fractions.optim = length(fractions.optim))</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">33</td> - <td class="coverage"></td> + <td class="coverage">70<em>x</em></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> + <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">#' # of online docs, as the command creates a directory and opens an editor</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">35</td> - <td class="coverage"></td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' #draft("example_analysis.rmd", template = "hierarchical_kinetics", package = "mkin")</pre> + <pre class="language-r"> oldpar <- par(no.readonly = TRUE)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">36</td> - <td class="coverage"></td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' }</pre> + <pre class="language-r"> on.exit(par(oldpar, no.readonly = TRUE))</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">37</td> - <td class="coverage"></td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <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">#' @export</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">39</td> - <td class="coverage"></td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">hierarchical_kinetics <- function(..., keep_tex = FALSE) {</pre> + <pre class="language-r"> s <- summary(object)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">40</td> - <td class="coverage"></td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> bpar <- data.frame(t(s$bpar[, c("Estimate", "Lower", "Upper")]))</pre> </td> </tr> - <tr class="missed"> + <tr class="covered"> <td class="num">41</td> - <td class="coverage">!</td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (getRversion() < "4.1.0")</pre> + <pre class="language-r"> par(mar = c(2.1, 2.1, 0.1, 2.1))</pre> </td> </tr> - <tr class="missed"> + <tr class="covered"> <td class="num">42</td> - <td class="coverage">!</td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> stop("You need R with version > 4.1.0 to compile this document")</pre> + <pre class="language-r"> par(cex = 1)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">43</td> - <td class="coverage"></td> + <td class="coverage">70<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> for (type in names(n.plot)) {</pre> </td> </tr> - <tr class="missed"> + <tr class="covered"> <td class="num">44</td> - <td class="coverage">!</td> + <td class="coverage">140<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (!requireNamespace("knitr")) stop("Please install the knitr package to use this template")</pre> + <pre class="language-r"> parnames <- get(type)</pre> </td> </tr> - <tr class="missed"> + <tr class="covered"> <td class="num">45</td> - <td class="coverage">!</td> + <td class="coverage">140<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (!requireNamespace("rmarkdown")) stop("Please install the rmarkdown package to use this template")</pre> + <pre class="language-r"> values <- bpar[parnames]</pre> </td> </tr> - <tr class="missed"> + <tr class="covered"> <td class="num">46</td> - <td class="coverage">!</td> + <td class="coverage">140<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> knitr::opts_chunk$set(cache = TRUE, comment = "", tidy = FALSE, echo = TRUE)</pre> + <pre class="language-r"> values_with_confints <- data.frame(t(subset(data.frame(t(values)), !is.na("Lower"))))</pre> </td> </tr> - <tr class="missed"> + <tr class="covered"> <td class="num">47</td> - <td class="coverage">!</td> + <td class="coverage">140<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> knitr::opts_chunk$set(fig.align = "center", fig.pos = "H")</pre> + <pre class="language-r"> xlim = switch(type,</pre> </td> </tr> - <tr class="missed"> + <tr class="covered"> <td class="num">48</td> - <td class="coverage">!</td> + <td class="coverage">140<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> options(knitr.kable.NA = "")</pre> + <pre class="language-r"> state.optim = range(c(0, unlist(values)),</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">49</td> - <td class="coverage"></td> + <td class="coverage">140<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> na.rm = TRUE, finite = TRUE),</pre> </td> </tr> - <tr class="missed"> + <tr class="covered"> <td class="num">50</td> - <td class="coverage">!</td> + <td class="coverage">140<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fmt <- rmarkdown::pdf_document(...,</pre> + <pre class="language-r"> rates.optim = range(c(0, unlist(values)),</pre> </td> </tr> - <tr class="missed"> + <tr class="covered"> <td class="num">51</td> - <td class="coverage">!</td> + <td class="coverage">140<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> keep_tex = keep_tex,</pre> + <pre class="language-r"> na.rm = TRUE, finite = TRUE),</pre> </td> </tr> - <tr class="missed"> + <tr class="covered"> <td class="num">52</td> - <td class="coverage">!</td> + <td class="coverage">140<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> toc = TRUE,</pre> + <pre class="language-r"> N.optim = range(c(0, 1, unlist(values)),</pre> </td> </tr> - <tr class="missed"> + <tr class="covered"> <td class="num">53</td> - <td class="coverage">!</td> + <td class="coverage">140<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> toc_depth = 3,</pre> + <pre class="language-r"> na.rm = TRUE, finite = TRUE),</pre> </td> </tr> - <tr class="missed"> + <tr class="covered"> <td class="num">54</td> - <td class="coverage">!</td> + <td class="coverage">140<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> includes = rmarkdown::includes(in_header = "header.tex"),</pre> + <pre class="language-r"> fractions.optim = range(c(0, 1, unlist(values)),</pre> </td> </tr> - <tr class="missed"> + <tr class="covered"> <td class="num">55</td> - <td class="coverage">!</td> + <td class="coverage">140<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> extra_dependencies = c("float", "listing", "framed")</pre> + <pre class="language-r"> na.rm = TRUE, finite = TRUE))</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">56</td> - <td class="coverage"></td> + <td class="coverage">140<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> )</pre> + <pre class="language-r"> parname_index <- length(parnames):1 # Reverse order for strip chart</pre> </td> </tr> <tr class="never"> @@ -43955,15 +40072,127 @@ table.table-condensed { <pre class="language-r"></pre> </td> </tr> - <tr class="missed"> + <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"> return(fmt)</pre> + <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">59</td> + <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> @@ -43972,1120 +40201,1120 @@ table.table-condensed { </tbody> </table> </div> - <div id="R/nlme.mmkin.R" class="hidden"> + <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"># Code inspired by nlme::nlme.nlsList and R/nlme_fit.R from nlmixr</pre> + <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> + <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> + <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"># environment that is always accessible, also e.g. when evaluation is done by</pre> + <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"># testthat or pkgdown. Therefore parent.frame() is not good enough. The</pre> + <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"># following environment will be in the mkin namespace.</pre> + <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">.nlme_env <- new.env(parent = emptyenv())</pre> + <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"></pre> + <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">#' @export</pre> + <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">nlme::nlme</pre> + <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"></pre> + <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">#' Retrieve a degradation function from the mmkin namespace</pre> + <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">#'</pre> + <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">#' @importFrom utils getFromNamespace</pre> + <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">#' @return A function that was likely previously assigned from within</pre> + <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">#' nlme.mmkin</pre> + <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">#' @export</pre> + <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">get_deg_func <- function() {</pre> + <pre class="language-r">#' predictions should be generated.</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">19</td> - <td class="coverage">217279<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> return(get("deg_func", getFromNamespace(".nlme_env", "mkin")))</pre> + <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">}</pre> + <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"></pre> + <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">#' Create an nlme model for an mmkin row object</pre> + <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">#'</pre> + <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">#' This functions sets up a nonlinear mixed effects model for an mmkin row</pre> + <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">#' object. An mmkin row object is essentially a list of mkinfit objects that</pre> + <pre class="language-r">#' @param method.ode The solution method passed via [mkinpredict] to `deSolve::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">#' have been obtained by fitting the same model to a list of datasets.</pre> + <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">#'</pre> + <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">#' Note that the convergence of the nlme algorithms depends on the quality</pre> + <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">#' of the data. In degradation kinetics, we often only have few datasets</pre> + <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">#' (e.g. data for few soils) and complicated degradation models, which may</pre> + <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">#' make it impossible to obtain convergence with nlme.</pre> + <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">#'</pre> + <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 model An [mmkin] row object.</pre> + <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 data Ignored, data are taken from the mmkin model</pre> + <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 fixed Ignored, all degradation parameters fitted in the</pre> + <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">#' mmkin model are used as fixed parameters</pre> + <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">#' @param random If not specified, no correlations between random effects are</pre> + <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">#' set up for the optimised degradation model parameters. This is</pre> + <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">#' achieved by using the [nlme::pdDiag] method.</pre> + <pre class="language-r">#' @param na_stop Should it be an error if `deSolve::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 groups See the documentation of nlme</pre> + <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">#' @param start If not specified, mean values of the fitted degradation</pre> + <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">#' parameters taken from the mmkin object are used</pre> + <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">#' @param correlation See the documentation of nlme</pre> + <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">#' @param weights passed to nlme</pre> + <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">#' @param subset passed to nlme</pre> + <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">#' @param method passed to nlme</pre> + <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">#' @param na.action passed to nlme</pre> + <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">#' @param naPattern passed to nlme</pre> + <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">#' @param control passed to nlme</pre> + <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">#' @param verbose passed to nlme</pre> + <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">#' @importFrom stats na.fail as.formula</pre> + <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">#' @return Upon success, a fitted 'nlme.mmkin' object, which is an nlme object</pre> + <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">#' with additional elements. It also inherits from 'mixed.mmkin'.</pre> + <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">#' @note As the object inherits from [nlme::nlme], there is a wealth of</pre> + <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">#' methods that will automatically work on 'nlme.mmkin' objects, such as</pre> + <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">#' [nlme::intervals()], [nlme::anova.lme()] and [nlme::coef.lme()].</pre> + <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> + <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">#' @seealso [nlme_function()], [plot.mixed.mmkin], [summary.nlme.mmkin]</pre> + <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">#' @examples</pre> + <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">#' ds <- lapply(experimental_data_for_UBA_2019[6:10],</pre> + <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">#' function(x) subset(x$data[c("name", "time", "value")], name == "parent"))</pre> + <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">#'</pre> + <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">#' \dontrun{</pre> + <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">#' f <- mmkin(c("SFO", "DFOP"), ds, quiet = TRUE, cores = 1)</pre> + <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">#' library(nlme)</pre> + <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">#' f_nlme_sfo <- nlme(f["SFO", ])</pre> + <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">#' f_nlme_dfop <- nlme(f["DFOP", ])</pre> + <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">#' anova(f_nlme_sfo, f_nlme_dfop)</pre> + <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">#' print(f_nlme_dfop)</pre> + <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">#' plot(f_nlme_dfop)</pre> + <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">#' endpoints(f_nlme_dfop)</pre> + <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">#'</pre> + <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">#' ds_2 <- lapply(experimental_data_for_UBA_2019[6:10],</pre> + <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">#' function(x) x$data[c("name", "time", "value")])</pre> + <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">#' m_sfo_sfo <- mkinmod(parent = mkinsub("SFO", "A1"),</pre> + <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">#' A1 = mkinsub("SFO"), use_of_ff = "min", quiet = TRUE)</pre> + <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">#' m_sfo_sfo_ff <- mkinmod(parent = mkinsub("SFO", "A1"),</pre> + <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">#' A1 = mkinsub("SFO"), use_of_ff = "max", quiet = TRUE)</pre> + <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">#' m_dfop_sfo <- mkinmod(parent = mkinsub("DFOP", "A1"),</pre> + <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">#' A1 = mkinsub("SFO"), quiet = TRUE)</pre> + <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">#'</pre> + <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">#' f_2 <- mmkin(list("SFO-SFO" = m_sfo_sfo,</pre> + <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">#' "SFO-SFO-ff" = m_sfo_sfo_ff,</pre> + <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">#' "DFOP-SFO" = m_dfop_sfo),</pre> + <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">#' ds_2, quiet = TRUE)</pre> + <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">#'</pre> + <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">#' f_nlme_sfo_sfo <- nlme(f_2["SFO-SFO", ])</pre> + <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">#' plot(f_nlme_sfo_sfo)</pre> + <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">#'</pre> + <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">#' # With formation fractions this does not coverge with defaults</pre> + <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">#' # f_nlme_sfo_sfo_ff <- nlme(f_2["SFO-SFO-ff", ])</pre> + <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">#' #plot(f_nlme_sfo_sfo_ff)</pre> + <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">#'</pre> + <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">#' # For the following, we need to increase pnlsMaxIter and the tolerance</pre> + <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">#' # to get convergence</pre> + <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">#' f_nlme_dfop_sfo <- nlme(f_2["DFOP-SFO", ],</pre> + <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">#' control = list(pnlsMaxIter = 120, tolerance = 5e-4))</pre> + <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> + <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">#' plot(f_nlme_dfop_sfo)</pre> + <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">#'</pre> + <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">#' anova(f_nlme_dfop_sfo, f_nlme_sfo_sfo)</pre> + <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">#'</pre> + <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">#' endpoints(f_nlme_sfo_sfo)</pre> + <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">#' endpoints(f_nlme_dfop_sfo)</pre> + <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> + <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">#' if (length(findFunction("varConstProp")) > 0) { # tc error model for nlme available</pre> + <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">#' # Attempts to fit metabolite kinetics with the tc error model are possible,</pre> + <pre class="language-r">{</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">108</td> - <td class="coverage"></td> + <td class="coverage">47544878<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' # but need tweeking of control values and sometimes do not converge</pre> + <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> + <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> + <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">#' f_nlme_sfo_tc <- nlme(f_tc["SFO", ])</pre> + <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">#' f_nlme_dfop_tc <- nlme(f_tc["DFOP", ])</pre> + <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">#' AIC(f_nlme_sfo, f_nlme_sfo_tc, f_nlme_dfop, f_nlme_dfop_tc)</pre> + <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">#' print(f_nlme_dfop_tc)</pre> + <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">#' }</pre> + <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">#'</pre> + <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">#' f_2_obs <- update(f_2, error_model = "obs")</pre> + <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">#' f_nlme_sfo_sfo_obs <- nlme(f_2_obs["SFO-SFO", ])</pre> + <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">#' print(f_nlme_sfo_sfo_obs)</pre> + <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">#' f_nlme_dfop_sfo_obs <- nlme(f_2_obs["DFOP-SFO", ],</pre> + <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">#' control = list(pnlsMaxIter = 120, tolerance = 5e-4))</pre> + <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">#'</pre> + <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">#' f_2_tc <- update(f_2, error_model = "tc")</pre> + <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">#' # f_nlme_sfo_sfo_tc <- nlme(f_2_tc["SFO-SFO", ]) # No convergence with 50 iterations</pre> + <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">#' # f_nlme_dfop_sfo_tc <- nlme(f_2_tc["DFOP-SFO", ],</pre> + <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">#' # control = list(pnlsMaxIter = 120, tolerance = 5e-4)) # Error in X[, fmap[[nm]]] <- gradnm</pre> + <pre class="language-r"> # Names of state variables and observed variables</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">127</td> - <td class="coverage"></td> + <td class="coverage">47544878<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> mod_vars <- names(x$diffs)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">128</td> - <td class="coverage"></td> + <td class="coverage">47544878<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' anova(f_nlme_dfop_sfo, f_nlme_dfop_sfo_obs)</pre> + <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> + <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> + <pre class="language-r"> # Order the inital values for state variables if they are named</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">131</td> - <td class="coverage"></td> + <td class="coverage">47544878<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">nlme.mmkin <- function(model, data = "auto",</pre> + <pre class="language-r"> if (!is.null(names(odeini))) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">132</td> - <td class="coverage"></td> + <td class="coverage">47544878<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fixed = lapply(as.list(names(mean_degparms(model))),</pre> + <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"> function(el) eval(parse(text = paste(el, 1, sep = "~")))),</pre> + <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"> random = pdDiag(fixed),</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">135</td> - <td class="coverage"></td> + <td class="coverage">47544878<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> groups,</pre> + <pre class="language-r"> out_obs <- matrix(NA, nrow = length(outtimes), ncol = 1 + length(obs_vars),</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">136</td> - <td class="coverage"></td> + <td class="coverage">47544878<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> start = mean_degparms(model, random = TRUE, test_log_parms = TRUE),</pre> + <pre class="language-r"> dimnames = list(as.character(outtimes), c("time", obs_vars)))</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">137</td> - <td class="coverage"></td> + <td class="coverage">47544878<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> correlation = NULL, weights = NULL,</pre> + <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"> subset, method = c("ML", "REML"),</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">139</td> - <td class="coverage"></td> + <td class="coverage">47544878<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> na.action = na.fail, naPattern,</pre> + <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"> control = list(), verbose= FALSE)</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">141</td> - <td class="coverage"></td> + <td class="coverage">47544878<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">{</pre> + <pre class="language-r"> if (solution_type == "analytical") {</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">142</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (nrow(model) > 1) stop("Only row objects allowed")</pre> + <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"></pre> + <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">1013<em>x</em></td> + <td class="coverage">1843695<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> thisCall <- as.list(match.call())[-1]</pre> + <pre class="language-r"> pseudo_observed <-</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">145</td> - <td class="coverage"></td> + <td class="coverage">1843695<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> data.frame(name = rep(obs_vars, each = length(outtimes)),</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">146</td> - <td class="coverage"></td> + <td class="coverage">1843695<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Warn in case arguments were used that are overriden</pre> + <pre class="language-r"> time = rep(outtimes, length(obs_vars)))</pre> </td> </tr> <tr class="covered"> <td class="num">147</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage">1843695<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (any(!is.na(match(names(thisCall),</pre> + <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">1013<em>x</em></td> + <td class="coverage">1843695<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> c("data"))))) {</pre> + <pre class="language-r"> for (obs_var in obs_vars) {</pre> </td> </tr> - <tr class="missed"> + <tr class="covered"> <td class="num">149</td> - <td class="coverage">!</td> + <td class="coverage">2431585<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> warning("'nlme.mmkin' will redefine 'data'")</pre> + <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> + <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> + <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"> # Get native symbol info for speed</pre> + <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">1013<em>x</em></td> + <td class="coverage">1843695<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> + <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"> # The mkinmod stored in the first fit will be used by nlme</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">155</td> - <td class="coverage">189<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> model[[1]]$mkinmod$symbols <- deSolve::checkDLL(</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">156</td> - <td class="coverage">189<em>x</em></td> + <td class="coverage">45701183<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> dllname = model[[1]]$mkinmod$dll_info[["name"]],</pre> + <pre class="language-r"> if (solution_type == "eigen") {</pre> </td> </tr> <tr class="covered"> <td class="num">157</td> - <td class="coverage">189<em>x</em></td> + <td class="coverage">97082<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> func = "diffs", initfunc = "initpar",</pre> + <pre class="language-r"> evalparse <- function(string) {</pre> </td> </tr> <tr class="covered"> <td class="num">158</td> - <td class="coverage">189<em>x</em></td> + <td class="coverage">392283<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> jacfunc = NULL, nout = 0, outnames = NULL)</pre> + <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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> @@ -45097,86 +41326,86 @@ table.table-condensed { </tr> <tr class="covered"> <td class="num">161</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage">97082<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> deg_func <- nlme_function(model)</pre> + <pre class="language-r"> coefmat.num <- matrix(sapply(as.vector(x$coefmat), evalparse),</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">162</td> - <td class="coverage"></td> + <td class="coverage">97082<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> nrow = length(mod_vars))</pre> </td> </tr> <tr class="covered"> <td class="num">163</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage">97082<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> assign("deg_func", deg_func, getFromNamespace(".nlme_env", "mkin"))</pre> + <pre class="language-r"> e <- eigen(coefmat.num)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">164</td> - <td class="coverage"></td> + <td class="coverage">97082<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> c <- solve(e$vectors, odeini)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">165</td> - <td class="coverage"></td> + <td class="coverage">97082<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # For the formula, get the degradation function from the mkin namespace</pre> + <pre class="language-r"> f.out <- function(t) {</pre> </td> </tr> <tr class="covered"> <td class="num">166</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage">1085040<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> this_model_text <- paste0("value ~ mkin::get_deg_func()(",</pre> + <pre class="language-r"> e$vectors %*% diag(exp(e$values * t), nrow=length(mod_vars)) %*% c</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">167</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> paste(names(formals(deg_func)), collapse = ", "), ")")</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="covered"> <td class="num">168</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage">97082<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> this_model <- as.formula(this_model_text)</pre> + <pre class="language-r"> o <- matrix(mapply(f.out, outtimes),</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">169</td> - <td class="coverage"></td> + <td class="coverage">97082<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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">1013<em>x</em></td> + <td class="coverage">97082<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> thisCall[["model"]] <- this_model</pre> + <pre class="language-r"> out <- cbind(outtimes, t(o))</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">171</td> - <td class="coverage"></td> + <td class="coverage">97082<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> colnames(out) <- c("time", mod_vars)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">172</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> thisCall[["data"]] <- nlme_data(model)</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> @@ -45188,576 +41417,576 @@ table.table-condensed { </tr> <tr class="covered"> <td class="num">174</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage">45701183<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> thisCall[["start"]] <- start</pre> + <pre class="language-r"> if (solution_type == "deSolve") {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">175</td> - <td class="coverage"></td> + <td class="coverage">45604101<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> if (!is.null(x$cf) & use_compiled[1] != FALSE) {</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">176</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> thisCall[["fixed"]] <- fixed</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">177</td> - <td class="coverage"></td> + <td class="coverage">45603235<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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">1013<em>x</em></td> + <td class="coverage">1427314<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> thisCall[["random"]] <- random</pre> + <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"></pre> + <pre class="language-r"> } else {</pre> </td> </tr> <tr class="covered"> <td class="num">180</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage">44175921<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> error_model <- model[[1]]$err_mod</pre> + <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> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">182</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (missing(weights)) {</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">183</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage">45603235<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> thisCall[["weights"]] <- switch(error_model,</pre> + <pre class="language-r"> out <- deSolve::lsoda(</pre> </td> </tr> <tr class="covered"> <td class="num">184</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage">45603235<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> const = NULL,</pre> + <pre class="language-r"> y = odeini,</pre> </td> </tr> <tr class="covered"> <td class="num">185</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage">45603235<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> obs = varIdent(form = ~ 1 | name),</pre> + <pre class="language-r"> times = outtimes,</pre> </td> </tr> <tr class="covered"> <td class="num">186</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage">45603235<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> tc = varConstProp())</pre> + <pre class="language-r"> func = lsoda_func,</pre> </td> </tr> <tr class="covered"> <td class="num">187</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage">45603235<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> sigma <- switch(error_model,</pre> + <pre class="language-r"> initfunc = "initpar",</pre> </td> </tr> <tr class="covered"> <td class="num">188</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage">45603235<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> tc = 1,</pre> + <pre class="language-r"> dllname = x$dll_info[["name"]],</pre> </td> </tr> <tr class="covered"> <td class="num">189</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage">45603235<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> NULL)</pre> + <pre class="language-r"> parms = odeparms[x$parms], # Order matters when using compiled models</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">190</td> - <td class="coverage"></td> + <td class="coverage">45603235<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> atol = atol,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">191</td> - <td class="coverage"></td> + <td class="coverage">45603235<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> rtol = rtol,</pre> </td> </tr> <tr class="covered"> <td class="num">192</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage">45603235<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> control <- thisCall[["control"]]</pre> + <pre class="language-r"> maxsteps = maxsteps,</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">193</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (error_model == "tc") {</pre> + <pre class="language-r"> ...</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">194</td> - <td class="coverage">928<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> control$sigma = 1</pre> + <pre class="language-r"> )</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">195</td> - <td class="coverage">928<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> thisCall[["control"]] <- control</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">196</td> - <td class="coverage"></td> + <td class="coverage">45603235<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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"></pre> + <pre class="language-r"> } else {</pre> </td> </tr> <tr class="covered"> <td class="num">198</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage">866<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fit_time <- system.time(val <- do.call("nlme.formula", thisCall))</pre> + <pre class="language-r"> mkindiff <- function(t, state, parms) {</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">199</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> val$time <- fit_time</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">200</td> - <td class="coverage"></td> + <td class="coverage">145229<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> time <- t</pre> </td> </tr> <tr class="covered"> <td class="num">201</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage">145229<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> val$mkinmod <- model[[1]]$mkinmod</pre> + <pre class="language-r"> diffs <- vector()</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">202</td> - <td class="coverage"></td> + <td class="coverage">145229<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Don't return addresses that will become invalid</pre> + <pre class="language-r"> for (box in names(x$diffs))</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">203</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> val$mkinmod$symbols <- NULL</pre> + <pre class="language-r"> {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">204</td> - <td class="coverage"></td> + <td class="coverage">145229<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> diffname <- paste("d", box, sep="_")</pre> </td> </tr> <tr class="covered"> <td class="num">205</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage">145229<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> val$data <- thisCall[["data"]]</pre> + <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">1013<em>x</em></td> + <td class="coverage">145229<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> val$mmkin <- model</pre> + <pre class="language-r"> eval(parse(text=x$diffs[[box]])))</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">207</td> - <td class="coverage">824<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (is.list(start)) val$mean_dp_start <- start$fixed</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="covered"> <td class="num">208</td> - <td class="coverage">189<em>x</em></td> + <td class="coverage">145229<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> else val$mean_dp_start <- start</pre> + <pre class="language-r"> return(list(c(diffs)))</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">209</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> val$transform_rates <- model[[1]]$transform_rates</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="covered"> <td class="num">210</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage">866<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> val$transform_fractions <- model[[1]]$transform_fractions</pre> + <pre class="language-r"> out <- deSolve::ode(</pre> </td> </tr> <tr class="covered"> <td class="num">211</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage">866<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> val$solution_type <- model[[1]]$solution_type</pre> + <pre class="language-r"> y = odeini,</pre> </td> </tr> <tr class="covered"> <td class="num">212</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage">866<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> val$err_mode <- error_model</pre> + <pre class="language-r"> times = outtimes,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">213</td> - <td class="coverage"></td> + <td class="coverage">866<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> func = mkindiff,</pre> </td> </tr> <tr class="covered"> <td class="num">214</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage">866<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> val$bparms.optim <- backtransform_odeparms(val$coefficients$fixed,</pre> + <pre class="language-r"> parms = odeparms,</pre> </td> </tr> <tr class="covered"> <td class="num">215</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage">866<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> val$mkinmod,</pre> + <pre class="language-r"> method = method.ode,</pre> </td> </tr> <tr class="covered"> <td class="num">216</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage">866<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> transform_rates = val$transform_rates,</pre> + <pre class="language-r"> atol = atol,</pre> </td> </tr> <tr class="covered"> <td class="num">217</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage">866<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> transform_fractions = val$transform_fractions)</pre> + <pre class="language-r"> rtol = rtol,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">218</td> - <td class="coverage"></td> + <td class="coverage">866<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> maxsteps = maxsteps,</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">219</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> val$bparms.fixed <- model[[1]]$bparms.fixed</pre> + <pre class="language-r"> ...</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">220</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> val$date.fit <- date()</pre> + <pre class="language-r"> )</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">221</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> val$nlmeversion <- as.character(utils::packageVersion("nlme"))</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="covered"> <td class="num">222</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage">45604101<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> val$mkinversion <- as.character(utils::packageVersion("mkin"))</pre> + <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">1013<em>x</em></td> + <td class="coverage">45604101<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> val$Rversion <- paste(R.version$major, R.version$minor, sep=".")</pre> + <pre class="language-r"> if (n_out_na > 0 & na_stop) {</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">224</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> class(val) <- c("nlme.mmkin", "mixed.mmkin", "nlme", "lme")</pre> + <pre class="language-r"> cat("odeini:\n")</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">225</td> - <td class="coverage">1013<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> return(val)</pre> + <pre class="language-r"> print(odeini)</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">226</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">}</pre> + <pre class="language-r"> cat("odeparms:\n")</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">227</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> print(odeparms)</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">228</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <pre class="language-r"> cat("out:\n")</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">229</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#' @rdname nlme.mmkin</pre> + <pre class="language-r"> print(out)</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">230</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#' @param x An nlme.mmkin object to print</pre> + <pre class="language-r"> stop("Differential equations were not integrated for all output times because\n",</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">231</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#' @param digits Number of digits to use for printing</pre> + <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">print.nlme.mmkin <- function(x, digits = max(3, getOption("digits") - 3), ...) {</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">233</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat( "Kinetic nonlinear mixed-effects model fit by " )</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">234</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat( if(x$method == "REML") "REML\n" else "maximum likelihood\n")</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">235</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage">45701183<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nStructural model:\n")</pre> + <pre class="language-r"> if (map_output) {</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">236</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> diffs <- x$mmkin[[1]]$mkinmod$diffs</pre> + <pre class="language-r"> # Output transformation for models with unobserved compartments like SFORB</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">237</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> nice_diffs <- gsub("^(d.*) =", "\\1/dt =", diffs)</pre> + <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">117<em>x</em></td> + <td class="coverage">45701183<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> writeLines(strwrap(nice_diffs, exdent = 11))</pre> + <pre class="language-r"> if (n_out_na > 0 & !na_stop) {</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">239</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nData:\n")</pre> + <pre class="language-r"> available <- c(TRUE, rep(FALSE, length(outtimes) - 1))</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">240</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat(nrow(x$data), "observations of",</pre> + <pre class="language-r"> } else {</pre> </td> </tr> <tr class="covered"> <td class="num">241</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage">45701183<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> length(unique(x$data$name)), "variable(s) grouped in",</pre> + <pre class="language-r"> available <- rep(TRUE, length(outtimes))</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">242</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> length(unique(x$data$ds)), "datasets\n")</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="covered"> <td class="num">243</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage">45701183<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nLog-", if(x$method == "REML") "restricted-" else "",</pre> + <pre class="language-r"> for (var in names(x$map)) {</pre> </td> </tr> <tr class="covered"> <td class="num">244</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage">93237433<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> "likelihood: ", format(x$logLik, digits = digits), "\n", sep = "")</pre> + <pre class="language-r"> if((length(x$map[[var]]) == 1)) {</pre> </td> </tr> <tr class="covered"> <td class="num">245</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage">93235081<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fixF <- x$call$fixed</pre> + <pre class="language-r"> out_obs[available, var] <- out[available, var]</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">246</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nFixed effects:\n",</pre> + <pre class="language-r"> } else {</pre> </td> </tr> <tr class="covered"> <td class="num">247</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage">2352<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> deparse(</pre> + <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">117<em>x</em></td> + <td class="coverage">2352<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if(inherits(fixF, "formula") || is.call(fixF) || is.name(fixF))</pre> + <pre class="language-r"> out[available, x$map[[var]][2]]</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">249</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> x$call$fixed</pre> + <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"> else</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="covered"> <td class="num">251</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage">45701183<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> lapply(fixF, function(el) as.name(deparse(el)))), "\n")</pre> + <pre class="language-r"> return(out_obs)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">252</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> print(fixef(x), digits = digits, ...)</pre> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">253</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> cat("\n")</pre> + <pre class="language-r"> dimnames(out) <- list(time = as.character(outtimes), c("time", mod_vars))</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">254</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> print(summary(x$modelStruct), sigma = x$sigma, digits = digits, ...)</pre> + <pre class="language-r"> return(out)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">255</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> invisible(x)</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> @@ -45778,524 +42007,552 @@ table.table-condensed { <td class="num">258</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <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">#' @rdname nlme.mmkin</pre> + <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">#' @param object An nlme.mmkin object to update</pre> + <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">#' @param ... Update specifications passed to update.nlme</pre> + <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">update.nlme.mmkin <- function(object, ...) {</pre> + <pre class="language-r"> odeini = x$bparms.state,</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">263</td> - <td class="coverage">85<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> res <- NextMethod()</pre> + <pre class="language-r"> outtimes = seq(0, 120, by = 0.1),</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">264</td> - <td class="coverage">85<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> res$mmkin <- object$mmkin</pre> + <pre class="language-r"> solution_type = "deSolve",</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">265</td> - <td class="coverage">85<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> class(res) <- c("nlme.mmkin", "nlme", "lme")</pre> + <pre class="language-r"> use_compiled = "auto",</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">266</td> - <td class="coverage">85<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> return(res)</pre> + <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/mkinresplot.R" class="hidden"> + <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">utils::globalVariables(c("variable", "residual"))</pre> + <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> + <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> + <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">#'</pre> + <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">#' This function plots the residuals for the specified subset of the observed</pre> + <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">#' variables from an mkinfit object. A combined plot of the fitted model and</pre> + <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">#' the residuals can be obtained using \code{\link{plot.mkinfit}} using the</pre> + <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">#' argument \code{show_residuals = TRUE}.</pre> + <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">#'</pre> + <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">#' @importFrom stats residuals</pre> + <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">#' @param object A fit represented in an \code{\link{mkinfit}} object.</pre> + <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">#' @param obs_vars A character vector of names of the observed variables for</pre> + <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">#' which residuals should be plotted. Defaults to all observed variables in</pre> + <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">#' the model</pre> + <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">#' @param xlim plot range in x direction.</pre> + <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">#' @param xlab Label for the x axis.</pre> + <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">#' @param standardized Should the residuals be standardized by dividing by the</pre> + <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">#' standard deviation given by the error model of the fit?</pre> + <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">#' @param ylab Label for the y axis.</pre> + <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">#' @param maxabs Maximum absolute value of the residuals. This is used for the</pre> + <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">#' scaling of the y axis and defaults to "auto".</pre> + <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">#' @param legend Should a legend be plotted?</pre> + <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">#' @param lpos Where should the legend be placed? Default is "topright". Will</pre> + <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">#' be passed on to \code{\link{legend}}.</pre> + <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">#' @param col_obs Colors for the observed variables.</pre> + <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">#' @param pch_obs Symbols to be used for the observed variables.</pre> + <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">#' @param frame Should a frame be drawn around the plots?</pre> + <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">#' @param \dots further arguments passed to \code{\link{plot}}.</pre> + <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">#' @return Nothing is returned by this function, as it is called for its side</pre> + <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">#' effect, namely to produce a plot.</pre> + <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">#' @author Johannes Ranke and Katrin Lindenberger</pre> + <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">#' @seealso \code{\link{mkinplot}}, for a way to plot the data and the fitted</pre> + <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">#' lines of the mkinfit object, and \code{\link{plot_res}} for a function</pre> + <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">#' combining the plot of the fit and the residual plot.</pre> + <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">#' @examples</pre> + <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">#'</pre> + <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">#' model <- mkinmod(parent = mkinsub("SFO", "m1"), m1 = mkinsub("SFO"))</pre> + <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">#' fit <- mkinfit(model, FOCUS_2006_D, quiet = TRUE)</pre> + <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">#' mkinresplot(fit, "m1")</pre> + <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">#'</pre> + <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">#' @export</pre> + <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">mkinresplot <- function (object,</pre> + <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"> obs_vars = names(object$mkinmod$map),</pre> + <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"> xlim = c(0, 1.1 * max(object$data$time)),</pre> + <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"> standardized = FALSE,</pre> + <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"> xlab = "Time", ylab = ifelse(standardized, "Standardized residual", "Residual"),</pre> + <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"> maxabs = "auto", legend = TRUE, lpos = "topright",</pre> + <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"> col_obs = "auto", pch_obs = "auto",</pre> + <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"> frame = TRUE,</pre> + <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"> ...)</pre> + <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">{</pre> + <pre class="language-r">#' # augPred does not work on fits with more than one state</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">52</td> - <td class="coverage">1228<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> obs_vars_all <- as.character(unique(object$data$variable))</pre> + <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> + <pre class="language-r">#' #</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">54</td> - <td class="coverage">1228<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (length(obs_vars) > 0){</pre> + <pre class="language-r">#' # The procedure is greatly simplified by the nlme.mmkin function</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">55</td> - <td class="coverage">1228<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> obs_vars <- intersect(obs_vars_all, obs_vars)</pre> + <pre class="language-r">#' f_nlme <- nlme(f)</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">56</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> } else obs_vars <- obs_vars_all</pre> + <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"></pre> + <pre class="language-r">#' @return A function that can be used with nlme</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">58</td> - <td class="coverage">1228<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (standardized) {</pre> + <pre class="language-r">#' @export</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">59</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> res_col <- "standardized"</pre> + <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"> object$data[[res_col]] <- residuals(object, standardized = TRUE)</pre> + <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"> } else {</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">62</td> - <td class="coverage">1228<em>x</em></td> + <td class="coverage">1168<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> res_col <- "residual"</pre> + <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> + <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="coverage">1168<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> res <- subset(object$data, variable %in% obs_vars)[res_col]</pre> + <pre class="language-r"> degparm_names <- names(mean_degparms(object))</pre> </td> </tr> <tr class="never"> @@ -46305,151 +42562,151 @@ table.table-condensed { <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">66</td> - <td class="coverage">1228<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (maxabs == "auto") maxabs = max(abs(res), na.rm = TRUE)</pre> + <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"></pre> + <pre class="language-r"> # and https://stackoverflow.com/a/26280789/3805440</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">68</td> - <td class="coverage"></td> + <td class="coverage">1168<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Set colors and symbols</pre> + <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">1228<em>x</em></td> + <td class="coverage">1168<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (col_obs[1] == "auto") {</pre> + <pre class="language-r"> names(model_function_alist) <- c("name", "time", degparm_names)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">70</td> - <td class="coverage">948<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> col_obs <- 1:length(obs_vars)</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">71</td> - <td class="coverage"></td> + <td class="coverage">1168<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> model_function_body <- quote({</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">72</td> - <td class="coverage"></td> + <td class="coverage">252739<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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">1228<em>x</em></td> + <td class="coverage">252739<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (pch_obs[1] == "auto") {</pre> + <pre class="language-r"> res_frame <- arg_frame[1:2]</pre> </td> </tr> <tr class="covered"> <td class="num">74</td> - <td class="coverage">948<em>x</em></td> + <td class="coverage">252739<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> pch_obs <- 1:length(obs_vars)</pre> + <pre class="language-r"> parm_frame <- arg_frame[-(1:2)]</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">75</td> - <td class="coverage"></td> + <td class="coverage">252739<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> parms_unique <- unique(parm_frame)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">76</td> - <td class="coverage">1228<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> names(col_obs) <- names(pch_obs) <- obs_vars</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">77</td> - <td class="coverage"></td> + <td class="coverage">252739<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> n_unique <- nrow(parms_unique)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">78</td> - <td class="coverage">1228<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> plot(0, type = "n", frame = frame,</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">79</td> - <td class="coverage">1228<em>x</em></td> + <td class="coverage">252739<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> xlab = xlab, ylab = ylab,</pre> + <pre class="language-r"> times_ds <- list()</pre> </td> </tr> <tr class="covered"> <td class="num">80</td> - <td class="coverage">1228<em>x</em></td> + <td class="coverage">252739<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> xlim = xlim,</pre> + <pre class="language-r"> names_ds <- list()</pre> </td> </tr> <tr class="covered"> <td class="num">81</td> - <td class="coverage">1228<em>x</em></td> + <td class="coverage">252739<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ylim = c(-1.2 * maxabs, 1.2 * maxabs), ...)</pre> + <pre class="language-r"> for (i in 1:n_unique) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">82</td> - <td class="coverage"></td> + <td class="coverage">2342789<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> times_ds[[i]] <-</pre> </td> </tr> <tr class="covered"> <td class="num">83</td> - <td class="coverage">1228<em>x</em></td> + <td class="coverage">2342789<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> for(obs_var in obs_vars){</pre> + <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">1298<em>x</em></td> + <td class="coverage">2342789<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> + <pre class="language-r"> names_ds[[i]] <-</pre> </td> </tr> <tr class="covered"> <td class="num">85</td> - <td class="coverage">1298<em>x</em></td> + <td class="coverage">2342789<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> + <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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> @@ -46461,48 +42718,405 @@ table.table-condensed { </tr> <tr class="covered"> <td class="num">88</td> - <td class="coverage">1228<em>x</em></td> + <td class="coverage">252739<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> abline(h = 0, lty = 2)</pre> + <pre class="language-r"> res_list <- lapply(1:n_unique, function(x) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">89</td> - <td class="coverage"></td> + <td class="coverage">2342789<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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">1228<em>x</em></td> + <td class="coverage">2342789<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (legend == TRUE) {</pre> + <pre class="language-r"> parms_fixed <- object[[1]]$bparms.fixed</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">91</td> - <td class="coverage">!</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> + <pre class="language-r"></pre> </td> </tr> - <tr class="missed"> + <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 `nlme::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"> col = col_obs[obs_vars], pch = pch_obs[obs_vars])</pre> + <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">93</td> + <td class="num">134</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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">94</td> + <td class="num">145</td> <td class="coverage"></td> <td class="col-sm-12"> <pre class="language-r">}</pre> @@ -46511,1103 +43125,1494 @@ table.table-condensed { </tbody> </table> </div> - <div id="R/plot.mmkin.R" class="hidden"> + <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">#' Plot model fits (observed and fitted) and the residuals for a row or column</pre> + <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">#' of an mmkin object</pre> + <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">#'</pre> + <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">#' When x is a row selected from an mmkin object (\code{\link{[.mmkin}}), the</pre> + <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">#' same model fitted for at least one dataset is shown. When it is a column,</pre> + <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">#' the fit of at least one model to the same dataset is shown.</pre> + <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">#'</pre> + <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">#' If the current plot device is a \code{\link[tikzDevice]{tikz}} device, then</pre> + <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">#' latex is being used for the formatting of the chi2 error level.</pre> + <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> + <pre class="language-r">{</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">11</td> - <td class="coverage"></td> + <td class="coverage">589<em>x</em></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> + <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">#' column.</pre> + <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 main The main title placed on the outer margin of the plot.</pre> + <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 legends An index for the fits for which legends should be shown.</pre> + <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">#' @param resplot Should the residuals plotted against time, using</pre> + <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">#' \code{\link{mkinresplot}}, or as squared residuals against predicted</pre> + <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">#' values, with the error model, using \code{\link{mkinerrplot}}.</pre> + <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">#' @param ylab Label for the y axis.</pre> + <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">#' @param standardized Should the residuals be standardized? This option</pre> + <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">#' is passed to \code{\link{mkinresplot}}, it only takes effect if</pre> + <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">#' `resplot = "time"`.</pre> + <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">#' @param show_errmin Should the chi2 error level be shown on top of the plots</pre> + <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">#' to the left?</pre> + <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">#' @param errmin_var The variable for which the FOCUS chi2 error value should</pre> + <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">#' be shown.</pre> + <pre class="language-r">status.mmkin <- function(object, ...) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">26</td> - <td class="coverage"></td> + <td class="coverage">376<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @param errmin_digits The number of significant digits for rounding the FOCUS</pre> + <pre class="language-r"> all_summary_warnings <- character()</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">27</td> - <td class="coverage"></td> + <td class="coverage">376<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' chi2 error percentage.</pre> + <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">#' @param cex Passed to the plot functions and \code{\link{mtext}}.</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">29</td> - <td class="coverage"></td> + <td class="coverage">376<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @param rel.height.middle The relative height of the middle plot, if more</pre> + <pre class="language-r"> result <- lapply(object,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">30</td> - <td class="coverage"></td> + <td class="coverage">376<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' than two rows of plots are shown.</pre> + <pre class="language-r"> function(fit) {</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">31</td> - <td class="coverage"></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> + <pre class="language-r"> if (inherits(fit, "try-error")) return("E")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">32</td> - <td class="coverage"></td> + <td class="coverage">4391<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @param \dots Further arguments passed to \code{\link{plot.mkinfit}} and</pre> + <pre class="language-r"> sw <- fit$summary_warnings</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">33</td> - <td class="coverage"></td> + <td class="coverage">4391<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' \code{\link{mkinresplot}}.</pre> + <pre class="language-r"> swn <- names(sw)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">34</td> - <td class="coverage"></td> + <td class="coverage">4391<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @return The function is called for its side effect.</pre> + <pre class="language-r"> if (length(sw) > 0) {</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">35</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#' @author Johannes Ranke</pre> + <pre class="language-r"> if (any(grepl("S", swn))) {</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">36</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#' @examples</pre> + <pre class="language-r"> sww <<- sww + 1</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">37</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <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">#' \dontrun{</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">39</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#' # Only use one core not to offend CRAN checks</pre> + <pre class="language-r"> warnstring <- paste(swn, collapse = ", ")</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">40</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#' fits <- mmkin(c("FOMC", "HS"),</pre> + <pre class="language-r"> names(sw) <- swn</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">41</td> - <td class="coverage"></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> + <pre class="language-r"> all_summary_warnings <<- c(all_summary_warnings, sw)</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">42</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#' cores = 1, quiet = TRUE, error_model = "tc")</pre> + <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">#' plot(fits[, "FOCUS C"])</pre> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">44</td> - <td class="coverage"></td> + <td class="coverage">4391<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' plot(fits["FOMC", ])</pre> + <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">#' plot(fits["FOMC", ], show_errmin = FALSE)</pre> + <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> + <pre class="language-r"> })</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">47</td> - <td class="coverage"></td> + <td class="coverage">376<em>x</em></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> + <pre class="language-r"> result <- unlist(result)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">48</td> - <td class="coverage"></td> + <td class="coverage">376<em>x</em></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> + <pre class="language-r"> dim(result) <- dim(object)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">49</td> - <td class="coverage"></td> + <td class="coverage">376<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' # generated by pkgdown, as far as I know).</pre> + <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">#' plot(fits["FOMC", "FOCUS C"]) # same as plot(fits[1, 2])</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">51</td> - <td class="coverage"></td> + <td class="coverage">376<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r"> u_swn <- unique(names(all_summary_warnings))</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">52</td> - <td class="coverage"></td> + <td class="coverage">376<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' # Show the error models</pre> + <pre class="language-r"> attr(result, "unique_warnings") <- all_summary_warnings[u_swn]</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">53</td> - <td class="coverage"></td> + <td class="coverage">376<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' plot(fits["FOMC", ], resplot = "errmod")</pre> + <pre class="language-r"> class(result) <- "status.mmkin"</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">54</td> - <td class="coverage"></td> + <td class="coverage">376<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' }</pre> + <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> + <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> + <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">plot.mmkin <- function(x, main = "auto", legends = 1,</pre> + <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"> resplot = c("time", "errmod"),</pre> + <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"> ylab = "Residue",</pre> + <pre class="language-r">print.status.mmkin <- function(x, ...) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">60</td> - <td class="coverage"></td> + <td class="coverage">376<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> standardized = FALSE,</pre> + <pre class="language-r"> u_w <- attr(x, "unique_warnings")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">61</td> - <td class="coverage"></td> + <td class="coverage">376<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> show_errmin = TRUE,</pre> + <pre class="language-r"> attr(x, "unique_warnings") <- NULL</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">62</td> - <td class="coverage"></td> + <td class="coverage">376<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> errmin_var = "All data", errmin_digits = 3,</pre> + <pre class="language-r"> class(x) <- NULL</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">63</td> - <td class="coverage"></td> + <td class="coverage">376<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cex = 0.7, rel.height.middle = 0.9,</pre> + <pre class="language-r"> print(x, quote = FALSE)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">64</td> - <td class="coverage"></td> + <td class="coverage">376<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ymax = "auto", ...)</pre> + <pre class="language-r"> cat("\n")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">65</td> - <td class="coverage"></td> + <td class="coverage">376<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">{</pre> + <pre class="language-r"> for (i in seq_along(u_w)) {</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">66</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> cat(names(u_w)[i], ": ", u_w[i], "\n", sep = "")</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">67</td> - <td class="coverage">316<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> oldpar <- par(no.readonly = TRUE)</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="covered"> <td class="num">68</td> - <td class="coverage">316<em>x</em></td> + <td class="coverage">376<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> on.exit(par(oldpar, no.readonly = TRUE))</pre> + <pre class="language-r"> if (any(x == "OK")) cat("OK: No warnings\n")</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">69</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> if (any(x == "E")) cat("E: Error\n")</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">70</td> - <td class="coverage">316<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> n.m <- nrow(x)</pre> + <pre class="language-r">}</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">71</td> - <td class="coverage">316<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> n.d <- ncol(x)</pre> + <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> + <pre class="language-r">#' @rdname status</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">73</td> - <td class="coverage">316<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> resplot <- match.arg(resplot)</pre> + <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"></pre> + <pre class="language-r">status.mhmkin <- function(object, ...) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">75</td> - <td class="coverage"></td> + <td class="coverage">125<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # We can handle either a row (different models, same dataset)</pre> + <pre class="language-r"> if (inherits(object[[1]], "saem.mmkin")) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">76</td> - <td class="coverage"></td> + <td class="coverage">125<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # or a column (same model, different datasets)</pre> + <pre class="language-r"> test_func <- function(fit) {</pre> </td> </tr> - <tr class="missed"> + <tr class="covered"> <td class="num">77</td> - <td class="coverage">!</td> + <td class="coverage">500<em>x</em></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> + <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"> if (n.m == 1 & n.d == 1) loop_over = "none"</pre> + <pre class="language-r"> return("E")</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">79</td> - <td class="coverage">246<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (n.m > 1) loop_over <- "models"</pre> + <pre class="language-r"> } else {</pre> </td> </tr> <tr class="covered"> <td class="num">80</td> - <td class="coverage">70<em>x</em></td> + <td class="coverage">500<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (n.d > 1) loop_over <- "datasets"</pre> + <pre class="language-r"> if (inherits(fit$so, "try-error")) {</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">81</td> - <td class="coverage">316<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> n.fits <- length(x)</pre> + <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"></pre> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">83</td> - <td class="coverage"></td> + <td class="coverage">500<em>x</em></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> + <pre class="language-r"> if (!is.null(fit$FIM_failed)) {</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">84</td> - <td class="coverage"></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> + <pre class="language-r"> return_values <- c("fixed effects" = "Fth",</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">85</td> - <td class="coverage">316<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> if (main == "auto") {</pre> + <pre class="language-r"> "random effects and error model parameters" = "FO")</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">86</td> - <td class="coverage">140<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> main = switch(loop_over,</pre> + <pre class="language-r"> return(paste(return_values[fit$FIM_failed], collapse = ", "))</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">87</td> - <td class="coverage">140<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> none = paste(rownames(x), colnames(x)),</pre> + <pre class="language-r"> } else {</pre> </td> </tr> <tr class="covered"> <td class="num">88</td> - <td class="coverage">140<em>x</em></td> + <td class="coverage">500<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> models = colnames(x),</pre> + <pre class="language-r"> return("OK")</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">89</td> - <td class="coverage">140<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> datasets = rownames(x))</pre> + <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> + <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> + <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> + <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"> # and the middle plots (if n.fits >2) are smaller by rel.height.middle</pre> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">94</td> - <td class="coverage">316<em>x</em></td> + <td class="coverage">!</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> + <pre class="language-r"> stop("Only mhmkin objects containing saem.mmkin objects currently supported")</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">95</td> - <td class="coverage">316<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> else rep(1, n.fits)</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="covered"> <td class="num">96</td> - <td class="coverage">316<em>x</em></td> + <td class="coverage">125<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> + <pre class="language-r"> result <- lapply(object, test_func)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">97</td> - <td class="coverage"></td> + <td class="coverage">125<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> result <- unlist(result)</pre> </td> </tr> <tr class="covered"> <td class="num">98</td> - <td class="coverage">316<em>x</em></td> + <td class="coverage">125<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> par(cex = cex)</pre> + <pre class="language-r"> dim(result) <- dim(object)</pre> </td> </tr> - <tr class="never"> + <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">100</td> - <td class="coverage">316<em>x</em></td> + <td class="num">101</td> + <td class="coverage">125<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> for (i.fit in 1:n.fits) {</pre> + <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">101</td> + <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">102</td> + <td class="num">105</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> + <pre class="language-r">#' @rdname status</pre> </td> </tr> <tr class="never"> - <td class="num">103</td> + <td class="num">106</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> + <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">104</td> - <td class="coverage">948<em>x</em></td> + <td class="num">108</td> + <td class="coverage">125<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (i.fit == 1 & n.fits > 1) {</pre> + <pre class="language-r"> class(x) <- NULL</pre> </td> </tr> <tr class="covered"> - <td class="num">105</td> - <td class="coverage">316<em>x</em></td> + <td class="num">109</td> + <td class="coverage">125<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> + <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">106</td> + <td class="num">116</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">}</pre> </td> </tr> <tr class="never"> - <td class="num">107</td> + <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/CAKE_export.R" class="hidden"> + <table class="table-condensed"> + <tbody> <tr class="never"> - <td class="num">108</td> + <td class="num">1</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # Margins for middle rows of plots, if any</pre> + <pre class="language-r">#' Export a list of datasets format to a CAKE study file</pre> </td> </tr> - <tr class="covered"> - <td class="num">109</td> - <td class="coverage">948<em>x</em></td> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (i.fit > 1 & i.fit < n.fits) {</pre> + <pre class="language-r">#' </pre> </td> </tr> <tr class="never"> - <td class="num">110</td> + <td class="num">3</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> + <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">111</td> + <td class="num">4</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> + <pre class="language-r">#' specified as well.</pre> </td> </tr> - <tr class="covered"> - <td class="num">112</td> - <td class="coverage">316<em>x</em></td> + <tr class="never"> + <td class="num">5</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> + <pre class="language-r">#' </pre> </td> </tr> <tr class="never"> - <td class="num">113</td> + <td class="num">6</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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">114</td> + <td class="num">7</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' \code{\link{mkinfit}}.</pre> </td> </tr> <tr class="never"> - <td class="num">115</td> + <td class="num">8</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> + <pre class="language-r">#' @param map A character vector with CAKE compartment names (Parent, A1, ...),</pre> </td> </tr> - <tr class="covered"> - <td class="num">116</td> - <td class="coverage">948<em>x</em></td> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (i.fit == n.fits & n.fits > 1) {</pre> + <pre class="language-r">#' named with the names used in the list of datasets.</pre> </td> </tr> <tr class="never"> - <td class="num">117</td> + <td class="num">10</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> + <pre class="language-r">#' @param links An optional character vector of target compartments, named with</pre> </td> </tr> - <tr class="covered"> - <td class="num">118</td> - <td class="coverage">316<em>x</em></td> + <tr class="never"> + <td class="num">11</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> + <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">119</td> + <td class="num">12</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">#' names are used as in the datasets supplied.</pre> </td> </tr> <tr class="never"> - <td class="num">120</td> + <td class="num">13</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' @param filename Where to write the result. Should end in .csf in order to be</pre> </td> </tr> - <tr class="covered"> - <td class="num">121</td> - <td class="coverage">948<em>x</em></td> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> fit <- x[[i.fit]]</pre> + <pre class="language-r">#' compatible with CAKE.</pre> </td> </tr> - <tr class="covered"> - <td class="num">122</td> - <td class="coverage">948<em>x</em></td> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (ymax == "auto") {</pre> + <pre class="language-r">#' @param path An optional path to the output file.</pre> </td> </tr> - <tr class="covered"> - <td class="num">123</td> - <td class="coverage">948<em>x</em></td> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> plot(fit, legend = legends == i.fit, ylab = ylab, ...)</pre> + <pre class="language-r">#' @param overwrite If TRUE, existing files are overwritten.</pre> </td> </tr> <tr class="never"> - <td class="num">124</td> + <td class="num">17</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r">#' @param study The name of the study.</pre> </td> </tr> - <tr class="missed"> - <td class="num">125</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">18</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> + <pre class="language-r">#' @param description An optional description.</pre> </td> </tr> <tr class="never"> - <td class="num">126</td> + <td class="num">19</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">#' @param time_unit The time unit for the residue data.</pre> </td> </tr> <tr class="never"> - <td class="num">127</td> + <td class="num">20</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' @param res_unit The unit used for the residues.</pre> </td> </tr> - <tr class="covered"> - <td class="num">128</td> - <td class="coverage">948<em>x</em></td> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> title(main, outer = TRUE, line = -2)</pre> + <pre class="language-r">#' @param comment An optional comment.</pre> </td> </tr> <tr class="never"> - <td class="num">129</td> + <td class="num">22</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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">130</td> - <td class="coverage">948<em>x</em></td> + <td class="num">39</td> + <td class="coverage">741<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fit_name <- switch(loop_over,</pre> + <pre class="language-r"> file <- file.path(path, filename)</pre> </td> </tr> <tr class="covered"> - <td class="num">131</td> - <td class="coverage">948<em>x</em></td> + <td class="num">40</td> + <td class="coverage">247<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> models = rownames(x)[i.fit],</pre> + <pre class="language-r"> if (file.exists(file) & !overwrite) stop(file, " already exists, stopping")</pre> </td> </tr> <tr class="covered"> - <td class="num">132</td> - <td class="coverage">948<em>x</em></td> + <td class="num">41</td> + <td class="coverage">494<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> datasets = colnames(x)[i.fit],</pre> + <pre class="language-r"> csf <- file(file, encoding = "latin1", open = "w+")</pre> </td> </tr> <tr class="covered"> - <td class="num">133</td> - <td class="coverage">948<em>x</em></td> + <td class="num">42</td> + <td class="coverage">494<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> none = "")</pre> + <pre class="language-r"> on.exit(close(csf))</pre> </td> </tr> <tr class="never"> - <td class="num">134</td> + <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">135</td> - <td class="coverage">948<em>x</em></td> + <td class="num">44</td> + <td class="coverage">494<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (show_errmin) {</pre> + <pre class="language-r"> CAKE_compartments = c("Parent", "A1", "A2", "A3", "B1", "B2", "C1")</pre> </td> </tr> <tr class="covered"> - <td class="num">136</td> - <td class="coverage">948<em>x</em></td> + <td class="num">45</td> + <td class="coverage">494<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> + <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">137</td> + <td class="num">47</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">138</td> + <td class="num">48</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # Use LateX if the current plotting device is tikz</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">139</td> - <td class="coverage">948<em>x</em></td> + <td class="num">49</td> + <td class="coverage">247<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (names(dev.cur()) == "tikz output") {</pre> + <pre class="language-r"> add <- function(x) cat(paste0(x, "\r\n"), file = csf, append = TRUE)</pre> </td> </tr> - <tr class="missed"> - <td class="num">140</td> - <td class="coverage">!</td> + <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"> chi2_text <- paste0(fit_name, " $\\chi^2$ error level = ", chi2, "\\%")</pre> + <pre class="language-r"> add0 <- function(x) cat(x, file = csf, append = TRUE)</pre> </td> </tr> <tr class="never"> - <td class="num">141</td> + <td class="num">51</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">142</td> - <td class="coverage">948<em>x</em></td> + <td class="num">52</td> + <td class="coverage">247<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> chi2_perc <- paste0(chi2, "%")</pre> + <pre class="language-r"> add("[FileInfo]")</pre> </td> </tr> <tr class="covered"> - <td class="num">143</td> - <td class="coverage">948<em>x</em></td> + <td class="num">53</td> + <td class="coverage">247<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> + <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">144</td> + <td class="num">62</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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="num">63</td> + <td class="coverage">247<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> mtext(chi2_text, cex = cex, line = 0.4)</pre> + <pre class="language-r"> add("[Data]")</pre> </td> </tr> <tr class="never"> - <td class="num">146</td> + <td class="num">64</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="missed"> - <td class="num">147</td> - <td class="coverage">!</td> + <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"> mtext(fit_name, cex = cex, line = 0.4)</pre> + <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">148</td> + <td class="num">74</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">149</td> + <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">150</td> - <td class="coverage">948<em>x</em></td> + <td class="num">76</td> + <td class="coverage">247<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (resplot == "time") {</pre> + <pre class="language-r"> if (!is.na(links)) {</pre> </td> </tr> <tr class="covered"> - <td class="num">151</td> - <td class="coverage">948<em>x</em></td> + <td class="num">77</td> + <td class="coverage">247<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> mkinresplot(fit, legend = FALSE, standardized = standardized, ...)</pre> + <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">152</td> + <td class="num">82</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="missed"> - <td class="num">153</td> - <td class="coverage">!</td> + <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"> mkinerrplot(fit, legend = FALSE, ...)</pre> + <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">154</td> + <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">155</td> - <td class="coverage">948<em>x</em></td> + <td class="num">89</td> + <td class="coverage">247<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> mtext(paste(fit_name, "residuals"), cex = cex, line = 0.4)</pre> + <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">156</td> + <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">157</td> + <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> @@ -47616,14 +44621,14 @@ table.table-condensed { </tbody> </table> </div> - <div id="R/summary.mmkin.R" class="hidden"> + <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">#' Summary method for class "mmkin"</pre> + <pre class="language-r">#' Plot parameter variability of multistart objects</pre> </td> </tr> <tr class="never"> @@ -47637,517 +44642,1028 @@ table.table-condensed { <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> + <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">#' and gives an overview of ill-defined parameters calculated by [illparms].</pre> + <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">#'</pre> + <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">#' @param object an object of class [mmkin]</pre> + <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 x an object of class \code{summary.mmkin}.</pre> + <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">#' @param conf.level confidence level for testing parameters</pre> + <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">#' @param digits number of digits to use for printing</pre> + <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">#' @param \dots optional arguments passed to methods like \code{print}.</pre> + <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">#' @examples</pre> + <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">#'</pre> + <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">#' fits <- mmkin(</pre> + <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">#' c("SFO", "FOMC"),</pre> + <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">#' list("FOCUS A" = FOCUS_2006_A,</pre> + <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">#' "FOCUS C" = FOCUS_2006_C),</pre> + <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">#' quiet = TRUE, cores = 1)</pre> + <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">#' summary(fits)</pre> + <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">#'</pre> + <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">#' @export</pre> + <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">summary.mmkin <- function(object, conf.level = 0.95, ...) {</pre> + <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"></pre> + <pre class="language-r">#' identifiability in the frame of nonlinear mixed effects models: the example</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">23</td> - <td class="coverage">1<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> ans <- list(</pre> + <pre class="language-r">#' of the in vitro erythropoiesis. BMC Bioinformatics. 2021 Oct 4;22(1):478.</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">24</td> - <td class="coverage">1<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> err_mod = object[[1, 1]]$err_mod,</pre> + <pre class="language-r">#' doi: 10.1186/s12859-021-04373-4.</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">25</td> - <td class="coverage">1<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> time = attr(object, "time"),</pre> + <pre class="language-r">#' @seealso [multistart]</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">26</td> - <td class="coverage">1<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> illparms = illparms(object),</pre> + <pre class="language-r">#' @importFrom stats median quantile</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">27</td> - <td class="coverage">1<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> status = status(object)</pre> + <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"> )</pre> + <pre class="language-r">parplot <- function(object, ...) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">29</td> - <td class="coverage"></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> UseMethod("parplot")</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">30</td> - <td class="coverage">1<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> class(ans) <- c("summary.mmkin")</pre> + <pre class="language-r">}</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">31</td> - <td class="coverage">1<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> return(ans)</pre> + <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">}</pre> + <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"></pre> + <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">#' @rdname summary.mmkin</pre> + <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">#' @export</pre> + <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">print.summary.mmkin <- function(x, digits = max(3, getOption("digits") - 3), ...) {</pre> + <pre class="language-r"> lpos = "bottomleft", main = "", ...)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">37</td> - <td class="coverage">1<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (!is.null(x$err_mod)) {</pre> + <pre class="language-r">{</pre> </td> </tr> <tr class="covered"> <td class="num">38</td> - <td class="coverage">1<em>x</em></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cat("Error model: ")</pre> + <pre class="language-r"> orig <- attr(object, "orig")</pre> </td> </tr> <tr class="covered"> <td class="num">39</td> - <td class="coverage">1<em>x</em></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cat(switch(x$err_mod,</pre> + <pre class="language-r"> orig_parms <- parms(orig)</pre> </td> </tr> <tr class="covered"> <td class="num">40</td> - <td class="coverage">1<em>x</em></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> const = "Constant variance",</pre> + <pre class="language-r"> start_degparms <- orig$mean_dp_start</pre> </td> </tr> <tr class="covered"> <td class="num">41</td> - <td class="coverage">1<em>x</em></td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> obs = "Variance unique to each observed variable",</pre> + <pre class="language-r"> all_parms <- parms(object, exclude_failed = FALSE)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">42</td> - <td class="coverage">1<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> tc = "Two-component variance function"), "\n")</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <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"> if (inherits(object, "multistart.saem.mmkin")) {</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"> llfunc <- function(object) {</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 (inherits(object$so, "try-error")) return(NA)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">46</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">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"> } else {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">49</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">50</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="num">51</td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cat("Fitted in", x$time[["elapsed"]], "s\n")</pre> + <pre class="language-r"> ll <- sapply(object, llfunc)</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"> if (!is.na(llquant[1])) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">53</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">54</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">45</td> + <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">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">57</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">58</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="num">59</td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nStatus:\n")</pre> + <pre class="language-r"> if (orig$transformations == "mkin") {</pre> </td> </tr> <tr class="covered"> - <td class="num">47</td> - <td class="coverage">1<em>x</em></td> + <td class="num">60</td> + <td class="coverage">88<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> print(x$status)</pre> + <pre class="language-r"> degparm_names_transformed <- names(start_degparms)</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">61</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">62</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> orig_degparms <- backtransform_odeparms(</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">63</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">64</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">65</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">66</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">67</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">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"> degparm_names <- names(start_degparms)</pre> </td> </tr> <tr class="never"> - <td class="num">48</td> + <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">49</td> - <td class="coverage">1<em>x</em></td> + <td class="num">73</td> + <td class="coverage">88<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (any(x$illparms != "")) {</pre> + <pre class="language-r"> orig_parms_back <- orig_parms</pre> </td> </tr> <tr class="covered"> - <td class="num">50</td> - <td class="coverage">1<em>x</em></td> + <td class="num">74</td> + <td class="coverage">88<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nIll-defined parameters:\n")</pre> + <pre class="language-r"> orig_parms_back[degparm_index] <- orig_degparms</pre> </td> </tr> <tr class="covered"> - <td class="num">51</td> - <td class="coverage">1<em>x</em></td> + <td class="num">75</td> + <td class="coverage">88<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> print(x$illparms)</pre> + <pre class="language-r"> names(orig_parms_back)[degparm_index] <- degparm_names</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">76</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> orig_parms <- orig_parms_back</pre> </td> </tr> <tr class="never"> - <td class="num">52</td> + <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">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">79</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">80</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">81</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">82</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">83</td> + <td class="coverage">88<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> colnames(selected_parms)[degparm_index] <- degparm_names</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">53</td> + <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">54</td> - <td class="coverage">1<em>x</em></td> + <td class="num">86</td> + <td class="coverage">176<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> invisible(x)</pre> + <pre class="language-r"> start_errparms <- orig$so@model@error.init</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"> names(start_errparms) <- orig$so@model@name.sigma</pre> </td> </tr> <tr class="never"> - <td class="num">55</td> + <td class="num">88</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">}</pre> + <pre class="language-r"></pre> + </td> + </tr> + <tr class="covered"> + <td class="num">89</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">56</td> + <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">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">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">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">94</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">95</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">96</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">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"> # Boxplots of all scaled parameters</pre> + </td> + </tr> + <tr class="covered"> + <td class="num">100</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">101</td> + <td class="coverage">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> i_negative <- selected_scaled_parms <= 0</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"> parms_with_negative_scaled_values <- paste(names(which(apply(i_negative, 2, any))), collapse = ", ")</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"> if (any(i_negative)) {</pre> + </td> + </tr> + <tr class="missed"> + <td class="num">104</td> + <td class="coverage">!</td> + <td class="col-sm-12"> + <pre class="language-r"> warning("There are negative values for ", parms_with_negative_scaled_values, " which are set to NA for plotting")</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">176<em>x</em></td> + <td class="col-sm-12"> + <pre class="language-r"> selected_scaled_parms[i_negative] <- NA</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"> boxplot(selected_scaled_parms, log = "y", main = main, ,</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"> ylab = "Normalised parameters", ...)</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"> # Show starting parameters</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"> start_scaled_parms <- rep(NA_real_, length(orig_parms))</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"> names(start_scaled_parms) <- names(orig_parms)</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"> start_scaled_parms[names(start_parms)] <-</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"> start_parms / parm_scale[names(start_parms)]</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"> points(start_scaled_parms, col = 3, cex = 3)</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"> # Show parameters of original run</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"> orig_scaled_parms <- orig_parms / parm_scale</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"> points(orig_scaled_parms, col = 2, cex = 2)</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">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">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">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">124</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">125</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">126</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">127</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">128</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">129</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"> + <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">#' Read datasets and relevant meta information from a spreadsheet file</pre> + <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">#'</pre> + <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">#' This function imports one dataset from each sheet of a spreadsheet file.</pre> + <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">#' These sheets are selected based on the contents of a sheet 'Datasets', with</pre> + <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">#' a column called 'Dataset Number', containing numbers identifying the dataset</pre> + <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">#' sheets to be read in. In the second column there must be a grouping</pre> + <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">#' variable, which will often be named 'Soil'. Optionally, time normalization</pre> + <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">#' factors can be given in columns named 'Temperature' and 'Moisture'.</pre> + <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">#'</pre> + <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">#' There must be a sheet 'Compounds', with columns 'Name' and 'Acronym'.</pre> + <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">#' The first row read after the header read in from this sheet is assumed</pre> + <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">#' to contain name and acronym of the parent compound.</pre> + <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> + <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">#' The dataset sheets should be named using the dataset numbers read in from</pre> + <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">#' the 'Datasets' sheet, i.e. '1', '2', ... . In each dataset sheet, the name</pre> + <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">#' of the observed variable (e.g. the acronym of the parent compound or</pre> + <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">#' one of its transformation products) should be in the first column,</pre> + <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">#' the time values should be in the second colum, and the observed value</pre> + <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">#' in the third column.</pre> + <pre class="language-r">#' lower number of fitted parameters (null hypothesis).</pre> </td> </tr> <tr class="never"> @@ -48161,1803 +45677,2658 @@ table.table-condensed { <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> + <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">#' in a sheet 'Covariates', containing one line for each value of the grouping</pre> + <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">#' variable specified in 'Datasets'. These values should be in the first</pre> + <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">#' column and the column must have the same name as the second column in</pre> + <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">#' 'Datasets'. Covariates will be read in from columns four and higher.</pre> + <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">#' Their names should preferably not contain special characters like spaces,</pre> + <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">#' so they can be easily used for specifying covariate models.</pre> + <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> + <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">#' A similar data structure is defined as the R6 class [mkindsg], but</pre> + <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">#' is probably more complicated to use.</pre> + <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">#'</pre> + <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">#' @param path Absolute or relative path to the spreadsheet file</pre> + <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">#' @param valid_datasets Optional numeric index of the valid datasets, default is</pre> + <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">#' to use all datasets</pre> + <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">#' @param parent_only Should only the parent data be used?</pre> + <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">#' @param normalize Should the time scale be normalized using temperature</pre> + <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">#' and moisture normalisation factors in the sheet 'Datasets'?</pre> + <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">#' @export</pre> + <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">read_spreadsheet <- function(path, valid_datasets = "all",</pre> + <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"> parent_only = FALSE, normalize = TRUE)</pre> + <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">{</pre> + <pre class="language-r">#' lrtest(dfop_fit, update(dfop_fit, error_model = "tc"))</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">42</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (!requireNamespace("readxl", quietly = TRUE))</pre> + <pre class="language-r">#' lrtest(dfop_fit, update(dfop_fit, fixed_parms = c(k2 = 0)))</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">43</td> - <td class="coverage">!</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> + <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"></pre> + <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"> # Read the compound table</pre> + <pre class="language-r">lrtest.mkinfit <- function(object, object_2 = NULL, ...) {</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">46</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> compounds <- readxl::read_excel(path, sheet = "Compounds")</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">47</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage">6<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> parent <- compounds[1, ]$Acronym</pre> + <pre class="language-r"> name_function <- function(x) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">48</td> - <td class="coverage"></td> + <td class="coverage">10<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> object_name <- paste(x$mkinmod$name, "with error model", x$err_mod)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">49</td> - <td class="coverage"></td> + <td class="coverage">10<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Read in meta information</pre> + <pre class="language-r"> if (length(x$bparms.fixed) > 0) {</pre> </td> </tr> <tr class="covered"> <td class="num">50</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage">7<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ds_meta <- readxl::read_excel(path, sheet = "Datasets")</pre> + <pre class="language-r"> object_name <- paste(object_name,</pre> </td> </tr> <tr class="covered"> <td class="num">51</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage">7<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ds_meta["Dataset Number"] <- as.character(ds_meta[["Dataset Number"]])</pre> + <pre class="language-r"> "and fixed parameter(s)",</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">52</td> - <td class="coverage"></td> + <td class="coverage">7<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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"> # Select valid datasets</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="missed"> + <tr class="covered"> <td class="num">54</td> - <td class="coverage">!</td> + <td class="coverage">10<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (valid_datasets[1] == "all") valid_datasets <- 1:nrow(ds_meta)</pre> + <pre class="language-r"> return(object_name)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">55</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> ds_numbers_valid <- ds_meta[valid_datasets, ]$`Dataset Number`</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">56</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> grouping_factor <- names(ds_meta[2]) # Often "Soil"</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">57</td> - <td class="coverage"></td> + <td class="coverage">6<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> if (is.null(object_2)) {</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">58</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> # Read in valid datasets</pre> + <pre class="language-r"> object_2 <- update(object, ...)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">59</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> ds_raw <- lapply(ds_numbers_valid,</pre> + <pre class="language-r"> } else {</pre> </td> </tr> <tr class="covered"> <td class="num">60</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage">6<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> function(dsn) readxl::read_excel(path, sheet = as.character(dsn)))</pre> + <pre class="language-r"> data_object <- object$data[c("time", "variable", "observed")]</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">61</td> - <td class="coverage"></td> + <td class="coverage">6<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> data_object_2 <- object_2$data[c("time", "variable", "observed")]</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">62</td> - <td class="coverage"></td> + <td class="coverage">6<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Make data frames compatible with mmkin</pre> + <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">117<em>x</em></td> + <td class="coverage">1<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ds_tmp <- lapply(ds_raw, function(x) {</pre> + <pre class="language-r"> stop("It seems that the mkinfit objects have not been fitted to the same data")</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">64</td> - <td class="coverage">1287<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> ds_ret <- x[1:3] |></pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">65</td> - <td class="coverage">1287<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> rlang::set_names(c("name", "time", "value")) |></pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="covered"> <td class="num">66</td> - <td class="coverage">1287<em>x</em></td> + <td class="coverage">5<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> transform(value = as.numeric(value))</pre> + <pre class="language-r"> if (attr(logLik(object), "df") > attr(logLik(object_2), "df")) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">67</td> - <td class="coverage"></td> + <td class="coverage">2<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> })</pre> + <pre class="language-r"> lmtest::lrtest.default(object, object_2, name = name_function)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">68</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> names(ds_tmp) <- ds_numbers_valid</pre> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">69</td> - <td class="coverage"></td> + <td class="coverage">3<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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"> # Normalize with temperature and moisture correction factors</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">71</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (normalize) {</pre> + <pre class="language-r">}</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">72</td> - <td class="coverage">117<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> ds_norm <- lapply(ds_numbers_valid, function(ds_number) {</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">73</td> - <td class="coverage">1287<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> f_corr <- as.numeric(ds_meta[ds_number, c("Temperature", "Moisture")])</pre> + <pre class="language-r">#' @rdname lrtest.mkinfit</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">74</td> - <td class="coverage">1287<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> ds_corr <- ds_tmp[[ds_number]] |></pre> + <pre class="language-r">#' @export</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">75</td> - <td class="coverage">1287<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> transform(time = time * f_corr[1] * f_corr[2])</pre> + <pre class="language-r">lrtest.mmkin <- function(object, ...) {</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">76</td> - <td class="coverage">1287<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> return(ds_corr)</pre> + <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="never"> + <tr class="missed"> <td class="num">77</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> })</pre> + <pre class="language-r"> object[[1, 1]]$mkinmod$name <- rownames(object)[1]</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">78</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <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"> ds_norm <- ds_tmp</pre> + <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> + <pre class="language-r">}</pre> </td> </tr> - <tr class="covered"> - <td class="num">81</td> - <td class="coverage">117<em>x</em></td> + </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"> names(ds_norm) <- ds_numbers_valid</pre> + <pre class="language-r">#' Summary method for class "saem.mmkin"</pre> </td> </tr> <tr class="never"> - <td class="num">82</td> + <td class="num">2</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#'</pre> </td> </tr> <tr class="never"> - <td class="num">83</td> + <td class="num">3</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # Select parent data only if requested</pre> + <pre class="language-r">#' Lists model equations, initial parameter values, optimised parameters</pre> </td> </tr> - <tr class="covered"> - <td class="num">84</td> - <td class="coverage">117<em>x</em></td> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (parent_only) {</pre> + <pre class="language-r">#' for fixed effects (population), random effects (deviations from the</pre> </td> </tr> - <tr class="missed"> - <td class="num">85</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">5</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> + <pre class="language-r">#' population mean) and residual error model, as well as the resulting</pre> </td> </tr> - <tr class="missed"> - <td class="num">86</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> compounds <- compounds[1, ]</pre> + <pre class="language-r">#' endpoints such as formation fractions and DT50 values. Optionally</pre> </td> </tr> <tr class="never"> - <td class="num">87</td> + <td class="num">7</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">#' (default is FALSE), the data are listed in full.</pre> </td> </tr> <tr class="never"> - <td class="num">88</td> + <td class="num">8</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#'</pre> </td> </tr> <tr class="never"> - <td class="num">89</td> + <td class="num">9</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> + <pre class="language-r">#' @param object an object of class [saem.mmkin]</pre> </td> </tr> - <tr class="covered"> - <td class="num">90</td> - <td class="coverage">117<em>x</em></td> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> ds_all <- vctrs::vec_rbind(!!!ds_norm, .names_to = "Dataset Number")</pre> + <pre class="language-r">#' @param x an object of class [summary.saem.mmkin]</pre> </td> </tr> - <tr class="covered"> - <td class="num">91</td> - <td class="coverage">117<em>x</em></td> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> ds_all_group <- merge(ds_all, ds_meta[c("Dataset Number", grouping_factor)])</pre> + <pre class="language-r">#' @param data logical, indicating whether the full data should be included in</pre> </td> </tr> - <tr class="covered"> - <td class="num">92</td> - <td class="coverage">117<em>x</em></td> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> groups <- unique(ds_meta[valid_datasets, ][[grouping_factor]])</pre> + <pre class="language-r">#' the summary.</pre> </td> </tr> <tr class="never"> - <td class="num">93</td> + <td class="num">13</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' @param verbose Should the summary be verbose?</pre> </td> </tr> - <tr class="covered"> - <td class="num">94</td> - <td class="coverage">117<em>x</em></td> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> ds <- lapply(groups, function(x) {</pre> + <pre class="language-r">#' @param distimes logical, indicating whether DT50 and DT90 values should be</pre> </td> </tr> - <tr class="covered"> - <td class="num">95</td> - <td class="coverage">819<em>x</em></td> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> ret <- ds_all_group[ds_all_group[[grouping_factor]] == x, ]</pre> + <pre class="language-r">#' included.</pre> </td> </tr> - <tr class="covered"> - <td class="num">96</td> - <td class="coverage">819<em>x</em></td> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> ret[c("name", "time", "value")]</pre> + <pre class="language-r">#' @param digits Number of digits to use for printing</pre> </td> </tr> <tr class="never"> - <td class="num">97</td> + <td class="num">17</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">#' @param \dots optional arguments passed to methods like \code{print}.</pre> </td> </tr> <tr class="never"> - <td class="num">98</td> + <td class="num">18</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> )</pre> + <pre class="language-r">#' @inheritParams endpoints</pre> </td> </tr> - <tr class="covered"> - <td class="num">99</td> - <td class="coverage">117<em>x</em></td> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> names(ds) <- groups</pre> + <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">100</td> + <td class="num">20</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' obtained in the fit, with at least the following additional components</pre> </td> </tr> <tr class="never"> - <td class="num">101</td> + <td class="num">21</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # Get covariates</pre> + <pre class="language-r">#' \item{saemixversion, mkinversion, Rversion}{The saemix, mkin and R versions used}</pre> </td> </tr> - <tr class="covered"> - <td class="num">102</td> - <td class="coverage">117<em>x</em></td> + <tr class="never"> + <td class="num">22</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> covariates_raw <- readxl::read_excel(path, sheet = "Covariates")</pre> + <pre class="language-r">#' \item{date.fit, date.summary}{The dates where the fit and the summary were</pre> </td> </tr> - <tr class="covered"> - <td class="num">103</td> - <td class="coverage">117<em>x</em></td> + <tr class="never"> + <td class="num">23</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> covariates <- as.data.frame(covariates_raw[4:ncol(covariates_raw)])</pre> + <pre class="language-r">#' produced}</pre> </td> </tr> - <tr class="covered"> - <td class="num">104</td> - <td class="coverage">117<em>x</em></td> + <tr class="never"> + <td class="num">24</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> nocov <- setdiff(groups, covariates_raw[[1]])</pre> + <pre class="language-r">#' \item{diffs}{The differential equations used in the degradation model}</pre> </td> </tr> - <tr class="covered"> - <td class="num">105</td> - <td class="coverage">117<em>x</em></td> + <tr class="never"> + <td class="num">25</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (length(nocov) > 0) {</pre> + <pre class="language-r">#' \item{use_of_ff}{Was maximum or minimum use made of formation fractions}</pre> </td> </tr> - <tr class="missed"> - <td class="num">106</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">26</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> + <pre class="language-r">#' \item{data}{The data}</pre> </td> </tr> - <tr class="missed"> - <td class="num">107</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> message("Not returning covariate data")</pre> + <pre class="language-r">#' \item{confint_trans}{Transformed parameters as used in the optimisation, with confidence intervals}</pre> </td> </tr> - <tr class="missed"> - <td class="num">108</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> attr(ds, "covariates") <- NULL</pre> + <pre class="language-r">#' \item{confint_back}{Backtransformed parameters, with confidence intervals if available}</pre> </td> </tr> <tr class="never"> - <td class="num">109</td> + <td class="num">29</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r">#' \item{confint_errmod}{Error model parameters with confidence intervals}</pre> </td> </tr> - <tr class="covered"> - <td class="num">110</td> - <td class="coverage">117<em>x</em></td> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> rownames(covariates) <- covariates_raw[[1]]</pre> + <pre class="language-r">#' \item{ff}{The estimated formation fractions derived from the fitted</pre> </td> </tr> - <tr class="covered"> - <td class="num">111</td> - <td class="coverage">117<em>x</em></td> + <tr class="never"> + <td class="num">31</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> covariates <- covariates[which(colnames(covariates) != "Remarks")]</pre> + <pre class="language-r">#' model.}</pre> </td> </tr> <tr class="never"> - <td class="num">112</td> + <td class="num">32</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # Attach covariate data if available</pre> + <pre class="language-r">#' \item{distimes}{The DT50 and DT90 values for each observed variable.}</pre> </td> </tr> - <tr class="covered"> - <td class="num">113</td> - <td class="coverage">117<em>x</em></td> + <tr class="never"> + <td class="num">33</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> attr(ds, "covariates") <- covariates[groups, , drop = FALSE]</pre> + <pre class="language-r">#' \item{SFORB}{If applicable, eigenvalues of SFORB components of the model.}</pre> </td> </tr> <tr class="never"> - <td class="num">114</td> + <td class="num">34</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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">115</td> + <td class="num">35</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' @importFrom stats predict vcov</pre> </td> </tr> <tr class="never"> - <td class="num">116</td> + <td class="num">36</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # Attach the compound list to support automatic model building</pre> + <pre class="language-r">#' @author Johannes Ranke for the mkin specific parts</pre> </td> </tr> - <tr class="covered"> - <td class="num">117</td> - <td class="coverage">117<em>x</em></td> + <tr class="never"> + <td class="num">37</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> attr(ds, "compounds") <- as.data.frame(compounds)</pre> + <pre class="language-r">#' saemix authors for the parts inherited from saemix.</pre> </td> </tr> <tr class="never"> - <td class="num">118</td> + <td class="num">38</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' @examples</pre> </td> </tr> - <tr class="covered"> - <td class="num">119</td> - <td class="coverage">117<em>x</em></td> + <tr class="never"> + <td class="num">39</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> return(ds)</pre> + <pre class="language-r">#' # Generate five datasets following DFOP-SFO kinetics</pre> </td> </tr> <tr class="never"> - <td class="num">120</td> + <td class="num">40</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">}</pre> + <pre class="language-r">#' sampling_times = c(0, 1, 3, 7, 14, 28, 60, 90, 120)</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="num">41</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> + <pre class="language-r">#' dfop_sfo <- mkinmod(parent = mkinsub("DFOP", "m1"),</pre> </td> </tr> <tr class="never"> - <td class="num">2</td> + <td class="num">42</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' </pre> + <pre class="language-r">#' m1 = mkinsub("SFO"), quiet = TRUE)</pre> </td> </tr> <tr class="never"> - <td class="num">3</td> + <td class="num">43</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> + <pre class="language-r">#' set.seed(1234)</pre> </td> </tr> <tr class="never"> - <td class="num">4</td> + <td class="num">44</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' specified as well.</pre> + <pre class="language-r">#' k1_in <- rlnorm(5, log(0.1), 0.3)</pre> </td> </tr> <tr class="never"> - <td class="num">5</td> + <td class="num">45</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' </pre> + <pre class="language-r">#' k2_in <- rlnorm(5, log(0.02), 0.3)</pre> </td> </tr> <tr class="never"> - <td class="num">6</td> + <td class="num">46</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> + <pre class="language-r">#' g_in <- plogis(rnorm(5, qlogis(0.5), 0.3))</pre> </td> </tr> <tr class="never"> - <td class="num">7</td> + <td class="num">47</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' \code{\link{mkinfit}}.</pre> + <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">8</td> + <td class="num">48</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> + <pre class="language-r">#' k_m1_in <- rlnorm(5, log(0.02), 0.3)</pre> </td> </tr> <tr class="never"> - <td class="num">9</td> + <td class="num">49</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> + <pre class="language-r">#'</pre> </td> </tr> <tr class="never"> - <td class="num">10</td> + <td class="num">50</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> + <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">11</td> + <td class="num">51</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> + <pre class="language-r">#' mkinpredict(dfop_sfo,</pre> </td> </tr> <tr class="never"> - <td class="num">12</td> + <td class="num">52</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' names are used as in the datasets supplied.</pre> + <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">13</td> + <td class="num">53</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> + <pre class="language-r">#' c(parent = 100, m1 = 0),</pre> </td> </tr> <tr class="never"> - <td class="num">14</td> + <td class="num">54</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' compatible with CAKE.</pre> + <pre class="language-r">#' sampling_times)</pre> </td> </tr> <tr class="never"> - <td class="num">15</td> + <td class="num">55</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @param path An optional path to the output file.</pre> + <pre class="language-r">#' }</pre> </td> </tr> <tr class="never"> - <td class="num">16</td> + <td class="num">56</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @param overwrite If TRUE, existing files are overwritten.</pre> + <pre class="language-r">#'</pre> </td> </tr> <tr class="never"> - <td class="num">17</td> + <td class="num">57</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @param study The name of the study.</pre> + <pre class="language-r">#' ds_mean_dfop_sfo <- lapply(1:5, function(i) {</pre> </td> </tr> <tr class="never"> - <td class="num">18</td> + <td class="num">58</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @param description An optional description.</pre> + <pre class="language-r">#' mkinpredict(dfop_sfo,</pre> </td> </tr> <tr class="never"> - <td class="num">19</td> + <td class="num">59</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> + <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">20</td> + <td class="num">60</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @param res_unit The unit used for the residues.</pre> + <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">21</td> + <td class="num">61</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @param comment An optional comment.</pre> + <pre class="language-r">#' c(parent = 100, m1 = 0),</pre> </td> </tr> <tr class="never"> - <td class="num">22</td> + <td class="num">62</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @param date The date of file creation.</pre> + <pre class="language-r">#' sampling_times)</pre> </td> </tr> <tr class="never"> - <td class="num">23</td> + <td class="num">63</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @param optimiser Can be OLS or IRLS.</pre> + <pre class="language-r">#' })</pre> </td> </tr> <tr class="never"> - <td class="num">24</td> + <td class="num">64</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @importFrom utils write.table</pre> + <pre class="language-r">#' names(ds_mean_dfop_sfo) <- paste("ds", 1:5)</pre> </td> </tr> <tr class="never"> - <td class="num">25</td> + <td class="num">65</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @return The function is called for its side effect.</pre> + <pre class="language-r">#'</pre> </td> </tr> <tr class="never"> - <td class="num">26</td> + <td class="num">66</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @author Johannes Ranke</pre> + <pre class="language-r">#' ds_syn_dfop_sfo <- lapply(ds_mean_dfop_sfo, function(ds) {</pre> </td> </tr> <tr class="never"> - <td class="num">27</td> + <td class="num">67</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <pre class="language-r">#' add_err(ds,</pre> </td> </tr> <tr class="never"> - <td class="num">28</td> + <td class="num">68</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">CAKE_export <- function(ds, map = c(parent = "Parent"),</pre> + <pre class="language-r">#' sdfunc = function(value) sqrt(1^2 + value^2 * 0.07^2),</pre> </td> </tr> <tr class="never"> - <td class="num">29</td> + <td class="num">69</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> links = NA,</pre> + <pre class="language-r">#' n = 1)[[1]]</pre> </td> </tr> <tr class="never"> - <td class="num">30</td> + <td class="num">70</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> filename = "CAKE_export.csf", path = ".", overwrite = FALSE,</pre> + <pre class="language-r">#' })</pre> </td> </tr> <tr class="never"> - <td class="num">31</td> + <td class="num">71</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> study = "Degradinol aerobic soil degradation",</pre> + <pre class="language-r">#'</pre> </td> </tr> <tr class="never"> - <td class="num">32</td> + <td class="num">72</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> description = "",</pre> + <pre class="language-r">#' \dontrun{</pre> </td> </tr> <tr class="never"> - <td class="num">33</td> + <td class="num">73</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> time_unit = "days",</pre> + <pre class="language-r">#' # Evaluate using mmkin and saem</pre> </td> </tr> <tr class="never"> - <td class="num">34</td> + <td class="num">74</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> res_unit = "% AR",</pre> + <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">35</td> + <td class="num">75</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> comment = "",</pre> + <pre class="language-r">#' quiet = TRUE, error_model = "tc", cores = 5)</pre> </td> </tr> <tr class="never"> - <td class="num">36</td> + <td class="num">76</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> date = Sys.Date(),</pre> + <pre class="language-r">#' f_saem_dfop_sfo <- saem(f_mmkin_dfop_sfo)</pre> </td> </tr> <tr class="never"> - <td class="num">37</td> + <td class="num">77</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> optimiser = "IRLS")</pre> + <pre class="language-r">#' print(f_saem_dfop_sfo)</pre> </td> </tr> <tr class="never"> - <td class="num">38</td> + <td class="num">78</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">{</pre> + <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">39</td> - <td class="coverage">741<em>x</em></td> + <td class="num">101</td> + <td class="coverage">800<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> file <- file.path(path, filename)</pre> + <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">40</td> - <td class="coverage">247<em>x</em></td> + <td class="num">103</td> + <td class="coverage">800<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (file.exists(file) & !overwrite) stop(file, " already exists, stopping")</pre> + <pre class="language-r"> pnames <- names(object$mean_dp_start)</pre> </td> </tr> <tr class="covered"> - <td class="num">41</td> - <td class="coverage">494<em>x</em></td> + <td class="num">104</td> + <td class="coverage">800<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> csf <- file(file, encoding = "latin1", open = "w+")</pre> + <pre class="language-r"> names_fixed_effects <- object$so@results@name.fixed</pre> </td> </tr> <tr class="covered"> - <td class="num">42</td> - <td class="coverage">494<em>x</em></td> + <td class="num">105</td> + <td class="coverage">800<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> on.exit(close(csf))</pre> + <pre class="language-r"> n_fixed <- length(names_fixed_effects)</pre> </td> </tr> <tr class="never"> - <td class="num">43</td> + <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">44</td> - <td class="coverage">494<em>x</em></td> + <td class="num">107</td> + <td class="coverage">800<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> CAKE_compartments = c("Parent", "A1", "A2", "A3", "B1", "B2", "C1")</pre> + <pre class="language-r"> conf.int <- object$so@results@conf.int</pre> </td> </tr> <tr class="covered"> - <td class="num">45</td> - <td class="coverage">494<em>x</em></td> + <td class="num">108</td> + <td class="coverage">800<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (!all(map %in% CAKE_compartments)) {</pre> + <pre class="language-r"> rownames(conf.int) <- conf.int$name</pre> </td> </tr> <tr class="covered"> - <td class="num">46</td> - <td class="coverage">247<em>x</em></td> + <td class="num">109</td> + <td class="coverage">800<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> + <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">47</td> + <td class="num">111</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">48</td> + <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">49</td> - <td class="coverage">247<em>x</em></td> + <td class="num">115</td> + <td class="coverage">800<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> + <pre class="language-r"> if (object$transformations == "mkin") {</pre> </td> </tr> <tr class="covered"> - <td class="num">50</td> - <td class="coverage">247<em>x</em></td> + <td class="num">116</td> + <td class="coverage">396<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> add0 <- function(x) cat(x, file = csf, append = TRUE)</pre> + <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">51</td> + <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">52</td> - <td class="coverage">247<em>x</em></td> + <td class="num">122</td> + <td class="coverage">396<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> add("[FileInfo]")</pre> + <pre class="language-r"> f_names_skip <- character(0)</pre> </td> </tr> <tr class="covered"> - <td class="num">53</td> - <td class="coverage">247<em>x</em></td> + <td class="num">123</td> + <td class="coverage">396<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> add("CAKE-Version: 3.4 (Release)")</pre> + <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">54</td> - <td class="coverage">247<em>x</em></td> + <td class="num">124</td> + <td class="coverage">492<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> add(paste("Name:", study))</pre> + <pre class="language-r"> f_names <- grep(paste("^f", box, sep = "_"), pnames, value = TRUE)</pre> </td> </tr> <tr class="covered"> - <td class="num">55</td> - <td class="coverage">247<em>x</em></td> + <td class="num">125</td> + <td class="coverage">492<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> add(paste("Description:", description))</pre> + <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">56</td> - <td class="coverage">247<em>x</em></td> + <td class="num">129</td> + <td class="coverage">396<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> add(paste("MeasurementUnits:", res_unit))</pre> + <pre class="language-r"> confint_back <- matrix(NA, nrow = length(bp), ncol = 3,</pre> </td> </tr> <tr class="covered"> - <td class="num">57</td> - <td class="coverage">247<em>x</em></td> + <td class="num">130</td> + <td class="coverage">396<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> add(paste("TimeUnits:", time_unit))</pre> + <pre class="language-r"> dimnames = list(bpnames, colnames(confint_trans)))</pre> </td> </tr> <tr class="covered"> - <td class="num">58</td> - <td class="coverage">247<em>x</em></td> + <td class="num">131</td> + <td class="coverage">396<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> add(paste("Comments:", comment))</pre> + <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">59</td> - <td class="coverage">247<em>x</em></td> + <td class="num">133</td> + <td class="coverage">396<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> add(paste("Date:", date))</pre> + <pre class="language-r"> for (pname in pnames) {</pre> </td> </tr> <tr class="covered"> - <td class="num">60</td> - <td class="coverage">247<em>x</em></td> + <td class="num">134</td> + <td class="coverage">1291<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> add(paste("Optimiser:", optimiser))</pre> + <pre class="language-r"> if (!pname %in% f_names_skip) {</pre> </td> </tr> <tr class="covered"> - <td class="num">61</td> - <td class="coverage">247<em>x</em></td> + <td class="num">135</td> + <td class="coverage">1291<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> add("")</pre> + <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">62</td> + <td class="num">146</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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">63</td> - <td class="coverage">247<em>x</em></td> + <td class="num">149</td> + <td class="coverage">404<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> add("[Data]")</pre> + <pre class="language-r"> confint_back <- confint_trans[names_fixed_effects, ]</pre> </td> </tr> <tr class="never"> - <td class="num">64</td> + <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">65</td> - <td class="coverage">247<em>x</em></td> + <tr class="never"> + <td class="num">152</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> for (i in seq_along(ds)) {</pre> + <pre class="language-r"> # Correlation of fixed effects (inspired by summary.nlme)</pre> </td> </tr> <tr class="covered"> - <td class="num">66</td> - <td class="coverage">494<em>x</em></td> + <td class="num">153</td> + <td class="coverage">800<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> add(paste("NewDataSet:", names(ds)[i]))</pre> + <pre class="language-r"> cov_so <- try(solve(object$so@results@fim), silent = TRUE)</pre> </td> </tr> <tr class="covered"> - <td class="num">67</td> - <td class="coverage">494<em>x</em></td> + <td class="num">154</td> + <td class="coverage">800<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> d <- mkin_long_to_wide(ds[[i]])</pre> + <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">68</td> - <td class="coverage">494<em>x</em></td> + <td class="num">157</td> + <td class="coverage">800<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> names(d) <- c("Time", map[names(d)[-1]])</pre> + <pre class="language-r"> varFix <- cov_so[1:n_fixed, 1:n_fixed]</pre> </td> </tr> <tr class="covered"> - <td class="num">69</td> - <td class="coverage">494<em>x</em></td> + <td class="num">158</td> + <td class="coverage">800<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> write.table(d, csf,</pre> + <pre class="language-r"> stdFix <- sqrt(diag(varFix))</pre> </td> </tr> <tr class="covered"> - <td class="num">70</td> - <td class="coverage">494<em>x</em></td> + <td class="num">159</td> + <td class="coverage">800<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> sep = "\t", col.names = TRUE,</pre> + <pre class="language-r"> object$corFixed <- array(</pre> </td> </tr> <tr class="covered"> - <td class="num">71</td> - <td class="coverage">494<em>x</em></td> + <td class="num">160</td> + <td class="coverage">800<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> row.names = FALSE,</pre> + <pre class="language-r"> t(varFix/stdFix)/stdFix,</pre> </td> </tr> <tr class="covered"> - <td class="num">72</td> - <td class="coverage">494<em>x</em></td> + <td class="num">161</td> + <td class="coverage">800<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> quote = FALSE, eol = "\r\n", na = "")</pre> + <pre class="language-r"> dim(varFix),</pre> </td> </tr> <tr class="covered"> - <td class="num">73</td> - <td class="coverage">494<em>x</em></td> + <td class="num">162</td> + <td class="coverage">800<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> add("")</pre> + <pre class="language-r"> list(names_fixed_effects, names_fixed_effects))</pre> </td> </tr> <tr class="never"> - <td class="num">74</td> + <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">75</td> + <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">76</td> - <td class="coverage">247<em>x</em></td> + <td class="num">166</td> + <td class="coverage">800<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (!is.na(links)) {</pre> + <pre class="language-r"> sdnames <- intersect(rownames(conf.int), paste0("SD.", pnames))</pre> </td> </tr> <tr class="covered"> - <td class="num">77</td> - <td class="coverage">247<em>x</em></td> + <td class="num">167</td> + <td class="coverage">800<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> add("")</pre> + <pre class="language-r"> corrnames <- grep("^Corr.", rownames(conf.int), value = TRUE)</pre> </td> </tr> <tr class="covered"> - <td class="num">78</td> - <td class="coverage">247<em>x</em></td> + <td class="num">168</td> + <td class="coverage">800<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> add("[Model]")</pre> + <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">79</td> - <td class="coverage">247<em>x</em></td> + <td class="num">169</td> + <td class="coverage">800<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> + <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">80</td> - <td class="coverage">247<em>x</em></td> + <td class="num">172</td> + <td class="coverage">800<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> for (name in names(map)[-1]) {</pre> + <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">81</td> - <td class="coverage">247<em>x</em></td> + <td class="num">173</td> + <td class="coverage">800<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> add(paste0("Compartment: ", map[name], "\t", name, "\t", name))</pre> + <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">82</td> + <td class="num">175</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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="num">176</td> + <td class="coverage">800<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> for (li in names(links)) {</pre> + <pre class="language-r"> object$confint_trans <- confint_trans</pre> </td> </tr> <tr class="covered"> - <td class="num">84</td> - <td class="coverage">247<em>x</em></td> + <td class="num">177</td> + <td class="coverage">800<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> + <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">85</td> + <td class="num">180</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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">86</td> + <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">87</td> + <td class="num">189</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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">88</td> + <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">89</td> - <td class="coverage">247<em>x</em></td> + <td class="num">192</td> + <td class="coverage">800<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> add("")</pre> + <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">90</td> - <td class="coverage">247<em>x</em></td> + <td class="num">194</td> + <td class="coverage">800<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> add("[ComponentNames]")</pre> + <pre class="language-r"> object$fixed <- object$mmkin_orig[[1]]$fixed</pre> </td> </tr> <tr class="covered"> - <td class="num">91</td> - <td class="coverage">247<em>x</em></td> + <td class="num">195</td> + <td class="coverage">800<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> for (name in names(map)) {</pre> + <pre class="language-r"> ll <-try(logLik(object$so, method = "is"), silent = TRUE)</pre> </td> </tr> <tr class="covered"> - <td class="num">92</td> - <td class="coverage">494<em>x</em></td> + <td class="num">196</td> + <td class="coverage">800<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> add(paste0(map[name], ":", name))</pre> + <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">93</td> + <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">94</td> + <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">95</td> + <td class="num">212</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="num">213</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> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">2</td> + <td class="num">214</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <pre class="language-r">#' @rdname summary.saem.mmkin</pre> </td> </tr> <tr class="never"> - <td class="num">3</td> + <td class="num">215</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> + <pre class="language-r">#' @export</pre> </td> </tr> <tr class="never"> - <td class="num">4</td> + <td class="num">216</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' option `results = "asis"`.</pre> + <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">5</td> + <td class="num">220</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <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">6</td> + <td class="num">223</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> + <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">7</td> + <td class="num">227</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @param caption An optional caption</pre> + <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">8</td> + <td class="num">232</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @param label An optional label, ignored in html output</pre> + <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">9</td> + <td class="num">234</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> + <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">10</td> + <td class="num">238</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <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">11</td> + <td class="num">244</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">summary_listing <- function(object, caption = NULL, label = NULL,</pre> + <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">12</td> + <td class="num">247</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> clearpage = TRUE) {</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="missed"> - <td class="num">13</td> - <td class="coverage">!</td> + <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"> if (knitr::is_latex_output()) {</pre> + <pre class="language-r"> cat("\nFixed degradation parameter values:\n")</pre> </td> </tr> - <tr class="missed"> - <td class="num">14</td> - <td class="coverage">!</td> + <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"> tex_listing(object = object, caption = caption, label = label,</pre> + <pre class="language-r"> if(length(x$fixed$value) == 0) cat("None\n")</pre> </td> </tr> <tr class="missed"> - <td class="num">15</td> + <td class="num">250</td> <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> clearpage = clearpage)</pre> + <pre class="language-r"> else print(x$fixed, digits = digits)</pre> </td> </tr> <tr class="never"> - <td class="num">16</td> + <td class="num">251</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="missed"> - <td class="num">17</td> - <td class="coverage">!</td> + <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"> if (knitr::is_html_output()) {</pre> + <pre class="language-r"> cat("\nStarting values for random effects (square root of initial entries in omega):\n")</pre> </td> </tr> - <tr class="missed"> - <td class="num">18</td> - <td class="coverage">!</td> + <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"> html_listing(object = object, caption = caption)</pre> + <pre class="language-r"> print(sqrt(x$so@model@omega.init), digits = digits)</pre> </td> </tr> <tr class="never"> - <td class="num">19</td> + <td class="num">254</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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">20</td> + <td class="num">260</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">}</pre> + <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">21</td> + <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">22</td> + <td class="num">268</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @rdname summary_listing</pre> + <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">23</td> + <td class="num">271</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <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">24</td> + <td class="num">275</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">tex_listing <- function(object, caption = NULL, label = NULL,</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">25</td> + <td class="num">276</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> clearpage = TRUE) {</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="missed"> - <td class="num">26</td> - <td class="coverage">!</td> + <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("\n")</pre> + <pre class="language-r"> cat("\nRandom effects:\n")</pre> </td> </tr> - <tr class="missed"> - <td class="num">27</td> - <td class="coverage">!</td> + <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"> cat("\\begin{listing}", "\n")</pre> + <pre class="language-r"> print(x$confint_ranef, digits = digits)</pre> </td> </tr> - <tr class="missed"> - <td class="num">28</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">279</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (!is.null(caption)) {</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="missed"> - <td class="num">29</td> - <td class="coverage">!</td> + <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("\\caption{", caption, "}", "\n", sep = "")</pre> + <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">30</td> + <td class="num">282</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="missed"> - <td class="num">31</td> - <td class="coverage">!</td> + <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 (!is.null(label)) {</pre> + <pre class="language-r"> if (x$transformations == "mkin") {</pre> </td> </tr> - <tr class="missed"> - <td class="num">32</td> - <td class="coverage">!</td> + <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("\\caption{", label, "}", "\n", sep = "")</pre> + <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">33</td> + <td class="num">286</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> + <tr class="never"> + <td class="num">287</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\\begin{snugshade}", "\n")</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="missed"> - <td class="num">35</td> - <td class="coverage">!</td> + <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"> cat("\\scriptsize", "\n")</pre> + <pre class="language-r"> if (!is.null(x$covariates)) {</pre> </td> </tr> <tr class="missed"> - <td class="num">36</td> + <td class="num">289</td> <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> cat("\\begin{verbatim}", "\n")</pre> + <pre class="language-r"> cat("\nCovariates used for endpoints below:\n")</pre> </td> </tr> <tr class="missed"> - <td class="num">37</td> + <td class="num">290</td> <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> cat(capture.output(suppressWarnings(summary(object))), sep = "\n")</pre> + <pre class="language-r"> print(x$covariates)</pre> </td> </tr> - <tr class="missed"> - <td class="num">38</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">291</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\n")</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="missed"> - <td class="num">39</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">292</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\\end{verbatim}", "\n")</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="missed"> - <td class="num">40</td> - <td class="coverage">!</td> + <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"> cat("\\end{snugshade}", "\n")</pre> + <pre class="language-r"> printSFORB <- !is.null(x$SFORB)</pre> </td> </tr> - <tr class="missed"> - <td class="num">41</td> - <td class="coverage">!</td> + <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"> cat("\\end{listing}", "\n")</pre> + <pre class="language-r"> if(printSFORB){</pre> </td> </tr> <tr class="missed"> - <td class="num">42</td> + <td class="num">295</td> <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> if (clearpage) {</pre> + <pre class="language-r"> cat("\nEstimated Eigenvalues of SFORB model(s):\n")</pre> </td> </tr> <tr class="missed"> - <td class="num">43</td> + <td class="num">296</td> <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> cat("\\clearpage", "\n")</pre> + <pre class="language-r"> print(x$SFORB, digits = digits,...)</pre> </td> </tr> <tr class="never"> - <td class="num">44</td> + <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">45</td> + <td class="num">298</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">}</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> - <td class="num">46</td> - <td class="coverage"></td> + <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"></pre> + <pre class="language-r"> printff <- !is.null(x$ff)</pre> </td> </tr> - <tr class="never"> - <td class="num">47</td> - <td class="coverage"></td> + <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">#' @rdname summary_listing</pre> + <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">48</td> + <td class="num">303</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">49</td> + <td class="num">304</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">html_listing <- function(object, caption = NULL) {</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="missed"> - <td class="num">50</td> - <td class="coverage">!</td> + <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"> cat("\n")</pre> + <pre class="language-r"> printdistimes <- !is.null(x$distimes)</pre> </td> </tr> - <tr class="missed"> - <td class="num">51</td> - <td class="coverage">!</td> + <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 (!is.null(caption)) {</pre> + <pre class="language-r"> if(printdistimes){</pre> </td> </tr> - <tr class="missed"> - <td class="num">52</td> - <td class="coverage">!</td> + <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("<caption>", caption, "</caption>", "\n", sep = "")</pre> + <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">53</td> + <td class="num">309</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> + <tr class="never"> + <td class="num">310</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("<pre><code>\n")</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="missed"> - <td class="num">55</td> - <td class="coverage">!</td> + <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"> cat(capture.output(suppressWarnings(summary(object))), sep = "\n")</pre> + <pre class="language-r"> if (x$print_data){</pre> </td> </tr> <tr class="missed"> - <td class="num">56</td> + <td class="num">312</td> <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> cat("\n")</pre> + <pre class="language-r"> cat("\nData:\n")</pre> </td> </tr> <tr class="missed"> - <td class="num">57</td> + <td class="num">313</td> <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> cat("</pre></code>\n")</pre> + <pre class="language-r"> print(format(x$data, digits = digits, ...), row.names = FALSE)</pre> </td> </tr> <tr class="never"> - <td class="num">58</td> + <td class="num">314</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">}</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">59</td> + <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/multistart.R" class="hidden"> + <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">#' Perform a hierarchical model fit with multiple starting values</pre> + <pre class="language-r">#' Set non-detects and unquantified values in residue series without replicates</pre> </td> </tr> <tr class="never"> @@ -49971,798 +48342,798 @@ table.table-condensed { <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> + <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">#' nonlinear hierarchical models (also known as nonlinear mixed-effects models)</pre> + <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">#' will reliably yield results that are sufficiently similar to each other, if</pre> + <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">#' started with a certain range of reasonable starting parameters. It is</pre> + <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">#' inspired by the article on practical identifiabiliy in the frame of nonlinear</pre> + <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">#' mixed-effects models by Duchesne et al (2021).</pre> + <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">#'</pre> + <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">#' @param object The fit object to work with</pre> + <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">#' @param n How many different combinations of starting parameters should be</pre> + <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">#' used?</pre> + <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">#' @param cores How many fits should be run in parallel (only on posix platforms)?</pre> + <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">#' @param cluster A cluster as returned by [parallel::makeCluster] to be used</pre> + <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">#' for parallel execution.</pre> + <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 \dots Passed to the update function.</pre> + <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 x The multistart object to print</pre> + <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">#' @return A list of [saem.mmkin] objects, with class attributes</pre> + <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">#' 'multistart.saem.mmkin' and 'multistart'.</pre> + <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">#' @seealso [parplot], [llhist]</pre> + <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">#'</pre> + <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 Duchesne R, Guillemin A, Gandrillon O, Crauste F. Practical</pre> + <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">#' identifiability in the frame of nonlinear mixed effects models: the example</pre> + <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">#' of the in vitro erythropoiesis. BMC Bioinformatics. 2021 Oct 4;22(1):478.</pre> + <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">#' doi: 10.1186/s12859-021-04373-4.</pre> + <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">#' @export</pre> + <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">#' @examples</pre> + <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">#' \dontrun{</pre> + <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">#' library(mkin)</pre> + <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">#' dmta_ds <- lapply(1:7, function(i) {</pre> + <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">#' ds_i <- dimethenamid_2018$ds[[i]]$data</pre> + <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">#' ds_i[ds_i$name == "DMTAP", "name"] <- "DMTA"</pre> + <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">#' ds_i$time <- ds_i$time * dimethenamid_2018$f_time_norm[i]</pre> + <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">#' ds_i</pre> + <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">#' })</pre> + <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">#' names(dmta_ds) <- sapply(dimethenamid_2018$ds, function(ds) ds$title)</pre> + <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">#' dmta_ds[["Elliot"]] <- rbind(dmta_ds[["Elliot 1"]], dmta_ds[["Elliot 2"]])</pre> + <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">#' dmta_ds[["Elliot 1"]] <- dmta_ds[["Elliot 2"]] <- NULL</pre> + <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">#'</pre> + <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">#' f_mmkin <- mmkin("DFOP", dmta_ds, error_model = "tc", cores = 7, quiet = TRUE)</pre> + <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">#' f_saem_full <- saem(f_mmkin)</pre> + <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">#' f_saem_full_multi <- multistart(f_saem_full, n = 16, cores = 16)</pre> + <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">#' parplot(f_saem_full_multi, lpos = "topleft")</pre> + <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">#' illparms(f_saem_full)</pre> + <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> + <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> + <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">#' illparms(f_saem_reduced)</pre> + <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">#' # On Windows, we need to create a PSOCK cluster first and refer to it</pre> + <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">#' # in the call to multistart()</pre> + <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">#' library(parallel)</pre> + <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">#' cl <- makePSOCKcluster(12)</pre> + <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">#' f_saem_reduced_multi <- multistart(f_saem_reduced, n = 16, cluster = cl)</pre> + <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">#' parplot(f_saem_reduced_multi, lpos = "topright", ylim = c(0.5, 2))</pre> + <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">#' stopCluster(cl)</pre> + <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">#' }</pre> + <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">multistart <- function(object, n = 50,</pre> + <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"> cores = if (Sys.info()["sysname"] == "Windows") 1 else parallel::detectCores(),</pre> + <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"> cluster = NULL, ...)</pre> + <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">{</pre> + <pre class="language-r">#' 10, 10, 10, rep("nd", 3),</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">60</td> - <td class="coverage">200<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> UseMethod("multistart", object)</pre> + <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">}</pre> + <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"></pre> + <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">#' @rdname multistart</pre> + <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">#' @export</pre> + <pre class="language-r">set_nd_nq <- function(res_raw, lod, loq = NA, time_zero_presence = FALSE) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">65</td> - <td class="coverage"></td> + <td class="coverage">10<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">multistart.saem.mmkin <- function(object, n = 50, cores = 1,</pre> + <pre class="language-r"> if (!is.character(res_raw)) {</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">66</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> cluster = NULL, ...) {</pre> + <pre class="language-r"> stop("Please supply a vector or a matrix of character values")</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">67</td> - <td class="coverage">200<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> call <- match.call()</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="missed"> + <tr class="covered"> <td class="num">68</td> - <td class="coverage">!</td> + <td class="coverage">10<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (n <= 1) stop("Please specify an n of at least 2")</pre> + <pre class="language-r"> if (is.vector(res_raw)) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">69</td> - <td class="coverage"></td> + <td class="coverage">8<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> was_vector <- TRUE</pre> </td> </tr> <tr class="covered"> <td class="num">70</td> - <td class="coverage">200<em>x</em></td> + <td class="coverage">8<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> mmkin_object <- object$mmkin</pre> + <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"></pre> + <pre class="language-r"> } else {</pre> </td> </tr> <tr class="covered"> <td class="num">72</td> - <td class="coverage">200<em>x</em></td> + <td class="coverage">2<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> mmkin_parms <- parms(mmkin_object, errparms = FALSE,</pre> + <pre class="language-r"> was_vector <- FALSE</pre> </td> </tr> <tr class="covered"> <td class="num">73</td> - <td class="coverage">200<em>x</em></td> + <td class="coverage">2<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> transformed = object$transformations == "mkin")</pre> + <pre class="language-r"> if (!is.matrix(res_raw)) {</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">74</td> - <td class="coverage">200<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> start_parms <- apply(</pre> + <pre class="language-r"> stop("Please supply a vector or a matrix of character values")</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">75</td> - <td class="coverage">200<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> mmkin_parms, 1,</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">76</td> - <td class="coverage">200<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> function(x) stats::runif(n, min(x), max(x)))</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">77</td> - <td class="coverage"></td> + <td class="coverage">10<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> nq <- 0.5 * (loq + lod)</pre> </td> </tr> <tr class="covered"> <td class="num">78</td> - <td class="coverage">200<em>x</em></td> + <td class="coverage">10<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> saem_call <- object$call</pre> + <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">200<em>x</em></td> + <td class="coverage">10<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> saem_call[[1]] <- saem</pre> + <pre class="language-r"> res_raw[res_raw == "nq"] <- nq</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">80</td> - <td class="coverage">200<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> saem_call[[2]] <- mmkin_object</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">81</td> - <td class="coverage">200<em>x</em></td> + <td class="coverage">10<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> i_startparms <- which(names(saem_call) == "degparms_start")</pre> + <pre class="language-r"> if (!time_zero_presence) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">82</td> - <td class="coverage"></td> + <td class="coverage">8<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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">200<em>x</em></td> + <td class="coverage">3<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fit_function <- function(x) {</pre> + <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> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">85</td> - <td class="coverage">16<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> new_startparms <- str2lang(</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="covered"> <td class="num">86</td> - <td class="coverage">16<em>x</em></td> + <td class="coverage">10<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> paste0(capture.output(dput(start_parms[x, ])),</pre> + <pre class="language-r"> res_raw[res_raw == "na"] <- NA</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">87</td> - <td class="coverage">16<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> collapse = ""))</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">88</td> - <td class="coverage"></td> + <td class="coverage">10<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> not_nd_na <- function(value) !(grepl("nd", value) | is.na(value))</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">89</td> - <td class="coverage">16<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (length(i_startparms) == 0) {</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">90</td> - <td class="coverage">16<em>x</em></td> + <td class="coverage">10<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> + <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">16<em>x</em></td> + <td class="coverage">94<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> saem_call <- as.call(saem_call)</pre> + <pre class="language-r"> for (j in 1:ncol(res_raw)) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">92</td> - <td class="coverage"></td> + <td class="coverage">164<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r"> if (!is.na(res_raw[i, j]) && res_raw[i, j] == "nd") {</pre> </td> </tr> - <tr class="missed"> + <tr class="covered"> <td class="num">93</td> - <td class="coverage">!</td> + <td class="coverage">98<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> saem_call[i_startparms] <- new_startparms</pre> + <pre class="language-r"> if (i > 1) { # check earlier sample in same layer</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">94</td> - <td class="coverage"></td> + <td class="coverage">17<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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> + <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="coverage">98<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ret <- eval(saem_call)</pre> + <pre class="language-r"> if (i < nrow(res_raw)) { # check later sample</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">97</td> - <td class="coverage"></td> + <td class="coverage">7<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> if (not_nd_na(res_raw[i + 1, j])) res_raw[i, j] <- "nda"</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">98</td> - <td class="coverage">16<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> return(ret)</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">99</td> - <td class="coverage"></td> + <td class="coverage">98<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> if (j > 1) { # check above sample at the same time</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">100</td> - <td class="coverage"></td> + <td class="coverage">9<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> if (not_nd_na(res_raw[i, j - 1])) res_raw[i, j] <- "nda"</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">101</td> - <td class="coverage">200<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (is.null(cluster)) {</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="covered"> <td class="num">102</td> - <td class="coverage">200<em>x</em></td> + <td class="coverage">98<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> res <- parallel::mclapply(1:n, fit_function,</pre> + <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">200<em>x</em></td> + <td class="coverage">2<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> mc.cores = cores, mc.preschedule = FALSE)</pre> + <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"> } else {</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">105</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> res <- parallel::parLapplyLB(cluster, 1:n, fit_function)</pre> + <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> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">107</td> - <td class="coverage">184<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> attr(res, "orig") <- object</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="covered"> <td class="num">108</td> - <td class="coverage">184<em>x</em></td> + <td class="coverage">10<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> attr(res, "start_parms") <- start_parms</pre> + <pre class="language-r"> res_raw[res_raw == "nda"] <- nda</pre> </td> </tr> <tr class="covered"> <td class="num">109</td> - <td class="coverage">184<em>x</em></td> + <td class="coverage">10<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> attr(res, "call") <- call</pre> + <pre class="language-r"> res_raw[res_raw == "nd"] <- NA</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">110</td> - <td class="coverage">184<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> class(res) <- c("multistart.saem.mmkin", "multistart")</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">111</td> - <td class="coverage">184<em>x</em></td> + <td class="coverage">10<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> return(res)</pre> + <pre class="language-r"> result <- as.numeric(res_raw)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">112</td> - <td class="coverage"></td> + <td class="coverage">10<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">}</pre> + <pre class="language-r"> dim(result) <- dim(res_raw)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">113</td> - <td class="coverage"></td> + <td class="coverage">10<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> dimnames(result) <- dimnames(res_raw)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">114</td> - <td class="coverage"></td> + <td class="coverage">8<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <pre class="language-r"> if (was_vector) result <- as.vector(result)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">115</td> - <td class="coverage"></td> + <td class="coverage">10<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">status.multistart <- function(object, ...) {</pre> + <pre class="language-r"> return(result)</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">116</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> all_summary_warnings <- character()</pre> + <pre class="language-r">}</pre> </td> </tr> <tr class="never"> @@ -50772,312 +49143,312 @@ table.table-condensed { <pre class="language-r"></pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">118</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> result <- lapply(object,</pre> + <pre class="language-r">#' @describeIn set_nd_nq Set non-detects in residue time series according to FOCUS rules</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">119</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> function(fit) {</pre> + <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="missed"> + <tr class="never"> <td class="num">120</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (inherits(fit, "try-error")) return("E")</pre> + <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"> else {</pre> + <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="missed"> + <tr class="never"> <td class="num">122</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> return("OK")</pre> + <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"> }</pre> + <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"> })</pre> + <pre class="language-r">#' @export</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">125</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> result <- unlist(result)</pre> + <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"></pre> + <pre class="language-r"> set_first_sample_nd = TRUE, first_sample_nd_value = 0,</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">127</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> class(result) <- "status.multistart"</pre> + <pre class="language-r"> ignore_below_loq_after_first_nd = TRUE)</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">128</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> return(result)</pre> + <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> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">130</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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">#' @export</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">132</td> - <td class="coverage"></td> + <td class="coverage">5<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">status.multistart.saem.mmkin <- function(object, ...) {</pre> + <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">88<em>x</em></td> + <td class="coverage">1<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> all_summary_warnings <- character()</pre> + <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> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">135</td> - <td class="coverage">88<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> result <- lapply(object,</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">136</td> - <td class="coverage">88<em>x</em></td> + <td class="coverage">4<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> function(fit) {</pre> + <pre class="language-r"> n <- length(res_raw)</pre> </td> </tr> - <tr class="missed"> + <tr class="covered"> <td class="num">137</td> - <td class="coverage">!</td> + <td class="coverage">4<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (inherits(fit$so, "try-error")) return("E")</pre> + <pre class="language-r"> if (ignore_below_loq_after_first_nd) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">138</td> - <td class="coverage"></td> + <td class="coverage">4<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> else {</pre> + <pre class="language-r"> for (i in 3:n) {</pre> </td> </tr> <tr class="covered"> <td class="num">139</td> - <td class="coverage">704<em>x</em></td> + <td class="coverage">35<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> return("OK")</pre> + <pre class="language-r"> if (!res_raw[i - 2] %in% c("na", "nd")) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">140</td> - <td class="coverage"></td> + <td class="coverage">21<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> if (res_raw[i - 1] == "nd") {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">141</td> - <td class="coverage"></td> + <td class="coverage">5<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> })</pre> + <pre class="language-r"> res_remaining <- res_raw[i:n]</pre> </td> </tr> <tr class="covered"> <td class="num">142</td> - <td class="coverage">88<em>x</em></td> + <td class="coverage">5<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> result <- unlist(result)</pre> + <pre class="language-r"> res_remaining_unquantified <- ifelse(res_remaining == "na", TRUE,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">143</td> - <td class="coverage"></td> + <td class="coverage">5<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> ifelse(res_remaining == "nd", TRUE,</pre> </td> </tr> <tr class="covered"> <td class="num">144</td> - <td class="coverage">88<em>x</em></td> + <td class="coverage">5<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> class(result) <- "status.multistart"</pre> + <pre class="language-r"> ifelse(res_remaining == "nq", TRUE,</pre> </td> </tr> <tr class="covered"> <td class="num">145</td> - <td class="coverage">88<em>x</em></td> + <td class="coverage">5<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> return(result)</pre> + <pre class="language-r"> ifelse(suppressWarnings(as.numeric(res_remaining)) < loq, TRUE, FALSE))))</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">146</td> - <td class="coverage"></td> + <td class="coverage">5<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">}</pre> + <pre class="language-r"> res_remaining_numeric <- suppressWarnings(as.numeric(res_remaining))</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">147</td> - <td class="coverage"></td> + <td class="coverage">5<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> res_remaining_below_loq <- ifelse(res_remaining == "nq", TRUE,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">148</td> - <td class="coverage"></td> + <td class="coverage">5<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <pre class="language-r"> ifelse(!is.na(res_remaining_numeric) & res_remaining_numeric < loq, TRUE, FALSE))</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">149</td> - <td class="coverage"></td> + <td class="coverage">5<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">print.status.multistart <- function(x, ...) {</pre> + <pre class="language-r"> if (all(res_remaining_unquantified)) {</pre> </td> </tr> <tr class="covered"> <td class="num">150</td> - <td class="coverage">88<em>x</em></td> + <td class="coverage">4<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> class(x) <- NULL</pre> + <pre class="language-r"> res_raw[i:n] <- ifelse(res_remaining_below_loq, "nd", res_remaining)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">151</td> - <td class="coverage">88<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> print(table(x, dnn = NULL))</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">152</td> - <td class="coverage">88<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (any(x == "OK")) cat("OK: Fit terminated successfully\n")</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">153</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (any(x == "E")) cat("E: Error\n")</pre> + <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> + <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> + <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> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">157</td> - <td class="coverage"></td> + <td class="coverage">4<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <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">print.multistart <- function(x, ...) {</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">159</td> - <td class="coverage">88<em>x</em></td> + <td class="coverage">4<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cat("<multistart> object with", length(x), "fits:\n")</pre> + <pre class="language-r"> if (set_first_sample_nd) {</pre> </td> </tr> <tr class="covered"> <td class="num">160</td> - <td class="coverage">88<em>x</em></td> + <td class="coverage">1<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> print(status(x))</pre> + <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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> @@ -51087,435 +49458,609 @@ table.table-condensed { <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">163</td> - <td class="coverage"></td> + <td class="coverage">4<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @rdname multistart</pre> + <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">#' @export</pre> + <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">165</td> + <td class="num">1</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">best <- function(object, ...)</pre> + <pre class="language-r">#' Calculate Akaike weights for model averaging</pre> </td> </tr> <tr class="never"> - <td class="num">166</td> + <td class="num">2</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">{</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> - <td class="num">167</td> - <td class="coverage">184<em>x</em></td> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> UseMethod("best", object)</pre> + <pre class="language-r">#' Akaike weights are calculated based on the relative</pre> </td> </tr> <tr class="never"> - <td class="num">168</td> + <td class="num">4</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">}</pre> + <pre class="language-r">#' expected Kullback-Leibler information as specified</pre> </td> </tr> <tr class="never"> - <td class="num">169</td> + <td class="num">5</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' by Burnham and Anderson (2004).</pre> </td> </tr> <tr class="never"> - <td class="num">170</td> + <td class="num">6</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <pre class="language-r">#'</pre> </td> </tr> <tr class="never"> - <td class="num">171</td> + <td class="num">7</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @return The object with the highest likelihood</pre> + <pre class="language-r">#' @param object An [mmkin] column object, containing two or more</pre> </td> </tr> <tr class="never"> - <td class="num">172</td> + <td class="num">8</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @rdname multistart</pre> + <pre class="language-r">#' [mkinfit] models that have been fitted to the same data,</pre> </td> </tr> <tr class="never"> - <td class="num">173</td> + <td class="num">9</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">best.default <- function(object, ...)</pre> + <pre class="language-r">#' or an mkinfit object. In the latter case, further mkinfit</pre> </td> </tr> <tr class="never"> - <td class="num">174</td> + <td class="num">10</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">{</pre> + <pre class="language-r">#' objects fitted to the same data should be specified</pre> </td> </tr> - <tr class="covered"> - <td class="num">175</td> - <td class="coverage">184<em>x</em></td> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> return(object[[which.best(object)]])</pre> + <pre class="language-r">#' as dots arguments.</pre> </td> </tr> <tr class="never"> - <td class="num">176</td> + <td class="num">12</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">}</pre> + <pre class="language-r">#' @param \dots Not used in the method for [mmkin] column objects,</pre> </td> </tr> <tr class="never"> - <td class="num">177</td> + <td class="num">13</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' further [mkinfit] objects in the method for mkinfit objects.</pre> </td> </tr> <tr class="never"> - <td class="num">178</td> + <td class="num">14</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> + <pre class="language-r">#' @references Burnham KP and Anderson DR (2004) Multimodel</pre> </td> </tr> <tr class="never"> - <td class="num">179</td> + <td class="num">15</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @rdname multistart</pre> + <pre class="language-r">#' Inference: Understanding AIC and BIC in Model Selection.</pre> </td> </tr> <tr class="never"> - <td class="num">180</td> + <td class="num">16</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <pre class="language-r">#' *Sociological Methods & Research* **33**(2) 261-304</pre> </td> </tr> <tr class="never"> - <td class="num">181</td> + <td class="num">17</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">which.best <- function(object, ...)</pre> + <pre class="language-r">#' @md</pre> </td> </tr> <tr class="never"> - <td class="num">182</td> + <td class="num">18</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">{</pre> + <pre class="language-r">#' @examples</pre> </td> </tr> - <tr class="covered"> - <td class="num">183</td> - <td class="coverage">360<em>x</em></td> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> UseMethod("which.best", object)</pre> + <pre class="language-r">#' \dontrun{</pre> </td> </tr> <tr class="never"> - <td class="num">184</td> + <td class="num">20</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">}</pre> + <pre class="language-r">#' f_sfo <- mkinfit("SFO", FOCUS_2006_D, quiet = TRUE)</pre> </td> </tr> <tr class="never"> - <td class="num">185</td> + <td class="num">21</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' f_dfop <- mkinfit("DFOP", FOCUS_2006_D, quiet = TRUE)</pre> </td> </tr> <tr class="never"> - <td class="num">186</td> + <td class="num">22</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @rdname multistart</pre> + <pre class="language-r">#' aw_sfo_dfop <- aw(f_sfo, f_dfop)</pre> </td> </tr> <tr class="never"> - <td class="num">187</td> + <td class="num">23</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <pre class="language-r">#' sum(aw_sfo_dfop)</pre> </td> </tr> <tr class="never"> - <td class="num">188</td> + <td class="num">24</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">which.best.default <- function(object, ...)</pre> + <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">189</td> + <td class="num">25</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">{</pre> + <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="covered"> - <td class="num">190</td> - <td class="coverage">360<em>x</em></td> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> llfunc <- function(object) {</pre> + <pre class="language-r">#' aw(f)</pre> </td> </tr> - <tr class="covered"> - <td class="num">191</td> - <td class="coverage">2528<em>x</em></td> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> ret <- try(logLik(object))</pre> + <pre class="language-r">#' sum(aw(f))</pre> </td> </tr> - <tr class="missed"> - <td class="num">192</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">28</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (inherits(ret, "try-error")) return(NA)</pre> + <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">193</td> - <td class="coverage">2528<em>x</em></td> + <td class="num">31</td> + <td class="coverage">1482<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> else return(ret)</pre> + <pre class="language-r">aw <- function(object, ...) UseMethod("aw")</pre> </td> </tr> <tr class="never"> - <td class="num">194</td> + <td class="num">32</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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">195</td> - <td class="coverage">360<em>x</em></td> + <td class="num">34</td> + <td class="coverage">494<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ll <- sapply(object, llfunc)</pre> + <pre class="language-r"> AIC_all <- sapply(all_objects, AIC)</pre> </td> </tr> <tr class="covered"> - <td class="num">196</td> - <td class="coverage">360<em>x</em></td> + <td class="num">35</td> + <td class="coverage">494<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> return(which.max(ll))</pre> + <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">197</td> + <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">198</td> + <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">199</td> + <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">200</td> + <td class="num">42</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">update.multistart <- function(object, ..., evaluate = TRUE) {</pre> + <pre class="language-r">#' @rdname aw</pre> </td> </tr> - <tr class="missed"> - <td class="num">201</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">43</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> call <- attr(object, "call")</pre> + <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">202</td> + <td class="num">51</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> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">203</td> + <td class="num">52</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> + <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">204</td> + <td class="num">55</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> # multistart.saem.mmkin</pre> + <pre class="language-r">}</pre> </td> </tr> - <tr class="missed"> - <td class="num">205</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">56</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> call[[1]] <- multistart</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">206</td> + <td class="num">57</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' @export</pre> </td> </tr> - <tr class="missed"> - <td class="num">207</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">58</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> update_arguments <- match.call(expand.dots = FALSE)$...</pre> + <pre class="language-r">#' @rdname aw</pre> </td> </tr> <tr class="never"> - <td class="num">208</td> + <td class="num">59</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">aw.mmkin <- function(object, ...) {</pre> </td> </tr> - <tr class="missed"> - <td class="num">209</td> - <td class="coverage">!</td> + <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 (length(update_arguments) > 0) {</pre> + <pre class="language-r"> if (ncol(object) > 1) stop("Please supply an mmkin column object")</pre> </td> </tr> - <tr class="missed"> - <td class="num">210</td> - <td class="coverage">!</td> + <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"> update_arguments_in_call <- !is.na(match(names(update_arguments), names(call)))</pre> + <pre class="language-r"> do.call(aw, object)</pre> </td> </tr> <tr class="never"> - <td class="num">211</td> + <td class="num">62</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">}</pre> </td> </tr> <tr class="never"> - <td class="num">212</td> + <td class="num">63</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> + <tr class="never"> + <td class="num">64</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> + <pre class="language-r">#' @export</pre> </td> </tr> - <tr class="missed"> - <td class="num">214</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">65</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> call[[a]] <- update_arguments[[a]]</pre> + <pre class="language-r">#' @rdname aw</pre> </td> </tr> <tr class="never"> - <td class="num">215</td> + <td class="num">66</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">aw.mixed.mmkin <- function(object, ...) {</pre> </td> </tr> - <tr class="never"> - <td class="num">216</td> - <td class="coverage"></td> + <tr class="missed"> + <td class="num">67</td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> oo <- list(...)</pre> </td> </tr> <tr class="missed"> - <td class="num">217</td> + <td class="num">68</td> <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> update_arguments_not_in_call <- !update_arguments_in_call</pre> + <pre class="language-r"> data_object <- object$data[c("ds", "name", "time", "value")]</pre> </td> </tr> <tr class="missed"> - <td class="num">218</td> + <td class="num">69</td> <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> if(any(update_arguments_not_in_call)) {</pre> + <pre class="language-r"> for (i in seq_along(oo)) {</pre> </td> </tr> <tr class="missed"> - <td class="num">219</td> + <td class="num">70</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> + <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">220</td> + <td class="num">71</td> <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> call <- as.call(call)</pre> + <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">221</td> + <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">222</td> + <td class="num">76</td> <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> if(evaluate) eval(call, parent.frame())</pre> + <pre class="language-r"> all_objects <- list(object, ...)</pre> </td> </tr> <tr class="missed"> - <td class="num">223</td> + <td class="num">77</td> <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> else call</pre> + <pre class="language-r"> .aw(all_objects)</pre> </td> </tr> <tr class="never"> - <td class="num">224</td> + <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> @@ -51524,1163 +50069,1955 @@ table.table-condensed { </tbody> </table> </div> - <div id="R/lrtest.mkinfit.R" class="hidden"> + <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">#' @importFrom lmtest lrtest</pre> + <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">#' @export</pre> + <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">lmtest::lrtest</pre> + <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"></pre> + <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">#' Likelihood ratio test for mkinfit models</pre> + <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">#'</pre> + <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">#' Compare two mkinfit models based on their likelihood. If two fitted</pre> + <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">#' mkinfit objects are given as arguments, it is checked if they have been</pre> + <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">#' fitted to the same data. It is the responsibility of the user to make sure</pre> + <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">#' that the models are nested, i.e. one of them has less degrees of freedom</pre> + <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">#' and can be expressed by fixing the parameters of the other.</pre> + <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">#'</pre> + <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">#' Alternatively, an argument to mkinfit can be given which is then passed</pre> + <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">#' to \code{\link{update.mkinfit}} to obtain the alternative model.</pre> + <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">#'</pre> + <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">#' The comparison is then made by the \code{\link[lmtest]{lrtest.default}}</pre> + <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">#' method from the lmtest package. The model with the higher number of fitted</pre> + <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">#' parameters (alternative hypothesis) is listed first, then the model with the</pre> + <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">#' lower number of fitted parameters (null hypothesis).</pre> + <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">#'</pre> + <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">#' @importFrom stats logLik update</pre> + <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 object An \code{\link{mkinfit}} object, or an \code{\link{mmkin}} column</pre> + <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">#' object containing two fits to the same data.</pre> + <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">#' @param object_2 Optionally, another mkinfit object fitted to the same data.</pre> + <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">#' @param \dots Argument to \code{\link{mkinfit}}, passed to</pre> + <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">#' \code{\link{update.mkinfit}} for creating the alternative fitted object.</pre> + <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">#' @examples</pre> + <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">#' \dontrun{</pre> + <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">#' test_data <- subset(synthetic_data_for_UBA_2014[[12]]$data, name == "parent")</pre> + <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">#' sfo_fit <- mkinfit("SFO", test_data, quiet = TRUE)</pre> + <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">#' dfop_fit <- mkinfit("DFOP", test_data, quiet = TRUE)</pre> + <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">#' lrtest(dfop_fit, sfo_fit)</pre> + <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">#' lrtest(sfo_fit, dfop_fit)</pre> + <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">#'</pre> + <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">#' # The following two examples are commented out as they fail during</pre> + <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">#' # generation of the static help pages by pkgdown</pre> + <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">#' #lrtest(dfop_fit, error_model = "tc")</pre> + <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">#' #lrtest(dfop_fit, fixed_parms = c(k2 = 0))</pre> + <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">#'</pre> + <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">#' # However, this equivalent syntax also works for static help pages</pre> + <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">#' lrtest(dfop_fit, update(dfop_fit, error_model = "tc"))</pre> + <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">#' lrtest(dfop_fit, update(dfop_fit, fixed_parms = c(k2 = 0)))</pre> + <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">#' }</pre> + <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">#' @export</pre> + <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">lrtest.mkinfit <- function(object, object_2 = NULL, ...) {</pre> + <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> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">47</td> - <td class="coverage">6<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> name_function <- function(x) {</pre> + <pre class="language-r">#' # Fit the model to the FOCUS example dataset D using defaults</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">48</td> - <td class="coverage">10<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object_name <- paste(x$mkinmod$name, "with error model", x$err_mod)</pre> + <pre class="language-r">#' FOCUS_D <- subset(FOCUS_2006_D, value != 0) # remove zero values to avoid warning</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">49</td> - <td class="coverage">10<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (length(x$bparms.fixed) > 0) {</pre> + <pre class="language-r">#' fit <- mkinfit(SFO_SFO, FOCUS_D, quiet = TRUE)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">50</td> - <td class="coverage">7<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object_name <- paste(object_name,</pre> + <pre class="language-r">#' fit.s <- summary(fit)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">51</td> - <td class="coverage">7<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> "and fixed parameter(s)",</pre> + <pre class="language-r">#' # Transformed and backtransformed parameters</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">52</td> - <td class="coverage">7<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> paste(names(x$bparms.fixed), collapse = ", "))</pre> + <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"> }</pre> + <pre class="language-r">#' print(fit.s$bpar, 3)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">54</td> - <td class="coverage">10<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> return(object_name)</pre> + <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> + <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"></pre> + <pre class="language-r">#' # Compare to the version without transforming rate parameters (does not work</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">57</td> - <td class="coverage">6<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (is.null(object_2)) {</pre> + <pre class="language-r">#' # with analytical solution, we get NA values for m1 in predictions)</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">58</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object_2 <- update(object, ...)</pre> + <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"> } else {</pre> + <pre class="language-r">#' solution_type = "deSolve", quiet = TRUE)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">60</td> - <td class="coverage">6<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> data_object <- object$data[c("time", "variable", "observed")]</pre> + <pre class="language-r">#' fit.2.s <- summary(fit.2)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">61</td> - <td class="coverage">6<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> data_object_2 <- object_2$data[c("time", "variable", "observed")]</pre> + <pre class="language-r">#' print(fit.2.s$par, 3)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">62</td> - <td class="coverage">6<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (!identical(data_object, data_object_2)) {</pre> + <pre class="language-r">#' print(fit.2.s$bpar, 3)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">63</td> - <td class="coverage">1<em>x</em></td> + <td class="coverage"></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> + <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> + <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> + <pre class="language-r">#' initials <- fit$start$value</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">66</td> - <td class="coverage">5<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (attr(logLik(object), "df") > attr(logLik(object_2), "df")) {</pre> + <pre class="language-r">#' names(initials) <- rownames(fit$start)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">67</td> - <td class="coverage">2<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> lmtest::lrtest.default(object, object_2, name = name_function)</pre> + <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"> } else {</pre> + <pre class="language-r">#' names(transformed) <- rownames(fit$start_transformed)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">69</td> - <td class="coverage">3<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> lmtest::lrtest.default(object_2, object, name = name_function)</pre> + <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"> }</pre> + <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> + <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> + <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">#' @rdname lrtest.mkinfit</pre> + <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">#' @export</pre> + <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">lrtest.mmkin <- function(object, ...) {</pre> + <pre class="language-r">#' parent = list(type = "SFO", to = "m1", sink = TRUE),</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">76</td> - <td class="coverage">!</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> + <pre class="language-r">#' m1 = list(type = "SFO"),</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">77</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object[[1, 1]]$mkinmod$name <- rownames(object)[1]</pre> + <pre class="language-r">#' use_of_ff = "max")</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">78</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object[[2, 1]]$mkinmod$name <- rownames(object)[2]</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">79</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> lrtest(object[[1, 1]], object[[2, 1]])</pre> + <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">}</pre> + <pre class="language-r">#' fit.ff.s <- summary(fit.ff)</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="num">81</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' Calculate Akaike weights for model averaging</pre> + <pre class="language-r">#' print(fit.ff.s$par, 3)</pre> </td> </tr> <tr class="never"> - <td class="num">2</td> + <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">3</td> + <td class="num">87</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' Akaike weights are calculated based on the relative</pre> + <pre class="language-r">#' # And without sink</pre> </td> </tr> <tr class="never"> - <td class="num">4</td> + <td class="num">88</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' expected Kullback-Leibler information as specified</pre> + <pre class="language-r">#' SFO_SFO.ff.2 <- mkinmod(</pre> </td> </tr> <tr class="never"> - <td class="num">5</td> + <td class="num">89</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' by Burnham and Anderson (2004).</pre> + <pre class="language-r">#' parent = list(type = "SFO", to = "m1", sink = FALSE),</pre> </td> </tr> <tr class="never"> - <td class="num">6</td> + <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">7</td> + <td class="num">93</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> + <pre class="language-r">#'</pre> </td> </tr> <tr class="never"> - <td class="num">8</td> + <td class="num">94</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> + <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">9</td> + <td class="num">95</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> + <pre class="language-r">#' fit.ff.2.s <- summary(fit.ff.2)</pre> </td> </tr> <tr class="never"> - <td class="num">10</td> + <td class="num">96</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' objects fitted to the same data should be specified</pre> + <pre class="language-r">#' print(fit.ff.2.s$par, 3)</pre> </td> </tr> <tr class="never"> - <td class="num">11</td> + <td class="num">97</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' as dots arguments.</pre> + <pre class="language-r">#' print(fit.ff.2.s$bpar, 3)</pre> </td> </tr> <tr class="never"> - <td class="num">12</td> + <td class="num">98</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> + <pre class="language-r">#' }</pre> </td> </tr> <tr class="never"> - <td class="num">13</td> + <td class="num">99</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' further [mkinfit] objects in the method for mkinfit objects.</pre> + <pre class="language-r">#'</pre> </td> </tr> <tr class="never"> - <td class="num">14</td> + <td class="num">100</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @references Burnham KP and Anderson DR (2004) Multimodel</pre> + <pre class="language-r">#' @export transform_odeparms</pre> </td> </tr> <tr class="never"> - <td class="num">15</td> + <td class="num">101</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' Inference: Understanding AIC and BIC in Model Selection.</pre> + <pre class="language-r">transform_odeparms <- function(parms, mkinmod,</pre> </td> </tr> <tr class="never"> - <td class="num">16</td> + <td class="num">102</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' *Sociological Methods & Research* **33**(2) 261-304</pre> + <pre class="language-r"> transform_rates = TRUE, transform_fractions = TRUE)</pre> </td> </tr> <tr class="never"> - <td class="num">17</td> + <td class="num">103</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @md</pre> + <pre class="language-r">{</pre> </td> </tr> <tr class="never"> - <td class="num">18</td> + <td class="num">104</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @examples</pre> + <pre class="language-r"> # We need the model specification for the names of the model</pre> </td> </tr> <tr class="never"> - <td class="num">19</td> + <td class="num">105</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' \dontrun{</pre> + <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">20</td> + <td class="num">107</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' f_sfo <- mkinfit("SFO", FOCUS_2006_D, quiet = TRUE)</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">21</td> + <td class="num">108</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' f_dfop <- mkinfit("DFOP", FOCUS_2006_D, quiet = TRUE)</pre> + <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">22</td> + <td class="num">110</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' aw_sfo_dfop <- aw(f_sfo, f_dfop)</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">23</td> + <td class="num">111</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' sum(aw_sfo_dfop)</pre> + <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">24</td> + <td class="num">114</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> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">25</td> + <td class="num">115</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> + <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">26</td> + <td class="num">123</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' aw(f)</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">27</td> + <td class="num">124</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' sum(aw(f))</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">28</td> + <td class="num">125</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' aw(f[c("SFO", "DFOP")])</pre> + <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">29</td> + <td class="num">128</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' }</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">30</td> + <td class="num">129</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <pre class="language-r"> # Go through state variables and transform formation fractions if requested</pre> </td> </tr> <tr class="covered"> - <td class="num">31</td> - <td class="coverage">1482<em>x</em></td> + <td class="num">130</td> + <td class="coverage">25587<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">aw <- function(object, ...) UseMethod("aw")</pre> + <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">32</td> + <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">33</td> + <td class="num">140</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">.aw <- function(all_objects) {</pre> + <pre class="language-r"> } else {</pre> </td> </tr> <tr class="covered"> - <td class="num">34</td> - <td class="coverage">494<em>x</em></td> + <td class="num">141</td> + <td class="coverage">14<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> AIC_all <- sapply(all_objects, AIC)</pre> + <pre class="language-r"> trans_f <- ilr(c(f, 1 - sum(f)))</pre> </td> </tr> <tr class="covered"> - <td class="num">35</td> - <td class="coverage">494<em>x</em></td> + <td class="num">142</td> + <td class="coverage">14<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> delta_i <- AIC_all - min(AIC_all)</pre> + <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">36</td> - <td class="coverage">494<em>x</em></td> + <td class="num">143</td> + <td class="coverage">14<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> denom <- sum(exp(-delta_i/2))</pre> + <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">37</td> - <td class="coverage">494<em>x</em></td> + <td class="num">146</td> + <td class="coverage">2<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> w_i <- exp(-delta_i/2) / denom</pre> + <pre class="language-r"> if (length(f) > 1) {</pre> </td> </tr> <tr class="covered"> - <td class="num">38</td> - <td class="coverage">494<em>x</em></td> + <td class="num">147</td> + <td class="coverage">2<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> return(w_i)</pre> + <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">39</td> + <td class="num">150</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">}</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">40</td> + <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">41</td> + <td class="num">158</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <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">42</td> + <td class="num">159</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @rdname aw</pre> + <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">43</td> + <td class="num">160</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">aw.mkinfit <- function(object, ...) {</pre> + <pre class="language-r"> # transformation of rates is requested</pre> </td> </tr> <tr class="covered"> - <td class="num">44</td> - <td class="coverage">988<em>x</em></td> + <td class="num">161</td> + <td class="coverage">25587<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> oo <- list(...)</pre> + <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">45</td> - <td class="coverage">988<em>x</em></td> + <td class="num">162</td> + <td class="coverage">204696<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> data_object <- object$data[c("time", "variable", "observed")]</pre> + <pre class="language-r"> if (!is.na(parms[pname])) {</pre> </td> </tr> <tr class="covered"> - <td class="num">46</td> - <td class="coverage">988<em>x</em></td> + <td class="num">163</td> + <td class="coverage">6006<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> for (i in seq_along(oo)) {</pre> + <pre class="language-r"> if (transform_rates) {</pre> </td> </tr> <tr class="covered"> - <td class="num">47</td> - <td class="coverage">247<em>x</em></td> + <td class="num">164</td> + <td class="coverage">6006<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> + <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">48</td> - <td class="coverage">988<em>x</em></td> + <td class="num">172</td> + <td class="coverage">25587<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> data_other_object <- oo[[i]]$data[c("time", "variable", "observed")]</pre> + <pre class="language-r"> if (!is.na(parms["g"])) {</pre> </td> </tr> <tr class="covered"> - <td class="num">49</td> - <td class="coverage">988<em>x</em></td> + <td class="num">173</td> + <td class="coverage">1978<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (!identical(data_object, data_other_object)) {</pre> + <pre class="language-r"> g <- parms["g"]</pre> </td> </tr> <tr class="covered"> - <td class="num">50</td> - <td class="coverage">247<em>x</em></td> + <td class="num">174</td> + <td class="coverage">1978<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> + <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">51</td> + <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">52</td> + <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">53</td> - <td class="coverage">494<em>x</em></td> + <tr class="never"> + <td class="num">180</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> all_objects <- list(object, ...)</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> - <td class="num">54</td> - <td class="coverage">494<em>x</em></td> + <td class="num">181</td> + <td class="coverage">25587<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> .aw(all_objects)</pre> + <pre class="language-r"> return(transparms)</pre> </td> </tr> <tr class="never"> - <td class="num">55</td> + <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">56</td> + <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">57</td> + <td class="num">184</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <pre class="language-r">#' @rdname transform_odeparms</pre> </td> </tr> <tr class="never"> - <td class="num">58</td> + <td class="num">185</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @rdname aw</pre> + <pre class="language-r">#' @export backtransform_odeparms</pre> </td> </tr> <tr class="never"> - <td class="num">59</td> + <td class="num">186</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">aw.mmkin <- function(object, ...) {</pre> + <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">60</td> - <td class="coverage">247<em>x</em></td> + <td class="num">192</td> + <td class="coverage">49214214<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> + <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">61</td> - <td class="coverage">247<em>x</em></td> + <td class="num">195</td> + <td class="coverage">49214214<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> do.call(aw, object)</pre> + <pre class="language-r"> parms <- numeric(0)</pre> </td> </tr> <tr class="never"> - <td class="num">62</td> + <td class="num">196</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">}</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">63</td> + <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">64</td> + <td class="num">201</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <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">65</td> + <td class="num">209</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @rdname aw</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">66</td> + <td class="num">210</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">aw.mixed.mmkin <- function(object, ...) {</pre> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="missed"> - <td class="num">67</td> - <td class="coverage">!</td> + <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"> oo <- list(...)</pre> + <pre class="language-r"> trans_k <- transparms[grep("^k_", names(transparms))]</pre> </td> </tr> - <tr class="missed"> - <td class="num">68</td> - <td class="coverage">!</td> + <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"> data_object <- object$data[c("ds", "name", "time", "value")]</pre> + <pre class="language-r"> parms[names(trans_k)] <- trans_k</pre> </td> </tr> - <tr class="missed"> - <td class="num">69</td> - <td class="coverage">!</td> + <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"> for (i in seq_along(oo)) {</pre> + <pre class="language-r"> trans_k__iore <- transparms[grep("^k__iore_", names(transparms))]</pre> </td> </tr> - <tr class="missed"> - <td class="num">70</td> - <td class="coverage">!</td> + <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"> if (!inherits(oo[[i]], "mixed.mmkin")) stop("Please supply objects inheriting from mixed.mmkin")</pre> + <pre class="language-r"> parms[names(trans_k__iore)] <- trans_k__iore</pre> </td> </tr> - <tr class="missed"> - <td class="num">71</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">215</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> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="missed"> - <td class="num">72</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">216</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (!identical(data_object, data_other_object)) {</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="missed"> - <td class="num">73</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">217</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> + <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">74</td> + <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">75</td> + <td class="num">246</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> + <tr class="never"> + <td class="num">247</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> all_objects <- list(object, ...)</pre> + <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">77</td> + <td class="num">257</td> <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> .aw(all_objects)</pre> + <pre class="language-r"> parms[pname] <- transparms[pname]</pre> </td> </tr> <tr class="never"> - <td class="num">78</td> + <td class="num">258</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">}</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">79</td> + <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">80</td> + <td class="num">262</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <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">81</td> + <td class="num">266</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @rdname aw</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> - <td class="num">82</td> + <td class="num">267</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">aw.multistart <- function(object, ...) {</pre> + <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">83</td> + <td class="num">269</td> <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> do.call(aw, object)</pre> + <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">84</td> + <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> @@ -53166,6 +52503,425 @@ table.table-condensed { </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/ilr.R" class="hidden"> <table class="table-condensed"> <tbody> @@ -53795,6 +53551,852 @@ table.table-condensed { </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/max_twa_parent.R" class="hidden"> <table class="table-condensed"> <tbody> @@ -57564,229 +58166,6 @@ table.table-condensed { </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> @@ -58989,439 +59368,6 @@ table.table-condensed { </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> @@ -61094,917 +61040,917 @@ table.table-condensed { </tbody> </table> </div> - <div id="R/set_nd_nq.R" class="hidden"> + <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">#' Set non-detects and unquantified values in residue series without replicates</pre> + <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">#'</pre> + <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">#' This function automates replacing unquantified values in residue time and</pre> + <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">#' depth series. For time series, the function performs part of the residue</pre> + <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">#' processing proposed in the FOCUS kinetics guidance for parent compounds</pre> + <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">#' and metabolites. For two-dimensional residue series over time and depth,</pre> + <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">#' it automates the proposal of Boesten et al (2015).</pre> + <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">#'</pre> + <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">#' @param res_raw Character vector of a residue time series, or matrix of</pre> + <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">#' residue values with rows representing depth profiles for a specific sampling</pre> + <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">#' time, and columns representing time series of residues at the same depth.</pre> + <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">#' Values below the limit of detection (lod) have to be coded as "nd", values</pre> + <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">#' between the limit of detection and the limit of quantification, if any, have</pre> + <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">#' to be coded as "nq". Samples not analysed have to be coded as "na". All</pre> + <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">#' values that are not "na", "nd" or "nq" have to be coercible to numeric</pre> + <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">#' @param lod Limit of detection (numeric)</pre> + <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">#' @param loq Limit of quantification(numeric). Must be specified if the FOCUS rule to</pre> + <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">#' stop after the first non-detection is to be applied</pre> + <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">#' @param time_zero_presence Do we assume that residues occur at time zero?</pre> + <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">#' This only affects samples from the first sampling time that have been</pre> + <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">#' reported as "nd" (not detected).</pre> + <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">#' @references Boesten, J. J. T. I., van der Linden, A. M. A., Beltman, W. H.</pre> + <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">#' J. and Pol, J. W. (2015). Leaching of plant protection products and their</pre> + <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">#' transformation products; Proposals for improving the assessment of leaching</pre> + <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">#' to groundwater in the Netherlands — Version 2. Alterra report 2630, Alterra</pre> + <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">#' Wageningen UR (University & Research centre)</pre> + <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">#' @references FOCUS (2014) Generic Guidance for Estimating Persistence and Degradation</pre> + <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">#' Kinetics from Environmental Fate Studies on Pesticides in EU Registration, Version 1.1,</pre> + <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">#' 18 December 2014, p. 251</pre> + <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">#' @return A numeric vector, if a vector was supplied, or a numeric matrix otherwise</pre> + <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">#' @export</pre> + <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">#' @examples</pre> + <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">#' # FOCUS (2014) p. 75/76 and 131/132</pre> + <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">#' parent_1 <- c(.12, .09, .05, .03, "nd", "nd", "nd", "nd", "nd", "nd")</pre> + <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">#' set_nd_nq(parent_1, 0.02)</pre> + <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">#' parent_2 <- c(.12, .09, .05, .03, "nd", "nd", .03, "nd", "nd", "nd")</pre> + <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">#' set_nd_nq(parent_2, 0.02)</pre> + <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">#' set_nd_nq_focus(parent_2, 0.02, loq = 0.05)</pre> + <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">#' parent_3 <- c(.12, .09, .05, .03, "nd", "nd", .06, "nd", "nd", "nd")</pre> + <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">#' set_nd_nq(parent_3, 0.02)</pre> + <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">#' set_nd_nq_focus(parent_3, 0.02, loq = 0.05)</pre> + <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">#' metabolite <- c("nd", "nd", "nd", 0.03, 0.06, 0.10, 0.11, 0.10, 0.09, 0.05, 0.03, "nd", "nd")</pre> + <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">#' set_nd_nq(metabolite, 0.02)</pre> + <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">#' set_nd_nq_focus(metabolite, 0.02, 0.05)</pre> + <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> + <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">#' # Boesten et al. (2015), p. 57/58</pre> + <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">#' table_8 <- matrix(</pre> + <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">#' c(10, 10, rep("nd", 4),</pre> + <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">#' 10, 10, rep("nq", 2), rep("nd", 2),</pre> + <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">#' 10, 10, 10, "nq", "nd", "nd",</pre> + <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">#' "nq", 10, "nq", rep("nd", 3),</pre> + <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">#' "nd", "nq", "nq", rep("nd", 3),</pre> + <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">#' rep("nd", 6), rep("nd", 6)),</pre> + <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">#' ncol = 6, byrow = TRUE)</pre> + <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">#' set_nd_nq(table_8, 0.5, 1.5, time_zero_presence = TRUE)</pre> + <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">#' table_10 <- matrix(</pre> + <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">#' c(10, 10, rep("nd", 4),</pre> + <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">#' 10, 10, rep("nd", 4),</pre> + <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">#' 10, 10, 10, rep("nd", 3),</pre> + <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">#' "nd", 10, rep("nd", 4),</pre> + <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">#' rep("nd", 18)),</pre> + <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">#' ncol = 6, byrow = TRUE)</pre> + <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">#' set_nd_nq(table_10, 0.5, time_zero_presence = TRUE)</pre> + <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">set_nd_nq <- function(res_raw, lod, loq = NA, time_zero_presence = FALSE) {</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">65</td> - <td class="coverage">10<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (!is.character(res_raw)) {</pre> + <pre class="language-r">#' # On Windows, we can use multiple cores by making a cluster first</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">66</td> - <td class="coverage">!</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> + <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"> }</pre> + <pre class="language-r">#' f <- mmkin(c("SFO", "FOMC", "DFOP"),</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">68</td> - <td class="coverage">10<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (is.vector(res_raw)) {</pre> + <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="covered"> + <tr class="never"> <td class="num">69</td> - <td class="coverage">8<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> was_vector <- TRUE</pre> + <pre class="language-r">#' cluster = cl, quiet = TRUE)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">70</td> - <td class="coverage">8<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> res_raw <- as.matrix(res_raw)</pre> + <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"> } else {</pre> + <pre class="language-r">#' # We get false convergence for the FOMC fit to FOCUS_2006_A because this</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">72</td> - <td class="coverage">2<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> was_vector <- FALSE</pre> + <pre class="language-r">#' # dataset is really SFO, and the FOMC fit is overparameterised</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">73</td> - <td class="coverage">2<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (!is.matrix(res_raw)) {</pre> + <pre class="language-r">#' parallel::stopCluster(cl)</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">74</td> - <td class="coverage">!</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> + <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> + <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> + <pre class="language-r">#' @export mmkin</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">77</td> - <td class="coverage">10<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> nq <- 0.5 * (loq + lod)</pre> + <pre class="language-r">mmkin <- function(models = c("SFO", "FOMC", "DFOP"), datasets,</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">78</td> - <td class="coverage">10<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> nda <- 0.5 * lod # not detected but adjacent to detection</pre> + <pre class="language-r"> cores = if (Sys.info()["sysname"] == "Windows") 1 else parallel::detectCores(), cluster = NULL, ...)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">79</td> - <td class="coverage">10<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> res_raw[res_raw == "nq"] <- nq</pre> + <pre class="language-r">{</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">80</td> - <td class="coverage"></td> + <td class="coverage">4032<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> call <- match.call()</pre> </td> </tr> <tr class="covered"> <td class="num">81</td> - <td class="coverage">10<em>x</em></td> + <td class="coverage">4032<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (!time_zero_presence) {</pre> + <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">8<em>x</em></td> + <td class="coverage">4032<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> for (j in 1:ncol(res_raw)) {</pre> + <pre class="language-r"> n.m <- length(models)</pre> </td> </tr> <tr class="covered"> <td class="num">83</td> - <td class="coverage">3<em>x</em></td> + <td class="coverage">4032<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> + <pre class="language-r"> n.d <- length(datasets)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">84</td> - <td class="coverage"></td> + <td class="coverage">4032<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> n.fits <- n.m * n.d</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">85</td> - <td class="coverage"></td> + <td class="coverage">4032<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> fit_indices <- matrix(1:n.fits, ncol = n.d)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">86</td> - <td class="coverage">10<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> res_raw[res_raw == "na"] <- NA</pre> + <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> + <pre class="language-r"> # Check models and define their names</pre> </td> </tr> <tr class="covered"> <td class="num">88</td> - <td class="coverage">10<em>x</em></td> + <td class="coverage">4032<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> + <pre class="language-r"> if (!all(sapply(models, function(x) inherits(x, "mkinmod")))) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">89</td> - <td class="coverage"></td> + <td class="coverage">2323<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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">10<em>x</em></td> + <td class="coverage">50<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> for (i in 1:nrow(res_raw)) {</pre> + <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">94<em>x</em></td> + <td class="coverage">50<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> for (j in 1:ncol(res_raw)) {</pre> + <pre class="language-r"> paste(parent_models_available, collapse = ", "))</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">92</td> - <td class="coverage">164<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (!is.na(res_raw[i, j]) && res_raw[i, j] == "nd") {</pre> + <pre class="language-r"> } else {</pre> </td> </tr> <tr class="covered"> <td class="num">93</td> - <td class="coverage">98<em>x</em></td> + <td class="coverage">2273<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (i > 1) { # check earlier sample in same layer</pre> + <pre class="language-r"> names(models) <- models</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">94</td> - <td class="coverage">17<em>x</em></td> + <td class="coverage"></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> + <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> + <pre class="language-r"> } else {</pre> </td> </tr> <tr class="covered"> <td class="num">96</td> - <td class="coverage">98<em>x</em></td> + <td class="coverage">1087<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (i < nrow(res_raw)) { # check later sample</pre> + <pre class="language-r"> if (is.null(names(models))) names(models) <- as.character(1:n.m)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">97</td> - <td class="coverage">7<em>x</em></td> + <td class="coverage"></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> + <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> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">99</td> - <td class="coverage">98<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (j > 1) { # check above sample at the same time</pre> + <pre class="language-r"> # Check datasets and define their names</pre> </td> </tr> <tr class="covered"> <td class="num">100</td> - <td class="coverage">9<em>x</em></td> + <td class="coverage">1575<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> + <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> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">102</td> - <td class="coverage">98<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (j < ncol(res_raw)) { # check sample below at the same time</pre> + <pre class="language-r"> # Define names for fit index</pre> </td> </tr> <tr class="covered"> <td class="num">103</td> - <td class="coverage">2<em>x</em></td> + <td class="coverage">3982<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> + <pre class="language-r"> dimnames(fit_indices) <- list(model = names(models),</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">104</td> - <td class="coverage"></td> + <td class="coverage">3982<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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> + <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> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">107</td> - <td class="coverage"></td> + <td class="coverage">3982<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> fit_function <- function(fit_index) {</pre> </td> </tr> <tr class="covered"> <td class="num">108</td> - <td class="coverage">10<em>x</em></td> + <td class="coverage">793<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> res_raw[res_raw == "nda"] <- nda</pre> + <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">10<em>x</em></td> + <td class="coverage">793<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> res_raw[res_raw == "nd"] <- NA</pre> + <pre class="language-r"> model_index <- w[1]</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">110</td> - <td class="coverage"></td> + <td class="coverage">793<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> dataset_index <- w[2]</pre> </td> </tr> <tr class="covered"> <td class="num">111</td> - <td class="coverage">10<em>x</em></td> + <td class="coverage">793<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> result <- as.numeric(res_raw)</pre> + <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">10<em>x</em></td> + <td class="coverage">793<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> dim(result) <- dim(res_raw)</pre> + <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">10<em>x</em></td> + <td class="coverage">793<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> dimnames(result) <- dimnames(res_raw)</pre> + <pre class="language-r"> return(res)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">114</td> - <td class="coverage">8<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (was_vector) result <- as.vector(result)</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">115</td> - <td class="coverage">10<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> return(result)</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">116</td> - <td class="coverage"></td> + <td class="coverage">3982<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">}</pre> + <pre class="language-r"> fit_time <- system.time({</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">117</td> - <td class="coverage"></td> + <td class="coverage">3982<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> if (is.null(cluster)) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">118</td> - <td class="coverage"></td> + <td class="coverage">2154<em>x</em></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> + <pre class="language-r"> results <- parallel::mclapply(as.list(1:n.fits), fit_function,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">119</td> - <td class="coverage"></td> + <td class="coverage">2154<em>x</em></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> + <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">#' in case it is a non-detection?</pre> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">121</td> - <td class="coverage"></td> + <td class="coverage">1828<em>x</em></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> + <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">#' @param ignore_below_loq_after_first_nd Should we ignore values below the LOQ after the first</pre> + <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">#' non-detection that occurs after the quantified values?</pre> + <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">#' @export</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">125</td> - <td class="coverage"></td> + <td class="coverage">3798<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">set_nd_nq_focus <- function(res_raw, lod, loq = NA,</pre> + <pre class="language-r"> attributes(results) <- attributes(fit_indices)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">126</td> - <td class="coverage"></td> + <td class="coverage">3798<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> set_first_sample_nd = TRUE, first_sample_nd_value = 0,</pre> + <pre class="language-r"> attr(results, "call") <- call</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">127</td> - <td class="coverage"></td> + <td class="coverage">3798<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ignore_below_loq_after_first_nd = TRUE)</pre> + <pre class="language-r"> attr(results, "time") <- fit_time</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">128</td> - <td class="coverage"></td> + <td class="coverage">3798<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">{</pre> + <pre class="language-r"> class(results) <- "mmkin"</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">129</td> - <td class="coverage"></td> + <td class="coverage">3798<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> return(results)</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">130</td> - <td class="coverage">!</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> + <pre class="language-r">}</pre> </td> </tr> <tr class="never"> @@ -62014,232 +61960,477 @@ table.table-condensed { <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">132</td> - <td class="coverage">5<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (ignore_below_loq_after_first_nd & is.na(loq)) {</pre> + <pre class="language-r">#' Subsetting method for mmkin objects</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">133</td> - <td class="coverage">1<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> stop("You need to specify an LOQ")</pre> + <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> + <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"></pre> + <pre class="language-r">#' @param i Row index selecting the fits for specific models</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">136</td> - <td class="coverage">4<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> n <- length(res_raw)</pre> + <pre class="language-r">#' @param j Column index selecting the fits to specific datasets</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">137</td> - <td class="coverage">4<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (ignore_below_loq_after_first_nd) {</pre> + <pre class="language-r">#' @param ... Not used, only there to satisfy the generic method definition</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">138</td> - <td class="coverage">4<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> for (i in 3:n) {</pre> + <pre class="language-r">#' @param drop If FALSE, the method always returns an mmkin object, otherwise</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">139</td> - <td class="coverage">35<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (!res_raw[i - 2] %in% c("na", "nd")) {</pre> + <pre class="language-r">#' either a list of mkinfit objects or a single mkinfit object.</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">140</td> - <td class="coverage">21<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (res_raw[i - 1] == "nd") {</pre> + <pre class="language-r">#' @return An object of class \code{\link{mmkin}}.</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">141</td> - <td class="coverage">5<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> res_remaining <- res_raw[i:n]</pre> + <pre class="language-r">#' @author Johannes Ranke</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">142</td> - <td class="coverage">5<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> res_remaining_unquantified <- ifelse(res_remaining == "na", TRUE,</pre> + <pre class="language-r">#' @rdname Extract.mmkin</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">143</td> - <td class="coverage">5<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> ifelse(res_remaining == "nd", TRUE,</pre> + <pre class="language-r">#' @examples</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">144</td> - <td class="coverage">5<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> ifelse(res_remaining == "nq", TRUE,</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">145</td> - <td class="coverage">5<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> ifelse(suppressWarnings(as.numeric(res_remaining)) < loq, TRUE, FALSE))))</pre> + <pre class="language-r">#' # Only use one core, to pass R CMD check --as-cran</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">146</td> - <td class="coverage">5<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> res_remaining_numeric <- suppressWarnings(as.numeric(res_remaining))</pre> + <pre class="language-r">#' fits <- mmkin(c("SFO", "FOMC"), list(B = FOCUS_2006_B, C = FOCUS_2006_C),</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">147</td> - <td class="coverage">5<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> res_remaining_below_loq <- ifelse(res_remaining == "nq", TRUE,</pre> + <pre class="language-r">#' cores = 1, quiet = TRUE)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">148</td> - <td class="coverage">5<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> ifelse(!is.na(res_remaining_numeric) & res_remaining_numeric < loq, TRUE, FALSE))</pre> + <pre class="language-r">#' fits["FOMC", ]</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">149</td> - <td class="coverage">5<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (all(res_remaining_unquantified)) {</pre> + <pre class="language-r">#' fits[, "B"]</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">150</td> - <td class="coverage">4<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> res_raw[i:n] <- ifelse(res_remaining_below_loq, "nd", res_remaining)</pre> + <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> + <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> + <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"> }</pre> + <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"> }</pre> + <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> + <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">157</td> - <td class="coverage">4<em>x</em></td> + <td class="num">171</td> + <td class="coverage">375<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> result <- set_nd_nq(res_raw, lod = lod, loq = loq)</pre> + <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">158</td> + <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">159</td> - <td class="coverage">4<em>x</em></td> + <td class="num">179</td> + <td class="coverage">256<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (set_first_sample_nd) {</pre> + <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">160</td> - <td class="coverage">1<em>x</em></td> + <td class="num">181</td> + <td class="coverage">256<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> + <pre class="language-r"> update_arguments <- match.call(expand.dots = FALSE)$...</pre> </td> </tr> <tr class="never"> - <td class="num">161</td> + <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">162</td> + <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">163</td> - <td class="coverage">4<em>x</em></td> + <td class="num">187</td> + <td class="coverage">256<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> return(result)</pre> + <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">164</td> + <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> @@ -62248,529 +62439,431 @@ table.table-condensed { </tbody> </table> </div> - <div id="R/mkinparplot.R" class="hidden"> + <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">#' Function to plot the confidence intervals obtained using mkinfit</pre> + <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> + <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> + <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">#' \code{\link{mkinfit}}.</pre> + <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">#' </pre> + <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">#' @param object A fit represented in an \code{\link{mkinfit}} object.</pre> + <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">#' @return Nothing is returned by this function, as it is called for its side</pre> + <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">#' effect, namely to produce a plot.</pre> + <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">#' @author Johannes Ranke</pre> + <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">#' @examples</pre> + <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">#' </pre> + <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">#' \dontrun{</pre> + <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">#' model <- mkinmod(</pre> + <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">#' T245 = mkinsub("SFO", to = c("phenol"), sink = FALSE),</pre> + <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">#' phenol = mkinsub("SFO", to = c("anisole")),</pre> + <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">#' anisole = mkinsub("SFO"), use_of_ff = "max")</pre> + <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">#' fit <- mkinfit(model, subset(mccall81_245T, soil == "Commerce"), quiet = TRUE)</pre> + <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">#' mkinparplot(fit)</pre> + <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">#' }</pre> + <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">#' @export</pre> + <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">mkinparplot <- function(object) {</pre> + <pre class="language-r">#' }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">22</td> - <td class="coverage">70<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> state.optim = rownames(subset(object$start, type == "state"))</pre> + <pre class="language-r">#' @export</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">23</td> - <td class="coverage">70<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> deparms.optim = rownames(subset(object$start, type == "deparm"))</pre> + <pre class="language-r">update.mkinfit <- function(object, ..., evaluate = TRUE)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">24</td> - <td class="coverage">70<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> fractions.optim = grep("^f_", deparms.optim, value = TRUE)</pre> + <pre class="language-r">{</pre> </td> </tr> <tr class="covered"> <td class="num">25</td> - <td class="coverage">70<em>x</em></td> + <td class="coverage">5<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> N.optim = grep("^N_", deparms.optim, value = TRUE)</pre> + <pre class="language-r"> call <- object$call</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">26</td> - <td class="coverage">!</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> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">27</td> - <td class="coverage">70<em>x</em></td> + <td class="coverage">5<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> + <pre class="language-r"> update_arguments <- match.call(expand.dots = FALSE)$...</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">28</td> - <td class="coverage">70<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> rates.optim <- rownames(object$start[rates.optim.unsorted, ])</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">29</td> - <td class="coverage">70<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> n.plot <- c(state.optim = length(state.optim),</pre> + <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">70<em>x</em></td> + <td class="coverage">5<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> rates.optim = length(rates.optim),</pre> + <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">70<em>x</em></td> + <td class="coverage">5<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> N.optim = length(N.optim),</pre> + <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">70<em>x</em></td> + <td class="coverage">5<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fractions.optim = length(fractions.optim))</pre> + <pre class="language-r"> if ("parms.ini" %in% names(update_arguments)) {</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">33</td> - <td class="coverage">70<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> n.plot <- n.plot[n.plot > 0]</pre> + <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> + <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="coverage">5<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> oldpar <- par(no.readonly = TRUE)</pre> + <pre class="language-r"> if (length(ode_start)) update_arguments[["parms.ini"]] <- ode_start</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">36</td> - <td class="coverage">70<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> on.exit(par(oldpar, no.readonly = TRUE))</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">37</td> - <td class="coverage">70<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> layout(matrix(1:length(n.plot), ncol = 1), heights = n.plot + 1)</pre> + <pre class="language-r"> # Get optimised values for initial states and let state.ini override them</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">38</td> - <td class="coverage"></td> + <td class="coverage">5<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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">70<em>x</em></td> + <td class="coverage">5<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> s <- summary(object)</pre> + <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">70<em>x</em></td> + <td class="coverage">5<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> bpar <- data.frame(t(s$bpar[, c("Estimate", "Lower", "Upper")]))</pre> + <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">70<em>x</em></td> + <td class="coverage">5<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> + <pre class="language-r"> if ("state.ini" %in% names(update_arguments)) {</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">42</td> - <td class="coverage">70<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> par(cex = 1)</pre> + <pre class="language-r"> state_start[names(update_arguments["state.ini"])] <- update_arguments["state.ini"]</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">43</td> - <td class="coverage">70<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> for (type in names(n.plot)) {</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="covered"> <td class="num">44</td> - <td class="coverage">140<em>x</em></td> + <td class="coverage">5<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> parnames <- get(type)</pre> + <pre class="language-r"> if (length(state_start)) update_arguments[["state.ini"]] <- state_start</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">45</td> - <td class="coverage">140<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> values <- bpar[parnames]</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">46</td> - <td class="coverage">140<em>x</em></td> + <td class="coverage">5<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> + <pre class="language-r"> if (length(update_arguments) > 0) {</pre> </td> </tr> <tr class="covered"> <td class="num">47</td> - <td class="coverage">140<em>x</em></td> + <td class="coverage">5<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> xlim = switch(type,</pre> + <pre class="language-r"> update_arguments_in_call <- !is.na(match(names(update_arguments), names(call)))</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">48</td> - <td class="coverage">140<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> state.optim = range(c(0, unlist(values)),</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">49</td> - <td class="coverage">140<em>x</em></td> + <td class="coverage">5<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> na.rm = TRUE, finite = TRUE),</pre> + <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">140<em>x</em></td> + <td class="coverage">3<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> rates.optim = range(c(0, unlist(values)),</pre> + <pre class="language-r"> call[[a]] <- update_arguments[[a]]</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">51</td> - <td class="coverage">140<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> na.rm = TRUE, finite = TRUE),</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">52</td> - <td class="coverage">140<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> N.optim = range(c(0, 1, unlist(values)),</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">53</td> - <td class="coverage">140<em>x</em></td> + <td class="coverage">5<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> na.rm = TRUE, finite = TRUE),</pre> + <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">140<em>x</em></td> + <td class="coverage">5<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> fractions.optim = range(c(0, 1, unlist(values)),</pre> + <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">140<em>x</em></td> + <td class="coverage">5<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> na.rm = TRUE, finite = TRUE))</pre> + <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">140<em>x</em></td> + <td class="coverage">5<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> parname_index <- length(parnames):1 # Reverse order for strip chart</pre> + <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> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">58</td> - <td class="coverage">140<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> stripchart(values["Estimate", ][parname_index],</pre> + <pre class="language-r"> }</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="coverage">5<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> + <pre class="language-r"> if(evaluate) eval(call, parent.frame())</pre> </td> </tr> <tr class="missed"> - <td class="num">63</td> + <td class="num">60</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> + <pre class="language-r"> else call</pre> </td> </tr> <tr class="never"> - <td class="num">75</td> + <td class="num">61</td> <td class="coverage"></td> <td class="col-sm-12"> <pre class="language-r">}</pre> @@ -62779,14 +62872,14 @@ table.table-condensed { </tbody> </table> </div> - <div id="R/summary.saem.mmkin.R" class="hidden"> + <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">#' Summary method for class "saem.mmkin"</pre> + <pre class="language-r">#' Perform a hierarchical model fit with multiple starting values</pre> </td> </tr> <tr class="never"> @@ -62800,364 +62893,364 @@ table.table-condensed { <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> + <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">#' for fixed effects (population), random effects (deviations from the</pre> + <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">#' population mean) and residual error model, as well as the resulting</pre> + <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">#' endpoints such as formation fractions and DT50 values. Optionally</pre> + <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">#' (default is FALSE), the data are listed in full.</pre> + <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">#'</pre> + <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">#' @param object an object of class [saem.mmkin]</pre> + <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 x an object of class [summary.saem.mmkin]</pre> + <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 data logical, indicating whether the full data should be included in</pre> + <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">#' the summary.</pre> + <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 verbose Should the summary be verbose?</pre> + <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 distimes logical, indicating whether DT50 and DT90 values should be</pre> + <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">#' included.</pre> + <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 digits Number of digits to use for printing</pre> + <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 \dots optional arguments passed to methods like \code{print}.</pre> + <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">#' @inheritParams endpoints</pre> + <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">#' @return The summary function returns a list based on the [saemix::SaemixObject]</pre> + <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">#' obtained in the fit, with at least the following additional components</pre> + <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">#' \item{saemixversion, mkinversion, Rversion}{The saemix, mkin and R versions used}</pre> + <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">#' \item{date.fit, date.summary}{The dates where the fit and the summary were</pre> + <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">#' produced}</pre> + <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">#' \item{diffs}{The differential equations used in the degradation model}</pre> + <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">#' \item{use_of_ff}{Was maximum or minimum use made of formation fractions}</pre> + <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">#' \item{data}{The data}</pre> + <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">#' \item{confint_trans}{Transformed parameters as used in the optimisation, with confidence intervals}</pre> + <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">#' \item{confint_back}{Backtransformed parameters, with confidence intervals if available}</pre> + <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">#' \item{confint_errmod}{Error model parameters with confidence intervals}</pre> + <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">#' \item{ff}{The estimated formation fractions derived from the fitted</pre> + <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">#' model.}</pre> + <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">#' \item{distimes}{The DT50 and DT90 values for each observed variable.}</pre> + <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">#' \item{SFORB}{If applicable, eigenvalues of SFORB components of the model.}</pre> + <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">#' The print method is called for its side effect, i.e. printing the summary.</pre> + <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">#' @importFrom stats predict vcov</pre> + <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">#' @author Johannes Ranke for the mkin specific parts</pre> + <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">#' saemix authors for the parts inherited from saemix.</pre> + <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">#' @examples</pre> + <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">#' # Generate five datasets following DFOP-SFO kinetics</pre> + <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">#' sampling_times = c(0, 1, 3, 7, 14, 28, 60, 90, 120)</pre> + <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">#' dfop_sfo <- mkinmod(parent = mkinsub("DFOP", "m1"),</pre> + <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">#' m1 = mkinsub("SFO"), quiet = TRUE)</pre> + <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">#' set.seed(1234)</pre> + <pre class="language-r">#' parplot(f_saem_full_multi, lpos = "topleft", las = 2)</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> + <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">#' k2_in <- rlnorm(5, log(0.02), 0.3)</pre> + <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">#' g_in <- plogis(rnorm(5, qlogis(0.5), 0.3))</pre> + <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">#' f_parent_to_m1_in <- plogis(rnorm(5, qlogis(0.3), 0.3))</pre> + <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">#' k_m1_in <- rlnorm(5, log(0.02), 0.3)</pre> + <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">#'</pre> + <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">#' pred_dfop_sfo <- function(k1, k2, g, f_parent_to_m1, k_m1) {</pre> + <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">#' mkinpredict(dfop_sfo,</pre> + <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">#' c(k1 = k1, k2 = k2, g = g, f_parent_to_m1 = f_parent_to_m1, k_m1 = k_m1),</pre> + <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">#' c(parent = 100, m1 = 0),</pre> + <pre class="language-r">#' parplot(f_saem_reduced_multi, lpos = "topright", ylim = c(0.5, 2), las = 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">#' sampling_times)</pre> + <pre class="language-r">#' stopCluster(cl)</pre> </td> </tr> <tr class="never"> @@ -63171,308 +63264,308 @@ table.table-condensed { <td class="num">56</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#'</pre> + <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">#' ds_mean_dfop_sfo <- lapply(1:5, function(i) {</pre> + <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">#' mkinpredict(dfop_sfo,</pre> + <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">#' c(k1 = k1_in[i], k2 = k2_in[i], g = g_in[i],</pre> + <pre class="language-r">{</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">60</td> - <td class="coverage"></td> + <td class="coverage">200<em>x</em></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> + <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">#' c(parent = 100, m1 = 0),</pre> + <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">#' sampling_times)</pre> + <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> + <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">#' names(ds_mean_dfop_sfo) <- paste("ds", 1:5)</pre> + <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">#'</pre> + <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">#' ds_syn_dfop_sfo <- lapply(ds_mean_dfop_sfo, function(ds) {</pre> + <pre class="language-r"> cluster = NULL, ...) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">67</td> - <td class="coverage"></td> + <td class="coverage">200<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' add_err(ds,</pre> + <pre class="language-r"> call <- match.call()</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">68</td> - <td class="coverage"></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> + <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">#' n = 1)[[1]]</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">70</td> - <td class="coverage"></td> + <td class="coverage">200<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' })</pre> + <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> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">72</td> - <td class="coverage"></td> + <td class="coverage">200<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' \dontrun{</pre> + <pre class="language-r"> mmkin_parms <- parms(mmkin_object, errparms = FALSE,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">73</td> - <td class="coverage"></td> + <td class="coverage">200<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' # Evaluate using mmkin and saem</pre> + <pre class="language-r"> transformed = object$transformations == "mkin")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">74</td> - <td class="coverage"></td> + <td class="coverage">200<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' f_mmkin_dfop_sfo <- mmkin(list(dfop_sfo), ds_syn_dfop_sfo,</pre> + <pre class="language-r"> start_parms <- apply(</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">75</td> - <td class="coverage"></td> + <td class="coverage">200<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' quiet = TRUE, error_model = "tc", cores = 5)</pre> + <pre class="language-r"> mmkin_parms, 1,</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">76</td> - <td class="coverage"></td> + <td class="coverage">200<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' f_saem_dfop_sfo <- saem(f_mmkin_dfop_sfo)</pre> + <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">#' print(f_saem_dfop_sfo)</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">78</td> - <td class="coverage"></td> + <td class="coverage">200<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' illparms(f_saem_dfop_sfo)</pre> + <pre class="language-r"> saem_call <- object$call</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">79</td> - <td class="coverage"></td> + <td class="coverage">200<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' f_saem_dfop_sfo_2 <- update(f_saem_dfop_sfo,</pre> + <pre class="language-r"> saem_call[[1]] <- saem</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">80</td> - <td class="coverage"></td> + <td class="coverage">200<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' no_random_effect = c("parent_0", "log_k_m1"))</pre> + <pre class="language-r"> saem_call[[2]] <- mmkin_object</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">81</td> - <td class="coverage"></td> + <td class="coverage">200<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' illparms(f_saem_dfop_sfo_2)</pre> + <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">#' intervals(f_saem_dfop_sfo_2)</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">83</td> - <td class="coverage"></td> + <td class="coverage">200<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' summary(f_saem_dfop_sfo_2, data = TRUE)</pre> + <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">#' # Add a correlation between random effects of g and k2</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">85</td> - <td class="coverage"></td> + <td class="coverage">16<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' cov_model_3 <- f_saem_dfop_sfo_2$so@model@covariance.model</pre> + <pre class="language-r"> new_startparms <- str2lang(</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">86</td> - <td class="coverage"></td> + <td class="coverage">16<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' cov_model_3["log_k2", "g_qlogis"] <- 1</pre> + <pre class="language-r"> paste0(capture.output(dput(start_parms[x, ])),</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">87</td> - <td class="coverage"></td> + <td class="coverage">16<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' cov_model_3["g_qlogis", "log_k2"] <- 1</pre> + <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">#' f_saem_dfop_sfo_3 <- update(f_saem_dfop_sfo,</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">89</td> - <td class="coverage"></td> + <td class="coverage">16<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' covariance.model = cov_model_3)</pre> + <pre class="language-r"> if (length(i_startparms) == 0) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">90</td> - <td class="coverage"></td> + <td class="coverage">16<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' intervals(f_saem_dfop_sfo_3)</pre> + <pre class="language-r"> saem_call <- c(as.list(saem_call), degparms_start = new_startparms)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">91</td> - <td class="coverage"></td> + <td class="coverage">16<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' # The correlation does not improve the fit judged by AIC and BIC, although</pre> + <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">#' # the likelihood is higher with the additional parameter</pre> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">93</td> - <td class="coverage"></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> + <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> + <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> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">96</td> - <td class="coverage"></td> + <td class="coverage">16<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">#' @export</pre> + <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">summary.saem.mmkin <- function(object, data = FALSE, verbose = FALSE,</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">98</td> - <td class="coverage"></td> + <td class="coverage">16<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> covariates = NULL, covariate_quantile = 0.5,</pre> + <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"> distimes = TRUE, ...) {</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="never"> @@ -63484,590 +63577,590 @@ table.table-condensed { </tr> <tr class="covered"> <td class="num">101</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage">200<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> mod_vars <- names(object$mkinmod$diffs)</pre> + <pre class="language-r"> if (is.null(cluster)) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">102</td> - <td class="coverage"></td> + <td class="coverage">200<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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">800<em>x</em></td> + <td class="coverage">200<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> pnames <- names(object$mean_dp_start)</pre> + <pre class="language-r"> mc.cores = cores, mc.preschedule = FALSE)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">104</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> names_fixed_effects <- object$so@results@name.fixed</pre> + <pre class="language-r"> } else {</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">105</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> n_fixed <- length(names_fixed_effects)</pre> + <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> + <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="coverage">184<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> conf.int <- object$so@results@conf.int</pre> + <pre class="language-r"> attr(res, "orig") <- object</pre> </td> </tr> <tr class="covered"> <td class="num">108</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage">184<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> rownames(conf.int) <- conf.int$name</pre> + <pre class="language-r"> attr(res, "start_parms") <- start_parms</pre> </td> </tr> <tr class="covered"> <td class="num">109</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage">184<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> confint_trans <- as.matrix(parms(object, ci = TRUE))</pre> + <pre class="language-r"> attr(res, "call") <- call</pre> </td> </tr> <tr class="covered"> <td class="num">110</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage">184<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> colnames(confint_trans)[1] <- "est."</pre> + <pre class="language-r"> class(res) <- c("multistart.saem.mmkin", "multistart")</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">111</td> - <td class="coverage"></td> + <td class="coverage">184<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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"> # In case objects were produced by earlier versions of saem</pre> + <pre class="language-r">}</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">113</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (is.null(object$transformations)) object$transformations <- "mkin"</pre> + <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> + <pre class="language-r">#' @export</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">115</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (object$transformations == "mkin") {</pre> + <pre class="language-r">status.multistart <- function(object, ...) {</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">116</td> - <td class="coverage">396<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> bp <- backtransform_odeparms(confint_trans[pnames, "est."], object$mkinmod,</pre> + <pre class="language-r"> all_summary_warnings <- character()</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">117</td> - <td class="coverage">396<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$transform_rates, object$transform_fractions)</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">118</td> - <td class="coverage">396<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> bpnames <- names(bp)</pre> + <pre class="language-r"> result <- lapply(object,</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">119</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> function(fit) {</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">120</td> - <td class="coverage"></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> + <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"> # with the exception of sets of formation fractions (single fractions are OK).</pre> + <pre class="language-r"> else {</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">122</td> - <td class="coverage">396<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> f_names_skip <- character(0)</pre> + <pre class="language-r"> return("OK")</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">123</td> - <td class="coverage">396<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> for (box in mod_vars) { # Figure out sets of fractions to skip</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">124</td> - <td class="coverage">492<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> f_names <- grep(paste("^f", box, sep = "_"), pnames, value = TRUE)</pre> + <pre class="language-r"> })</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">125</td> - <td class="coverage">492<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> n_paths <- length(f_names)</pre> + <pre class="language-r"> result <- unlist(result)</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">126</td> - <td class="coverage">!</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> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">127</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> class(result) <- "status.multistart"</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">128</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> return(result)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">129</td> - <td class="coverage">396<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> confint_back <- matrix(NA, nrow = length(bp), ncol = 3,</pre> + <pre class="language-r">}</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">130</td> - <td class="coverage">396<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> dimnames = list(bpnames, colnames(confint_trans)))</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">131</td> - <td class="coverage">396<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> confint_back[, "est."] <- bp</pre> + <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"></pre> + <pre class="language-r">status.multistart.saem.mmkin <- function(object, ...) {</pre> </td> </tr> <tr class="covered"> <td class="num">133</td> - <td class="coverage">396<em>x</em></td> + <td class="coverage">88<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> for (pname in pnames) {</pre> + <pre class="language-r"> all_summary_warnings <- character()</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">134</td> - <td class="coverage">1291<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (!pname %in% f_names_skip) {</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">135</td> - <td class="coverage">1291<em>x</em></td> + <td class="coverage">88<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> par.lower <- confint_trans[pname, "lower"]</pre> + <pre class="language-r"> result <- lapply(object,</pre> </td> </tr> <tr class="covered"> <td class="num">136</td> - <td class="coverage">1291<em>x</em></td> + <td class="coverage">88<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> par.upper <- confint_trans[pname, "upper"]</pre> + <pre class="language-r"> function(fit) {</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">137</td> - <td class="coverage">1291<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> names(par.lower) <- names(par.upper) <- pname</pre> + <pre class="language-r"> if (inherits(fit$so, "try-error")) return("E")</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">138</td> - <td class="coverage">1291<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> bpl <- backtransform_odeparms(par.lower, object$mkinmod,</pre> + <pre class="language-r"> else {</pre> </td> </tr> <tr class="covered"> <td class="num">139</td> - <td class="coverage">1291<em>x</em></td> + <td class="coverage">704<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> object$transform_rates,</pre> + <pre class="language-r"> return("OK")</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">140</td> - <td class="coverage">1291<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$transform_fractions)</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">141</td> - <td class="coverage">1291<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> bpu <- backtransform_odeparms(par.upper, object$mkinmod,</pre> + <pre class="language-r"> })</pre> </td> </tr> <tr class="covered"> <td class="num">142</td> - <td class="coverage">1291<em>x</em></td> + <td class="coverage">88<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> object$transform_rates,</pre> + <pre class="language-r"> result <- unlist(result)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">143</td> - <td class="coverage">1291<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$transform_fractions)</pre> + <pre class="language-r"></pre> </td> </tr> <tr class="covered"> <td class="num">144</td> - <td class="coverage">1291<em>x</em></td> + <td class="coverage">88<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> confint_back[names(bpl), "lower"] <- bpl</pre> + <pre class="language-r"> class(result) <- "status.multistart"</pre> </td> </tr> <tr class="covered"> <td class="num">145</td> - <td class="coverage">1291<em>x</em></td> + <td class="coverage">88<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> confint_back[names(bpu), "upper"] <- bpu</pre> + <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> + <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> + <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> + <pre class="language-r">#' @export</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">149</td> - <td class="coverage">404<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> confint_back <- confint_trans[names_fixed_effects, ]</pre> + <pre class="language-r">print.status.multistart <- function(x, ...) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">150</td> - <td class="coverage"></td> + <td class="coverage">88<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r"> class(x) <- NULL</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">151</td> - <td class="coverage"></td> + <td class="coverage">88<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> print(table(x, dnn = NULL))</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">152</td> - <td class="coverage"></td> + <td class="coverage">88<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> # Correlation of fixed effects (inspired by summary.nlme)</pre> + <pre class="language-r"> if (any(x == "OK")) cat("OK: Fit terminated successfully\n")</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">153</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> cov_so <- try(solve(object$so@results@fim), silent = TRUE)</pre> + <pre class="language-r"> if (any(x == "E")) cat("E: Error\n")</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">154</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (inherits(cov_so, "try-error")) {</pre> + <pre class="language-r">}</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">155</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$corFixed <- NA</pre> + <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"> } else {</pre> + <pre class="language-r">#' @rdname multistart</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">157</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> varFix <- cov_so[1:n_fixed, 1:n_fixed]</pre> + <pre class="language-r">#' @export</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">158</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> stdFix <- sqrt(diag(varFix))</pre> + <pre class="language-r">print.multistart <- function(x, ...) {</pre> </td> </tr> <tr class="covered"> <td class="num">159</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage">88<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> object$corFixed <- array(</pre> + <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">800<em>x</em></td> + <td class="coverage">88<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> t(varFix/stdFix)/stdFix,</pre> + <pre class="language-r"> print(status(x))</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">161</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> dim(varFix),</pre> + <pre class="language-r">}</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">162</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> list(names_fixed_effects, names_fixed_effects))</pre> + <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> + <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"></pre> + <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"> # Random effects</pre> + <pre class="language-r">best <- function(object, ...)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">166</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> sdnames <- intersect(rownames(conf.int), paste0("SD.", pnames))</pre> + <pre class="language-r">{</pre> </td> </tr> <tr class="covered"> <td class="num">167</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage">184<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> corrnames <- grep("^Corr.", rownames(conf.int), value = TRUE)</pre> + <pre class="language-r"> UseMethod("best", object)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">168</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> confint_ranef <- as.matrix(conf.int[c(sdnames, corrnames), c("estimate", "lower", "upper")])</pre> + <pre class="language-r">}</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">169</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> colnames(confint_ranef)[1] <- "est."</pre> + <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> + <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"> # Error model</pre> + <pre class="language-r">#' @return The object with the highest likelihood</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">172</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage"></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> + <pre class="language-r">#' @rdname multistart</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">173</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> confint_errmod <- as.matrix(conf.int[enames, c("estimate", "lower", "upper")])</pre> + <pre class="language-r">best.default <- function(object, ...)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">174</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> colnames(confint_errmod)[1] <- "est."</pre> + <pre class="language-r">{</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">175</td> - <td class="coverage"></td> + <td class="coverage">184<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> return(object[[which.best(object)]])</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">176</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$confint_trans <- confint_trans</pre> + <pre class="language-r">}</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">177</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$confint_ranef <- confint_ranef</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">178</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$confint_errmod <- confint_errmod</pre> + <pre class="language-r">#' @return The index of the object with the highest likelihood</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">179</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$confint_back <- confint_back</pre> + <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"></pre> + <pre class="language-r">#' @export</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">181</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$date.summary = date()</pre> + <pre class="language-r">which.best <- function(object, ...)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">182</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$use_of_ff = object$mkinmod$use_of_ff</pre> + <pre class="language-r">{</pre> </td> </tr> <tr class="covered"> <td class="num">183</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage">360<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> + <pre class="language-r"> UseMethod("which.best", object)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">184</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> err_mod = object$mmkin_orig[[1]]$err_mod</pre> + <pre class="language-r">}</pre> </td> </tr> <tr class="never"> @@ -64077,1139 +64170,1171 @@ table.table-condensed { <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">186</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$diffs <- object$mkinmod$diffs</pre> + <pre class="language-r">#' @rdname multistart</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">187</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$print_data <- data # boolean: Should we print the data?</pre> + <pre class="language-r">#' @export</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">188</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> so_pred <- object$so@results@predictions</pre> + <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> + <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="coverage">360<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> names(object$data)[4] <- "observed" # rename value to observed</pre> + <pre class="language-r"> llfunc <- function(object) {</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">191</td> - <td class="coverage"></td> + <td class="coverage">2528<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> ret <- try(logLik(object))</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">192</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> object$verbose <- verbose</pre> + <pre class="language-r"> if (inherits(ret, "try-error")) return(NA)</pre> </td> </tr> - <tr class="never"> + <tr class="covered"> <td class="num">193</td> - <td class="coverage"></td> + <td class="coverage">2528<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> else return(ret)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">194</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$fixed <- object$mmkin_orig[[1]]$fixed</pre> + <pre class="language-r"> }</pre> </td> </tr> <tr class="covered"> <td class="num">195</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage">360<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> ll <-try(logLik(object$so, method = "is"), silent = TRUE)</pre> + <pre class="language-r"> ll <- sapply(object, llfunc)</pre> </td> </tr> <tr class="covered"> <td class="num">196</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage">360<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (inherits(ll, "try-error")) {</pre> + <pre class="language-r"> return(which.max(ll))</pre> </td> </tr> - <tr class="missed"> + <tr class="never"> <td class="num">197</td> - <td class="coverage">!</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$logLik <- object$AIC <- object $BIC <- NA</pre> + <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"> } else {</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">199</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$logLik = logLik(object$so, method = "is")</pre> + <pre class="language-r">#' @export</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">200</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> object$AIC = AIC(object$so)</pre> + <pre class="language-r">update.multistart <- function(object, ..., evaluate = TRUE) {</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">201</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> object$BIC = BIC(object$so)</pre> + <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"> }</pre> + <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"></pre> + <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="covered"> + <tr class="never"> <td class="num">204</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> ep <- endpoints(object)</pre> + <pre class="language-r"> # multistart.saem.mmkin</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">205</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> object$covariates <- ep$covariates</pre> + <pre class="language-r"> call[[1]] <- multistart</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">206</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (length(ep$ff) != 0)</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">207</td> - <td class="coverage">330<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> object$ff <- ep$ff</pre> + <pre class="language-r"> update_arguments <- match.call(expand.dots = FALSE)$...</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">208</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (distimes) object$distimes <- ep$distimes</pre> + <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(ep$SFORB) != 0) object$SFORB <- ep$SFORB</pre> + <pre class="language-r"> if (length(update_arguments) > 0) {</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">210</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> class(object) <- c("summary.saem.mmkin")</pre> + <pre class="language-r"> update_arguments_in_call <- !is.na(match(names(update_arguments), names(call)))</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">211</td> - <td class="coverage">800<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> return(object)</pre> + <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> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">213</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> for (a in names(update_arguments)[update_arguments_in_call]) {</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">214</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r">#' @rdname summary.saem.mmkin</pre> + <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">#' @export</pre> + <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">print.summary.saem.mmkin <- function(x, digits = max(3, getOption("digits") - 3), verbose = x$verbose, ...) {</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">217</td> - <td class="coverage">242<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> cat("saemix version used for fitting: ", x$saemixversion, "\n")</pre> + <pre class="language-r"> update_arguments_not_in_call <- !update_arguments_in_call</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">218</td> - <td class="coverage">242<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> cat("mkin version used for pre-fitting: ", x$mkinversion, "\n")</pre> + <pre class="language-r"> if(any(update_arguments_not_in_call)) {</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">219</td> - <td class="coverage">242<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> cat("R version used for fitting: ", x$Rversion, "\n")</pre> + <pre class="language-r"> call <- c(as.list(call), update_arguments[update_arguments_not_in_call])</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">220</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> call <- as.call(call)</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">221</td> - <td class="coverage">242<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("Date of fit: ", x$date.fit, "\n")</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="covered"> + <tr class="missed"> <td class="num">222</td> - <td class="coverage">242<em>x</em></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"> cat("Date of summary:", x$date.summary, "\n")</pre> + <pre class="language-r"> if(evaluate) eval(call, parent.frame())</pre> </td> </tr> - <tr class="never"> + <tr class="missed"> <td class="num">223</td> - <td class="coverage"></td> + <td class="coverage">!</td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r"> else call</pre> </td> </tr> - <tr class="covered"> + <tr class="never"> <td class="num">224</td> - <td class="coverage">242<em>x</em></td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nEquations:\n")</pre> + <pre class="language-r">}</pre> </td> </tr> - <tr class="covered"> - <td class="num">225</td> - <td class="coverage">242<em>x</em></td> + </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"> nice_diffs <- gsub("^(d.*) =", "\\1/dt =", x[["diffs"]])</pre> + <pre class="language-r">#' Extract residuals from an mkinfit model</pre> </td> </tr> - <tr class="covered"> - <td class="num">226</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> writeLines(strwrap(nice_diffs, exdent = 11))</pre> + <pre class="language-r">#'</pre> </td> </tr> <tr class="never"> - <td class="num">227</td> + <td class="num">3</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' @param object A \code{\link{mkinfit}} object</pre> </td> </tr> - <tr class="covered"> - <td class="num">228</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nData:\n")</pre> + <pre class="language-r">#' @param standardized Should the residuals be standardized by dividing by the</pre> </td> </tr> - <tr class="covered"> - <td class="num">229</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat(nrow(x$data), "observations of",</pre> + <pre class="language-r">#' standard deviation obtained from the fitted error model?</pre> </td> </tr> - <tr class="covered"> - <td class="num">230</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> length(unique(x$data$name)), "variable(s) grouped in",</pre> + <pre class="language-r">#' @param \dots Not used</pre> </td> </tr> - <tr class="covered"> - <td class="num">231</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> length(unique(x$data$ds)), "datasets\n")</pre> + <pre class="language-r">#' @export</pre> </td> </tr> <tr class="never"> - <td class="num">232</td> + <td class="num">8</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' @examples</pre> </td> </tr> - <tr class="covered"> - <td class="num">233</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nModel predictions using solution type", x$solution_type, "\n")</pre> + <pre class="language-r">#' f <- mkinfit("DFOP", FOCUS_2006_C, quiet = TRUE)</pre> </td> </tr> <tr class="never"> - <td class="num">234</td> + <td class="num">10</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' residuals(f)</pre> </td> </tr> - <tr class="covered"> - <td class="num">235</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nFitted in", x$time[["elapsed"]], "s\n")</pre> + <pre class="language-r">#' residuals(f, standardized = TRUE)</pre> </td> </tr> - <tr class="covered"> - <td class="num">236</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("Using", paste(x$so@options$nbiter.saemix, collapse = ", "),</pre> + <pre class="language-r">residuals.mkinfit <- function(object, standardized = FALSE, ...) {</pre> </td> </tr> <tr class="covered"> - <td class="num">237</td> - <td class="coverage">242<em>x</em></td> + <td class="num">13</td> + <td class="coverage">2493<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> "iterations and", x$so@options$nb.chains, "chains\n")</pre> + <pre class="language-r"> res <- object$data[["residual"]]</pre> </td> </tr> - <tr class="never"> - <td class="num">238</td> - <td class="coverage"></td> + <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"></pre> + <pre class="language-r"> if (standardized) {</pre> </td> </tr> <tr class="covered"> - <td class="num">239</td> - <td class="coverage">242<em>x</em></td> + <td class="num">15</td> + <td class="coverage">2428<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nVariance model: ")</pre> + <pre class="language-r"> if (object$err_mod == "const") {</pre> </td> </tr> <tr class="covered"> - <td class="num">240</td> - <td class="coverage">242<em>x</em></td> + <td class="num">16</td> + <td class="coverage">543<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cat(switch(x$err_mod,</pre> + <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">241</td> - <td class="coverage">242<em>x</em></td> + <td class="num">18</td> + <td class="coverage">2428<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> const = "Constant variance",</pre> + <pre class="language-r"> if (object$err_mod == "obs") {</pre> </td> </tr> <tr class="covered"> - <td class="num">242</td> - <td class="coverage">242<em>x</em></td> + <td class="num">19</td> + <td class="coverage">65<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> obs = "Variance unique to each observed variable",</pre> + <pre class="language-r"> sigma_names = paste0("sigma_", object$data[["variable"]])</pre> </td> </tr> <tr class="covered"> - <td class="num">243</td> - <td class="coverage">242<em>x</em></td> + <td class="num">20</td> + <td class="coverage">65<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> tc = "Two-component variance function"), "\n")</pre> + <pre class="language-r"> sigma_fitted <- object$errparms[sigma_names]</pre> </td> </tr> <tr class="never"> - <td class="num">244</td> + <td class="num">21</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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="num">22</td> + <td class="coverage">2428<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nStarting values for degradation parameters:\n")</pre> + <pre class="language-r"> if (object$err_mod == "tc") {</pre> </td> </tr> <tr class="covered"> - <td class="num">246</td> - <td class="coverage">242<em>x</em></td> + <td class="num">23</td> + <td class="coverage">1820<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> print(x$mean_dp_start, digits = digits)</pre> + <pre class="language-r"> sigma_fitted <- sigma_twocomp(object$data[["predicted"]],</pre> </td> </tr> - <tr class="never"> - <td class="num">247</td> - <td class="coverage"></td> + <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"></pre> + <pre class="language-r"> sigma_low = object$errparms[1],</pre> </td> </tr> <tr class="covered"> - <td class="num">248</td> - <td class="coverage">242<em>x</em></td> + <td class="num">25</td> + <td class="coverage">1820<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nFixed degradation parameter values:\n")</pre> + <pre class="language-r"> rsd_high = object$errparms[2])</pre> </td> </tr> - <tr class="covered"> - <td class="num">249</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">26</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if(length(x$fixed$value) == 0) cat("None\n")</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="missed"> - <td class="num">250</td> - <td class="coverage">!</td> + <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"> else print(x$fixed, digits = digits)</pre> + <pre class="language-r"> return(res / sigma_fitted)</pre> </td> </tr> <tr class="never"> - <td class="num">251</td> + <td class="num">28</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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="num">29</td> + <td class="coverage">65<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> + <pre class="language-r"> return(res)</pre> </td> </tr> - <tr class="covered"> - <td class="num">253</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">30</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> print(sqrt(x$so@model@omega.init), digits = digits)</pre> + <pre class="language-r">}</pre> </td> </tr> <tr class="never"> - <td class="num">254</td> + <td class="num">31</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> + </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"> cat("\nStarting values for error model parameters:\n")</pre> + <pre class="language-r">#' Number of observations on which an mkinfit object was fitted</pre> </td> </tr> - <tr class="covered"> - <td class="num">256</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> errparms <- x$so@model@error.init</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> - <td class="num">257</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> names(errparms) <- x$so@model@name.sigma</pre> + <pre class="language-r">#' @importFrom stats nobs</pre> </td> </tr> - <tr class="covered"> - <td class="num">258</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> errparms <- errparms[x$so@model@indx.res]</pre> + <pre class="language-r">#' @param object An mkinfit object</pre> </td> </tr> - <tr class="covered"> - <td class="num">259</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> print(errparms, digits = digits)</pre> + <pre class="language-r">#' @param \dots For compatibility with the generic method</pre> </td> </tr> <tr class="never"> - <td class="num">260</td> + <td class="num">6</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' @return The number of rows in the data included in the mkinfit object</pre> </td> </tr> - <tr class="covered"> - <td class="num">261</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nResults:\n\n")</pre> + <pre class="language-r">#' @export</pre> </td> </tr> <tr class="covered"> - <td class="num">262</td> - <td class="coverage">242<em>x</em></td> + <td class="num">8</td> + <td class="coverage">166810<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cat("Likelihood computed by importance sampling\n")</pre> + <pre class="language-r">nobs.mkinfit <- function(object, ...) nrow(object$data)</pre> </td> </tr> - <tr class="covered"> - <td class="num">263</td> - <td class="coverage">242<em>x</em></td> + </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"> print(data.frame(AIC = x$AIC, BIC = x$BIC, logLik = x$logLik,</pre> + <pre class="language-r">#' Convert a dataframe from long to wide format</pre> </td> </tr> - <tr class="covered"> - <td class="num">264</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> row.names = " "), digits = digits)</pre> + <pre class="language-r">#' </pre> </td> </tr> <tr class="never"> - <td class="num">265</td> + <td class="num">3</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <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="covered"> - <td class="num">266</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">4</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nOptimised parameters:\n")</pre> + <pre class="language-r">#' observed value, and converts it into a dataframe with one independent</pre> </td> </tr> - <tr class="covered"> - <td class="num">267</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">5</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> print(x$confint_trans, digits = digits)</pre> + <pre class="language-r">#' variable and several dependent variables as columns.</pre> </td> </tr> <tr class="never"> - <td class="num">268</td> + <td class="num">6</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' </pre> </td> </tr> - <tr class="covered"> - <td class="num">269</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (identical(x$corFixed, NA)) {</pre> + <pre class="language-r">#' @param long_data The dataframe must contain one variable called "time" with</pre> </td> </tr> - <tr class="missed"> - <td class="num">270</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nCorrelation is not available\n")</pre> + <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">271</td> + <td class="num">9</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> } else {</pre> + <pre class="language-r">#' "name" with the grouping of the observed values, and finally one column of</pre> </td> </tr> - <tr class="covered"> - <td class="num">272</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">10</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> corr <- x$corFixed</pre> + <pre class="language-r">#' observed values called "value".</pre> </td> </tr> - <tr class="covered"> - <td class="num">273</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">11</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> class(corr) <- "correlation"</pre> + <pre class="language-r">#' @param time The name of the time variable in the long input data.</pre> </td> </tr> - <tr class="covered"> - <td class="num">274</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> print(corr, title = "\nCorrelation:", rdig = digits, ...)</pre> + <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">275</td> + <td class="num">13</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">#' @return Dataframe in wide format.</pre> </td> </tr> <tr class="never"> - <td class="num">276</td> + <td class="num">14</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' @author Johannes Ranke</pre> </td> </tr> - <tr class="covered"> - <td class="num">277</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nRandom effects:\n")</pre> + <pre class="language-r">#' @examples</pre> </td> </tr> - <tr class="covered"> - <td class="num">278</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">16</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> print(x$confint_ranef, digits = digits)</pre> + <pre class="language-r">#' </pre> </td> </tr> <tr class="never"> - <td class="num">279</td> + <td class="num">17</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' mkin_long_to_wide(FOCUS_2006_D)</pre> </td> </tr> - <tr class="covered"> - <td class="num">280</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nVariance model:\n")</pre> + <pre class="language-r">#' </pre> </td> </tr> - <tr class="covered"> - <td class="num">281</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> print(x$confint_errmod, digits = digits)</pre> + <pre class="language-r">#' @export mkin_long_to_wide</pre> </td> </tr> <tr class="never"> - <td class="num">282</td> + <td class="num">20</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">mkin_long_to_wide <- function(long_data, time = "time", outtime = "time")</pre> </td> </tr> - <tr class="covered"> - <td class="num">283</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">21</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (x$transformations == "mkin") {</pre> + <pre class="language-r">{</pre> </td> </tr> <tr class="covered"> - <td class="num">284</td> - <td class="coverage">125<em>x</em></td> + <td class="num">22</td> + <td class="coverage">494<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nBacktransformed parameters:\n")</pre> + <pre class="language-r"> colnames <- unique(long_data$name)</pre> </td> </tr> <tr class="covered"> - <td class="num">285</td> - <td class="coverage">125<em>x</em></td> + <td class="num">23</td> + <td class="coverage">494<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> print(x$confint_back, digits = digits)</pre> + <pre class="language-r"> wide_data <- data.frame(time = subset(long_data, name == colnames[1], time))</pre> </td> </tr> - <tr class="never"> - <td class="num">286</td> - <td class="coverage"></td> + <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"> }</pre> + <pre class="language-r"> names(wide_data) <- outtime</pre> </td> </tr> - <tr class="never"> - <td class="num">287</td> - <td class="coverage"></td> + <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"></pre> + <pre class="language-r"> for (var in colnames) {</pre> </td> </tr> <tr class="covered"> - <td class="num">288</td> - <td class="coverage">242<em>x</em></td> + <td class="num">26</td> + <td class="coverage">741<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> if (!is.null(x$covariates)) {</pre> + <pre class="language-r"> wide_data[var] <- subset(long_data, name == var, value)</pre> </td> </tr> - <tr class="missed"> - <td class="num">289</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">27</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nCovariates used for endpoints below:\n")</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="missed"> - <td class="num">290</td> - <td class="coverage">!</td> + <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"> print(x$covariates)</pre> + <pre class="language-r"> return(wide_data)</pre> </td> </tr> <tr class="never"> - <td class="num">291</td> + <td class="num">29</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <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">292</td> + <td class="num">1</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> + <pre class="language-r">#' Summary method for class "mmkin"</pre> </td> </tr> - <tr class="missed"> - <td class="num">295</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">2</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nEstimated Eigenvalues of SFORB model(s):\n")</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="missed"> - <td class="num">296</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">3</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> print(x$SFORB, digits = digits,...)</pre> + <pre class="language-r">#' Shows status information on the [mkinfit] objects contained in the object</pre> </td> </tr> <tr class="never"> - <td class="num">297</td> + <td class="num">4</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">#' and gives an overview of ill-defined parameters calculated by [illparms].</pre> </td> </tr> <tr class="never"> - <td class="num">298</td> + <td class="num">5</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> - <td class="num">299</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">6</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> printff <- !is.null(x$ff)</pre> + <pre class="language-r">#' @param object an object of class [mmkin]</pre> </td> </tr> - <tr class="covered"> - <td class="num">300</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">7</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if(printff){</pre> + <pre class="language-r">#' @param x an object of class \code{summary.mmkin}.</pre> </td> </tr> - <tr class="covered"> - <td class="num">301</td> - <td class="coverage">117<em>x</em></td> + <tr class="never"> + <td class="num">8</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nResulting formation fractions:\n")</pre> + <pre class="language-r">#' @param conf.level confidence level for testing parameters</pre> </td> </tr> - <tr class="covered"> - <td class="num">302</td> - <td class="coverage">117<em>x</em></td> + <tr class="never"> + <td class="num">9</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> print(data.frame(ff = x$ff), digits = digits,...)</pre> + <pre class="language-r">#' @param digits number of digits to use for printing</pre> </td> </tr> <tr class="never"> - <td class="num">303</td> + <td class="num">10</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">#' @param \dots optional arguments passed to methods like \code{print}.</pre> </td> </tr> <tr class="never"> - <td class="num">304</td> + <td class="num">11</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' @examples</pre> </td> </tr> - <tr class="covered"> - <td class="num">305</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">12</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> printdistimes <- !is.null(x$distimes)</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="covered"> - <td class="num">306</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">13</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if(printdistimes){</pre> + <pre class="language-r">#' fits <- mmkin(</pre> </td> </tr> - <tr class="covered"> - <td class="num">307</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">14</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nEstimated disappearance times:\n")</pre> + <pre class="language-r">#' c("SFO", "FOMC"),</pre> </td> </tr> - <tr class="covered"> - <td class="num">308</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">15</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> print(x$distimes, digits = digits,...)</pre> + <pre class="language-r">#' list("FOCUS A" = FOCUS_2006_A,</pre> </td> </tr> <tr class="never"> - <td class="num">309</td> + <td class="num">16</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">#' "FOCUS C" = FOCUS_2006_C),</pre> </td> </tr> <tr class="never"> - <td class="num">310</td> + <td class="num">17</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"></pre> + <pre class="language-r">#' quiet = TRUE, cores = 1)</pre> </td> </tr> - <tr class="covered"> - <td class="num">311</td> - <td class="coverage">242<em>x</em></td> + <tr class="never"> + <td class="num">18</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> if (x$print_data){</pre> + <pre class="language-r">#' summary(fits)</pre> </td> </tr> - <tr class="missed"> - <td class="num">312</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">19</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> cat("\nData:\n")</pre> + <pre class="language-r">#'</pre> </td> </tr> - <tr class="missed"> - <td class="num">313</td> - <td class="coverage">!</td> + <tr class="never"> + <td class="num">20</td> + <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> print(format(x$data, digits = digits, ...), row.names = FALSE)</pre> + <pre class="language-r">#' @export</pre> </td> </tr> <tr class="never"> - <td class="num">314</td> + <td class="num">21</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r"> }</pre> + <pre class="language-r">summary.mmkin <- function(object, conf.level = 0.95, ...) {</pre> </td> </tr> <tr class="never"> - <td class="num">315</td> + <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">316</td> - <td class="coverage">242<em>x</em></td> + <td class="num">23</td> + <td class="coverage">1<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> invisible(x)</pre> + <pre class="language-r"> ans <- list(</pre> </td> </tr> - <tr class="never"> - <td class="num">317</td> - <td class="coverage"></td> + <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">}</pre> + <pre class="language-r"> err_mod = object[[1, 1]]$err_mod,</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> + <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">#' Convert a dataframe from long to wide format</pre> + <pre class="language-r"> time = attr(object, "time"),</pre> </td> </tr> - <tr class="never"> - <td class="num">2</td> - <td class="coverage"></td> + <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">#' </pre> + <pre class="language-r"> illparms = illparms(object),</pre> </td> </tr> - <tr class="never"> - <td class="num">3</td> - <td class="coverage"></td> + <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">#' This function takes a dataframe in the long form, i.e. with a row for each</pre> + <pre class="language-r"> status = status(object)</pre> </td> </tr> <tr class="never"> - <td class="num">4</td> + <td class="num">28</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> + <pre class="language-r"> )</pre> </td> </tr> <tr class="never"> - <td class="num">5</td> + <td class="num">29</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' variable and several dependent variables as columns.</pre> + <pre class="language-r"></pre> </td> </tr> - <tr class="never"> - <td class="num">6</td> - <td class="coverage"></td> + <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">#' </pre> + <pre class="language-r"> class(ans) <- c("summary.mmkin")</pre> </td> </tr> - <tr class="never"> - <td class="num">7</td> - <td class="coverage"></td> + <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">#' @param long_data The dataframe must contain one variable called "time" with</pre> + <pre class="language-r"> return(ans)</pre> </td> </tr> <tr class="never"> - <td class="num">8</td> + <td class="num">32</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> + <pre class="language-r">}</pre> </td> </tr> <tr class="never"> - <td class="num">9</td> + <td class="num">33</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> + <pre class="language-r"></pre> </td> </tr> <tr class="never"> - <td class="num">10</td> + <td class="num">34</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' observed values called "value".</pre> + <pre class="language-r">#' @rdname summary.mmkin</pre> </td> </tr> <tr class="never"> - <td class="num">11</td> + <td class="num">35</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> + <pre class="language-r">#' @export</pre> </td> </tr> <tr class="never"> - <td class="num">12</td> + <td class="num">36</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> + <pre class="language-r">print.summary.mmkin <- function(x, digits = max(3, getOption("digits") - 3), ...) {</pre> </td> </tr> - <tr class="never"> - <td class="num">13</td> - <td class="coverage"></td> + <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">#' @return Dataframe in wide format.</pre> + <pre class="language-r"> if (!is.null(x$err_mod)) {</pre> </td> </tr> - <tr class="never"> - <td class="num">14</td> - <td class="coverage"></td> + <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">#' @author Johannes Ranke</pre> + <pre class="language-r"> cat("Error model: ")</pre> </td> </tr> - <tr class="never"> - <td class="num">15</td> - <td class="coverage"></td> + <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">#' @examples</pre> + <pre class="language-r"> cat(switch(x$err_mod,</pre> </td> </tr> - <tr class="never"> - <td class="num">16</td> - <td class="coverage"></td> + <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">#' </pre> + <pre class="language-r"> const = "Constant variance",</pre> </td> </tr> - <tr class="never"> - <td class="num">17</td> - <td class="coverage"></td> + <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">#' mkin_long_to_wide(FOCUS_2006_D)</pre> + <pre class="language-r"> obs = "Variance unique to each observed variable",</pre> </td> </tr> - <tr class="never"> - <td class="num">18</td> - <td class="coverage"></td> + <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">#' </pre> + <pre class="language-r"> tc = "Two-component variance function"), "\n")</pre> </td> </tr> <tr class="never"> - <td class="num">19</td> + <td class="num">43</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">#' @export mkin_long_to_wide</pre> + <pre class="language-r"> }</pre> </td> </tr> - <tr class="never"> - <td class="num">20</td> - <td class="coverage"></td> + <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">mkin_long_to_wide <- function(long_data, time = "time", outtime = "time")</pre> + <pre class="language-r"> cat("Fitted in", x$time[["elapsed"]], "s\n")</pre> </td> </tr> <tr class="never"> - <td class="num">21</td> + <td class="num">45</td> <td class="coverage"></td> <td class="col-sm-12"> - <pre class="language-r">{</pre> + <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="num">46</td> + <td class="coverage">1<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> colnames <- unique(long_data$name)</pre> + <pre class="language-r"> cat("\nStatus:\n")</pre> </td> </tr> <tr class="covered"> - <td class="num">23</td> - <td class="coverage">494<em>x</em></td> + <td class="num">47</td> + <td class="coverage">1<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> + <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">24</td> - <td class="coverage">494<em>x</em></td> + <td class="num">49</td> + <td class="coverage">1<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> names(wide_data) <- outtime</pre> + <pre class="language-r"> if (any(x$illparms != "")) {</pre> </td> </tr> <tr class="covered"> - <td class="num">25</td> - <td class="coverage">494<em>x</em></td> + <td class="num">50</td> + <td class="coverage">1<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> for (var in colnames) {</pre> + <pre class="language-r"> cat("\nIll-defined parameters:\n")</pre> </td> </tr> <tr class="covered"> - <td class="num">26</td> - <td class="coverage">741<em>x</em></td> + <td class="num">51</td> + <td class="coverage">1<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> wide_data[var] <- subset(long_data, name == var, value)</pre> + <pre class="language-r"> print(x$illparms)</pre> </td> </tr> <tr class="never"> - <td class="num">27</td> + <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">28</td> - <td class="coverage">494<em>x</em></td> + <td class="num">54</td> + <td class="coverage">1<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r"> return(wide_data)</pre> + <pre class="language-r"> invisible(x)</pre> </td> </tr> <tr class="never"> - <td class="num">29</td> + <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> @@ -69274,63 +69399,126 @@ table.table-condensed { </tbody> </table> </div> - <div id="R/nobs.mkinfit.R" class="hidden"> + <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">#' Number of observations on which an mkinfit object was fitted</pre> + <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">#'</pre> + <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">#' @importFrom stats nobs</pre> + <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 object An mkinfit object</pre> + <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">#' @param \dots For compatibility with the generic method</pre> + <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">#' @return The number of rows in the data included in the mkinfit object</pre> + <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">8</td> - <td class="coverage">166810<em>x</em></td> + <td class="num">16</td> + <td class="coverage">9864<em>x</em></td> <td class="col-sm-12"> - <pre class="language-r">nobs.mkinfit <- function(object, ...) nrow(object$data)</pre> + <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> @@ -69720,131 +69908,6 @@ table.table-condensed { </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> |