diff --git a/RBBGCMuso/R/musoMont.R b/RBBGCMuso/R/musoMont.R deleted file mode 100644 index 3185794..0000000 --- a/RBBGCMuso/R/musoMont.R +++ /dev/null @@ -1,205 +0,0 @@ -#' musoMont -#' -#' This function does monteCarlo on BiomeBGC-MuSo. It samples specified modell variables in given rangge from conditional multivariate uniform distribution, and runs the modell for each run. -#' @author Roland Hollos -#' @param settings A list of montecarlos environmental variables. It is generated by the setupMuso() function. In default the settings parameter is generated automatically. -#' @param parameters This is a dataframe (heterogen data-matrix), which first column is the name of the parameters, the second is a numeric vector of the rownumbers of the given variable in the epc-fie, the last two column consist the endpont of the parameter-ranges, where the parameters will be randomized. -#' @param calibrationPar You may want to change some parameters in your epc file, before you run the modell. You have to select the appropirate modell parameters. You can refence to these with the number of the line in the epc file where the variables are. It indexes from one. You should use a vector for this, like: c(1,5,8) -#' @param inputDir The location of the input directory, this directory must content a viable pack of all inputfiles and the executable file. -#' @param iterations number of the monteCarlo run. -#' @param preTag It will be the name of the output files. For example preTag-1.csv, pretag-2csv... -#' @param outputType This parameter can be "oneCsv", "moreCsv", and "netCDF". If "oneCsv" is choosen the function create 1 big csv file for all of the runs, if "moreCsv" is choosen, every modell output goes to separate files, if netCDF is selected the outputs will be put in a netCDF file. The default value of the outputTypes is "moreCsv". netCDF is not implemented yet. -#' @param fun If you select a variable from the possible outputs (with specify the varIndex parameter), you have to provide a function which maps to a subset of real numbers. The most frequent possibilities are: mean, min, max, var, but you can define any function for your need. -#' @param varIndex This parameter specify which parameter of the output will be used. You can extract this information from the ini-files. At the output parameter specifications, the parameters order will determine this number. For example, if you have set these output parameters: 412, 874, 926, 888, and you want to use 926, you should address varIndex with 3. -#' @param debugging If you set this parameter, you can save every logfile, and RBBGCMuso will select those which contains errors. -#' @param keepEpc if you set keepEpc also true, it will save every selected epc file, and put the wrong ones in the WRONGEPC directory. -#' @export - -musoMonte <- function(settings=NULL, - parameters=NULL, - inputDir = "./", - outLoc = "./calib", - iterations = 10, - preTag = "mont-", - outputType = "moreCsv", - fun=mean, - varIndex = 1, - silent = TRUE, - skipSpinup = FALSE, - debugging = FALSE, - keepEpc = FALSE, - ...){ - - getEpcValue <- function(epc, linum){ - numcord <- numeric(3) - numcord[1] <- as.integer(linNum) - linNum <- as.integer(round(linNum * 100)) - numcord[3] <-linNum %% 10 +1 - numcord[2] <- (linNum %/% 10) %% 10 + 1 - numcord - } - - - if(is.null(parameters)){ - parameters <- tryCatch(read.csv("parameters.csv"), error = function (e) { - stop("You need to specify a path for the parameters.csv, or a matrix.") - }) - } else { - if((!is.list(parameters)) & (!is.matrix(parameters))){ - parameters <- tryCatch(read.csv(parameters), error = function (e){ - stop("Cannot find neither parameters file neither the parameters matrix") - }) - }} - - outLocPlain <- basename(outLoc) #Where to put the csv outputs - currDir <- getwd() # just to go back, It is unlikely to be used - inputDir <- normalizePath(inputDir) # Where are the model files. - - if(!dir.exists(outLoc)){ - dir.create(outLoc) - warning(paste(outLoc," is not exists, so it was created")) - } - - outLoc <- normalizePath(outLoc) - - - if(is.null(settings)){ - settings <- setupMuso() - } - - parameterNames <- parameters[,1] - parReal <- parameters[,-1] - Otable <- OtableMaker(parReal) - A <- as.matrix(Otable[[1]][,c(2,4,5,6)]) - B <- as.matrix(Otable[[2]]) - settings$calibrationPar <- A[,1] - pretag <- file.path(outLoc,preTag) - npar <- length(settings$calibrationPar) - - ##reading the original epc file at the specified - ## row numbers - - origEpcFile <- readLines(settings$epcInput[2]) - - origEpc <- unlist(lapply(settings$calibrationPar, function (x) { - as.numeric(unlist(strsplit(origEpcFile[x],split="[\t ]"))[1]) - })) - - ## Prepare the preservedEpc matrix for the faster - ## run. - preservedEpc <- matrix(nrow = (iterations +1 ), ncol = npar) - preservedEpc[1,] <- origEpc - Otable[[1]][,1] <- (as.character(Otable[[1]][,1])) - for(i in parameters[,2]){ - Otable[[1]][Otable[[1]][,2]==i,1] <- as.character(parameters[parameters[,2]==i,1]) - } - - colnames(preservedEpc) <- Otable[[1]][,1] - preservedEpc <- cbind(preservedEpc,rep(NA,(iterations+1))) - colnames(preservedEpc)[(npar+1)] <- "y" - ## Save the backupEpc, while change the settings - ## variable and set the output. - file.copy(settings$epc[2],"savedEpc",overwrite = TRUE) # do I need this? - pretag <- file.path(outLoc,preTag) - - ## Creating function for generating separate - ## csv files for each run - - progBar <- txtProgressBar(1,iterations,style=3) - - modelRun <- function(settings, debugging, parameters, keepEpc, silent, skipSpinup){ - if(!skipSpinup){ - calibMuso(settings, debugging = debugging, parameters = parameters, keepEpc = keepEpc, silent = silent) - } else { - normalMuso(settings, debugging = debugging, parameters = parameters, keepEpc = keepEpc, silent = silent) - } - - } - - moreCsv <- function(){ - - if(skipSpinup){#skipSpinup is boolean - spinupMuso(settings = settings , silent = silent) - } - a <- numeric(iterations+1) - tempData <- modelRun(settings=settings, - debugging = debugging, - parameters = origEpc, - keepEpc = keepEpc, - silent = silent, - skipSpinup = skipSpinup) - ## tempData <- calibMuso(settings, debugging = "stamplog", parameters = origEpc,keepEpc = TRUE,silent = silent) - a[1] <- tryCatch(fun(tempData[,varIndex]),error=function(e){return(NA)}) - preservedEpc[1,(npar+1)] <- a[1] - write.table(t(preservedEpc[1,]),row.names = FALSE,"preservedEpc.csv",sep=",") - write.csv(x=tempData, file=paste0(preTag,1,".csv")) - for(i in 1:iterations){ - parVar <- musoRandomizer(A,B)[,2] - preservedEpc[(i+1),] <- c(parVar,NA) - exportName <- paste0(preTag,(i+1),".csv") - tempData <- modelRun(settings = settings, - debugging = debugging, - parameters = parVar, - keepEpc = keepEpc, - silent=silent, - skipSpinup =skipSpinup) - write.csv(x=tempData,file=exportName) - - preservedEpc[(i+1),(npar+1)] <- a[i+1]<- tryCatch(fun(tempData[,varIndex]),error=function(e){return(NA)}) - write.table(t(preservedEpc[(i+1),]),file="preservedEpc.csv",row.names=FALSE,col.names=FALSE, append=TRUE,sep=",") - setTxtProgressBar(progBar,i) - } - cat("\n") - return(preservedEpc) - } - - ## Creating function for generating one - ## csv files for each run - - oneCsv <- function () { - numDays <- settings$numdata[1] - if(!onDisk){ - for(i in 1:iterations){ - - parVar <- apply(parameters,1,function (x) { - runif(1, as.numeric(x[3]), as.numeric(x[4]))}) - - preservedEpc[(i+1),] <- parVar - exportName <- paste0(preTag,".csv") - write.csv(parvar,"preservedEpc.csv",append=TRUE) - calibMuso(settings,debugging = "stamplog", - parameters = parVar,keepEpc = TRUE) %>% - {mutate(.,iD = i)} %>% - {write.csv(.,file=exportName,append=TRUE)} - } - - return(preservedEpc) - } else { - - } - } - - netCDF <- function () { - stop("This function is not inplemented yet") - } - - ## Call one function according to the outputType - switch(outputType, - "oneCsv" = (a <- oneCsv()), - "moreCsv" = (a <- moreCsv()), - "netCDF" = (a <- netCDF())) - - ## Change back the epc file to the original - for(i in file.path("./",grep(outLocPlain, list.files(inputDir), invert = TRUE, value = TRUE))){ - file.remove(i,recursive=TRUE) - } - for(i in list.files()){ - file.copy(i,outLoc,recursive=TRUE,overwrite = TRUE) - } - - unlink(tmp,recursive = TRUE) - setwd(currDir) - file.copy("savedEpc",settings$epc[2],overwrite = TRUE) - return(a) -} - diff --git a/RBBGCMuso/R/musoSensi.R b/RBBGCMuso/R/musoSensi.R index 3f3d291..a84790f 100644 --- a/RBBGCMuso/R/musoSensi.R +++ b/RBBGCMuso/R/musoSensi.R @@ -16,7 +16,6 @@ #' @param varIndex This parameter specifies which parameter will be used for the Monte Carlo experiment from the output list of Biome-BGCMuSo (defined by the INI file). You can extract this information from the INI files. At the output parameter specifications, the parameter order will determine this number. For example, if you have set these output parameters: 412, 874, 926, 888, and you want to use 926 for the experiment, you should specify varIndex as 3. #' @param skipSpinup With this parameter you can turn off the spinup phase after the first spinup was successfully executed (endpoint file is available). This option can dramatically decrease the time needed for the sensitivity analysis. Note that in case of natural vegetation this option might not be feasible. For croplands this is more feasible. #' @importFrom ggplot2 geom_bar ggplot aes theme element_text xlab ylab ggtitle ggsave scale_y_continuous -#' @importFrom scales percent #' @export musoSensi <- function(monteCarloFile = NULL, @@ -74,7 +73,7 @@ musoSensi <- function(monteCarloFile = NULL, xlab(NULL)+ ylab(NULL)+ ggtitle("Sensitivity")+ - scale_y_continuous(labels = percent,limits=c(0,1)) + scale_y_continuous(labels = scales::percent,limits=c(0,1)) print(sensiPlot) ggsave(plotName,dpi=dpi) return(S) @@ -110,3 +109,6 @@ musoSensi <- function(monteCarloFile = NULL, return(doSensi(M)) } } + + + diff --git a/RBBGCMuso/R/runModell.R b/RBBGCMuso/R/runModell.R deleted file mode 100644 index 4e0ac8a..0000000 --- a/RBBGCMuso/R/runModell.R +++ /dev/null @@ -1,21 +0,0 @@ -## runModell <- function(executable,) -## { - - -## if(silent){#silenc mode -## if(Linuxp){ -## #In this case, in linux machines -## tryCatch(system(paste(executable,iniInput[1],"> /dev/null",sep=" ")), -## error= function (e){stop("Cannot run the modell-check the executable!")}) -## } else { -## #In windows machines there is a show.output.on.console option -## tryCatch(system(paste(executable,iniInput[1],sep=" "),show.output.on.console = FALSE), -## error= function (e){stop("Cannot run the modell-check the executable!")}) -## } - -## } else { -## system(paste(executable,iniInput[1],sep=" ")) -## } - - -## } diff --git a/RBBGCMuso/R/rungettanul.R b/RBBGCMuso/R/rungettanul.R deleted file mode 100644 index ff38c2d..0000000 --- a/RBBGCMuso/R/rungettanul.R +++ /dev/null @@ -1,240 +0,0 @@ -## rungetMuso <- function(settings, timee="d", debugging=FALSE, logfilename=NULL, keepEpc=FALSE, export=FALSE, silent=FALSE, aggressive=FALSE, leapYear=FALSE){ - - - - -## ########################################################################## -## ###########################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() - -## ############################################################# -## ############################spinup run############################ -## ########################################################## - - -## ##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(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. - -## ## Set the working directory to the inputloc temporary. -## setwd(inputloc) - - -## ##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) -## } - -## } 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 -## } - -## 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. - -## ##################################################################### -## ###########################normal run######################### -## ################################################################# - -## ##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) -## } - -## } else { -## system(paste(executable,ininput[2],sep=" ")) -## } - - -## ##read the output - -## 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 - -## ############################################### -## #############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 - -## 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(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(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]) - -## WRONGEPC<-paste(inputloc,"WRONGEPC",sep="") -## EPCS<-paste(inputloc,"EPCS",sep="") - -## if(!dir.exists(WRONGEPC)){ -## dir.create(WRONGEPC) -## } - -## 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)) -## } - -## } -## } - - - - - -## 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=""))) -## } - -## 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)){ - -## 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)) -## } - -## } 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(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") -## } - -## 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(export!=FALSE){ -## setwd(whereAmI) - -## ## switch(fextension(export), -## ## "csv"=(write.csv(Reva,export)), -## ## "xlsx"=(), -## ## "odt"= - - -## ## ) -## write.csv(Reva,export) - -## } else{ -## setwd(whereAmI) -## return(Reva)} -## } - - - diff --git a/RBBGCMuso/R/soilCalib.R b/RBBGCMuso/R/soilCalib.R deleted file mode 100644 index 053d7ba..0000000 --- a/RBBGCMuso/R/soilCalib.R +++ /dev/null @@ -1 +0,0 @@ -#soilMatrix <- function(numberOfLayers=)