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
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

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.
#'
@ -91,8 +91,18 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
if(length(logspinup)==0){
return("Modell Failure")#in that case the modell did not create even a logfile
}
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)
}
}
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 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,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)){
errorsign <- 1
} 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))
}
}
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
#'
#' @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
@ -44,30 +44,32 @@ plotMuso <- function(settings,
logfilename=logfilename,
export=export)
xlab_muso<- switch(timee, "d"="days","y"="years","m"="months")
numVari <- ncol(musoData)
xlab_muso<- switch(timee, "d"="days","y"="years","m"="months")
numVari <- ncol(musoData)
if(is.numeric(variable)){
if((variable>numVari)|(variable<1)){
return(print(paste("The variable parameter must be between 1 and ",numVari)))
}
if(is.numeric(variable)){
if((variable>numVari)|(variable<1)){
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])
} else {
if(variable=="all"){
plot(musoData[,variable],pch=20,col = "dark blue",xlab=xlab_muso,ylab=colnames(musoData)[variable])
} 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]]))
return(print("Everything was Ok. ;)"))
} else {
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\""))
}
}
}
}

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
}
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,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(length(perror)>sum(perror)){
errorsign <- 1
} 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")
##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)}
## }

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
#' @export
setupMuso <- function(executable=NULL,
parallel = F,
calibrationpar =c(1),
outputloc=NULL,
inputloc=NULL,
metinput=NULL,
CO2input=NULL,
plantinput=NULL,
thininput=NULL,
mowinput=NULL,
grazinput=NULL,
harvinput=NULL,
plouginput=NULL,
fertinput=NULL,
irrinput=NULL,
nitinput=NULL,
ininput=NULL,
epcinput=NULL
){
parallel = F,
calibrationpar =c(1),
outputloc=NULL,
inputloc=NULL,
metinput=NULL,
CO2input=NULL,
plantinput=NULL,
thininput=NULL,
mowinput=NULL,
grazinput=NULL,
harvinput=NULL,
plouginput=NULL,
fertinput=NULL,
irrinput=NULL,
nitinput=NULL,
ininput=NULL,
epcinput=NULL,
mapData=NULL
){
Linuxp <-(Sys.info()[1]=="Linux")
if(is.null(inputloc)){
inputloc<- "./"
} 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)]!="/"){
inp<-c(inp,"/")
inputloc <- paste(inp,collapse = "")
rm(inp)
}# If inp not ends in / paste one at the end, then make a string, that will be the new inputloc
if(inp[length(inp)]!="/"){
inp<-c(inp,"/")
inputloc <- paste(inp,collapse = "")
rm(inp)
}# 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
@ -223,16 +224,34 @@ setupMuso <- function(executable=NULL,
inifiles[[2]][grep("do IRRIGATION",inifiles[[2]])]<-paste(irrinput[2],"do IRRIGATION",sep="")
}}
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]))
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)]
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)
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)
}
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(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)
## outputname <- unlist(strsplit(grep("prefix for output files",inifiles[[2]],value=TRUE),"[\ \t]"))[1]
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)){
## outputloc<-paste((rev(rev(unlist(strsplit(outputname,"/")))[-1])),collapse="/")
## outputloc<-paste((rev(rev(unlist(strsplit(outputname,"/")))[-1])),collapse="/")
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
}
\author{
Roland Hollos
Roland Hollos, Dora Hidy
}

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

Binary file not shown.