aboutsummaryrefslogtreecommitdiff
path: root/R/mkinmod.R
diff options
context:
space:
mode:
authorJohannes Ranke <jranke@uni-bremen.de>2020-05-07 22:13:33 +0200
committerJohannes Ranke <jranke@uni-bremen.de>2020-05-07 22:14:19 +0200
commit92bd33824bde6b6b21bfc7e30953092a74d3cce5 (patch)
treebb2e08ef15d8a4f4f7b04cf4f5312ec861ec1d1c /R/mkinmod.R
parent67c8163487e776e9a378c9dfcd39c74f6e6bc507 (diff)
Another overhaul of analytical solutions
Still in preparation for analytical solutions of coupled models
Diffstat (limited to 'R/mkinmod.R')
-rw-r--r--R/mkinmod.R43
1 files changed, 3 insertions, 40 deletions
diff --git a/R/mkinmod.R b/R/mkinmod.R
index f52baa4f..21551861 100644
--- a/R/mkinmod.R
+++ b/R/mkinmod.R
@@ -101,7 +101,7 @@
#' }
#'
#' @export mkinmod
-mkinmod <- function(..., use_of_ff = "min", speclist = NULL, quiet = FALSE, verbose = FALSE)
+mkinmod <- function(..., use_of_ff = "max", speclist = NULL, quiet = FALSE, verbose = FALSE)
{
if (is.null(speclist)) spec <- list(...)
else spec <- speclist
@@ -421,45 +421,8 @@ mkinmod <- function(..., use_of_ff = "min", speclist = NULL, quiet = FALSE, verb
}
# }}}
- # Attach a degradation function if an analytical solution is available {{{
- parent_type = spec[[1]]$type
- parent_name = names(spec)[[1]]
- if (length(spec) == 1) {
- odeparm_map <- switch(parent_type,
- SFO = c(
- k = if(use_of_ff == "min") paste("k", parent_name, "sink", sep = "_")
- else paste("k", parent_name, sep = "_")),
- FOMC = c(alpha = "alpha", beta = "beta"),
- IORE = c(
- k__iore = if(use_of_ff == "min") paste("k__iore", parent_name, "sink", sep = "_")
- else paste("k__iore", parent_name, sep = "_"),
- N = paste("N", parent_name, sep = "_")),
- DFOP = c(k1 = "k1", k2 = "k2", g = "g"),
- HS = c(k1 = "k1", k2 = "k2", tb = "tb"),
- SFORB = c(
- k_12 = paste("k", parent_name, "free_bound", sep = "_"),
- k_21 = paste("k", parent_name, "bound_free", sep = "_"),
- k_1output = paste("k", parent_name, "free_sink", sep = "_")),
- logistic = c(kmax = "kmax", k0 = "k0", r = "r")
- )
- odeparm_rev_map <- names(odeparm_map)
- names(odeparm_rev_map) <- odeparm_map
-
- model$deg_func <- function(odeini, odeparms, outtimes) {
- parent_func <- getFromNamespace(paste0(parent_type, ".solution"), "mkin")
- odeparm_list <- as.list(odeparms)
- names(odeparm_list) <- odeparm_rev_map[names(odeparm_list)]
-
- values <- do.call(parent_func,
- args = c(
- list(t = outtimes, parent_0 = odeini[1]),
- odeparm_list))
- out <- data.frame(outtimes, values)
- names(out) <- c("time", parent_name)
- return(out)
- }
- }
- # }}}
+ # Attach a degradation function if an analytical solution is available
+ model$deg_func <- create_deg_func(spec, use_of_ff)
class(model) <- "mkinmod"
return(model)

Contact - Imprint