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

solve the old file(con,"r") problem, and many more

Browse Source
This commit is contained in:
hollorol 2017-09-16 14:41:21 +02:00
parent af240c9200
commit f9554f28a1
9 changed files with 320 additions and 232 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
RBBGCMuso/DESCRIPTION
View File

@ -1,6 +1,6 @@
Package: RBBGCMuso Package: RBBGCMuso
Title: An R package for BiomeBGC-MuSo ecosystem modelling 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")) Authors@R: person("Roland", "Hollo's", , "hollorol@gmail.com", role = c("aut", "cre"))
Description: What the package does (one paragraph). Description: What the package does (one paragraph).
Depends: R (>= 2.10) Depends: R (>= 2.10)
@ -15,5 +15,5 @@ Imports:
Maintainer: Roland Hollo's <hollorol@gmail.com> Maintainer: Roland Hollo's <hollorol@gmail.com>
RoxygenNote: 6.0.1 RoxygenNote: 6.0.1
Suggests: knitr, Suggests: knitr,
rmarkdown rmarkdown,
VignetteBuilder: knitr VignetteBuilder: knitr

23
RBBGCMuso/R/calibMuso.R
View File

@ -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. #' 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 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. if(!spincrash){##If spinup did not crashed, run the normal run.
@ -150,11 +160,16 @@ 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)){ if(length(perror)>sum(perror)){
errorsign <- 1 errorsign <- 1
} else { } else {
errorsign <- 0 if(spincrash){
errorsign <- 1
} else {
errorsign <- 0
}
} }

36
RBBGCMuso/R/otherUsefullFunctions.R
View File

@ -133,3 +133,39 @@ file.path2<-function(str1, str2){
return(file.path(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)
}

36
RBBGCMuso/R/plotMuso.R
View File

@ -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 #' 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 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 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 #' @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
@ -44,30 +44,32 @@ plotMuso <- function(settings,
logfilename=logfilename, logfilename=logfilename,
export=export) export=export)
xlab_muso<- switch(timee, "d"="days","y"="years","m"="months") xlab_muso<- switch(timee, "d"="days","y"="years","m"="months")
numVari <- ncol(musoData) numVari <- ncol(musoData)
if(is.numeric(variable)){ if(is.numeric(variable)){
if((variable>numVari)|(variable<1)){ if((variable>numVari)|(variable<1)){
return(print(paste("The variable parameter must be between 1 and ",numVari))) return(print(paste("The variable parameter must be between 1 and ",numVari)))
} }
plot(musoData[,variable],pch=20,col = "dark blue",xlab=xlab_muso,ylab=colnames(musoData)[variable]) plot(musoData[,variable],pch=20,col = "dark blue",xlab=xlab_muso,ylab=colnames(musoData)[variable])
} else { } else {
if(variable=="all"){ if(variable=="all"){
musoData <- rbind((1:ncol(musoData)),musoData) #creating the column indexes musoData <- rbind(1:numVari,musoData) #creating the column indexes
par(mfrow = c(2,numVari/2)) 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]])) apply(musoData, 2, function(x) plot(x[2:length(x)],pch=20,col="dark blue",xlab=xlab_muso,ylab = colnames(musoData)[x[1]]))
return(print("Everything was Ok. ;)")) par(mfrow=c(1,1))
} else { 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\"")) 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\""))
} }
}
}

20
RBBGCMuso/R/rungetMuso.R
View File

