From 5b3daf393831acc4099e1bde3fe4527993529d74 Mon Sep 17 00:00:00 2001
From: Johannes Ranke <jranke@uni-bremen.de>
Date: Wed, 18 Oct 2017 11:28:39 +0200
Subject: Version 3.2

---
 CakePenalties.R | 70 ++++++++++++++++++++++++++++-----------------------------
 1 file changed, 35 insertions(+), 35 deletions(-)

(limited to 'CakePenalties.R')

diff --git a/CakePenalties.R b/CakePenalties.R
index 1feffbe..5506b7f 100644
--- a/CakePenalties.R
+++ b/CakePenalties.R
@@ -1,8 +1,8 @@
 # $Id$
-# The CAKE R modules are based on mkin
-# CAKE (6245), by Tessella, for Syngenta: Copyright (C) 2011  Syngenta
+# Some of the CAKE R modules are based on mkin
+# CAKE (6245, 7247, 8361, 7414), by Tessella, for Syngenta: Copyright (C) 2011-2016 Syngenta
 #
-#    This program is free software: you can redistribute it and/or modify
+#    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.
@@ -13,44 +13,44 @@
 #    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 <http://www.gnu.org/licenses/>.”
+#    along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 # Penalty function for fits that should not be accepted
 CakePenalties<-function(params, modelled, obs, penalty.scale = 10, ...){
-	# Because the model cost is roughly proportional to points,
-	# make the penalties scale that way too for consistent behaviour
-	# with many or few data points
-	sum(CakePenaltiesLong(params, modelled, obs, penalty.scale, ...)$value) * dim(obs)[[1]]
+    # Because the model cost is roughly proportional to points,
+    # make the penalties scale that way too for consistent behaviour
+    # with many or few data points
+    sum(CakePenaltiesLong(params, modelled, obs, penalty.scale, ...)$value) * dim(obs)[[1]]
 }
-CakePenaltiesLong<-function(params, modelled, obs, penalty.scale = 10, ...){	
-	r<-data.frame(name=character(0), value=numeric(0))
-	
-	# Flow fractions > 1
-	#-------------------------------
-	fails<-CakePenaltiesFF(params);
-	if(dim(fails)[[1]] > 0){
-		#print("Penalty failures:")
-		#print(fails)
-		# Add a failure record for each flow fraction that missed
-		names(fails)<-c('name', 'value')
-		fails$value = 100*(fails$value - 1)
-		fails$name = lapply(fails$name, function(x) paste("FF_", x, sep=""))
-		r <- rbind(r, fails)
-		#totalPenalties <- totalPenalties + 100*sum(fails$x - 1)	# Penalty for failure
-	}	
+CakePenaltiesLong<-function(params, modelled, obs, penalty.scale = 10, ...){
+    r<-data.frame(name=character(0), value=numeric(0))
+    
+    # Flow fractions > 1
+    #-------------------------------
+    fails<-CakePenaltiesFF(params);
+    if(dim(fails)[[1]] > 0){
+        #print("Penalty failures:")
+        #print(fails)
+        # Add a failure record for each flow fraction that missed
+        names(fails)<-c('name', 'value')
+        fails$value = 100*(fails$value - 1)
+        fails$name = lapply(fails$name, function(x) paste("FF_", x, sep=""))
+        r <- rbind(r, fails)
+        #totalPenalties <- totalPenalties + 100*sum(fails$x - 1)	# Penalty for failure
+    }
 
-	r$value <- r$value * penalty.scale
-	return(r)
+    r$value <- r$value * penalty.scale
+    return(r)
 }
 
 CakePenaltiesFF<-function(params){
-	ff.values<-params["f_"==substr(names(params), 0, 2)]	# Flow fractions
-	if(length(ff.values) > 0){
-		ffs<-data.frame(t(sapply(strsplit(names(ff.values), '_'), FUN=function(x){ x[c(2,4)] })))	# Split into source/dest
-		names(ffs)<-c('source', 'dest')
-		ffs['value'] <- ff.values	# Add values
-		sums<-aggregate(ffs$value, list(s=ffs$source), sum)	# Sum of flows from each source
-		fails<-sums[sums$x>1.00001,]	# All compartments > 1
-	} else { fails<-data.frame(s=character(0), x=numeric(0)) }
-	return(fails)
+    ff.values<-params["f_"==substr(names(params), 0, 2)]	# Flow fractions
+    if(length(ff.values) > 0){
+        ffs<-data.frame(t(sapply(strsplit(names(ff.values), '_'), FUN=function(x){ x[c(2,4)] })))	# Split into source/dest
+        names(ffs)<-c('source', 'dest')
+        ffs['value'] <- ff.values	# Add values
+        sums<-aggregate(ffs$value, list(s=ffs$source), sum)	# Sum of flows from each source
+        fails<-sums[sums$x>1.00001,]	# All compartments > 1
+    } else { fails<-data.frame(s=character(0), x=numeric(0)) }
+    return(fails)
 }
\ No newline at end of file
-- 
cgit v1.2.1