diff options
| -rw-r--r-- | NAMESPACE | 2 | ||||
| -rw-r--r-- | NEWS.md | 2 | ||||
| -rw-r--r-- | R/mkinpredict.R | 77 | ||||
| -rw-r--r-- | man/mkinpredict.Rd | 42 | 
4 files changed, 82 insertions, 41 deletions
| @@ -7,6 +7,8 @@ S3method(summary, mkinfit)  S3method(print, summary.mkinfit)  S3method(plot, mmkin)  S3method("[", mmkin) +S3method(mkinpredict, mkinmod) +S3method(mkinpredict, mkinfit)  import(    stats, @@ -4,6 +4,8 @@  - 'max_twa_parent': Support maximum time weighted average concentration calculations for the hockey stick (HS) model +- 'mkinpredict': Make the function generic and create a method for mkinfit objects +  # mkin 0.9.47.5 (2018-09-14)  - Make the two-component error model stop in cases where it is inadequate to avoid nls crashes on windows diff --git a/R/mkinpredict.R b/R/mkinpredict.R index 994af703..8e0823a8 100644 --- a/R/mkinpredict.R +++ b/R/mkinpredict.R @@ -1,4 +1,4 @@ -# Copyright (C) 2010-2015 Johannes Ranke +# Copyright (C) 2010-2016,2018 Johannes Ranke  # Some lines in this code are copyright (C) 2013 Eurofins Regulatory AG  # Contact: jranke@uni-bremen.de @@ -17,14 +17,28 @@  # You should have received a copy of the GNU General Public License along with  # this program. If not, see <http://www.gnu.org/licenses/> -mkinpredict <- function(mkinmod, odeparms, odeini, -			outtimes, solution_type = "deSolve", -      use_compiled = "auto", -			method.ode = "lsoda", atol = 1e-8, rtol = 1e-10, -			map_output = TRUE, ...) { +mkinpredict <- function(x, odeparms, odeini, +  outtimes = seq(0, 120, by = 0.1), +  solution_type = "deSolve", +  use_compiled = "auto", +  method.ode = "lsoda", atol = 1e-8, rtol = 1e-10, +  map_output = TRUE, ...) +{ +  UseMethod("mkinpredict", x) +} + +mkinpredict.mkinmod <- function(x, +  odeparms = c(k_parent_sink = 0.1), +  odeini = c(parent = 100), +  outtimes = seq(0, 120, by = 0.1), +  solution_type = "deSolve", +  use_compiled = "auto", +  method.ode = "lsoda", atol = 1e-8, rtol = 1e-10, +  map_output = TRUE, ...) +{    # Get the names of the state variables in the model -  mod_vars <- names(mkinmod$diffs) +  mod_vars <- names(x$diffs)    # Order the inital values for state variables if they are named    if (!is.null(names(odeini))) { @@ -40,22 +54,22 @@ mkinpredict <- function(mkinmod, odeparms, odeini,    # Create a function calculating the differentials specified by the model    # if necessary    if (solution_type == "analytical") { -    parent.type = names(mkinmod$map[[1]])[1] -    parent.name = names(mkinmod$diffs)[[1]] +    parent.type = names(x$map[[1]])[1] +    parent.name = names(x$diffs)[[1]]      o <- switch(parent.type,        SFO = SFO.solution(outtimes,            evalparse(parent.name), -          ifelse(mkinmod$use_of_ff == "min", -	    evalparse(paste("k", parent.name, "sink", sep="_")), -	    evalparse(paste("k", parent.name, sep="_")))), +          ifelse(x$use_of_ff == "min", +      evalparse(paste("k", parent.name, "sink", sep="_")), +      evalparse(paste("k", parent.name, sep="_")))),        FOMC = FOMC.solution(outtimes,            evalparse(parent.name),            evalparse("alpha"), evalparse("beta")),        IORE = IORE.solution(outtimes,            evalparse(parent.name), -          ifelse(mkinmod$use_of_ff == "min", -	    evalparse(paste("k__iore", parent.name, "sink", sep="_")), -	    evalparse(paste("k__iore", parent.name, sep="_"))), +          ifelse(x$use_of_ff == "min", +      evalparse(paste("k__iore", parent.name, "sink", sep="_")), +      evalparse(paste("k__iore", parent.name, sep="_"))),              evalparse("N_parent")),        DFOP = DFOP.solution(outtimes,            evalparse(parent.name), @@ -75,7 +89,7 @@ mkinpredict <- function(mkinmod, odeparms, odeini,      names(out) <- c("time", sub("_free", "", parent.name))    }    if (solution_type == "eigen") { -    coefmat.num <- matrix(sapply(as.vector(mkinmod$coefmat), evalparse), +    coefmat.num <- matrix(sapply(as.vector(x$coefmat), evalparse),        nrow = length(mod_vars))      e <- eigen(coefmat.num)      c <- solve(e$vectors, odeini) @@ -88,14 +102,14 @@ mkinpredict <- function(mkinmod, odeparms, odeini,      names(out) <- c("time", mod_vars)    }    if (solution_type == "deSolve") { -    if (!is.null(mkinmod$cf) & use_compiled[1] != FALSE) { +    if (!is.null(x$cf) & use_compiled[1] != FALSE) {        out <- ode(          y = odeini,          times = outtimes,          func = "func",          initfunc = "initpar", -        dllname = getDynLib(mkinmod$cf)[["name"]], -        parms = odeparms[mkinmod$parms], # Order matters when using compiled models +        dllname = getDynLib(x$cf)[["name"]], +        parms = odeparms[x$parms], # Order matters when using compiled models          method = method.ode,          atol = atol,          rtol = rtol, @@ -106,11 +120,11 @@ mkinpredict <- function(mkinmod, odeparms, odeini,          time <- t          diffs <- vector() -        for (box in names(mkinmod$diffs)) +        for (box in names(x$diffs))          {            diffname <- paste("d", box, sep="_")            diffs[diffname] <- with(as.list(c(time, state, parms)), -            eval(parse(text=mkinmod$diffs[[box]]))) +            eval(parse(text=x$diffs[[box]])))          }          return(list(c(diffs)))        } @@ -127,17 +141,17 @@ mkinpredict <- function(mkinmod, odeparms, odeini,      }      if (sum(is.na(out)) > 0) {        stop("Differential equations were not integrated for all output times because\n", -	   "NaN values occurred in output from ode()") +     "NaN values occurred in output from ode()")        }    }    if (map_output) {      # Output transformation for models with unobserved compartments like SFORB      out_mapped <- data.frame(time = out[,"time"]) -    for (var in names(mkinmod$map)) { -      if((length(mkinmod$map[[var]]) == 1) || solution_type == "analytical") { +    for (var in names(x$map)) { +      if((length(x$map[[var]]) == 1) || solution_type == "analytical") {          out_mapped[var] <- out[, var]        } else { -        out_mapped[var] <- rowSums(out[, mkinmod$map[[var]]]) +        out_mapped[var] <- rowSums(out[, x$map[[var]]])        }      }      return(out_mapped) @@ -145,3 +159,16 @@ mkinpredict <- function(mkinmod, odeparms, odeini,      return(out)    }  } + +mkinpredict.mkinfit <- function(x, +  odeparms = x$bparms.ode, +  odeini = x$bparms.state, +  outtimes = seq(0, 120, by = 0.1), +  solution_type = "deSolve", +  use_compiled = "auto", +  method.ode = "lsoda", atol = 1e-8, rtol = 1e-10, +  map_output = TRUE, ...) +{ +  mkinpredict(x$mkinmod, odeparms, odeini, outtimes, solution_type, use_compiled, +              method.ode, atol, rtol, map_output, ...) +} diff --git a/man/mkinpredict.Rd b/man/mkinpredict.Rd index 524abbb5..24b918dc 100644 --- a/man/mkinpredict.Rd +++ b/man/mkinpredict.Rd @@ -1,5 +1,7 @@  \name{mkinpredict}  \alias{mkinpredict} +\alias{mkinpredict.mkinmod} +\alias{mkinpredict.mkinfit}  \title{    Produce predictions from a kinetic model using specific parameters  } @@ -9,13 +11,15 @@    kinetic parameters and initial values for the state variables.  }  \usage{ -  mkinpredict(mkinmod, odeparms, odeini, outtimes, solution_type = "deSolve", -	      use_compiled = "auto", method.ode = "lsoda", atol = 1e-08, rtol = 1e-10, -        map_output = TRUE, ...) +  mkinpredict(x, odeparms, odeini, outtimes = seq(0, 120, by = 0.1), +    solution_type = "deSolve", use_compiled = "auto", method.ode = "lsoda", +    atol = 1e-08, rtol = 1e-10, map_output = TRUE, ...)  }  \arguments{ -  \item{mkinmod}{ -    A kinetic model as produced by \code{\link{mkinmod}}. +  \item{x}{ +    A kinetic model as produced by \code{\link{mkinmod}}, or a kinetic +    fit as fitted by \code{\link{mkinfit}}. In the latter case, the fitted +    parameters are used for the prediction.    }    \item{odeparms}{      A numeric vector specifying the parameters used in the kinetic model, which @@ -69,35 +73,35 @@    Johannes Ranke  }  \examples{ -  SFO <- mkinmod(degradinol = list(type = "SFO")) +  SFO <- mkinmod(degradinol = mkinsub("SFO"))    # Compare solution types    mkinpredict(SFO, c(k_degradinol_sink = 0.3), c(degradinol = 100), 0:20, -	      solution_type = "analytical") +        solution_type = "analytical")    mkinpredict(SFO, c(k_degradinol_sink = 0.3), c(degradinol = 100), 0:20, -	      solution_type = "deSolve") +        solution_type = "deSolve")    mkinpredict(SFO, c(k_degradinol_sink = 0.3), c(degradinol = 100), 0:20, -	      solution_type = "deSolve", use_compiled = FALSE) +        solution_type = "deSolve", use_compiled = FALSE)    mkinpredict(SFO, c(k_degradinol_sink = 0.3), c(degradinol = 100), 0:20, -	      solution_type = "eigen") +        solution_type = "eigen")    # Compare integration methods to analytical solution    mkinpredict(SFO, c(k_degradinol_sink = 0.3), c(degradinol = 100), 0:20, -	      solution_type = "analytical")[21,] +        solution_type = "analytical")[21,]    mkinpredict(SFO, c(k_degradinol_sink = 0.3), c(degradinol = 100), 0:20, -	      method = "lsoda")[21,] +        method = "lsoda")[21,]    mkinpredict(SFO, c(k_degradinol_sink = 0.3), c(degradinol = 100), 0:20, -	      method = "ode45")[21,] +        method = "ode45")[21,]    mkinpredict(SFO, c(k_degradinol_sink = 0.3), c(degradinol = 100), 0:20, -	      method = "rk4")[21,] +        method = "rk4")[21,]   # rk4 is not as precise here    # The number of output times used to make a lot of difference until the    # default for atol was adjusted    mkinpredict(SFO, c(k_degradinol_sink = 0.3), c(degradinol = 100), -	      seq(0, 20, by = 0.1))[201,] +        seq(0, 20, by = 0.1))[201,]    mkinpredict(SFO, c(k_degradinol_sink = 0.3), c(degradinol = 100), -	      seq(0, 20, by = 0.01))[2001,] +        seq(0, 20, by = 0.01))[2001,]    # Check compiled model versions - they are faster than the eigenvalue based solutions!    SFO_SFO = mkinmod(parent = list(type = "SFO", to = "m1"), @@ -114,5 +118,11 @@      print(mkinpredict(SFO_SFO, c(k_parent_m1 = 0.05, k_parent_sink = 0.1, k_m1_sink = 0.01),                  c(parent = 100, m1 = 0), seq(0, 20, by = 0.1),                  solution_type = "deSolve", use_compiled = FALSE)[201,])) + +  \dontrun{ +    # Predict from a fitted model +    f <- mkinfit(SFO_SFO, FOCUS_2006_C) +    head(mkinpredict(f)) +  }  }  \keyword{ manip } | 
