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

postProc in calibMuso

Browse Source
This commit is contained in:
hollorol 2019-02-19 16:16:15 +01:00
parent cfd6a1f7be
commit eb23330d13
1 changed files with 72 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

138
RBBGCMuso/R/calibration.R
View File

@ -41,88 +41,94 @@ optiMuso <- function(measuredData, parameters = NULL, startDate,
exp(-sqrt(mean((x-y)^2))) exp(-sqrt(mean((x-y)^2)))
}, },
continious, continious,
modelVar = 3009) modelVar = 3009,
postProcString = NULL)
{ {
dataCol <- grep(dataVar, colnames(measuredData)) dataCol <- grep(dataVar, colnames(measuredData))
if(is.null(parameters)){ if(is.null(parameters)){
parameters <- tryCatch(read.csv("parameters.csv", stringsAsFactor=FALSE), error = function (e) { parameters <- tryCatch(read.csv("parameters.csv", stringsAsFactor=FALSE), error = function (e) {
stop("You need to specify a path for the parameters.csv, or a matrix.") stop("You need to specify a path for the parameters.csv, or a matrix.")
}) })
} else { } else {
if((!is.list(parameters)) & (!is.matrix(parameters))){ if((!is.list(parameters)) & (!is.matrix(parameters))){
parameters <- tryCatch(read.csv(parameters, stringsAsFactor=FALSE), error = function (e){ parameters <- tryCatch(read.csv(parameters, stringsAsFactor=FALSE), error = function (e){
stop("Cannot find neither parameters file neither the parameters matrix") stop("Cannot find neither parameters file neither the parameters matrix")
}) })
}} }}
outLoc <- normalizePath(outLoc) outLoc <- normalizePath(outLoc)
outLocPlain <- basename(outLoc) outLocPlain <- basename(outLoc)
currDir <- getwd() currDir <- getwd()
if(!dir.exists(outLoc)){
dir.create(outLoc)
warning(paste(outLoc," is not exists, so it was created"))
}
if(!dir.exists(outLoc)){ outLoc <- normalizePath(outLoc)
dir.create(outLoc)
warning(paste(outLoc," is not exists, so it was created"))
}
outLoc <- normalizePath(outLoc) if(is.null(settings)){
settings <- setupMuso()
if(is.null(settings)){ }
settings <- setupMuso()
} parameterNames <- parameters[,1]
pretag <- file.path(outLoc,preTag)
parameterNames <- parameters[,1] npar <- length(settings$calibrationPar)
pretag <- file.path(outLoc,preTag)
npar <- length(settings$calibrationPar)
##reading the original epc file at the specified ##reading the original epc file at the specified
## row numbers ## row numbers
print("optiMuso is randomizing the epc parameters now...",quote = FALSE) print("optiMuso is randomizing the epc parameters now...",quote = FALSE)
if(iterations < 3000){ if(iterations < 3000){
randVals <- musoRand(parameters = parameters,constrains = constrains, iterations = 3000) randVals <- musoRand(parameters = parameters,constrains = constrains, iterations = 3000)
randVals[[2]]<- randVals[[2]][sample(1:3000,iterations),] randVals[[2]]<- randVals[[2]][sample(1:3000,iterations),]
} else { } else {
randVals <- musoRand(parameters = parameters,constrains = constrains, iterations = iterations) randVals <- musoRand(parameters = parameters,constrains = constrains, iterations = iterations)
} }
origEpc <- readValuesFromFile(settings$epc[2],parameters[,2]) origEpc <- readValuesFromFile(settings$epc[2],parameters[,2])
## Prepare the preservedCalib matrix for the faster ## Prepare the preservedCalib matrix for the faster
## run. ## run.
pretag <- file.path(outLoc,preTag) pretag <- file.path(outLoc,preTag)
## Creating function for generating separate ## Creating function for generating separate
## csv files for each run ## csv files for each run
progBar <- txtProgressBar(1,iterations,style=3) progBar <- txtProgressBar(1,iterations,style=3)
colNumb <- which(settings$dailyVarCodes == modelVar) colNumb <- which(settings$dailyVarCodes == modelVar)
settings$iniInput[2] %>% settings$iniInput[2] %>%
(function(x) paste0(dirname(x),"/",tools::file_path_sans_ext(basename(x)),"-tmp.",tools::file_ext(x))) %>% (function(x) paste0(dirname(x),"/",tools::file_path_sans_ext(basename(x)),"-tmp.",tools::file_ext(x))) %>%
unlink unlink
randValues <- randVals[[2]] randValues <- randVals[[2]]
settings$calibrationPar <- randVals[[1]] settings$calibrationPar <- randVals[[1]]
list2env(alignData(measuredData,dataCol = dataCol,modellSettings = settings,startDate = startDate,endDate = endDate,leapYear = leapYearHandling, continious = continious),envir=environment()) list2env(alignData(measuredData,dataCol = dataCol,modellSettings = settings,startDate = startDate,endDate = endDate,leapYear = leapYearHandling, continious = continious),envir=environment())
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)
write.csv(x=origModellOut, file=paste0(pretag,1,".csv")) write.csv(x=origModellOut, file=paste0(pretag,1,".csv"))
modellOut[1] <- likelihood(measuredData,origModellOut[modIndex,colNumb]) modellOut[1] <- likelihood(measuredData,origModellOut[modIndex,colNumb])
print("Running the model with the random epc values...", quote = FALSE) print("Running the model with the random epc values...", quote = FALSE)
for(i in 2:(iterations+1)){
tmp <- tryCatch(calibMuso(settings = settings, if(!is.null(postProcString)){
parameters = randValues[(i-1),], colNumb <- length(settings$dailyVarCodes) + 1
silent= TRUE, }
skipSpinup = skipSpinup)[modIndex,colNumb], error = function (e) NA)
for(i in 2:(iterations+1)){
modellOut[i]<- likelihood(measuredData,tmp) tmp <- tryCatch(calibMuso(settings = settings,
rmse[i] <- sqrt(mean((measuredData-tmp)^2)) parameters = randValues[(i-1),],
write.csv(x=tmp, file=paste0(pretag,(i+1),".csv")) silent= TRUE,
setTxtProgressBar(progBar,i) skipSpinup = skipSpinup, postProcString = postProcString)[modIndex,colNumb], error = function (e) NA)
}
modellOut[i]<- likelihood(measuredData,tmp)
rmse[i] <- sqrt(mean((measuredData-tmp)^2))
write.csv(x=tmp, file=paste0(pretag,(i+1),".csv"))
setTxtProgressBar(progBar,i)
}
paramLines <- parameters[,2] paramLines <- parameters[,2]
paramLines <- order(paramLines) paramLines <- order(paramLines)
randInd <- randVals[[1]][(randVals[[1]] %in% parameters[,2])] randInd <- randVals[[1]][(randVals[[1]] %in% parameters[,2])]