solve the old file(con,"r") problem, and many more
This commit is contained in:
hollorol
parent
af240c9200
commit
f9554f28a1
@ -1,6 +1,6 @@
|
||||
Package: RBBGCMuso
|
||||
Title: An R package for BiomeBGC-MuSo ecosystem modelling
|
||||
Version: 0.3.1.0-1
|
||||
Version: 0.3.2.0-0
|
||||
Authors@R: person("Roland", "Hollo's", , "hollorol@gmail.com", role = c("aut", "cre"))
|
||||
Description: What the package does (one paragraph).
|
||||
Depends: R (>= 2.10)
|
||||
@ -15,5 +15,5 @@ Imports:
|
||||
Maintainer: Roland Hollo's <hollorol@gmail.com>
|
||||
RoxygenNote: 6.0.1
|
||||
Suggests: knitr,
|
||||
rmarkdown
|
||||
rmarkdown,
|
||||
VignetteBuilder: knitr
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
#' calibMuso
|
||||
t#' calibMuso
|
||||
#'
|
||||
#' This function changes the epc file and after that runs the BBGC-MuSo model and reads in its outputfile in a very structured way.
|
||||
#'
|
||||
@ -92,7 +92,17 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
|
||||
return("Modell Failure")#in that case the modell did not create even a logfile
|
||||
}
|
||||
|
||||
spincrash<-tail(readLines(paste(outputloc,logspinup,sep="/"),-1),1)==0 #If the last line in the logfile is 0 There are mistakes so the spinup crashes
|
||||
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)
|
||||
}
|
||||
}
|
||||
|
||||
#If the last line in the logfile is 0 There are mistakes so the spinup crashes
|
||||
|
||||
if(!spincrash){##If spinup did not crashed, run the normal run.
|
||||
|
||||
@ -150,12 +160,17 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
|
||||
}
|
||||
}
|
||||
|
||||
##if errorsign is 1 there is error, if it is 0 everything ok
|
||||
##if errorsign is 1 there is error, if it is 0 everything ok
|
||||
perror[is.na(perror)]<-0
|
||||
if(length(perror)>sum(perror)){
|
||||
errorsign <- 1
|
||||
} else {
|
||||
if(spincrash){
|
||||
errorsign <- 1
|
||||
} else {
|
||||
errorsign <- 0
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
if(keepEpc){#if keepepc option tured on
|
||||
|
||||
@ -133,3 +133,39 @@ file.path2<-function(str1, str2){
|
||||
return(file.path(str1,str2))
|
||||
}
|
||||
}
|
||||
|
||||
numFactors <- function(x,type="pos"){
|
||||
x <- as.integer(abs(x))
|
||||
div <- seq_len(x)
|
||||
posdiv <- div[x%%div==0L]
|
||||
negdiv <- posdiv*-1
|
||||
alldiv <- c(negdiv,posdiv)
|
||||
switch(type,"pos"=return(posdiv),"neg"=return(negdiv),"all"=return(alldiv))
|
||||
}
|
||||
|
||||
niceMatrixLayoutForPlots <- function(n){
|
||||
if(n==0){
|
||||
return(cat("Ther is nothing to do with 0 graph"))
|
||||
}
|
||||
n <- as.integer(n)
|
||||
factors <- numFactors(n)
|
||||
if(length(factors)==2){
|
||||
return(n)}
|
||||
sqrtn <- round(sqrt(n))
|
||||
num1 <- factors[which(min(abs(factors-sqrtn))==abs(factors-sqrtn))[1]]
|
||||
num2 <- n/num1
|
||||
return(c(num1,num2))
|
||||
}
|
||||
|
||||
truncNorm<-function(N,mean, sd, min, max){
|
||||
n=0
|
||||
randomNorm<-rep(NA,N)
|
||||
while(n<=N){
|
||||
transNorm<-rnorm(1,mean,sd)
|
||||
if((transNorm>min)&(transNorm<max)){
|
||||
randomNorm[n]<-transNorm
|
||||
n<-n+1
|
||||
}
|
||||
}
|
||||
return(randomNorm)
|
||||
}
|
||||
|
||||
@ -2,7 +2,7 @@
|
||||
#'
|
||||
#' This function runs the BBGC-MuSo model and reads in its outputfile in a very structured way, and after that plot the results automaticly
|
||||
#'
|
||||
#' @author Roland Hollos
|
||||
#' @author Roland Hollos, Dora Hidy
|
||||
#' @param settings You have to run the setupMuso function before rungetMuso. It is its output which contains all of the necessary system variables. It sets the whole environment
|
||||
#' @param timee The required timesteps in the modell output. It can be "d", if it is daily, "m", if it's monthly, "y", it it is yearly
|
||||
#' @param debugging If it is TRUE, it copies the log file to a Log directory to store it, if it is stamplog it contatenate a number before the logfile, which is one more than the maximum of the represented ones in the LOG directory. If it is true or stamplog it collects the "wrong" logfiles
|
||||
@ -57,16 +57,18 @@ plotMuso <- function(settings,
|
||||
} else {
|
||||
if(variable=="all"){
|
||||
|
||||
musoData <- rbind((1:ncol(musoData)),musoData) #creating the column indexes
|
||||
par(mfrow = c(2,numVari/2))
|
||||
musoData <- rbind(1:numVari,musoData) #creating the column indexes
|
||||
par(mfrow = niceMatrixLayoutForPlots(numVari))
|
||||
|
||||
apply(musoData, 2, function(x) plot(x[2:length(x)],pch=20,col="dark blue",xlab=xlab_muso,ylab = colnames(musoData)[x[1]]))
|
||||
par(mfrow=c(1,1))
|
||||
return(print("Everything was Ok. ;)"))
|
||||
} else {
|
||||
return(print("The variable option is the coloumn number of the output data-matrix, so it must be numeric, of if you want to plot the whole data matrix set it \"all\""))
|
||||
}
|
||||
|
||||
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
@ -87,7 +87,18 @@ rungetMuso <- function(settings, timee="d", debugging=FALSE, logfilename=NULL, k
|
||||
return("Modell Failure")#in that case the modell did not create even a logfile
|
||||
}
|
||||
|
||||
spincrash<-tail(readLines(paste(outputloc,logspinup,sep="/"),-1),1)==0 #If the last line in the logfile is 0 There are mistakes so the spinup crashes
|
||||
|
||||
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)
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
if(!spincrash){##If spinup did not crashed, run the normal run.
|
||||
|
||||
@ -145,9 +156,14 @@ rungetMuso <- function(settings, timee="d", debugging=FALSE, logfilename=NULL, k
|
||||
##if errorsign is 1 there is error, if it is 0 everything ok
|
||||
if(length(perror)>sum(perror)){
|
||||
errorsign <- 1
|
||||
|
||||
} else {
|
||||
if(spincrash){
|
||||
errorsign <- 1
|
||||
} else {
|
||||
errorsign <- 0
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
if(keepEpc){#if keepepc option tured on
|
||||
|
||||
@ -1,240 +1,240 @@
|
||||
rungetMuso <- function(settings, timee="d", debugging=FALSE, logfilename=NULL, keepEpc=FALSE, export=FALSE, silent=FALSE, aggressive=FALSE, leapYear=FALSE){
|
||||
## rungetMuso <- function(settings, timee="d", debugging=FALSE, logfilename=NULL, keepEpc=FALSE, export=FALSE, silent=FALSE, aggressive=FALSE, leapYear=FALSE){
|
||||
|
||||
|
||||
|
||||
|
||||
##########################################################################
|
||||
###########################Set local variables########################
|
||||
########################################################################
|
||||
## ##########################################################################
|
||||
## ###########################Set local variables########################
|
||||
## ########################################################################
|
||||
|
||||
Linuxp <-(Sys.info()[1]=="Linux")
|
||||
##Copy the variables from settings
|
||||
inputloc <- settings$inputloc
|
||||
outputloc <- settings$outputloc
|
||||
executable <- settings$executable
|
||||
ininput <- settings$ininput
|
||||
epc <- settings$epcinput
|
||||
calibrationpar <- settings$calibrationpar
|
||||
whereAmI<-getwd()
|
||||
## Linuxp <-(Sys.info()[1]=="Linux")
|
||||
## ##Copy the variables from settings
|
||||
## inputloc <- settings$inputloc
|
||||
## outputloc <- settings$outputloc
|
||||
## executable <- settings$executable
|
||||
## ininput <- settings$ininput
|
||||
## epc <- settings$epcinput
|
||||
## calibrationpar <- settings$calibrationpar
|
||||
## whereAmI<-getwd()
|
||||
|
||||
#############################################################
|
||||
############################spinup run############################
|
||||
##########################################################
|
||||
## #############################################################
|
||||
## ############################spinup run############################
|
||||
## ##########################################################
|
||||
|
||||
|
||||
##Sometimes a bug occure due to logfiles and controlfiles in the input loc directory
|
||||
## ##Sometimes a bug occure due to logfiles and controlfiles in the input loc directory
|
||||
|
||||
|
||||
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")
|
||||
## 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")
|
||||
|
||||
}
|
||||
## }
|
||||
|
||||
}
|
||||
## }
|
||||
|
||||
if(aggressive==TRUE){
|
||||
cleanupMuso(location=outputloc)
|
||||
}
|
||||
## if(aggressive==TRUE){
|
||||
## cleanupMuso(location=outputloc)
|
||||
## }
|
||||
|
||||
##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.
|
||||
## ##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)
|
||||
## ## Set the working directory to the inputloc temporary.
|
||||
## setwd(inputloc)
|
||||
|
||||
|
||||
##Run the model for the spinup run.
|
||||
## ##Run the model for the spinup run.
|
||||
|
||||
if(silent){#silenc mode
|
||||
if(Linuxp){
|
||||
#In this case, in linux machines
|
||||
system(paste(executable,ininput[1],"> /dev/null",sep=" "))
|
||||
} else {
|
||||
#In windows machines there is a show.output.on.console option
|
||||
system(paste(executable,ininput[1],sep=" "),show.output.on.console = FALSE)
|
||||
}
|
||||
## if(silent){#silenc mode
|
||||
## if(Linuxp){
|
||||
## #In this case, in linux machines
|
||||
## system(paste(executable,ininput[1],"> /dev/null",sep=" "))
|
||||
## } else {
|
||||
## #In windows machines there is a show.output.on.console option
|
||||
## system(paste(executable,ininput[1],sep=" "),show.output.on.console = FALSE)
|
||||
## }
|
||||
|
||||
} else {
|
||||
system(paste(executable,ininput[1],sep=" "))
|
||||
}
|
||||
## } else {
|
||||
## system(paste(executable,ininput[1],sep=" "))
|
||||
## }
|
||||
|
||||
|
||||
|
||||
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
|
||||
}
|
||||
## 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
|
||||
## }
|
||||
|
||||
spincrash<-tail(readLines(paste(outputloc,logspinup,sep="/"),-1),1)==0 #If the last line in the logfile is 0 There are mistakes so the spinup crashes
|
||||
## spincrash<-tail(readLines(paste(outputloc,logspinup,sep="/"),-1),1)==0 #If the last line in the logfile is 0 There are mistakes so the spinup crashes
|
||||
|
||||
if(!spincrash){##If spinup did not crashed, run the normal run.
|
||||
## if(!spincrash){##If spinup did not crashed, run the normal run.
|
||||
|
||||
#####################################################################
|
||||
###########################normal run#########################
|
||||
#################################################################
|
||||
## #####################################################################
|
||||
## ###########################normal run#########################
|
||||
## #################################################################
|
||||
|
||||
##for the sake of safe we set the location again
|
||||
setwd(inputloc)
|
||||
## ##for the sake of safe we set the location again
|
||||
## setwd(inputloc)
|
||||
|
||||
if(silent){
|
||||
if(Linuxp){
|
||||
system(paste(executable,ininput[2],"> /dev/null",sep=" "))
|
||||
} else {
|
||||
system(paste(executable,ininput[2],sep=" "),show.output.on.console = FALSE)
|
||||
}
|
||||
## if(silent){
|
||||
## if(Linuxp){
|
||||
## system(paste(executable,ininput[2],"> /dev/null",sep=" "))
|
||||
## } else {
|
||||
## system(paste(executable,ininput[2],sep=" "),show.output.on.console = FALSE)
|
||||
## }
|
||||
|
||||
} else {
|
||||
system(paste(executable,ininput[2],sep=" "))
|
||||
}
|
||||
## } else {
|
||||
## system(paste(executable,ininput[2],sep=" "))
|
||||
## }
|
||||
|
||||
|
||||
##read the output
|
||||
## ##read the output
|
||||
|
||||
switch(timee,
|
||||
"d"=(Reva<-getdailyout(settings)),
|
||||
"m"=(Reva<-getmonthlyout(settings)),
|
||||
"y"=(Reva<-getyearlyout(settings))
|
||||
)
|
||||
}
|
||||
## switch(timee,
|
||||
## "d"=(Reva<-getdailyout(settings)),
|
||||
## "m"=(Reva<-getmonthlyout(settings)),
|
||||
## "y"=(Reva<-getyearlyout(settings))
|
||||
## )
|
||||
## }
|
||||
|
||||
|
||||
logfiles <- list.files(outputloc)[grep("log$",list.files(outputloc))]#creating a vector for logfilenames
|
||||
## logfiles <- list.files(outputloc)[grep("log$",list.files(outputloc))]#creating a vector for logfilenames
|
||||
|
||||
###############################################
|
||||
#############LOG SECTION#######################
|
||||
###############################################
|
||||
## ###############################################
|
||||
## #############LOG SECTION#######################
|
||||
## ###############################################
|
||||
|
||||
perror<-as.numeric(as.vector(lapply(paste(outputloc,logfiles,sep="/"),function(x) tail(readLines(x,-1),1)))) #vector of spinup and normalrun error
|
||||
## perror<-as.numeric(as.vector(lapply(paste(outputloc,logfiles,sep="/"),function(x) tail(readLines(x,-1),1)))) #vector of spinup and normalrun error
|
||||
|
||||
if((debugging=="stamplog")|(debugging==TRUE)){#If debugging option turned on
|
||||
##If log or ERROR directory does not exists create it!
|
||||
dirName<-paste(inputloc,"LOG",sep="")
|
||||
dirERROR<-paste(inputloc,"ERROR",sep="")
|
||||
## if((debugging=="stamplog")|(debugging==TRUE)){#If debugging option turned on
|
||||
## ##If log or ERROR directory does not exists create it!
|
||||
## dirName<-paste(inputloc,"LOG",sep="")
|
||||
## dirERROR<-paste(inputloc,"ERROR",sep="")
|
||||
|
||||
if(!dir.exists(dirName)){
|
||||
dir.create(dirName)
|
||||
}
|
||||
## if(!dir.exists(dirName)){
|
||||
## dir.create(dirName)
|
||||
## }
|
||||
|
||||
if(!dir.exists(dirERROR)){
|
||||
dir.create(dirERROR)
|
||||
}
|
||||
}
|
||||
## if(!dir.exists(dirERROR)){
|
||||
## dir.create(dirERROR)
|
||||
## }
|
||||
## }
|
||||
|
||||
##if errorsign is 1 there is error, if it is 0 everything ok
|
||||
if(length(perror)>sum(perror)){
|
||||
errorsign <- 1
|
||||
} else {
|
||||
errorsign <- 0
|
||||
}
|
||||
## ##if errorsign is 1 there is error, if it is 0 everything ok
|
||||
## if(length(perror)>sum(perror)){
|
||||
## errorsign <- 1
|
||||
## } else {
|
||||
## errorsign <- 0
|
||||
## }
|
||||
|
||||
|
||||
if(keepEpc){#if keepepc option tured on
|
||||
## if(keepEpc){#if keepepc option tured on
|
||||
|
||||
if(length(unique(dirname(epc)))>1){
|
||||
print("Why are you playing with my nervs? Seriously? You hold your epc-s in different folders?")
|
||||
} else {
|
||||
epcdir <- dirname(epc[1])
|
||||
## if(length(unique(dirname(epc)))>1){
|
||||
## print("Why are you playing with my nervs? Seriously? You hold your epc-s in different folders?")
|
||||
## } else {
|
||||
## epcdir <- dirname(epc[1])
|
||||
|
||||
WRONGEPC<-paste(inputloc,"WRONGEPC",sep="")
|
||||
EPCS<-paste(inputloc,"EPCS",sep="")
|
||||
## WRONGEPC<-paste(inputloc,"WRONGEPC",sep="")
|
||||
## EPCS<-paste(inputloc,"EPCS",sep="")
|
||||
|
||||
if(!dir.exists(WRONGEPC)){
|
||||
dir.create(WRONGEPC)
|
||||
}
|
||||
## if(!dir.exists(WRONGEPC)){
|
||||
## dir.create(WRONGEPC)
|
||||
## }
|
||||
|
||||
if(!dir.exists(EPCS)){
|
||||
dir.create(EPCS)
|
||||
}
|
||||
## if(!dir.exists(EPCS)){
|
||||
## dir.create(EPCS)
|
||||
## }
|
||||
|
||||
epcfiles <- list.files(epcdir)[grep("epc$",list.files(epcdir))]
|
||||
stampnum<-stamp(EPCS)
|
||||
lapply(epcfiles,function (x) file.copy(from = paste(epcdir,"/",x,sep=""),to=paste(EPCS,"/",(stampnum+1),"-",x,sep="")))
|
||||
if(errorsign==1){
|
||||
lapply(epcfiles,function (x) file.copy(from = paste(EPCS,"/",(stampnum+1),"-",x,sep=""), to=WRONGEPC))
|
||||
}
|
||||
## epcfiles <- list.files(epcdir)[grep("epc$",list.files(epcdir))]
|
||||
## stampnum<-stamp(EPCS)
|
||||
## lapply(epcfiles,function (x) file.copy(from = paste(epcdir,"/",x,sep=""),to=paste(EPCS,"/",(stampnum+1),"-",x,sep="")))
|
||||
## if(errorsign==1){
|
||||
## lapply(epcfiles,function (x) file.copy(from = paste(EPCS,"/",(stampnum+1),"-",x,sep=""), to=WRONGEPC))
|
||||
## }
|
||||
|
||||
}
|
||||
}
|
||||
## }
|
||||
## }
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
if(debugging=="stamplog"){
|
||||
stampnum<-stamp(dirName)
|
||||
if(inputloc==outputloc){
|
||||
lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep=""), to=paste(dirName, "/",(stampnum+1),"-",x,sep="")))
|
||||
## if(debugging=="stamplog"){
|
||||
## stampnum<-stamp(dirName)
|
||||
## if(inputloc==outputloc){
|
||||
## lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep=""), to=paste(dirName, "/",(stampnum+1),"-",x,sep="")))
|
||||
|
||||
} else {
|
||||
lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep="/"), to=paste(dirName, "/",(stampnum+1),"-",x,sep="")))
|
||||
}
|
||||
## } else {
|
||||
## lapply( logfiles, function (x) file.rename(from=paste(outputloc,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 ))}
|
||||
## 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)){
|
||||
## } else { if(debugging){
|
||||
## if(is.null(logfilename)){
|
||||
|
||||
if(inputloc==outputloc){
|
||||
lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep=""), to=paste(dirName,"/", x, sep="")))
|
||||
} else {
|
||||
lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep="/"), to=paste(dirName,"/", x, sep="")))
|
||||
}
|
||||
## if(inputloc==outputloc){
|
||||
## lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep=""), to=paste(dirName,"/", x, sep="")))
|
||||
## } else {
|
||||
## lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep="/"), to=paste(dirName,"/", x, sep="")))
|
||||
## }
|
||||
|
||||
if(errorsign==1){
|
||||
lapply( logfiles, function (x) file.rename(from=paste(dirName,"/", x, sep=""), to=dirERROR))
|
||||
}
|
||||
## if(errorsign==1){
|
||||
## lapply( logfiles, function (x) file.rename(from=paste(dirName,"/", x, sep=""), to=dirERROR))
|
||||
## }
|
||||
|
||||
} else {
|
||||
## } else {
|
||||
|
||||
if(inputloc==outputloc){#These are very ugly solutions for a string problem: inputloc: "./", if outputloc equalent of inputloc, it ends with "/", the string manipulation can not handle this. The better solution is easy, but I dont have enough time(Roland Hollo's)
|
||||
lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep=""), to=paste(dirName, "/",logfilename,"-",x,sep="")))
|
||||
} else {
|
||||
lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep="/"), to=paste(dirName, "/",logfilename,"-",x,sep="")))
|
||||
}
|
||||
## if(inputloc==outputloc){#These are very ugly solutions for a string problem: inputloc: "./", if outputloc equalent of inputloc, it ends with "/", the string manipulation can not handle this. The better solution is easy, but I dont have enough time(Roland Hollo's)
|
||||
## lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep=""), to=paste(dirName, "/",logfilename,"-",x,sep="")))
|
||||
## } else {
|
||||
## lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep="/"), to=paste(dirName, "/",logfilename,"-",x,sep="")))
|
||||
## }
|
||||
|
||||
if(errorsign==1){
|
||||
lapply( logfiles, function (x) file.rename(from=paste(dirName, "/",logfilename,"-",x,sep=""), to=dirERROR))
|
||||
}
|
||||
}
|
||||
## if(errorsign==1){
|
||||
## lapply( logfiles, function (x) file.rename(from=paste(dirName, "/",logfilename,"-",x,sep=""), to=dirERROR))
|
||||
## }
|
||||
## }
|
||||
|
||||
}}
|
||||
## }}
|
||||
|
||||
cleanupMuso(location=outputloc)
|
||||
if(errorsign==1){
|
||||
return("Modell Failure")
|
||||
}
|
||||
## cleanupMuso(location=outputloc)
|
||||
## if(errorsign==1){
|
||||
## return("Modell Failure")
|
||||
## }
|
||||
|
||||
if(timee=="d"){
|
||||
colnames(Reva) <- unlist(settings$outputvars[[1]])
|
||||
} else {
|
||||
if(timee=="y")
|
||||
colnames(Reva) <- unlist(settings$outputvars[[2]])
|
||||
}
|
||||
## if(timee=="d"){
|
||||
## colnames(Reva) <- unlist(settings$outputvars[[1]])
|
||||
## } else {
|
||||
## if(timee=="y")
|
||||
## colnames(Reva) <- unlist(settings$outputvars[[2]])
|
||||
## }
|
||||
|
||||
if(leapYear){
|
||||
Reva <- corrigMuso(settings,Reva)
|
||||
rownames(Reva) <- musoDate(settings)
|
||||
} else {
|
||||
rownames(Reva) <- musoDate(settings, corrigated=FALSE)
|
||||
}
|
||||
## if(leapYear){
|
||||
## Reva <- corrigMuso(settings,Reva)
|
||||
## rownames(Reva) <- musoDate(settings)
|
||||
## } else {
|
||||
## rownames(Reva) <- musoDate(settings, corrigated=FALSE)
|
||||
## }
|
||||
|
||||
if(export!=FALSE){
|
||||
setwd(whereAmI)
|
||||
## if(export!=FALSE){
|
||||
## setwd(whereAmI)
|
||||
|
||||
## switch(fextension(export),
|
||||
## "csv"=(write.csv(Reva,export)),
|
||||
## "xlsx"=(),
|
||||
## "odt"=
|
||||
## ## switch(fextension(export),
|
||||
## ## "csv"=(write.csv(Reva,export)),
|
||||
## ## "xlsx"=(),
|
||||
## ## "odt"=
|
||||
|
||||
|
||||
## )
|
||||
write.csv(Reva,export)
|
||||
## ## )
|
||||
## write.csv(Reva,export)
|
||||
|
||||
} else{
|
||||
setwd(whereAmI)
|
||||
return(Reva)}
|
||||
}
|
||||
## } else{
|
||||
## setwd(whereAmI)
|
||||
## return(Reva)}
|
||||
## }
|
||||
|
||||
|
||||
|
||||
|
||||
@ -49,7 +49,8 @@ setupMuso <- function(executable=NULL,
|
||||
irrinput=NULL,
|
||||
nitinput=NULL,
|
||||
ininput=NULL,
|
||||
epcinput=NULL
|
||||
epcinput=NULL,
|
||||
mapData=NULL
|
||||
){
|
||||
|
||||
Linuxp <-(Sys.info()[1]=="Linux")
|
||||
@ -223,6 +224,8 @@ setupMuso <- function(executable=NULL,
|
||||
inifiles[[2]][grep("do IRRIGATION",inifiles[[2]])]<-paste(irrinput[2],"do IRRIGATION",sep="")
|
||||
}}
|
||||
|
||||
if(is.null(mapData)){
|
||||
|
||||
c<-grep("DAILY_OUTPUT",inifiles[[2]])+1
|
||||
numVar<-as.numeric(unlist(strsplit(inifiles[[2]][c],"[\ \t]"))[1])
|
||||
dailyVarCodes<-inifiles[[2]][(c+1):(c+numVar)]
|
||||
@ -232,9 +235,25 @@ setupMuso <- function(executable=NULL,
|
||||
numVar<-as.numeric(unlist(strsplit(inifiles[[2]][c],"[\ \t]"))[1])
|
||||
annualVarCodes<-inifiles[[2]][(c+1):(c+numVar)]
|
||||
annualVarnames<-lapply(annualVarCodes, function(x) musoMapping(unlist(strsplit(x,"[\ \t]"))[1]))
|
||||
outputvars<-list(dailyVarnames,annualVarnames)} else {
|
||||
|
||||
c<-grep("DAILY_OUTPUT",inifiles[[2]])+1
|
||||
numVar<-as.numeric(unlist(strsplit(inifiles[[2]][c],"[\ \t]"))[1])
|
||||
dailyVarCodes<-inifiles[[2]][(c+1):(c+numVar)]
|
||||
dailyVarnames<-lapply(dailyVarCodes, function(x) musoMapping(unlist(strsplit(x,"[\ \t]"))[1],mapData))
|
||||
|
||||
c<-grep("ANNUAL_OUTPUT",inifiles[[2]])+1
|
||||
numVar<-as.numeric(unlist(strsplit(inifiles[[2]][c],"[\ \t]"))[1])
|
||||
annualVarCodes<-inifiles[[2]][(c+1):(c+numVar)]
|
||||
annualVarnames<-lapply(annualVarCodes, function(x) musoMapping(unlist(strsplit(x,"[\ \t]"))[1],mapData))
|
||||
outputvars<-list(dailyVarnames,annualVarnames)
|
||||
|
||||
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
if(is.null(executable)){
|
||||
if(Linuxp){
|
||||
executable<-paste(inputloc,"muso",sep="")
|
||||
@ -252,8 +271,8 @@ setupMuso <- function(executable=NULL,
|
||||
if(is.null(outputname)){
|
||||
cat("I cannot find outputname, in your default ini file \n Please make sure that the line wich contains the name alse contains the prefix and the outmut keywords!")
|
||||
|
||||
}
|
||||
## outputname<-unlist(read.table(ininput[2],skip=93,nrows = 1))[1]
|
||||
}
|
||||
## outputname<-unlist(read.table(ininput[2],skip=93,nrows = 1))[1]
|
||||
|
||||
|
||||
if(is.null(outputloc)){
|
||||
|
||||
@ -38,5 +38,5 @@ It depends on the export parameter. The function returns with a matrix with the
|
||||
This function runs the BBGC-MuSo model and reads in its outputfile in a very structured way, and after that plot the results automaticly
|
||||
}
|
||||
\author{
|
||||
Roland Hollos
|
||||
Roland Hollos, Dora Hidy
|
||||
}
|
||||
|
||||
BIN
RBBGCMuso_0.3.2.0-0.tar.gz
Normal file
BIN
RBBGCMuso_0.3.2.0-0.tar.gz
Normal file
Binary file not shown.
Loading…
Reference in New Issue
Block a user