From ae64167d93bfae36158578f0a1c7771e6bab9350 Mon Sep 17 00:00:00 2001
From: Johannes Ranke <jranke@uni-bremen.de>
Date: Thu, 4 Jun 2020 13:27:44 +0200
Subject: Version 3.4 as just publicly announced

Peter Rainbird just announced the release on the PFMODELS email list.
---
 CakeModel.R | 42 ++++++++++++++++++++++++------------------
 1 file changed, 24 insertions(+), 18 deletions(-)

(limited to 'CakeModel.R')

diff --git a/CakeModel.R b/CakeModel.R
index 3a32779..116ef6b 100644
--- a/CakeModel.R
+++ b/CakeModel.R
@@ -4,8 +4,8 @@
 # Portions Johannes Ranke, 2010
 # Contact: mkin-devel@lists.berlios.de
 
-# Modifications developed by Tessella for Syngenta: Copyright (C) 2011-2016 Syngenta
-# Tessella Project Reference: 6245, 7247, 8361, 7414
+# Modifications developed by Tessella for Syngenta: Copyright (C) 2011-2020 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
@@ -22,6 +22,8 @@
 
 CakeModel <- function(..., use_of_ff = "max")
 {
+  # While spec is modified throughout this function, topology is added as-is to the returned model
+  topology <- list(...)
   spec <- list(...)
   obs_vars <- names(spec)
 
@@ -33,7 +35,7 @@ CakeModel <- function(..., use_of_ff = "max")
   parms <- vector()
   diffs <- vector()
   map <- list()
-  nlt = list()
+  nlt <- list()
 
   # Establish list of differential equations
   for (varname in obs_vars)
@@ -74,7 +76,7 @@ CakeModel <- function(..., use_of_ff = "max")
           ff <- vector()
           decline_term <- paste(nonlinear_term, "*", new_boxes[[1]])
         } else { # otherwise no decline term needed here
-          decline_term = "0" 
+          decline_term <- "0" 
         }
       } else {
         k_term <- paste("k", new_boxes[[1]], sep="_")
@@ -102,9 +104,9 @@ CakeModel <- function(..., use_of_ff = "max")
 
     # Construct and add DFOP term and add DFOP parameters if needed
     if(spec[[varname]]$type == "DFOP") {
-      k1_term = paste("k1", varname, sep="_")
-      k2_term = paste("k2", varname, sep="_")
-      g_term = paste("g", varname, sep="_")
+      k1_term <- paste("k1", varname, sep="_")
+      k2_term <- paste("k2", varname, sep="_")
+      g_term <- paste("g", varname, sep="_")
       
       new_parms <- c(k1_term, k2_term, g_term)
       ff <- vector()
@@ -121,7 +123,8 @@ CakeModel <- function(..., use_of_ff = "max")
         first_nonlinear_term <- paste(k1_term, new_boxes[[1]], sep=" * ")
         second_nonlinear_term <- paste(k2_term, new_boxes[[2]], sep=" * ")
         
-        overall_term_for_formation <- paste("(", g_term, " * ", first_nonlinear_term, " + (1 - ", g_term, ") *", second_nonlinear_term, ")")
+        # CU-150: formation has already been accounted for on the formation into the two sub-compartments; it does not need to be factored in again on the way out
+        overall_term_for_formation <- paste("(", first_nonlinear_term, " + ", second_nonlinear_term, ")")
         spec[[varname]]$nlt <- overall_term_for_formation
         
         new_diffs[[1]] <- paste(new_diffs[[1]], "-", first_nonlinear_term)
@@ -177,23 +180,23 @@ CakeModel <- function(..., use_of_ff = "max")
             # There is only one output, so no need for any flow fractions. Just add the whole flow from the parent
             formation_term <- spec[[varname]]$nlt
           } else {
-            fraction_to_target = paste("f", varname, "to", target, sep="_")
-            fraction_not_to_target = paste("(1 - ", fraction_to_target, ")", sep="")
+            fraction_to_target <- paste("f", varname, "to", target, sep="_")
+            fraction_not_to_target <- paste("(1 - ", fraction_to_target, ")", sep="")
             
             if(is.null(fraction_left)) {
-              fraction_really_to_target = fraction_to_target
-              fraction_left = fraction_not_to_target
+              fraction_really_to_target <- fraction_to_target
+              fraction_left <- fraction_not_to_target
             } else {
               # If this is the last output and there is no sink, it gets what's left
               if ( target==tail(to,1) && !spec[[varname]]$sink ) {
-                 fraction_really_to_target = fraction_left
+                 fraction_really_to_target <- fraction_left
               } else {
-                 fraction_really_to_target = fraction_to_target
-                 fraction_left = paste(fraction_left, " - ", fraction_to_target, sep="")
+                 fraction_really_to_target <- fraction_to_target
+                 fraction_left <- paste(fraction_left, " - ", fraction_to_target, sep="")
               }
             }
             
-            ff[target] = fraction_really_to_target
+            ff[target] <- fraction_really_to_target
             formation_term <- paste(ff[target], "*", spec[[varname]]$nlt)
             
             # Add the flow fraction parameter (if it exists)
@@ -218,9 +221,12 @@ CakeModel <- function(..., use_of_ff = "max")
     }
   }
   
-  model <- list(diffs = diffs, parms = parms, map = map, use_of_ff = use_of_ff)
+  model <- list(diffs = diffs, parms = parms, map = map, use_of_ff = use_of_ff, topology = topology)
 
-  if (exists("ff")) model$ff = ff
+  if (exists("ff")) {
+    model$ff <- ff
+  }
+  
   class(model) <- "mkinmod"
   invisible(model)
 }
-- 
cgit v1.2.1