@ -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 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. if(!spincrash){##If spinup did not crashed, run the normal run.
@ -145,8 +156,13 @@ rungetMuso <- function(settings, timee="d", debugging=FALSE, logfilename=NULL, k
##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
if(length(perror)>sum(perror)){ if(length(perror)>sum(perror)){
errorsign <- 1 errorsign <- 1
} else { } else {
errorsign <- 0 if(spincrash){
errorsign <- 1
} else {
errorsign <- 0
}
} }

336
RBBGCMuso/R/rungettanul.R
View File

@ -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") ## Linuxp <-(Sys.info()[1]=="Linux")
##Copy the variables from settings ## ##Copy the variables from settings
inputloc <- settings$inputloc ## inputloc <- settings$inputloc
outputloc <- settings$outputloc ## outputloc <- settings$outputloc
executable <- settings$executable ## executable <- settings$executable
ininput <- settings$ininput ## ininput <- settings$ininput
epc <- settings$epcinput ## epc <- settings$epcinput
calibrationpar <- settings$calibrationpar ## calibrationpar <- settings$calibrationpar
whereAmI<-getwd() ## 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(silent!=TRUE){
if(length(grep("(dayout$)|(log$)",list.files(inputloc)))>0){ ## 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") ## 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){ ## if(aggressive==TRUE){
cleanupMuso(location=outputloc) ## 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. ## ## Set the working directory to the inputloc temporary.
setwd(inputloc) ## setwd(inputloc)
##Run the model for the spinup run. ## ##Run the model for the spinup run.
if(silent){#silenc mode ## if(silent){#silenc mode
if(Linuxp){ ## if(Linuxp){
#In this case, in linux machines ## #In this case, in linux machines
system(paste(executable,ininput[1],"> /dev/null",sep=" ")) ## system(paste(executable,ininput[1],"> /dev/null",sep=" "))
} else { ## } else {
#In windows machines there is a show.output.on.console option ## #In windows machines there is a show.output.on.console option
system(paste(executable,ininput[1],sep=" "),show.output.on.console = FALSE) ## system(paste(executable,ininput[1],sep=" "),show.output.on.console = FALSE)
} ## }
} else { ## } else {
system(paste(executable,ininput[1],sep=" ")) ## system(paste(executable,ininput[1],sep=" "))
} ## }
logspinup<-list.files(outputloc)[grep("log$",list.files(outputloc))]#load the logfiles ## logspinup<-list.files(outputloc)[grep("log$",list.files(outputloc))]#load the logfiles
if(length(logspinup)==0){ ## if(length(logspinup)==0){
return("Modell Failure")#in that case the modell did not create even a logfile ## 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 ## ##for the sake of safe we set the location again
setwd(inputloc) ## setwd(inputloc)
if(silent){ ## if(silent){
if(Linuxp){ ## if(Linuxp){
system(paste(executable,ininput[2],"> /dev/null",sep=" ")) ## system(paste(executable,ininput[2],"> /dev/null",sep=" "))
} else { ## } else {
system(paste(executable,ininput[2],sep=" "),show.output.on.console = FALSE) ## system(paste(executable,ininput[2],sep=" "),show.output.on.console = FALSE)
} ## }
} else { ## } else {
system(paste(executable,ininput[2],sep=" ")) ## system(paste(executable,ininput[2],sep=" "))
} ## }
##read the output ## ##read the output
switch(timee, ## switch(timee,
"d"=(Reva<-getdailyout(settings)), ## "d"=(Reva<-getdailyout(settings)),
"m"=(Reva<-getmonthlyout(settings)), ## "m"=(Reva<-getmonthlyout(settings)),
"y"=(Reva<-getyearlyout(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((debugging=="stamplog")|(debugging==TRUE)){#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<-paste(inputloc,"LOG",sep="") ## dirName<-paste(inputloc,"LOG",sep="")
dirERROR<-paste(inputloc,"ERROR",sep="") ## dirERROR<-paste(inputloc,"ERROR",sep="")
if(!dir.exists(dirName)){ ## if(!dir.exists(dirName)){
dir.create(dirName) ## dir.create(dirName)
} ## }
if(!dir.exists(dirERROR)){ ## if(!dir.exists(dirERROR)){
dir.create(dirERROR) ## dir.create(dirERROR)
} ## }
} ## }
##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
if(length(perror)>sum(perror)){ ## if(length(perror)>sum(perror)){
errorsign <- 1 ## errorsign <- 1
} else { ## } else {
errorsign <- 0 ## errorsign <- 0
} ## }
if(keepEpc){#if keepepc option tured on ## if(keepEpc){#if keepepc option tured on
if(length(unique(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?") ## print("Why are you playing with my nervs? Seriously? You hold your epc-s in different folders?")
} else { ## } else {
epcdir <- dirname(epc[1]) ## epcdir <- dirname(epc[1])
WRONGEPC<-paste(inputloc,"WRONGEPC",sep="") ## WRONGEPC<-paste(inputloc,"WRONGEPC",sep="")
EPCS<-paste(inputloc,"EPCS",sep="") ## EPCS<-paste(inputloc,"EPCS",sep="")
if(!dir.exists(WRONGEPC)){ ## if(!dir.exists(WRONGEPC)){
dir.create(WRONGEPC) ## dir.create(WRONGEPC)
} ## }
if(!dir.exists(EPCS)){ ## if(!dir.exists(EPCS)){
dir.create(EPCS) ## dir.create(EPCS)
} ## }
epcfiles <- list.files(epcdir)[grep("epc$",list.files(epcdir))] ## epcfiles <- list.files(epcdir)[grep("epc$",list.files(epcdir))]
stampnum<-stamp(EPCS) ## stampnum<-stamp(EPCS)
lapply(epcfiles,function (x) file.copy(from = paste(epcdir,"/",x,sep=""),to=paste(EPCS,"/",(stampnum+1),"-",x,sep=""))) ## lapply(epcfiles,function (x) file.copy(from = paste(epcdir,"/",x,sep=""),to=paste(EPCS,"/",(stampnum+1),"-",x,sep="")))
if(errorsign==1){ ## if(errorsign==1){
lapply(epcfiles,function (x) file.copy(from = paste(EPCS,"/",(stampnum+1),"-",x,sep=""), to=WRONGEPC)) ## lapply(epcfiles,function (x) file.copy(from = paste(EPCS,"/",(stampnum+1),"-",x,sep=""), to=WRONGEPC))
} ## }
} ## }
} ## }
if(debugging=="stamplog"){ ## if(debugging=="stamplog"){
stampnum<-stamp(dirName) ## stampnum<-stamp(dirName)
if(inputloc==outputloc){ ## if(inputloc==outputloc){
lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep=""), to=paste(dirName, "/",(stampnum+1),"-",x,sep=""))) ## lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep=""), to=paste(dirName, "/",(stampnum+1),"-",x,sep="")))
} else { ## } else {
lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep="/"), to=paste(dirName, "/",(stampnum+1),"-",x,sep=""))) ## lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep="/"), to=paste(dirName, "/",(stampnum+1),"-",x,sep="")))
} ## }
if(errorsign==1){ ## if(errorsign==1){
lapply( logfiles, function (x) file.copy(from=paste(dirName, "/",(stampnum+1),"-",x,sep=""), to=dirERROR ))} ## lapply( logfiles, function (x) file.copy(from=paste(dirName, "/",(stampnum+1),"-",x,sep=""), to=dirERROR ))}
} else { if(debugging){ ## } else { if(debugging){
if(is.null(logfilename)){ ## if(is.null(logfilename)){
if(inputloc==outputloc){ ## if(inputloc==outputloc){
lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep=""), to=paste(dirName,"/", x, sep=""))) ## lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep=""), to=paste(dirName,"/", x, sep="")))
} else { ## } else {
lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep="/"), to=paste(dirName,"/", x, sep=""))) ## lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep="/"), to=paste(dirName,"/", x, sep="")))
} ## }
if(errorsign==1){ ## if(errorsign==1){
lapply( logfiles, function (x) file.rename(from=paste(dirName,"/", x, sep=""), to=dirERROR)) ## 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) ## 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=""))) ## lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep=""), to=paste(dirName, "/",logfilename,"-",x,sep="")))
} else { ## } else {
lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep="/"), to=paste(dirName, "/",logfilename,"-",x,sep=""))) ## lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep="/"), to=paste(dirName, "/",logfilename,"-",x,sep="")))
} ## }
if(errorsign==1){ ## if(errorsign==1){
lapply( logfiles, function (x) file.rename(from=paste(dirName, "/",logfilename,"-",x,sep=""), to=dirERROR)) ## lapply( logfiles, function (x) file.rename(from=paste(dirName, "/",logfilename,"-",x,sep=""), to=dirERROR))
} ## }
} ## }
}} ## }}
cleanupMuso(location=outputloc) ## cleanupMuso(location=outputloc)
if(errorsign==1){ ## if(errorsign==1){
return("Modell Failure") ## return("Modell Failure")
} ## }
if(timee=="d"){ ## if(timee=="d"){
colnames(Reva) <- unlist(settings$outputvars[[1]]) ## colnames(Reva) <- unlist(settings$outputvars[[1]])
} else { ## } else {
if(timee=="y") ## if(timee=="y")
colnames(Reva) <- unlist(settings$outputvars[[2]]) ## colnames(Reva) <- unlist(settings$outputvars[[2]])
} ## }
if(leapYear){ ## if(leapYear){
Reva <- corrigMuso(settings,Reva) ## Reva <- corrigMuso(settings,Reva)
rownames(Reva) <- musoDate(settings) ## rownames(Reva) <- musoDate(settings)
} else { ## } else {
rownames(Reva) <- musoDate(settings, corrigated=FALSE) ## rownames(Reva) <- musoDate(settings, corrigated=FALSE)
} ## }
if(export!=FALSE){ ## if(export!=FALSE){
setwd(whereAmI) ## setwd(whereAmI)
## switch(fextension(export), ## ## switch(fextension(export),
## "csv"=(write.csv(Reva,export)), ## ## "csv"=(write.csv(Reva,export)),
## "xlsx"=(), ## ## "xlsx"=(),
## "odt"= ## ## "odt"=
## ) ## ## )
write.csv(Reva,export) ## write.csv(Reva,export)
} else{ ## } else{
setwd(whereAmI) ## setwd(whereAmI)
return(Reva)} ## return(Reva)}
} ## }

