1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
|
#' Create degradation functions for known analytical solutions
#'
#' @param spec List of model specifications as contained in mkinmod objects
#' @param use_of_ff Minimum or maximum use of formation fractions
#' @return Degradation function to be attached to mkinmod objects
#' @examples
#'
#' SFO_SFO <- mkinmod(
#' parent = mkinsub("SFO", "m1"),
#' m1 = mkinsub("SFO"))
#' fit <- mkinfit(SFO_SFO, FOCUS_2006_D, quiet = TRUE)
create_deg_func <- function(spec, use_of_ff = c("min", "max")) {
use_of_ff <- match.arg(use_of_ff)
min_ff <- use_of_ff == "min"
obs_vars <- names(spec)
n <- character(0)
parent <- obs_vars[1]
n[1] <- paste0(parent, " = ", spec[[1]]$type, ".solution(outtimes, odeini['", parent,
if (spec[[1]]$type == "SFORB") "_free", "'], ",
switch(spec[[1]]$type,
SFO = paste0("k_", parent, if (min_ff) "_sink" else "", ")"),
FOMC = "alpha, beta)",
IORE = paste0("k__iore_", parent, if (min_ff) "_sink" else "", ", N_", parent, ")"),
DFOP = "k1, k2, g)",
SFORB = paste0("k_", parent, "_free_bound, k_", parent, "_bound_free, k_", parent, "_free", if (min_ff) "_sink" else "", ")"),
HS = "k1, k2, tb)",
logistic = "kmax, k0, r)"
)
)
all_n <- paste(n, collapse = ",\n")
f_body <- paste0("{\n",
"out <- with(as.list(odeparms), {\n",
"data.frame(\n",
"time = outtimes,\n",
all_n, "\n",
")})\n",
"return(out)\n}\n"
)
deg_func <- function(odeini, odeparms, outtimes) {}
body(deg_func) <- parse(text = f_body)
return(deg_func)
}
|
