diff options
author | jranke <jranke@edb9625f-4e0d-4859-8d74-9fd3b1da38cb> | 2012-04-10 21:50:22 +0000 |
---|---|---|
committer | jranke <jranke@edb9625f-4e0d-4859-8d74-9fd3b1da38cb> | 2012-04-10 21:50:22 +0000 |
commit | c1144753adfa0809003085009ebd85f8af9beda8 (patch) | |
tree | c07afafb9e6a3ffd1248167f4e40983bb3ef85fc /R/mkinpredict.R | |
parent | d3df16102c5ed4bf9182b4f1893561e99eaed166 (diff) |
- Fitting and summaries now work with the new parameter transformations.
- The SFORB models with metabolites is broken (see TODO)
- Moved the vignette to the location recommended since R 2.14
- Added the missing documentation
- Commented out the schaefer_complex_case test, as this version of
mkin is not able to fit a model without sink and therefore
mkin estimated parameters are quite different
git-svn-id: svn+ssh://svn.r-forge.r-project.org/svnroot/kinfit/pkg/mkin@22 edb9625f-4e0d-4859-8d74-9fd3b1da38cb
Diffstat (limited to 'R/mkinpredict.R')
-rw-r--r-- | R/mkinpredict.R | 90 |
1 files changed, 90 insertions, 0 deletions
diff --git a/R/mkinpredict.R b/R/mkinpredict.R new file mode 100644 index 00000000..49166f30 --- /dev/null +++ b/R/mkinpredict.R @@ -0,0 +1,90 @@ +mkinpredict <- function(mkinmod, odeparms, odeini, outtimes, solution_type = "deSolve", map_output = TRUE, atol = 1e-6, ...) { + + # Get the names of the state variables in the model + mod_vars <- names(mkinmod$diffs) + + # Create function for evaluation of expressions with ode parameters and initial values + evalparse <- function(string) + { + eval(parse(text=string), as.list(c(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]] + o <- switch(parent.type, + SFO = SFO.solution(outtimes, + evalparse(parent.name), + evalparse(paste("k", parent.name, sep="_"))), + FOMC = FOMC.solution(outtimes, + evalparse(parent.name), + evalparse("alpha"), evalparse("beta")), + DFOP = DFOP.solution(outtimes, + evalparse(parent.name), + evalparse("k1"), evalparse("k2"), + evalparse("g")), + HS = HS.solution(outtimes, + evalparse(parent.name), + evalparse("k1"), evalparse("k2"), + evalparse("tb")), + SFORB = SFORB.solution(outtimes, + evalparse(parent.name), + evalparse(paste("k", parent.name, "bound", sep="_")), + evalparse(paste("k", sub("free", "bound", parent.name), "free", sep="_")), + evalparse(paste("k", parent.name, sep="_"))) + ) + out <- cbind(outtimes, o) + dimnames(out) <- list(outtimes, c("time", sub("_free", "", parent.name))) + } + if (solution_type == "eigen") { + coefmat.num <- matrix(sapply(as.vector(mkinmod$coefmat), evalparse), + nrow = length(mod_vars)) + e <- eigen(coefmat.num) + c <- solve(e$vectors, odeini) + f.out <- function(t) { + e$vectors %*% diag(exp(e$values * t), nrow=length(mod_vars)) %*% c + } + o <- matrix(mapply(f.out, outtimes), + nrow = length(mod_vars), ncol = length(outtimes)) + dimnames(o) <- list(mod_vars, outtimes) + out <- cbind(time = outtimes, t(o)) + } + if (solution_type == "deSolve") { + mkindiff <- function(t, state, parms) { + + time <- t + diffs <- vector() + for (box in names(mkinmod$diffs)) + { + diffname <- paste("d", box, sep="_") + diffs[diffname] <- with(as.list(c(time, state, parms)), + eval(parse(text=mkinmod$diffs[[box]]))) + } + return(list(c(diffs))) + } + out <- ode( + y = odeini, + times = outtimes, + func = mkindiff, + parms = odeparms, + atol = atol, + ... + ) + } + 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") { + out_mapped[var] <- out[, var] + } else { + out_mapped[var] <- rowSums(out[, mkinmod$map[[var]]]) + } + } + return(out_mapped) + } else { + return(out) + } +} |