hollorol/RBBGCMuso
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fixing sensi bug

Browse Source
This commit is contained in:
Roland Hollós 2020-01-03 14:50:03 +01:00
parent 3290e40a8e
commit 9d45a2d03e
4 changed files with 21 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
RBBGCMuso/R/calibration.R
View File

@ -109,7 +109,7 @@ optiMuso <- function(measuredData, parameters = NULL, startDate = NULL,
modellOut <- numeric(iterations + 1) # single variable solution modellOut <- numeric(iterations + 1) # single variable solution
rmse <- numeric(iterations + 1) rmse <- numeric(iterations + 1)
origModellOut <- calibMuso(settings=settings,silent=TRUE, skipSpinup = skipSpinup) origModellOut <- calibMuso(settings=settings,silent=TRUE, skipSpinup = skipSpinup,postProcString=postProcString)
write.csv(x=origModellOut, file=paste0(pretag,1,".csv")) write.csv(x=origModellOut, file=paste0(pretag,1,".csv"))

6
RBBGCMuso/R/musoMonte.R
View File

@ -32,6 +32,7 @@ musoMonte <- function(settings=NULL,
keepEpc = FALSE, keepEpc = FALSE,
constrains = NULL, constrains = NULL,
skipZero = TRUE, skipZero = TRUE,
postProcString=NULL,
...){ ...){
@ -86,6 +87,9 @@ musoMonte <- function(settings=NULL,
outVarNames <- sapply(outVars, musoMapping) outVarNames <- sapply(outVars, musoMapping)
} }
if(!is.null(postProcString)){
outVarNames <- c(outVarNames,gsub("\\s","",unlist(strsplit(procString,"<-"))[1]))
}
parameterNames <- gsub("([\\s]|\\-epc)","",parameters[,1],perl=TRUE) parameterNames <- gsub("([\\s]|\\-epc)","",parameters[,1],perl=TRUE)
# settings$calibrationPar <- A[,1] #:LATER: # settings$calibrationPar <- A[,1] #:LATER:
@ -145,7 +149,7 @@ musoMonte <- function(settings=NULL,
skipSpinup = skipSpinup, skipSpinup = skipSpinup,
keepEpc = keepEpc, keepEpc = keepEpc,
debugging = debugging, debugging = debugging,
outVars = outVars), error = function (e) NA) outVars = outVars,postProcString=postProcString), error = function (e) NA)
if(length(dim(tmp))>=1){ if(length(dim(tmp))>=1){
for(j in 1:numVars){ for(j in 1:numVars){

5
RBBGCMuso/R/musoSensi.R
View File

@ -31,6 +31,7 @@ musoSensi <- function(monteCarloFile = NULL,
plotTitle = "Sensitivity", plotTitle = "Sensitivity",
skipSpinup = TRUE, skipSpinup = TRUE,
skipZero = TRUE, skipZero = TRUE,
postProcString=NULL,
dpi=300){ dpi=300){
if(is.null(parameters)){ if(is.null(parameters)){
@ -48,6 +49,7 @@ musoSensi <- function(monteCarloFile = NULL,
# browser() # browser()
npar <- ncol(M)-1 npar <- ncol(M)-1
M <- M[which(!is.na(M[,ncol(M)])),] M <- M[which(!is.na(M[,ncol(M)])),]
M <- M[-1,]
y <- M[,(npar+1)] y <- M[,(npar+1)]
colnames(M) <- gsub("\\.epc","-epc",colnames(M)) colnames(M) <- gsub("\\.epc","-epc",colnames(M))
M <- M[,colnames(M) %in% parameters[,1]] M <- M[,colnames(M) %in% parameters[,1]]
@ -93,7 +95,8 @@ musoSensi <- function(monteCarloFile = NULL,
fun = fun, fun = fun,
varIndex = varIndex, varIndex = varIndex,
skipSpinup = skipSpinup, skipSpinup = skipSpinup,
skipZero=skipZero skipZero=skipZero,
postProcString=postProcString
) )
M <- cbind(seq_along(M[,1]),M) M <- cbind(seq_along(M[,1]),M)
yInd <- grep("mod.", colnames(M))[varIndex] yInd <- grep("mod.", colnames(M))[varIndex]

11
RBBGCMuso/R/postProcString.R Normal file
View File

@ -0,0 +1,11 @@
postProcMuso <- function(modelData, procString){
modelDat <- modelData[,-(1:4)]
cNames <- colnames(modelData)
tocalc <- gsub("(@)(\\d)","modelDat[,\\2]",procString)
newVarName <- gsub("\\s","",unlist(strsplit(procString,"<-"))[1])
assign(newVarName,eval(parse(text = unlist(strsplit(tocalc,"<-"))[2])))
modelData <- cbind.data.frame(modelData,eval(parse(text = newVarName)))
colnames(modelData) <- c(cNames,newVarName)
modelData
}