RBBGCMuso/RBBGCMuso/R/musoMonte.R

#' musoMonte
#'
#' 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.
#' @export

musoMonte <- function(settings=NULL,
                     parameters,
                     inputDir = "./",
                     outLoc = "./calib",
                     iterations = 10,
                     preTag = "mont-",
                     outputType = "moreCsv",
                     fun=mean,
                     varIndex = 1,
                     ...){
    
    outLocPlain <- basename(outLoc)
    currDir <- getwd()
    inputDir <- normalizePath(inputDir)
    tmp <- file.path(outLoc,"tmp/")

    if(!dir.exists(outLoc)){
        dir.create(outLoc)
        warning(paste(outLoc," is not exists, so it was created"))
    }

    if(dir.exists(tmp)){
        stop("There is a tmp directory inside the output location, please replace it. tmp is an important temporary directory for the function")
    }
    dir.create(tmp)
    outLoc <- normalizePath(outLoc)
    tmp <- normalizePath(tmp)

    inputFiles <- file.path(inputDir,grep(basename(outLoc),list.files(inputDir),invert = TRUE,value = TRUE)) 

    
    for(i in inputFiles){
        file.copy(i,tmp)
    }
    setwd(tmp)
    
    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
    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
    moreCsv <- function(){
        a <- numeric(iterations+1)
        tempData <- calibMuso(settings, debugging = "stamplog", parameters = origEpc,keepEpc = TRUE)
        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 <- calibMuso(settings,debugging = "stamplog",
                                 parameters = parVar,
                                 keepEpc = TRUE)
            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=",")
        }
        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)
}