95
RBBGCMuso/R/setupMuso.R
View File

@ -33,39 +33,40 @@
#' executable, calibrationpar, outputloc, outputname, inputloc, ininput, metinput, epcinput,thininput,CO2input, mowinput, grazinput, harvinput, plouginput, fertinput, irrinput, nitinput, inputfiles, numdata, startyear, numyears, outputvars #' executable, calibrationpar, outputloc, outputname, inputloc, ininput, metinput, epcinput,thininput,CO2input, mowinput, grazinput, harvinput, plouginput, fertinput, irrinput, nitinput, inputfiles, numdata, startyear, numyears, outputvars
#' @export #' @export
setupMuso <- function(executable=NULL, setupMuso <- function(executable=NULL,
parallel = F, parallel = F,
calibrationpar =c(1), calibrationpar =c(1),
outputloc=NULL, outputloc=NULL,
inputloc=NULL, inputloc=NULL,
metinput=NULL, metinput=NULL,
CO2input=NULL, CO2input=NULL,
plantinput=NULL, plantinput=NULL,
thininput=NULL, thininput=NULL,
mowinput=NULL, mowinput=NULL,
grazinput=NULL, grazinput=NULL,
harvinput=NULL, harvinput=NULL,
plouginput=NULL, plouginput=NULL,
fertinput=NULL, fertinput=NULL,
irrinput=NULL, irrinput=NULL,
nitinput=NULL, nitinput=NULL,
ininput=NULL, ininput=NULL,
epcinput=NULL epcinput=NULL,
){ mapData=NULL
){
Linuxp <-(Sys.info()[1]=="Linux") Linuxp <-(Sys.info()[1]=="Linux")
if(is.null(inputloc)){ if(is.null(inputloc)){
inputloc<- "./" inputloc<- "./"
} else { } else {
inp <- unlist(strsplit(inputloc,"")) #This is the charactervector of the given imput location inp <- unlist(strsplit(inputloc,"")) #This is the charactervector of the given imput location
if(inp[length(inp)]!="/"){ if(inp[length(inp)]!="/"){
inp<-c(inp,"/") inp<-c(inp,"/")
inputloc <- paste(inp,collapse = "") inputloc <- paste(inp,collapse = "")
rm(inp) rm(inp)
}# If inp not ends in / paste one at the end, then make a string, that will be the new inputloc }# If inp not ends in / paste one at the end, then make a string, that will be the new inputloc
##Example: "a/b/c ==> a/b/c/" ##Example: "a/b/c ==> a/b/c/"
} }
inichangedp <- FALSE inichangedp <- FALSE
@ -223,16 +224,34 @@ setupMuso <- function(executable=NULL,
inifiles[[2]][grep("do IRRIGATION",inifiles[[2]])]<-paste(irrinput[2],"do IRRIGATION",sep="") inifiles[[2]][grep("do IRRIGATION",inifiles[[2]])]<-paste(irrinput[2],"do IRRIGATION",sep="")
}} }}
c<-grep("DAILY_OUTPUT",inifiles[[2]])+1 if(is.null(mapData)){
numVar<-as.numeric(unlist(strsplit(inifiles[[2]][c],"[\ \t]"))[1])
dailyVarCodes<-inifiles[[2]][(c+1):(c+numVar)] c<-grep("DAILY_OUTPUT",inifiles[[2]])+1
dailyVarnames<-lapply(dailyVarCodes, function(x) musoMapping(unlist(strsplit(x,"[\ \t]"))[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]))
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]))
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)
}
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]))
outputvars<-list(dailyVarnames,annualVarnames)
if(is.null(executable)){ if(is.null(executable)){
@ -246,18 +265,18 @@ setupMuso <- function(executable=NULL,
} }
outputname <- unlist(strsplit(inifiles[[2]][grep("OUTPUT_CONTROL",inifiles[[2]])+1],"[\ \t]"))[1] outputname <- 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] ## 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) ##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] ## outputname <- unlist(strsplit(grep("prefix for output files",inifiles[[2]],value=TRUE),"[\ \t]"))[1]
if(is.null(outputname)){ 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!") 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)){ if(is.null(outputloc)){
## outputloc<-paste((rev(rev(unlist(strsplit(outputname,"/")))[-1])),collapse="/") ## outputloc<-paste((rev(rev(unlist(strsplit(outputname,"/")))[-1])),collapse="/")
outputloc <- dirname(outputname) outputloc <- dirname(outputname)
} }

2
RBBGCMuso/man/plotMuso.Rd
View File

@ -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 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{ \author{
Roland Hollos Roland Hollos, Dora Hidy
} }

BIN
RBBGCMuso_0.3.2.0-0.tar.gz Normal file
View File

Binary file not shown.