diff --git a/RBBGCMuso/DESCRIPTION b/RBBGCMuso/DESCRIPTION index f84f3cc..0f5f082 100644 --- a/RBBGCMuso/DESCRIPTION +++ b/RBBGCMuso/DESCRIPTION @@ -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 RoxygenNote: 6.0.1 Suggests: knitr, - rmarkdown + rmarkdown, VignetteBuilder: knitr diff --git a/RBBGCMuso/R/calibMuso.R b/RBBGCMuso/R/calibMuso.R index 895fc32..6e994a4 100644 --- a/RBBGCMuso/R/calibMuso.R +++ b/RBBGCMuso/R/calibMuso.R @@ -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 + } } diff --git a/RBBGCMuso/R/otherUsefullFunctions.R b/RBBGCMuso/R/otherUsefullFunctions.R index b15f8dc..19f9acd 100644 --- a/RBBGCMuso/R/otherUsefullFunctions.R +++ b/RBBGCMuso/R/otherUsefullFunctions.R @@ -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)&(transNormnumVari)|(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\"")) - } + } + - } + } diff --git a/RBBGCMuso/R/rungetMuso.R b/RBBGCMuso/R/rungetMuso.R index e1b680a..57e91d3 100644 --- a/RBBGCMuso/R/rungetMuso.R +++ b/RBBGCMuso/R/rungetMuso.R @@ -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 + } } diff --git a/RBBGCMuso/R/rungettanul.R b/RBBGCMuso/R/rungettanul.R index 51899e5..480aaf1 100644 --- a/RBBGCMuso/R/rungettanul.R +++ b/RBBGCMuso/R/rungettanul.R @@ -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)} +## } diff --git a/RBBGCMuso/R/setupMuso.R b/RBBGCMuso/R/setupMuso.R index e2f05fd..d5ac5c2 100644 --- a/RBBGCMuso/R/setupMuso.R +++ b/RBBGCMuso/R/setupMuso.R @@ -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) } diff --git a/RBBGCMuso/man/plotMuso.Rd b/RBBGCMuso/man/plotMuso.Rd index 800637b..738e9f1 100644 --- a/RBBGCMuso/man/plotMuso.Rd +++ b/RBBGCMuso/man/plotMuso.Rd @@ -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 } diff --git a/RBBGCMuso_0.3.2.0-0.tar.gz b/RBBGCMuso_0.3.2.0-0.tar.gz new file mode 100644 index 0000000..9d30411 Binary files /dev/null and b/RBBGCMuso_0.3.2.0-0.tar.gz differ