#$Id$
# Generates model curves so the GUI can plot them. Used when all params are fixed so there was no fit
# Some of the CAKE R modules are based on mkin
# Based on code in IRLSkinfit
# Modifications developed by Hybrid Intelligence (formerly Tessella), part of
# Capgemini Engineering, for Syngenta, Copyright (C) 2011-2022 Syngenta
# Tessella Project Reference: 6245, 7247, 8361, 7414, 10091
# The CAKE R modules are free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see .
CakeNullPlot <- function(model, parms.ini, state.ini, observed, xlim = range(observed$time),
digits = max(3, getOption("digits") - 3), dfopDtMaxIter = 10000, atol = 1e-6, ...)
{
# Print the fixed values
fixed <- data.frame(value = c(state.ini, parms.ini))
fixed$type = c(rep("state", length(state.ini)), rep("deparm", length(parms.ini)))
cat("\nFixed parameter values:\n")
print(fixed)
parms.all = c(state.ini, parms.ini)
# Print disappearance times
obs_vars = unique(as.character(observed$name))
distimes <- data.frame(DT50 = rep(NA, length(obs_vars)),
DT90 = rep(NA, length(obs_vars)), row.names = obs_vars)
extraDT50<- data.frame(k1 = rep(NA, length(obs_vars)), k2 = rep(NA, length(obs_vars)), row.names = obs_vars)
for (obs_var in obs_vars) {
type = names(model$map[[obs_var]])[1]
if(exists("DT50")) distimes[obs_var, ] = c(DT50, DT90)
distimes[obs_var, ] = CakeDT(type,obs_var,parms.all,dfopDtMaxIter)
extraDT50[obs_var, ] = CakeExtraDT(type, obs_var, parms.all)
}
cat("\nEstimated disappearance times:\n")
print(distimes, digits=digits,...)
cat("\nHalf Lives for Extra k values:\n")
print(extraDT50, digits=digits,...)
ioreRepDT = CakeIORERepresentativeDT("Parent", parms.all)
printIoreRepDT <- !is.null(ioreRepDT)
if (printIoreRepDT){
cat("\nRepresentative Half Life for IORE:", format(signif(ioreRepDT, digits)))
}
cat("\n")
fomcRepDT = CakeFOMCBackCalculatedDT(parms.all)
printFomcRepDT <- !is.null(fomcRepDT)
if (printIoreRepDT){
cat("\nBack-calculated Half Life for FOMC:", format(signif(fomcRepDT, digits)))
}
cat("\n")
# Plot the model
outtimes <- seq(0, xlim[2], length.out=CAKE.plots.resolution)
odeini <- state.ini
odenames <- model$parms
odeparms <- parms.ini
# Solve the system
evalparse <- function(string)
{
eval(parse(text=string), as.list(c(odeparms, odeini)))
}
mod_vars <- names(model$diffs)
mkindiff <- function(t, state, parms) {
time <- t
diffs <- vector()
for (box in mod_vars) {
diffname <- paste("d", box, sep = "_")
diffs[diffname] <- with(as.list(c(time, state, parms)),
eval(parse(text = model$diffs[[box]])))
}
return(list(c(diffs)))
}
# Ensure initial state is at time 0
obstimes <- unique(c(0,observed$time))
odeini <- AdjustOdeInitialValues(odeini, model, odeparms)
# Solve at observation times
out <- ode(y = odeini, times = obstimes, func = mkindiff, parms = odeparms, atol = atol)
out_transformed <- PostProcessOdeOutput(out, model, atol)
predicted_long <- wide_to_long(out_transformed,time="time")
# Calculate chi2 error levels according to FOCUS (2006)
errmin<-CakeChi2(model, observed, predicted_long, obs_vars, c(), c(), state.ini, parms.ini, fixed)
cat("\nChi2 error levels in percent:\n")
errmin$err.min <- 100 * errmin$err.min
print(errmin, digits=digits,...)
# Fit to data
data<-observed
data$err<-rep(NA,length(data$time))
data<-merge(data, predicted_long, by=c("time","name"))
names(data)<-c("time", "variable", "observed","err-var", "predicted")
data$residual<-data$observed-data$predicted
data<-data[order(data$variable,data$time),]
cat("\nData:\n")
print(format(data, digits = digits, scientific = FALSE,...), row.names = FALSE)
additionalStats <- CakeAdditionalStats(data)
cat("\nAdditional Stats:\n");
print(additionalStats, digits = digits, ...)
# Solve at output times
out <- ode(
y = odeini,
times = outtimes,
func = mkindiff,
parms = odeparms)
out_transformed <- PostProcessOdeOutput(out, model, atol)
cat("\n\n")
print(out_transformed)
cat("\n")
}