many bugfixes
This commit is contained in:
hollorol
parent
15c174fa18
commit
af16508b9e
@ -19,11 +19,11 @@
|
||||
#' @import utils
|
||||
#' @export
|
||||
|
||||
calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logfilename=NULL, keepEpc=FALSE, export=FALSE, silent=FALSE, aggressive=FALSE, leapYear=FALSE,keepBinary=FALSE, binayPlace="./", fileToChange="epc"){
|
||||
calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logfilename=NULL, keepEpc=FALSE, export=FALSE, silent=FALSE, aggressive=FALSE, leapYear=FALSE,keepBinary=FALSE, binaryPlace="./", fileToChange="epc"){
|
||||
|
||||
|
||||
##########################################################################
|
||||
###########################Set local variables########################
|
||||
###########################Set local variables and places########################
|
||||
########################################################################
|
||||
|
||||
Linuxp <-(Sys.info()[1]=="Linux")
|
||||
@ -37,6 +37,9 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
|
||||
whereAmI<-getwd()
|
||||
|
||||
|
||||
## Set the working directory to the inputLoc temporarly.
|
||||
setwd(inputLoc)
|
||||
|
||||
|
||||
##########################################################################
|
||||
###########################Defining Functions########################
|
||||
@ -55,18 +58,20 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
|
||||
##Sometimes a bug occure due to logfiles and controlfiles in the input loc directory
|
||||
##alma
|
||||
|
||||
if(silent!=TRUE){
|
||||
if(length(grep("(dayout$)|(log$)",list.files(inputLoc)))>0){
|
||||
warning("there is a log or dayout file nearby the ini files, that may cause problemes. \n \n If you want to avoid that possible problemes, please copy the log or dayout files into a save place, and after do a cleanupMuso(), or delete these manually, or run the rungetMuso(), with the agressive=TRUE parameter \n \n")
|
||||
## if(silent!=TRUE){
|
||||
## if(length(grep("(dayout$)|(log$)",list.files(inputLoc)))>0){
|
||||
## warning("there is a log or dayout file nearby the ini files, that may cause problemes. \n \n If you want to avoid that possible problemes, please copy the log or dayout files into a save place, and after do a cleanupMuso(), or delete these manually, or run the rungetMuso(), with the agressive=TRUE parameter \n \n")
|
||||
|
||||
}
|
||||
## }
|
||||
|
||||
}
|
||||
## }
|
||||
|
||||
if(aggressive==TRUE){
|
||||
cleanupMuso(location=outputLoc,deep = TRUE)
|
||||
}
|
||||
## if(aggressive==TRUE){
|
||||
## cleanupMuso(location=outputLoc,deep = TRUE)
|
||||
## }
|
||||
|
||||
|
||||
|
||||
##change the epc file if and only if there are given parameters
|
||||
if(!is.null(parameters)){
|
||||
|
||||
@ -80,9 +85,6 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
|
||||
##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.
|
||||
setwd(inputLoc)
|
||||
|
||||
|
||||
##Run the model for the spinup run.
|
||||
|
||||
@ -102,6 +104,7 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
|
||||
|
||||
|
||||
logspinup<-list.files(outputLoc)[grep("log$",list.files(outputLoc))]#load the logfiles
|
||||
|
||||
if(length(logspinup)==0){
|
||||
return("Modell Failure")#in that case the modell did not create even a logfile
|
||||
}
|
||||
@ -146,11 +149,13 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
|
||||
"m"=(Reva<-getmonthlyout(settings)),
|
||||
"y"=(Reva<-getyearlyout(settings))
|
||||
)
|
||||
|
||||
if(keepBinary){
|
||||
file.copy(grep("out$",list.files(outputLoc),value=TRUE)
|
||||
file.copy(file.path(outputLoc,grep("out$",list.files(outputLoc),value=TRUE))
|
||||
,file.path(binaryPlace,paste0(stamp(binaryPlace),"-",grep("out$",list.files(outputLoc),value=TRUE))))
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
logfiles <- list.files(outputLoc)[grep("log$",list.files(outputLoc))]#creating a vector for logfilenames
|
||||
|
||||
|
||||
@ -12,8 +12,9 @@ getthespecdata<-function(settings,colnumbers){
|
||||
}
|
||||
|
||||
getdailyout<-function(settings){
|
||||
binaryname<-paste(settings$inputLoc,settings$outputNames,".dayout",sep="")
|
||||
binaryname<-paste0(settings$outputLoc,"/",settings$outputNames[2],".dayout")
|
||||
d<-file(binaryname,"rb")
|
||||
##leapyear is not implemented yet in this function
|
||||
dayoutput<-matrix(readBin(d,"double",size=8,n=(settings$numData[1])),(settings$numYears*365),byrow=TRUE)
|
||||
close(d)
|
||||
return(dayoutput)
|
||||
|
||||
@ -1,44 +1,54 @@
|
||||
normalMuso<- function(settings,parameters=c(" ECOPHYS"),timee="d",debugging=FALSE,logfilename=NULL){
|
||||
normalMuso<- function(settings,parameters=NULL,timee="d",debugging=FALSE,logfilename=NULL,keepEpc=FALSE, export=FALSE,silent=FALSE,aggressive=FALSE,leapYear=FALSE, binaryPlace="./",fileToChange="epc"){
|
||||
|
||||
Linuxp <-(Sys.info()[1]=="Linux")
|
||||
|
||||
########################################################
|
||||
###############################Preparational functions###############
|
||||
#####################################################
|
||||
##########################################################################
|
||||
###########################Set local variables########################
|
||||
########################################################################
|
||||
|
||||
numcut<-function(string){
|
||||
#This function returns only the starting numbers of a string
|
||||
unlist(strsplit(grep("^[0-9]",string,value = TRUE),"[aAzZ-]"))[1]
|
||||
}
|
||||
|
||||
numcutall<-function(vector){
|
||||
#numcall apply numcut for all elements of a string vector
|
||||
as.numeric(unlist(apply(as.matrix(vector),1,numcut)))
|
||||
}
|
||||
|
||||
stamp<-function(path="./"){
|
||||
#It gives back a stamp wich is the maximum number of the output numcall
|
||||
numbers<-numcutall(list.files(path))
|
||||
if(length(numbers)==0){
|
||||
return (0)} else {
|
||||
return(max(numbers))}
|
||||
}
|
||||
Linuxp <-(Sys.info()[1]=="Linux")
|
||||
##Copy the variables from settings
|
||||
inputLoc <- settings$inputLoc
|
||||
outputLoc <- settings$outputLoc
|
||||
executable <- settings$executable
|
||||
iniInput <- settings$iniInput
|
||||
epc <- settings$epcInput
|
||||
calibrationPar <- settings$calibrationPar
|
||||
whereAmI<-getwd()
|
||||
|
||||
|
||||
|
||||
|
||||
changemulline(settings,parameters)
|
||||
|
||||
|
||||
inputloc<-settings$inputloc
|
||||
executable<-settings$executable
|
||||
ininput<-settings$ininput
|
||||
|
||||
if(!is.null(parameters)){
|
||||
|
||||
switch(fileToChange,
|
||||
"epc"=(changemulline(filename=epc[2],calibrationPar,parameters)),
|
||||
"ini"=(changemulline(filename=iniInput[2],calibrationPar,parameters)),
|
||||
"both"=(stop("This option is not implemented yet, please choose epc or ini"))
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
setwd(inputloc)
|
||||
setwd(inputLoc)
|
||||
#normal run
|
||||
system(paste(executable,ininput[2],sep=" "))
|
||||
|
||||
if(silent){
|
||||
if(Linuxp){
|
||||
system(paste(executable,iniInput[2],"> /dev/null",sep=" "))
|
||||
} else {
|
||||
system(paste(executable,iniInput[2],sep=" "),show.output.on.console = FALSE)
|
||||
}
|
||||
|
||||
} else {
|
||||
system(paste(executable,iniInput[2],sep=" "))
|
||||
}
|
||||
|
||||
|
||||
|
||||
system(paste(executable,iniInput[2],sep=" "))
|
||||
|
||||
switch(timee,
|
||||
"d"=(Reva<-getdailyout(settings)),
|
||||
|
||||
@ -72,8 +72,8 @@ setupMuso <- function(executable=NULL,
|
||||
writep <<- writep+1
|
||||
if(filep)
|
||||
{
|
||||
tempVar["spinup"] <- paste0(inputLoc,inputParser(string=grepString,fileName=iniFiles$spinup,counter=1,value=TRUE))
|
||||
tempVar["normal"] <- paste0(inputLoc,inputParser(string=grepString,fileName=iniFiles$normal,counter=1,value=TRUE))
|
||||
tempVar["spinup"] <- file.path(inputLoc,inputParser(string=grepString,fileName=iniFiles$spinup,counter=1,value=TRUE))
|
||||
tempVar["normal"] <- file.path(inputLoc,inputParser(string=grepString,fileName=iniFiles$normal,counter=1,value=TRUE))
|
||||
} else {
|
||||
tempVar["spinup"] <- inputParser(string=grepString,fileName=iniFiles$spinup,counter=1,value=TRUE)
|
||||
tempVar["normal"] <- inputParser(string=grepString,fileName=iniFiles$normal,counter=1,value=TRUE)
|
||||
@ -89,9 +89,12 @@ setupMuso <- function(executable=NULL,
|
||||
}
|
||||
return(tempVar)
|
||||
}
|
||||
|
||||
|
||||
if(is.null(inputLoc)){
|
||||
inputLoc<- "./"}
|
||||
inputLoc<- normalizePath("./")
|
||||
} else{
|
||||
inputLoc <- normalizePath(inputLoc)
|
||||
}
|
||||
|
||||
#iniChangedp <- FALSE
|
||||
|
||||
@ -183,8 +186,9 @@ setupMuso <- function(executable=NULL,
|
||||
} else {
|
||||
file.copy(executable,inputLoc)
|
||||
}
|
||||
|
||||
outputName <- unlist(strsplit(iniFiles[[2]][grep("OUTPUT_CONTROL",iniFiles[[2]])+1],"[\ \t]"))[1]
|
||||
outputName <- character(2)
|
||||
outputName[1] <- basename(unlist(strsplit(iniFiles[[1]][grep("OUTPUT_CONTROL",iniFiles[[1]])+1],"[\ \t]"))[1])
|
||||
outputName[2] <- basename(unlist(strsplit(iniFiles[[2]][grep("OUTPUT_CONTROL",iniFiles[[2]])+1],"[\ \t]"))[1])
|
||||
## outputName <- unlist(strsplit(grep("output",grep("prefix",iniFiles[[2]],value=TRUE),value=TRUE),"[\ \t]"))[1]
|
||||
##THIS IS AN UGLY SOLUTION, WHICH NEEDS AN UPGRADE!!! FiXED (2017.09.11)
|
||||
## outputName <- unlist(strsplit(grep("prefix for output files",iniFiles[[2]],value=TRUE),"[\ \t]"))[1]
|
||||
@ -197,7 +201,13 @@ setupMuso <- function(executable=NULL,
|
||||
|
||||
if(is.null(outputLoc)){
|
||||
## outputLoc<-paste((rev(rev(unlist(strsplit(outputName,"/")))[-1])),collapse="/")
|
||||
outputLoc <- dirname(outputName)
|
||||
outputLoc <- dirname(unlist(strsplit(iniFiles[[2]][grep("OUTPUT_CONTROL",iniFiles[[2]])+1],"[\ \t]"))[1])
|
||||
if(substr(outputLoc,start = 1,stop = 1)!="/"){
|
||||
##if the outputName is not absolute path make it absolute
|
||||
outputLoc <- file.path(inputLoc,outputLoc)
|
||||
}
|
||||
} else {
|
||||
outputLoc <- normalizePath(outputLoc)
|
||||
}
|
||||
|
||||
|
||||
@ -219,6 +229,9 @@ setupMuso <- function(executable=NULL,
|
||||
|
||||
writeLines(iniFiles[[1]],iniInput[1])
|
||||
writeLines(iniFiles[[2]],iniInput[2])
|
||||
|
||||
suppressWarnings(file.remove(file.path(outputLoc,outputNames[1])))
|
||||
suppressWarnings(file.remove(file.path(outputLoc,outputNames[2])))
|
||||
|
||||
settings = list(executable = executable,
|
||||
calibrationPar = calibrationPar,
|
||||
@ -246,7 +259,7 @@ setupMuso <- function(executable=NULL,
|
||||
|
||||
if(writep!=nrow(grepHelper)){
|
||||
writeLines(iniFiles[[1]],iniInput[[1]])
|
||||
if(epcInput[1]!=epcInput[2]){ #Change need here
|
||||
if(inputs$epcInput[1]!=inputs$epc$Input[2]){ #Change need here
|
||||
writeLines(iniFiles[[2]],iniInput[[2]])
|
||||
}
|
||||
}
|
||||
|
||||
@ -15,7 +15,7 @@
|
||||
#' logfilename=NULL, keepEpc=FALSE, silent=FALSE, aggressive=FALSE)
|
||||
#' @export
|
||||
|
||||
spinupMuso <- function(settings, parameters=NULL, debugging=FALSE, logfilename=NULL, keepEpc=FALSE, silent=FALSE, aggressive=FALSE){
|
||||
spinupMuso <- function(settings, parameters=NULL, debugging=FALSE, logfilename=NULL, keepEpc=FALSE, silent=FALSE, aggressive=FALSE, fileToChange="epc"){
|
||||
|
||||
##########################################################################
|
||||
###########################Set local variables########################
|
||||
@ -40,16 +40,23 @@ spinupMuso <- function(settings, parameters=NULL, debugging=FALSE, logfilename=N
|
||||
|
||||
if(silent!=TRUE){
|
||||
if(length(grep("(dayout$)|(log$)",list.files(inputLoc)))>0){
|
||||
cat(" \n \n WARMING: there is a log or dayout file nearby the ini files, that may cause problemes. \n \n If you want to avoid that possible problemes, please copy the log or dayout files into a save place, and after do a cleanupMuso(), or delete these manually, or run the rungetMuso(), with the agressive=TRUE parameter \n \n")}}
|
||||
warning(" \n \n WARMING: there is a log or dayout file nearby the ini files, that may cause problemes. \n \n If you want to avoid that possible problemes, please copy the log or dayout files into a save place, and after do a cleanupMuso(), or delete these manually, or run the rungetMuso(), with the agressive=TRUE parameter \n \n")}}
|
||||
|
||||
##With the aggressive option every unneeded file will deleted
|
||||
if(aggressive==TRUE){
|
||||
cleanupMuso(location=outputLoc)}
|
||||
cleanupMuso(location=outputLoc,deep=TRUE)}
|
||||
|
||||
|
||||
##change the epc file if and only if there are given parameters
|
||||
## if(!is.null(parameters)){
|
||||
## changemulline(filename=epc[1], calibrationPar, parameters)}
|
||||
if(!is.null(parameters)){
|
||||
changemulline(filename=epc[1], calibrationPar, parameters)}
|
||||
switch(fileToChange,
|
||||
"epc"=(changemulline(filename=epc[2],calibrationPar,parameters)),
|
||||
"ini"=(changemulline(filename=iniInput[2],calibrationPar,parameters)),
|
||||
"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.
|
||||
|
||||
@ -73,7 +80,24 @@ spinupMuso <- function(settings, parameters=NULL, debugging=FALSE, logfilename=N
|
||||
#############LOG SECTION#######################
|
||||
###############################################
|
||||
logspinup<-list.files(outputLoc)[grep("log$",list.files(outputLoc))]
|
||||
spincrash<-tail(readLines(paste(outputLoc,logspinup,sep="/"),-1),1)==0
|
||||
## spincrash<-tail(readLines(paste(outputLoc,logspinup,sep="/"),-1),1)==0
|
||||
|
||||
logspinup<-list.files(outputLoc)[grep("log$",list.files(outputLoc))]#load the logfiles
|
||||
|
||||
if(length(logspinup)==0){
|
||||
spincrash <- TRUE
|
||||
}
|
||||
|
||||
if(length(logspinup)>1){
|
||||
spincrash <- TRUE
|
||||
} else {
|
||||
if(identical(tail(readLines(paste(outputLoc,logspinup,sep="/"),-1),1),character(0))){
|
||||
spincrash <- TRUE
|
||||
} else {
|
||||
spincrash <- (tail(readLines(paste(outputLoc,logspinup,sep="/"),-1),1)!=1)
|
||||
}
|
||||
}
|
||||
|
||||
logfiles <- list.files(outputLoc)[grep("log$",list.files(outputLoc))]
|
||||
|
||||
dirName<-paste(inputLoc,"/LOG",sep="")
|
||||
@ -164,7 +188,7 @@ spinupMuso <- function(settings, parameters=NULL, debugging=FALSE, logfilename=N
|
||||
|
||||
}}
|
||||
|
||||
cleanupMuso(location=outputLoc)
|
||||
#cleanupMuso(location=outputLoc)
|
||||
|
||||
|
||||
if(errorsign==1){
|
||||
|
||||
@ -248,3 +248,39 @@
|
||||
if(length(irrInput)==2){
|
||||
iniFiles[[2]][grep("do IRRIGATION",iniFiles[[2]])]<-paste(irrInput[2],"do IRRIGATION",sep="")
|
||||
}}
|
||||
getthewholedata<-function(settings){
|
||||
f1<-settings$ininput[2]
|
||||
filename = paste(settings$inputloc,settings$outputname,"_ann.txt",sep="")
|
||||
alloutput<-read.table(filename,skip=22, header = FALSE)
|
||||
return(alloutput)
|
||||
}
|
||||
|
||||
getthespecdata<-function(settings,colnumbers){
|
||||
filename<-paste(settings$inputloc,settings$outputname,"_ann.txt",sep="")
|
||||
specoutput<-read.table(filename,skip=22, header = FALSE)[,colnumbers]
|
||||
return(specoutput)
|
||||
}
|
||||
|
||||
getdailyout<-function(settings){
|
||||
binaryname<-paste(settings$inputLoc,settings$outputNames,".dayout",sep="")
|
||||
d<-file(binaryname,"rb")
|
||||
dayoutput<-matrix(readBin(d,"double",size=8,n=(settings$numData[1])),(settings$numYears*365),byrow=TRUE)
|
||||
close(d)
|
||||
return(dayoutput)
|
||||
}
|
||||
|
||||
getmonthlyout<-function(settings){
|
||||
binaryname<-paste(settings$inputloc,settings$outputname,".monavgout",sep="")
|
||||
d<-file(binaryname,"rb")
|
||||
monoutput<-matrix(readBin(d,"double",size=4,n=(settings$numdata[2])),(settings$numyears*12),byrow=TRUE)
|
||||
close(d)
|
||||
return(monoutput)
|
||||
}
|
||||
|
||||
getyearlyout<-function(settings){
|
||||
binaryname<-paste(settings$inputloc,settings$outputname,".annout",sep="")
|
||||
d<-file(binaryname,"rb")
|
||||
yearoutput<-matrix(readBin(d,"double",size=4,n=(settings$numdata[3])),(settings$numyears),byrow=TRUE)
|
||||
close(d)
|
||||
return(yearoutput)
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user