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

skipSpinup full solution, GLUE start.

Browse Source
This commit is contained in:
Roland Hollós 2018-07-17 15:44:22 +02:00
parent 1de976fdf3
commit 1f770d6426
7 changed files with 234 additions and 102 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
RBBGCMuso/R/calibMuso.R
View File

@ -49,7 +49,7 @@ calibMuso <- function(settings=NULL,parameters=NULL, timee="d", debugging=FALSE,
setwd(inputLoc) setwd(inputLoc)
if((debugging=="stamplog")|(debugging==TRUE)){#If debugging option turned on if(debugging){#If debugging option turned on
#If log or ERROR directory does not exists create it! #If log or ERROR directory does not exists create it!
dirName<-file.path(inputLoc,"LOG") dirName<-file.path(inputLoc,"LOG")
dirERROR<-file.path(inputLoc,"ERROR") dirERROR<-file.path(inputLoc,"ERROR")
@ -194,15 +194,15 @@ calibMuso <- function(settings=NULL,parameters=NULL, timee="d", debugging=FALSE,
##read the output ##read the output
switch(timee, switch(timee,
"d"=(Reva <- tryCatch(getdailyout(settings), "d"=(Reva <- tryCatch(getdailyout(settings), #(:INSIDE: getOutput.R )
error = function (e){ error = function (e){
setwd((whereAmI)) setwd((whereAmI))
stop("Cannot read binary output, please check if the output type is set 2 in the ini files!")})), stop("Cannot read binary output, please check if the output type is set 2 in the ini files!")})),
"m"=(Reva <- tryCatch(getmonthlyout(settings), "m"=(Reva <- tryCatch(getmonthlyout(settings), #(:INSIDE: getOutput.R )
error = function (e){ error = function (e){
setwd((whereAmI)) setwd((whereAmI))
stop("Cannot read binary output, please check if the output type is set 2 in the ini files!")})), stop("Cannot read binary output, please check if the output type is set 2 in the ini files!")})),
"y"=(Reva <- tryCatch(getyearlyout(settings), "y"=(Reva <- tryCatch(getyearlyout(settings), #(:INSIDE: getOutput.R )
error = function (e){ error = function (e){
setwd((whereAmI)) setwd((whereAmI))
stop("Cannot read binary output, please check if the output type is set 2 in the ini files!")})) stop("Cannot read binary output, please check if the output type is set 2 in the ini files!")}))
@ -221,7 +221,7 @@ calibMuso <- function(settings=NULL,parameters=NULL, timee="d", debugging=FALSE,
logfiles <- tryCatch(getLogs(outputLoc,outputNames,type="both"), logfiles <- tryCatch(getLogs(outputLoc,outputNames,type="both"),
error = function (e){ error = function (e){
setwd(whereAmI) setwd(whereAmI)
"Cannot find log files, something went wrong"}) stop("Cannot find log files, something went wrong")})
## list.files(outputLoc)[grep("log$",list.files(outputLoc))]#creating a vector for logfilenames ## list.files(outputLoc)[grep("log$",list.files(outputLoc))]#creating a vector for logfilenames
############################################### ###############################################
@ -262,7 +262,7 @@ calibMuso <- function(settings=NULL,parameters=NULL, timee="d", debugging=FALSE,
if(debugging==TRUE){ if(debugging){ #debugging is boolean
logfiles <- file.path(outputLoc,logfiles) logfiles <- file.path(outputLoc,logfiles)
stampAndDir(stampDir=dirName, wrongDir=dirERROR, names=logfiles, type="general",errorsign=errorsign,logfiles=logfiles)} stampAndDir(stampDir=dirName, wrongDir=dirERROR, names=logfiles, type="general",errorsign=errorsign,logfiles=logfiles)}

57
RBBGCMuso/R/musoGLUE.R Normal file
View File

@ -0,0 +1,57 @@
#' musoGlue
#'
#' This ...
#' #' @author Roland Hollos
#' @param monteCarloFile If you run musoMonte function previously, you did not have to rerun the monteCarlo, just provide the preservedEpc.csv file with its path. If you do not set this parameter, musoSensi will fun the musoMonte function to get all of the information.
#' @param outputFile The filename in which the output of musoSensi function will be saved. It's default value is: "sensitivity.csv"
#' @param plotName The name of the output barplot. It's default value is: "sensitivity.jpg"
#' @param settings A list of montecarlos environmental variables. It is generated by the setupMuso() function. In default the settings parameter is generated automatically.
#' @param parameters This is a dataframe (heterogen data-matrix), which first column is the name of the parameters, the second is a numeric vector of the rownumbers of the given variable in the epc-fie, the last two column consist the endpont of the parameter-ranges, where the parameters will be randomized.
#' @param calibrationPar You may want to change some parameters in your epc file, before you run the modell. You have to select the appropirate modell parameters. You can refence to these with the number of the line in the epc file where the variables are. It indexes from one. You should use a vector for this, like: c(1,5,8)
#' @param inputDir The location of the input directory, this directory must content a viable pack of all inputfiles and the executable file.
#' @param iterations number of the monteCarlo run.
#' @param preTag It will be the name of the output files. For example preTag-1.csv, pretag-2csv...
#' @param outputType This parameter can be "oneCsv", "moreCsv", and "netCDF". If "oneCsv" is choosen the function create 1 big csv file for all of the runs, if "moreCsv" is choosen, every modell output goes to separate files, if netCDF is selected the outputs will be put in a netCDF file. The default value of the outputTypes is "moreCsv". netCDF is not implemented yet.
#' @param fun If you select a variable from the possible outputs (with specify the varIndex parameter), you have to provide a function which maps to a subset of real numbers. The most frequent possibilities are: mean, min, max, var, but you can define any function for your need.
#' @param varIndex This parameter specify which parameter of the output will be used. You can extract this information from the ini-files. At the output parameter specifications, the parameters order will determine this number. For example, if you have set these output parameters: 412, 874, 926, 888, and you want to use 926, you should address varIndex with 3.
#' @param skipSpinup With this parameter, you can turn of the spinup phase after the first spinup. I will decrease the time significantly.
#' @import dplyr
#' @import graphics
#' @import grDevices
#' @import ggplot2
#' @export
musoGLUE <- function(monteCarloFile = NULL,
parameters = NULL,
settings = NULL,
inputDir = "./",
outLoc = "./calib",
iterations = 30,
preTag = "mont-",
outputType = "moreCsv",
fun = mean,
varIndex = 1,
outputFile = "sensitivity.csv",
plotName = "sensitivity.png",
plotTitle = "Sensitivity",
skipSpinup = FALSE,
dpi=300){
rmse <- function(modelled, measured){
(modelled-measured) %>%
(function(x) {x*x}) %>% # It is more clear than `^`(.,2) form, even it is longer
sum %>%
sqrt
}
}

49
RBBGCMuso/R/musoMonte.R
View File

@ -11,10 +11,12 @@
#' @param outputType This parameter can be "oneCsv", "moreCsv", and "netCDF". If "oneCsv" is choosen the function create 1 big csv file for all of the runs, if "moreCsv" is choosen, every modell output goes to separate files, if netCDF is selected the outputs will be put in a netCDF file. The default value of the outputTypes is "moreCsv". netCDF is not implemented yet. #' @param outputType This parameter can be "oneCsv", "moreCsv", and "netCDF". If "oneCsv" is choosen the function create 1 big csv file for all of the runs, if "moreCsv" is choosen, every modell output goes to separate files, if netCDF is selected the outputs will be put in a netCDF file. The default value of the outputTypes is "moreCsv". netCDF is not implemented yet.
#' @param fun If you select a variable from the possible outputs (with specify the varIndex parameter), you have to provide a function which maps to a subset of real numbers. The most frequent possibilities are: mean, min, max, var, but you can define any function for your need. #' @param fun If you select a variable from the possible outputs (with specify the varIndex parameter), you have to provide a function which maps to a subset of real numbers. The most frequent possibilities are: mean, min, max, var, but you can define any function for your need.
#' @param varIndex This parameter specify which parameter of the output will be used. You can extract this information from the ini-files. At the output parameter specifications, the parameters order will determine this number. For example, if you have set these output parameters: 412, 874, 926, 888, and you want to use 926, you should address varIndex with 3. #' @param varIndex This parameter specify which parameter of the output will be used. You can extract this information from the ini-files. At the output parameter specifications, the parameters order will determine this number. For example, if you have set these output parameters: 412, 874, 926, 888, and you want to use 926, you should address varIndex with 3.
#' @param debugging If you set this parameter, you can save every logfile, and RBBGCMuso will select those which contains errors.
#' @param keepEpc if you set keepEpc also true, it will save every selected epc file, and put the wrong ones in the WRONGEPC directory.
#' @export #' @export
musoMonte <- function(settings=NULL, musoMonte <- function(settings=NULL,
parameters, parameters=NULL,
inputDir = "./", inputDir = "./",
outLoc = "./calib", outLoc = "./calib",
iterations = 10, iterations = 10,
@ -23,8 +25,22 @@ musoMonte <- function(settings=NULL,
fun=mean, fun=mean,
varIndex = 1, varIndex = 1,
silent = TRUE, silent = TRUE,
skipSpinup = FALSE,
debugging = FALSE,
keepEpc = FALSE,
...){ ...){
if(is.null(parameters)){
parameters <- tryCatch(read.csv("parameters.csv"), error = function (e) {
stop("You need to specify a path for the parameters.csv, or a matrix.")
})
} else {
if((!is.list(parameters)) & (!is.matrix(parameters))){
parameters <- tryCatch(read.csv(parameters), error = function (e){
stop("Cannot find neither parameters file neither the parameters matrix")
})
}}
outLocPlain <- basename(outLoc) outLocPlain <- basename(outLoc)
currDir <- getwd() currDir <- getwd()
inputDir <- normalizePath(inputDir) inputDir <- normalizePath(inputDir)
@ -91,10 +107,31 @@ musoMonte <- function(settings=NULL,
## 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)
modelRun <- function(settings, debugging, parameters, keepEpc, silent, skipSpinup){
if(!skipSpinup){
calibMuso(settings, debugging = debugging, parameters = parameters, keepEpc = keepEpc, silent = silent)
} else {
normalMuso(settings, debugging = debugging, parameters = parameters, keepEpc = keepEpc, silent = silent)
}
}
moreCsv <- function(){ moreCsv <- function(){
if(skipSpinup){#skipSpinup is boolean
spinupMuso(settings = settings , silent = silent)
}
a <- numeric(iterations+1) a <- numeric(iterations+1)
tempData <- calibMuso(settings, debugging = "stamplog", parameters = origEpc,keepEpc = TRUE,silent = silent) tempData <- modelRun(settings=settings,
debugging = debugging,
parameters = origEpc,
keepEpc = keepEpc,
silent = silent,
skipSpinup = skipSpinup)
## tempData <- calibMuso(settings, debugging = "stamplog", parameters = origEpc,keepEpc = TRUE,silent = silent)
a[1] <- tryCatch(fun(tempData[,varIndex]),error=function(e){return(NA)}) a[1] <- tryCatch(fun(tempData[,varIndex]),error=function(e){return(NA)})
preservedEpc[1,(npar+1)] <- a[1] preservedEpc[1,(npar+1)] <- a[1]
write.table(t(preservedEpc[1,]),row.names = FALSE,"preservedEpc.csv",sep=",") write.table(t(preservedEpc[1,]),row.names = FALSE,"preservedEpc.csv",sep=",")
@ -103,10 +140,12 @@ musoMonte <- function(settings=NULL,
parVar <- musoRandomizer(A,B)[,2] parVar <- musoRandomizer(A,B)[,2]
preservedEpc[(i+1),] <- c(parVar,NA) preservedEpc[(i+1),] <- c(parVar,NA)
exportName <- paste0(preTag,(i+1),".csv") exportName <- paste0(preTag,(i+1),".csv")
tempData <- calibMuso(settings,debugging = "stamplog", tempData <- modelRun(settings = settings,
debugging = debugging,
parameters = parVar, parameters = parVar,
keepEpc = TRUE, keepEpc = keepEpc,
silent=silent) silent=silent,
skipSpinup =skipSpinup)
write.csv(x=tempData,file=exportName) write.csv(x=tempData,file=exportName)
preservedEpc[(i+1),(npar+1)] <- a[i+1]<- tryCatch(fun(tempData[,varIndex]),error=function(e){return(NA)}) preservedEpc[(i+1),(npar+1)] <- a[i+1]<- tryCatch(fun(tempData[,varIndex]),error=function(e){return(NA)})

23
RBBGCMuso/R/musoSensi.R
View File

@ -14,6 +14,7 @@
#' @param outputType This parameter can be "oneCsv", "moreCsv", and "netCDF". If "oneCsv" is choosen the function create 1 big csv file for all of the runs, if "moreCsv" is choosen, every modell output goes to separate files, if netCDF is selected the outputs will be put in a netCDF file. The default value of the outputTypes is "moreCsv". netCDF is not implemented yet. #' @param outputType This parameter can be "oneCsv", "moreCsv", and "netCDF". If "oneCsv" is choosen the function create 1 big csv file for all of the runs, if "moreCsv" is choosen, every modell output goes to separate files, if netCDF is selected the outputs will be put in a netCDF file. The default value of the outputTypes is "moreCsv". netCDF is not implemented yet.
#' @param fun If you select a variable from the possible outputs (with specify the varIndex parameter), you have to provide a function which maps to a subset of real numbers. The most frequent possibilities are: mean, min, max, var, but you can define any function for your need. #' @param fun If you select a variable from the possible outputs (with specify the varIndex parameter), you have to provide a function which maps to a subset of real numbers. The most frequent possibilities are: mean, min, max, var, but you can define any function for your need.
#' @param varIndex This parameter specify which parameter of the output will be used. You can extract this information from the ini-files. At the output parameter specifications, the parameters order will determine this number. For example, if you have set these output parameters: 412, 874, 926, 888, and you want to use 926, you should address varIndex with 3. #' @param varIndex This parameter specify which parameter of the output will be used. You can extract this information from the ini-files. At the output parameter specifications, the parameters order will determine this number. For example, if you have set these output parameters: 412, 874, 926, 888, and you want to use 926, you should address varIndex with 3.
#' @param skipSpinup With this parameter, you can turn of the spinup phase after the first spinup. I will decrease the time significantly.
#' @import dplyr #' @import dplyr
#' @import graphics #' @import graphics
#' @import grDevices #' @import grDevices
@ -21,9 +22,8 @@
#' @export #' @export
musoSensi <- function(monteCarloFile = NULL, musoSensi <- function(monteCarloFile = NULL,
parameters=NULL, parameters = NULL,
settings = NULL, settings = NULL,
parametersFromFile=FALSE,
inputDir = "./", inputDir = "./",
outLoc = "./calib", outLoc = "./calib",
iterations = 30, iterations = 30,
@ -34,17 +34,19 @@ musoSensi <- function(monteCarloFile = NULL,
outputFile = "sensitivity.csv", outputFile = "sensitivity.csv",
plotName = "sensitivity.png", plotName = "sensitivity.png",
plotTitle = "Sensitivity", plotTitle = "Sensitivity",
skipSpinup = FALSE,
dpi=300){ dpi=300){
if(is.null(parameters)){ if(is.null(parameters)){
parameters <- read.csv("parameters.csv") parameters <- tryCatch(read.csv("parameters.csv"), error = function (e) {
stop("You need to specify a path for the parameters.csv, or a matrix.")
})
} else { } else {
if(parametersFromFile){ if((!is.list(parameters)) & (!is.matrix(parameters))){
parameters <- read.csv(parameters,stringsAsFactors=FALSE) parameters <- tryCatch(read.csv(parameters), error = function (e){
} else { stop("Cannot find neither parameters file neither the parameters matrix")
parameters <- parameters })
} }}
}
doSensi <- function(M){ doSensi <- function(M){
npar <- ncol(M)-1 npar <- ncol(M)-1
@ -90,7 +92,8 @@ musoSensi <- function(monteCarloFile = NULL,
preTag = preTag, preTag = preTag,
outputType = outputType, outputType = outputType,
fun = fun, fun = fun,
varIndex = varIndex varIndex = varIndex,
skipSpinup = skipSpinup
) )
return(doSensi(M)) return(doSensi(M))

119
RBBGCMuso/R/normalMuso.R
View File

@ -30,9 +30,9 @@ normalMuso<- function(settings=NULL,parameters=NULL,timee="d",debugging=FALSE,lo
######################################################################## ########################################################################
if(is.null(settings)){ if(is.null(settings)){
settings <- setupMuso() settings <- setupMuso() #( :INSIDE: setupMuso.R)
} }
# The software works on Linux or Windows, Mac is not implemented yet, so with this simple dichotomy we can determine wich syste is running
Linuxp <-(Sys.info()[1]=="Linux") Linuxp <-(Sys.info()[1]=="Linux")
##Copy the variables from settings ##Copy the variables from settings
inputLoc <- settings$inputLoc inputLoc <- settings$inputLoc
@ -42,28 +42,65 @@ normalMuso<- function(settings=NULL,parameters=NULL,timee="d",debugging=FALSE,lo
iniInput <- settings$iniInput iniInput <- settings$iniInput
epc <- settings$epcInput epc <- settings$epcInput
calibrationPar <- settings$calibrationPar calibrationPar <- settings$calibrationPar
## We want to minimize the number of sideeffects so we store the state to restore in the end.
whereAmI<-getwd() whereAmI<-getwd()
## Optionally the user may want to store the original binary file. At default we set it to the output location.
if(is.null(binaryPlace)){ if(is.null(binaryPlace)){
binaryPlace <- outputLoc binaryPlace <- outputLoc
} }
## Now we create a directories for the debugging files if these are not exists, and if debugging or keepEpc options are set to true.
if(debugging){ #debugging is boolean, so we dont write debugging == TRUE for the sake of faster model run
#If log or ERROR directory does not exists create it!
dirName<-file.path(inputLoc,"LOG")
dirERROR<-file.path(inputLoc,"ERROR")
if(!dir.exists(dirName)){
dir.create(dirName)
}
if(!dir.exists(dirERROR)){
dir.create(dirERROR)
}
}
if(keepEpc) {#keepEpc is boolean
epcdir <- dirname(epc[1])
print(epcdir)
WRONGEPC<-file.path(inputLoc,"WRONGEPC")
EPCS<-file.path(inputLoc,"EPCS")
if(!dir.exists(WRONGEPC)){
dir.create(WRONGEPC)
}
if(!dir.exists(EPCS)){
dir.create(EPCS)
}
}
if(!is.null(parameters)){ if(!is.null(parameters)){
switch(fileToChange, switch(fileToChange,
"epc"=(changemulline(filename=epc[2],calibrationPar,parameters)), #(:TODO: trycatch /p4/) "epc" = tryCatch(changemulline(filename = epc[1],calibrationPar,parameters), #(:DONE: trycatch :INSIDE: changeMuso.R)
"ini"=(changemulline(filename=iniInput[2],calibrationPar,parameters)), error = function (e) {stop("Cannot change the epc file")}),
"both"=(stop("This option is not implemented yet, please choose epc or ini")) "ini" = tryCatch(changemulline(filename = iniInput[1],calibrationPar,parameters), #(:DONE: trycatch :INSIDE: changeMuso.R)
error = function (e) {stop("Cannot change the ini file")}),
"both" = (stop("This option is not implemented yet, please choose epc or ini"))
) )
} }
setwd(inputLoc)
#normal run #normal run
## if(silent){ ## if(silent){
@ -106,63 +143,51 @@ normalMuso<- function(settings=NULL,parameters=NULL,timee="d",debugging=FALSE,lo
##read the output ##read the output
switch(timee, switch(timee,
"d"=(Reva <- tryCatch(getdailyout(settings), "d"=(Reva <- tryCatch(getdailyout(settings), #(:INSIDE: getOutput.R )
error = function (e) {stop("Cannot read binary output, please check if the output type is set 2 in the ini files!")})), error = function (e){
"m"=(Reva <- tryCatch(getmonthlyout(settings), setwd((whereAmI))
error = function (e) {stop("Cannot read binary output, please check if the output type is set 2 in the ini files!")})), stop("Cannot read binary output, please check if the output type is set 2 in the ini files!")})),
"y"=(Reva <- tryCatch(getyearlyout(settings), "m"=(Reva <- tryCatch(getmonthlyout(settings), #(:INSIDE: getOutput.R )
error = function (e) {stop("Cannot read binary output, please check if the output type is set 2 in the ini files!")})) error = function (e){
setwd((whereAmI))
stop("Cannot read binary output, please check if the output type is set 2 in the ini files!")})),
"y"=(Reva <- tryCatch(getyearlyout(settings), #(:INSIDE: getOutput.R )
error = function (e){
setwd((whereAmI))
stop("Cannot read binary output, please check if the output type is set 2 in the ini files!")}))
) )
if(keepBinary){ if(keepBinary){
possibleNames <- getOutFiles(outputLoc = outputLoc,outputNames = outputNames) possibleNames <- getOutFiles(outputLoc = outputLoc,outputNames = outputNames) #(:INSIDE: assistantFunctions.R)
stampAndDir(outputLoc = outputLoc,names = possibleNames,stampDir=binaryPlace,type="output") stampAndDir(outputLoc = outputLoc,names = possibleNames,stampDir=binaryPlace,type="output") #(:INSIDE: assistantFunctions.R)
} }
logfiles <- getLogs(outputLoc,outputNames,type = "normal") logfiles <- getLogs(outputLoc,outputNames,type = "normal") #(:INSIDE: assistantFunctions.R)
#############LOG SECTION####################### #############LOG SECTION#######################
errorsign <- readErrors(outputLoc = outputLoc,logfiles = logfiles,type="normal") errorsign <- readErrors(outputLoc = outputLoc,logfiles = logfiles,type="normal") #(:INSIDE: assistantFunctions.R)
dirName<-paste(inputloc,"/LOG",sep="")
dirERROR<-paste(inputloc,"/ERROR",sep="")
ERROR_EPC<-paste(inputloc,"/ERROR_EPC",sep="")
if(!dir.exists(dirName)){ if(keepEpc){#if keepepc option turned on
dir.create(dirName)
}
if(!dir.exists(dirERROR)){
dir.create(dirERROR)
}
if(debugging=="stamplog"){
stampnum<-stamp(dirName)
lapply( logfiles, function (x) file.rename(from=paste(inputloc,x, sep=""), to=paste(dirName, "/",(stampnum+1),"-",x,sep="")))
if(errorsign==1){
lapply( logfiles, function (x) file.copy(from=paste(dirName, "/",(stampnum+1),"-",x,sep=""), to=dirERROR ))}
} else { if(debugging){
if(is.null(logfilename)){
lapply( logfiles, function (x) file.rename(from=paste(inputloc,x, sep=""), to=paste(dirName,"/", x, sep="")))
if(errorsign==1){
lapply( logfiles, function (x) file.rename(from=paste(dirName,"/", x, sep=""), to=dirERROR))
}
if(length(unique(dirname(epc)))>1){
stop("Why are you playing with my nervs? Seriously? You hold your epc-s in different folders?")
} else { } else {
lapply( logfiles, function (x) file.rename(from=paste(inputloc,x, sep=""), to=paste(dirName, "/",logfilename,"-",x,sep="")))
if(errorsign==1){ stampAndDir(stampDir=EPCS, wrongDir=WRONGEPC, names=epc[2], type="general", errorsign=errorsign, logfiles=logfiles)
lapply( logfiles, function (x) file.rename(from=paste(dirName, "/",logfilename,"-",x,sep=""), to=dirERROR))
} }
} }
}}
if(debugging){ #debugging is boolean
logfiles <- file.path(outputLoc,logfiles)
stampAndDir(stampDir=dirName, wrongDir=dirERROR, names=logfiles, type="general",errorsign=errorsign,logfiles=logfiles)}
cleanupMuso() cleanupMuso()
if(errorsign==1){ if(errorsign==1){
return("Modell Failure") return("Modell Failure")

16
RBBGCMuso/R/setupMuso.R
View File

@ -122,7 +122,6 @@ setupMuso <- function(executable=NULL,
inputs <- lapply(1:nrow(grepHelper), function (x) { inputs <- lapply(1:nrow(grepHelper), function (x) {
outMaker(grepHelper[x,1],grepHelper[x,2],grepHelper[x,3]) outMaker(grepHelper[x,1],grepHelper[x,2],grepHelper[x,3])
@ -149,14 +148,17 @@ setupMuso <- function(executable=NULL,
if(is.null(mapData)){ if(is.null(mapData)){
c<-grep("DAILY_OUTPUT",iniFiles[[2]])+1 outIndex<-grep("DAILY_OUTPUT",iniFiles[[2]])+1
numVar<-as.numeric(unlist(strsplit(iniFiles[[2]][c],"[\ \t]"))[1]) numVar<-as.numeric(unlist(strsplit(iniFiles[[2]][outIndex],"[\ \t]"))[1])
dailyVarCodes<-iniFiles[[2]][(c+1):(c+numVar)] dailyVarCodes<-tryCatch(iniFiles[[2]][(outIndex+1):(outIndex+numVar)],
error = function(e){
stop("Cannot read indexes of output variables from the normal ini file, please make sure you have not skiped a line after the flag: \"DAILY_OUTPUT\"")
})
dailyVarnames<-lapply(dailyVarCodes, function(x) musoMapping(unlist(strsplit(x,"[\ \t]"))[1])) dailyVarnames<-lapply(dailyVarCodes, function(x) musoMapping(unlist(strsplit(x,"[\ \t]"))[1]))
c<-grep("ANNUAL_OUTPUT",iniFiles[[2]])+1 outIndex<-grep("ANNUAL_OUTPUT",iniFiles[[2]])+1
numVar<-as.numeric(unlist(strsplit(iniFiles[[2]][c],"[\ \t]"))[1]) numVar<-as.numeric(unlist(strsplit(iniFiles[[2]][outIndex],"[\ \t]"))[1])
annualVarCodes<-iniFiles[[2]][(c+1):(c+numVar)] annualVarCodes<-iniFiles[[2]][(outIndex+1):(outIndex+numVar)]
annualVarnames<-lapply(annualVarCodes, function(x) musoMapping(unlist(strsplit(x,"[\ \t]"))[1])) annualVarnames<-lapply(annualVarCodes, function(x) musoMapping(unlist(strsplit(x,"[\ \t]"))[1]))
outputVars<-list(dailyVarnames,annualVarnames)} else { outputVars<-list(dailyVarnames,annualVarnames)} else {

32
RBBGCMuso/R/spinupMuso.R
View File

@ -22,11 +22,12 @@ spinupMuso <- function(settings=NULL, parameters=NULL, debugging=FALSE, logfilen
######################################################################## ########################################################################
if(is.null(settings)){ if(is.null(settings)){
settings <- setupMuso() settings <- setupMuso() #(:INSIDE: setupMuso.R)
}
}
# The software works on Linux or Windows, Mac is not implemented yet, so with this simple dichotomy we can determine wich system is running
Linuxp <-(Sys.info()[1]=="Linux") Linuxp <-(Sys.info()[1]=="Linux")
##Copy the variables from settings ##Copy the variables from settings for the sake of easy
inputLoc <- settings$inputLoc inputLoc <- settings$inputLoc
outputLoc <- settings$outputLoc outputLoc <- settings$outputLoc
outputNames <- settings$outputNames outputNames <- settings$outputNames
@ -34,6 +35,8 @@ spinupMuso <- function(settings=NULL, parameters=NULL, debugging=FALSE, logfilen
iniInput <- settings$iniInput iniInput <- settings$iniInput
epc <- settings$epcInput epc <- settings$epcInput
calibrationPar <- settings$calibrationPar calibrationPar <- settings$calibrationPar
## We want to minimize the number of sideeffects so we store the state to restore in the end.
whereAmI<-getwd() whereAmI<-getwd()
@ -41,26 +44,28 @@ spinupMuso <- function(settings=NULL, parameters=NULL, debugging=FALSE, logfilen
############################spinup run############################ ############################spinup run############################
########################################################## ##########################################################
## obsolete feature, but there can be cases in wich this option is helpfull
if(aggressive==TRUE){ if(aggressive==TRUE){
cleanupMuso(location=outputLoc,deep=TRUE)} cleanupMuso(location=outputLoc,deep=TRUE)} #(:INSIDE: cleanup.R)
## If parameters given, use changemulline, else leave this steps
if(!is.null(parameters)){ if(!is.null(parameters)){
switch(fileToChange, switch(fileToChange,
"epc"=tryCatch(changemulline(filename=epc[2],calibrationPar,parameters), "epc" = tryCatch(changemulline(filename = epc[1],calibrationPar,parameters), #(:INSIDE: changeMuso.R)
error = function (e) {stop("Cannot change the epc file")}), error = function (e) {stop("Cannot change the epc file")}),
"ini"=tryCatch(changemulline(filename=iniInput[2],calibrationPar,parameters), "ini" = tryCatch(changemulline(filename = iniInput[1],calibrationPar,parameters), #(:INSIDE: changeMuso.R)
error = function (e) {stop("Cannot change the ini file")}), error = function (e) {stop("Cannot change the ini file")}),
"both"=(stop("This option is not implemented yet, please choose epc or ini")) "both" = (stop("This option is not implemented yet, please choose epc or ini"))
) )
} }
##We change the working directory becase of the model, but we want to avoid sideeffects, so we save the current location and after that we will change everything to it.
## Set the working directory to the inputLoc temporary. ## Set the working directory to the inputLoc temporary.
setwd(inputLoc) setwd(inputLoc)
##Run the spinup
##Run the spinup modell
if(silent){#silenc mode if(silent){#silenc mode
if(Linuxp){ if(Linuxp){
#In this case, in linux machines #In this case, in linux machines
@ -76,7 +81,8 @@ spinupMuso <- function(settings=NULL, parameters=NULL, debugging=FALSE, logfilen
############################################### ###############################################
#############LOG SECTION####################### #############LOG SECTION#######################
############################################### ###############################################
logspinup <- getLogs(outputLoc,outputNames,type="spinup")
logspinup <- getLogs(outputLoc,outputNames,type="spinup") #(:INSIDE: assistantFunctions.R)
if(length(logspinup)==0){ if(length(logspinup)==0){
if(keepEpc){ if(keepEpc){
@ -101,7 +107,7 @@ spinupMuso <- function(settings=NULL, parameters=NULL, debugging=FALSE, logfilen
} }
dirName<-normalizePath(paste(inputLoc,"/LOG",sep="")) dirName<-normalizePath(paste(inputLoc,"/LOG",sep=""))
dirERROR<-paste(inputLoc,"/ERROR",sep="") dirERROR<-paste0(inputLoc,"/ERROR")
if(!dir.exists(dirName)){ if(!dir.exists(dirName)){
dir.create(dirName)} dir.create(dirName)}
@ -117,7 +123,7 @@ spinupMuso <- function(settings=NULL, parameters=NULL, debugging=FALSE, logfilen
if(debugging==TRUE){ if(debugging==TRUE){
stampAndDir(outputLoc=outputLoc,stampDir=dirName, names=logspinup, type="output") stampAndDir(outputLoc=outputLoc,stampDir=dirName, names=logspinup, type="output") #(:INSIDE: assistantFunctions.R)
} }