diff --git a/RBBGCMuso/DESCRIPTION b/RBBGCMuso/DESCRIPTION index 979b1dd..b6592a8 100644 --- a/RBBGCMuso/DESCRIPTION +++ b/RBBGCMuso/DESCRIPTION @@ -10,8 +10,13 @@ NeedsCompilation: no Packaged: 2017-07-19 14:00:04 UTC; hollorol Author: Roland Hollo's [aut, cre] Imports: + stats, utils, - graphics + graphics, + Rcpp, + magrittr, + dplyr +LinkingTo: Rcpp Maintainer: Roland Hollo's RoxygenNote: 6.0.1 Suggests: knitr, diff --git a/RBBGCMuso/NAMESPACE b/RBBGCMuso/NAMESPACE index 0d4df57..06bcff2 100644 --- a/RBBGCMuso/NAMESPACE +++ b/RBBGCMuso/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +export(OtableMaker) export(calibMuso) export(cleanupMuso) export(corrigMuso) @@ -8,11 +9,17 @@ export(getyearlycum) export(getyearlymax) export(musoDate) export(musoMapping) +export(musoRandomizer) export(plotMuso) export(rungetMuso) export(setupMuso) export(spinupMuso) export(supportedMuso) export(updateMusoMapping) +import(dplyr) import(graphics) +import(magrittr) +import(stats) import(utils) +importFrom(Rcpp,evalCpp) +useDynLib(RBBGCMuso) diff --git a/RBBGCMuso/R/#musoMonte.R# b/RBBGCMuso/R/#musoMonte.R# new file mode 100644 index 0000000..4d20d3d --- /dev/null +++ b/RBBGCMuso/R/#musoMonte.R# @@ -0,0 +1,121 @@ +musoMonte <- function(settings=NULL, + parameters, + inputDir = "./", + outLoc = "./calib", + iterations = 10, + preTag = "mont-", + inputName = paste0(pretag,"epcs.csv"), + outputType = "moreCsv", + fun=mean, + varIndex=8, + doSensitivity=FALSE, + onDisk=FALSE, + ...){ + + currDir <- getwd() + 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) + 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) + + ##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 = length(settings$calibrationPar)) + preservedEpc[1,] <- origEpc + colnames(preservedEpc) <- Otable[[1]][,1] + + ## 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 + a<-1:100000 + moreCsv <- function(){ + for(i in 1:iterations){ + parVar <- musoRandomizer(A,B)[,2] + #preservedEpc[(i+1),] <- parVar + exportName <- paste0(preTag,i,".csv") + tryCatch (calibMuso(settings,debugging = "stamplog", + parameters = parVar,export = exportName, + keepEpc = TRUE),error=function(e) NA ) + } + 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" = (preservedEpc <- oneCsv()), + "moreCsv" = (preservedEpc <- moreCsv()), + "netCDF" = (preservedEpc <- netCDF())) + + ## Change back the epc file to the original + + file.copy(savedEpc,settings$epc[2],overwrite = TRUE) + write.csv(preservedEpc,"preservedEpc.csv") +} \ No newline at end of file diff --git a/RBBGCMuso/R/#setupMuso.R# b/RBBGCMuso/R/#setupMuso.R# new file mode 100644 index 0000000..0383548 --- /dev/null +++ b/RBBGCMuso/R/#setupMuso.R# @@ -0,0 +1,256 @@ +#' setupMuso +#' +#' This funcion is fundamental for the BiomBGC-MuSo modell related functions like spinupMuso, normalMuso, rungetMuso, because it sets the modells environment. +#' +#' @author Roland Hollos +#' @param parallel Do you want to run multiple modell paralelly, if yes, set this variable to TRUE +#' @param executable This parameter stores the place of the modell-executable file. In normal usage, you don't have to be set this, because a RBBgcmuso package contains allways the latest modell executable. In spite of this, if you would like to use this package for modell development or just want to use different models (for example for comparison), you will find it useful +#' @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 outputLoc Where should the modell puts its outputs. You should give a location for it via this variable, for example: outputLoc="/place/of/the/outputs/" +#' @param inputLoc Usually it is the root directory, where you put the iniFiles for the modell +#' @param metInput Via metInput parameter, you can tell the modell where are the meteorological files. As default it reads this from the iniFiles. +#' @param CO2Input Via CO2 parameter, you can tell the modell where are the CO2 data files. As default it reads this from the iniFiles. +#' @param plantInput Via planting parameter, you can tell the modell where are the data files, which contains the planting informations. As default it reads this from the iniFiles. +#' @param thinInput Via thining parameter, you can tell the modell where are the data files, which contains the thining informations. As default it reads this from the iniFiles. +#' @param mowInput Via mowing parameter, you can tell the modell where are the data files, which contains the mowing informations. As default it reads this from the iniFiles. +#' @param grazInput Via grazing parameter, you can tell the modell where are the data files, which contains the grazing informations. As default it reads this from the iniFiles. +#' @param harvInput Via harvesting parameter, you can tell the modell where are the data files, which contains the harvesting informations. As default it reads this from the iniFiles. +#' @param plougInput Via ploughing parameter, you can tell the modell where are the data files, which contains the ploughing informations. As default it reads this from the iniFiles. +#' @param fertInput Via fertilizing parameter, you can tell the modell where are the fertilizing data files, which contains the fertilizing informations. As default it reads this from the iniFiles. +#' @param irrInput Via irrigation parameter, you can tell the modell where are the data files, which contains the irrigation informations. As default it reads this from the iniFiles. +#' @param nitInput Via this parameter, you can tell the modell where are the NO2 data files. As default it reads this from the iniFiles. +#' @param iniInput Via this parameter, you can tell the modell where are the ini files. As default it reads this from the iniFiles. +#' @param epcInput Via this parameter, you can tell the modell where are the epc data files. As default it reads this from the iniFiles. +#' @usage setupMuso(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, iniInput=NULL, epcInput=NULL) +#' @return The output is a the modell setting list wich contains the following elements: +#' executable, calibrationPar, outputLoc, outputName, inputLoc, iniInput, 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, + iniInput=NULL, + epcInput=NULL, + mapData=NULL, + leapYear=FALSE, + version=5 + ){ + + Linuxp <-(Sys.info()[1]=="Linux") + writep <- 0 + + if(is.null(mapData)&version==4){ + mData <- mMapping4 + } + + inputParser <- function(string,fileName,counter,value=TRUE){ + unlist(strsplit(grep(string,fileName,value=TRUE),"[\ \t]"))[counter] + } + + outMaker <- function(inputVar,grepString,filep){ + tempVar <- eval(parse(text=inputVar)) + if(is.null(tempVar)){ + writep <<- writep+1 + if(filep) + { + tempVar["spinup"] <- paste0(inputLoc,inputParser(string=grepString,fileName=iniFiles$spinup,counter=1,value=TRUE)) + tempVar["normal"] <- paste0(inputLoc,inputParser(string=grepString,fileName=iniFiles$normal,counter=1,value=TRUE)) + } else { + tempVar["spinup"] <- inputParser(string=grepString,fileName=iniFiles$spinup,counter=1,value=TRUE) + tempVar["normal"] <- inputParser(string=grepString,fileName=iniFiles$normal,counter=1,value=TRUE) + + } + + } else { + iniFiles$spinup[grep(grepString,iniFiles$spinup)] <<- paste0(tempVar[1],"\t ",grepString) + + if(length(tempVar)==2){ + iniFiles$normal[grep(" grepString",iniFiles$normal)] <<- paste0(tempVar[2],"\t ",grepString) + } + } + return(tempVar) + } + + if(is.null(inputLoc)){ + inputLoc<- "./"} + + #iniChangedp <- FALSE + + if(is.null(iniInput)){ + spinups<-grep("s.ini$",list.files(inputLoc),value=TRUE) + normals<-grep("n.ini$",list.files(inputLoc),value=TRUE) + + if(length(spinups)==1){ + iniInput[1]<-file.path(inputLoc,spinups) + } else {stop("There are multiple or no spinup ini files, please choose")} + + + if(length(normals)==1){ + iniInput[2]<-file.path(inputLoc,normals) + } else {stop("There are multiple or no normal ini files, please choose")} + + } + + ##read the ini files for the further changes + + iniFiles<-lapply(iniInput, function (x) readLines(x,-1)) + iniFiles[[1]] <- gsub("\\","/", iniFiles[[1]],fixed=TRUE) #replacing \ to / + iniFiles[[2]] <- gsub("\\","/", iniFiles[[2]],fixed=TRUE) #replacing \ to / + names(iniFiles) <- c("spinup","normal") + + + + + inputs <- lapply(1:nrow(grepHelper), function (x) { + + outMaker(grepHelper[x,1],grepHelper[x,2],grepHelper[x,3]) + + }) + names(inputs) <- grepHelper$inputVar + ## grepHelper is in sysdata.rda it is a table like this: + ## + ## inputVar string isFile + ## 1 epcInput EPC file name TRUE + ## 2 metInput met file name TRUE + ## 3 CO2Input CO2 file TRUE + ## 4 nitInput N-dep file TRUE + ## 5 thinInput do THINNING FALSE + ## 6 plantInput do PLANTING FALSE + ## 7 mowInput do MOWING FALSE + ## 8 grazInput do GRAZING FALSE + ## 9 harvInput do HARVESTING FALSE + ## 10 plougInput do PLOUGHING FALSE + ## 11 fertInput do FERTILIZING FALSE + ## 12 irrInput do IRRIGATION FALSE + # return(inputs) debug element + + + 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)} 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)){ + if(Linuxp){ + executable<-file.path(inputLoc,"muso") + } else { + executable<-file.path(inputLoc,"muso.exe") + } + } else { + file.copy(executable,inputLoc) + } + + 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] + ##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)){ + stop("I cannot find outputName in your default ini file \n Please make sure that the line wich contains the name also contains the prefix and the outmut keywords!") + + } + ## outputName<-unlist(read.table(iniInput[2],skip=93,nrows = 1))[1] + + + if(is.null(outputLoc)){ + ## outputLoc<-paste((rev(rev(unlist(strsplit(outputName,"/")))[-1])),collapse="/") + outputLoc <- dirname(outputName) + } + + + + inputFiles<-c(iniInput,epcInput,metInput) + numData<-rep(NA,3) + numYears <- as.numeric(unlist(strsplit(grep("simulation years",iniFiles[[2]],value=TRUE),"[\ \t]"))[1]) + ## numYears<-unlist(read.table(iniInput[2],skip = 14,nrows = 1)[1]) + numValues <- as.numeric(unlist(strsplit(grep("number of daily output variables",iniFiles[[2]],value=TRUE),"[\ \t]"))[1]) + ## numValues will be replaced to numVar + ## numValues<-unlist(read.table(iniInput[2],skip=102,nrows = 1)[1]) + startyear <- as.numeric(unlist(strsplit(grep("first simulation year",iniFiles[[2]],value=TRUE),"[\ \t]"))[1]) + numData[1] <- numValues * sumDaysOfPeriod(startyear,numYears,corrigated=leapYear) + + numData[2] <- numYears * numValues*12 + numData[3] <- numYears * numValues + + ##Writing out changed ini-file + + writeLines(iniFiles[[1]],iniInput[1]) + writeLines(iniFiles[[2]],iniInput[2]) + + settings = list(executable = executable, + calibrationPar = calibrationPar, + outputLoc=outputLoc, + outputNames=outputName, + inputLoc=inputLoc, + iniInput=iniInput, + metInput=inputs$metInput, + epcInput=inputs$epcInput, + thinInput=inputs$thinInput, + CO2Input=inputs$CO2Input, + mowInput=inputs$mowInput, + grazInput=inputs$grazInput, + harvInput=inputs$harvInput, + plougInput=inputs$plougInput, + fertInput=inputs$fertInput, + irrInput=inputs$irrInput, + nitInput=inputs$nitInput, + inputFiles=inputFiles, + numData=numData, + startyear=startyear, + numYears=numYears, + outputVars=outputVars + ) + + if(writep!=nrow(grepHelper)){ + writeLines(iniFiles[[1]],iniInput[[1]]) + if(epcInput[1]!=epcInput[2]){ #Change need here + writeLines(iniFiles[[2]],iniInput[[2]]) + } + } + return(settings) + +} + diff --git a/RBBGCMuso/R/OtableMaker.R b/RBBGCMuso/R/OtableMaker.R new file mode 100644 index 0000000..dd74ed0 --- /dev/null +++ b/RBBGCMuso/R/OtableMaker.R @@ -0,0 +1,50 @@ +#'OtableMaker +#' +#'This function is generating A and B table for musoRandomizer +#' +#'@param paramsReal The matrix of the parameters +#'@return List of two matrices: A and B matrix for musoRandomizer +#'@import stats +#'@import magrittr +#'@import dplyr +#'@export + +OtableMaker <- function(parametersReal){ + constMatrix %<>% arrange(TYPE,GROUP) + + OTF<- t(apply(parametersReal,1,function(x){ + Group <- constMatrix[constMatrix$INDEX==x[1],"GROUP"] + Type <- constMatrix[constMatrix$INDEX==x[1],"TYPE"] + return(unlist(c(x,GROUP=Group,TYPE=Type))) + })) %>% tbl_df() %>% arrange(TYPE,GROUP) + + + groupIDs <- unique(OTF$GROUP)[-1] + otfIndexes <- OTF$INDEX + zeroIndexes <- OTF[OTF$GROUP==0,"INDEX"] %>% as.data.frame() %>% unlist() + OTFzero <- OTF[OTF$GROUP==0,] + OT0 <- constMatrix [constMatrix$INDEX %in% zeroIndexes,] %>% + mutate(MIN=OTFzero$MIN,MAX=OTFzero$MAX) + + sliced <- constMatrix %>% + dplyr::filter(GROUP %in% groupIDs) + OTbig <- rbind(OT0,sliced) %>% data.frame() + parnumbers <- nrow(OTbig) + + for(i in 1:parnumbers){ + if(OTbig[i,1] %in% otfIndexes){ + OTbig[i,3] <- OTF[OTF$INDEX==OTbig[i,1],2] + OTbig[i,4] <- OTF[OTF$INDEX==OTbig[i,1],3] + if(OTbig$Type[i]==2){ + OTbig$DEPENDENCE[i] <-2 + } + } + } + + summaries <- OTbig %>% + group_by(TYPE,GROUP) %>% + summarize(nGroup=n()) %>% + select(nGroup,TYPE) + return(list(Otable=OTbig,driver=summaries)) + +} \ No newline at end of file diff --git a/RBBGCMuso/R/RcppExports.R b/RBBGCMuso/R/RcppExports.R new file mode 100644 index 0000000..59ef6b3 --- /dev/null +++ b/RBBGCMuso/R/RcppExports.R @@ -0,0 +1,20 @@ +# Generated by using Rcpp::compileAttributes() -> do not edit by hand +# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 + +randTypeOne <- function(m) { + .Call('_RBBGCMuso_randTypeOne', PACKAGE = 'RBBGCMuso', m) +} + +#' musoRandomizer +#' +#' This function is fastly randomize values based on min and max values, +#' and row indexes. +#' @importFrom Rcpp evalCpp +#' @useDynLib RBBGCMuso +#' @param A is the big matrix +#' @param B is the small matrix +#' @export +musoRandomizer <- function(A, B) { + .Call('_RBBGCMuso_musoRandomizer', PACKAGE = 'RBBGCMuso', A, B) +} + diff --git a/RBBGCMuso/R/calibMuso.R b/RBBGCMuso/R/calibMuso.R index ef4b0b6..6032ad0 100644 --- a/RBBGCMuso/R/calibMuso.R +++ b/RBBGCMuso/R/calibMuso.R @@ -7,7 +7,7 @@ #' @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 keepEpc If TRUE, it keeps the epc file and stamp it, after these copies it to the EPCS directory. If debugging True or false, it copies the wrong epc files to the wrong epc directory. -#' @param export if it is yes or you give a filename here, it converts the output to the specific extension. For example, if you set export to "example.csv", it converts the output to "csv", if you set it to "example.xls" it converts to example.xls with the xlsx package. If it is not installed it gives back a warning message and converts it to csv. +#' @param export if it is yes or you give a filename here, it converts the ouxtput to the specific extension. For example, if you set export to "example.csv", it converts the output to "csv", if you set it to "example.xls" it converts to example.xls with the xlsx package. If it is not installed it gives back a warning message and converts it to csv. #' @param silent If you set it TRUE all off the modells output to the screen will be suppressed. It can be usefull, because it increases the model-speed. #' @param aggressive It deletes every possible modell-outputs from the previous modell runs. #' @param parameters In the settings variable you have set the row indexes of the variables, you wish to change. In this parameter you can give an exact value for them in a vector like: c(1,2,3,4) diff --git a/RBBGCMuso/R/musoMonte.R b/RBBGCMuso/R/musoMonte.R new file mode 100644 index 0000000..85e1f9b --- /dev/null +++ b/RBBGCMuso/R/musoMonte.R @@ -0,0 +1,121 @@ +musoMonte <- function(settings=NULL, + parameters, + inputDir = "./", + outLoc = "./calib", + iterations = 10, + preTag = "mont-", + inputName = paste0(pretag,"epcs.csv"), + outputType = "moreCsv", + fun=mean, + varIndex=8, + doSensitivity=FALSE, + onDisk=FALSE, + ...){ + + currDir <- getwd() + 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) + 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) + + ##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 = length(settings$calibrationPar)) + preservedEpc[1,] <- origEpc + colnames(preservedEpc) <- Otable[[1]][,1] + + ## 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 + a<-1:100000 + moreCsv <- function(){ + for(i in 1:iterations){ + parVar <- musoRandomizer(A,B)[,2] + #preservedEpc[(i+1),] <- parVar + exportName <- paste0(preTag,i,".csv") + tryCatch (calibMuso(settings,debugging = "stamplog", + parameters = parVar,export = exportName, + keepEpc = TRUE),error=function(e) NA ) + } + 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" = (preservedEpc <- oneCsv()), + "moreCsv" = (preservedEpc <- moreCsv()), + "netCDF" = (preservedEpc <- netCDF())) + + ## Change back the epc file to the original + + file.copy(savedEpc,settings$epc[2],overwrite = TRUE) + write.csv(preservedEpc,"preservedEpc.csv") +} diff --git a/RBBGCMuso/R/musoMonte.R~ b/RBBGCMuso/R/musoMonte.R~ new file mode 100644 index 0000000..c2a91e3 --- /dev/null +++ b/RBBGCMuso/R/musoMonte.R~ @@ -0,0 +1,123 @@ +musoMonte <- function(settings=NULL,parameters, + inputDir = "./" + outLoc = "./calib", + iterations = 10, + preTag = "mont-", + inputName = paste0(pretag,"epcs.csv"), + outputType = "moreCsv", + fun=mean, + varIndex=8, + doSensitivity=FALSE, + onDisk=FALSE, + ...){ + + currDir <- getwd() + 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) + + + 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] + + + + ##reading the original epc file at the specified + ## row numbers + + origEpcFile <- readLines(settings$epcinput[2]) + origEpc <- unlist( lapply(parameters[,2], 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 = nrow(parameters)) + preservedEpc[1,] <- origEpc + colnames(preservedEpc) <- parameters[,1] + + ## Save the backupEpc, while change the settings + ## variable and set the output. + file.copy(settings$epc[2],savedEpc,overwrite = TRUE) # do I need this? + 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) + + ## Creating function for generating separate + ## csv files for each run + moreCsv <- function(){ + 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,i,".csv") + calibMuso(settings,debugging = "stamplog", + parameters = parVar,export = exportName, + keepEpc = TRUE) + } + 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" = (preservedEpc <- oneCsv()), + "moreCsv" = (preservedEpc <- moreCsv()), + "netCDF" = (preservedEpc <- netCDF())) + + ## Change back the epc file to the original + + file.copy(savedEpc,settings$epc[2],overwrite = TRUE) + write.csv(preservedEpc,"preservedEpc.csv") +} \ No newline at end of file diff --git a/RBBGCMuso/R/package.R b/RBBGCMuso/R/package.R new file mode 100644 index 0000000..e69de29 diff --git a/RBBGCMuso/R/sysdata.rda b/RBBGCMuso/R/sysdata.rda index 561b3cf..c7c199b 100644 Binary files a/RBBGCMuso/R/sysdata.rda and b/RBBGCMuso/R/sysdata.rda differ diff --git a/RBBGCMuso/man/OtableMaker.Rd b/RBBGCMuso/man/OtableMaker.Rd new file mode 100644 index 0000000..861a3a9 --- /dev/null +++ b/RBBGCMuso/man/OtableMaker.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/OtableMaker.R +\name{OtableMaker} +\alias{OtableMaker} +\title{OtableMaker} +\usage{ +OtableMaker(parametersReal) +} +\arguments{ +\item{paramsReal}{The matrix of the parameters} +} +\value{ +List of two matrices: A and B matrix for musoRandomizer +} +\description{ +This function is generating A and B table for musoRandomizer +} diff --git a/RBBGCMuso/man/calibMuso.Rd b/RBBGCMuso/man/calibMuso.Rd index c69d4dc..22734e1 100644 --- a/RBBGCMuso/man/calibMuso.Rd +++ b/RBBGCMuso/man/calibMuso.Rd @@ -20,7 +20,7 @@ keepEpc=FALSE, export=FALSE, silent=FALSE, aggressive=FALSE, leapYear=FALSE) \item{keepEpc}{If TRUE, it keeps the epc file and stamp it, after these copies it to the EPCS directory. If debugging True or false, it copies the wrong epc files to the wrong epc directory.} -\item{export}{if it is yes or you give a filename here, it converts the output to the specific extension. For example, if you set export to "example.csv", it converts the output to "csv", if you set it to "example.xls" it converts to example.xls with the xlsx package. If it is not installed it gives back a warning message and converts it to csv.} +\item{export}{if it is yes or you give a filename here, it converts the ouxtput to the specific extension. For example, if you set export to "example.csv", it converts the output to "csv", if you set it to "example.xls" it converts to example.xls with the xlsx package. If it is not installed it gives back a warning message and converts it to csv.} \item{silent}{If you set it TRUE all off the modells output to the screen will be suppressed. It can be usefull, because it increases the model-speed.} diff --git a/RBBGCMuso/man/changemulline.Rd b/RBBGCMuso/man/changemulline.Rd index 8cadd86..d558147 100644 --- a/RBBGCMuso/man/changemulline.Rd +++ b/RBBGCMuso/man/changemulline.Rd @@ -4,7 +4,7 @@ \alias{changemulline} \title{This is the function which is capable change multiple specific lines to other using their row numbers.} \usage{ -changemulline(filename, calibrationpar, contents) +changemulline(filename, calibrationPar, contents) } \description{ he function uses the previous changspecline function to operate. diff --git a/RBBGCMuso/man/musoRandomizer.Rd b/RBBGCMuso/man/musoRandomizer.Rd new file mode 100644 index 0000000..e731389 --- /dev/null +++ b/RBBGCMuso/man/musoRandomizer.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{musoRandomizer} +\alias{musoRandomizer} +\title{musoRandomizer} +\usage{ +musoRandomizer(A, B) +} +\arguments{ +\item{A}{is the big matrix} + +\item{B}{is the small matrix} +} +\description{ +This function is fastly randomize values based on min and max values, +and row indexes. +} diff --git a/RBBGCMuso/man/setupMuso.Rd b/RBBGCMuso/man/setupMuso.Rd index bd5bef6..c4d3d6a 100644 --- a/RBBGCMuso/man/setupMuso.Rd +++ b/RBBGCMuso/man/setupMuso.Rd @@ -4,55 +4,55 @@ \alias{setupMuso} \title{setupMuso} \usage{ -setupMuso(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) +setupMuso(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, iniInput=NULL, epcInput=NULL) } \arguments{ \item{executable}{This parameter stores the place of the modell-executable file. In normal usage, you don't have to be set this, because a RBBgcmuso package contains allways the latest modell executable. In spite of this, if you would like to use this package for modell development or just want to use different models (for example for comparison), you will find it useful} \item{parallel}{Do you want to run multiple modell paralelly, if yes, set this variable to TRUE} -\item{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)} +\item{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)} -\item{outputloc}{Where should the modell puts its outputs. You should give a location for it via this variable, for example: outputloc="/place/of/the/outputs/"} +\item{outputLoc}{Where should the modell puts its outputs. You should give a location for it via this variable, for example: outputLoc="/place/of/the/outputs/"} -\item{inputloc}{Usually it is the root directory, where you put the inifiles for the modell} +\item{inputLoc}{Usually it is the root directory, where you put the iniFiles for the modell} -\item{metinput}{Via metinput parameter, you can tell the modell where are the meteorological files. As default it reads this from the inifiles.} +\item{metInput}{Via metInput parameter, you can tell the modell where are the meteorological files. As default it reads this from the iniFiles.} -\item{CO2input}{Via CO2 parameter, you can tell the modell where are the CO2 data files. As default it reads this from the inifiles.} +\item{CO2Input}{Via CO2 parameter, you can tell the modell where are the CO2 data files. As default it reads this from the iniFiles.} -\item{plantinput}{Via planting parameter, you can tell the modell where are the data files, which contains the planting informations. As default it reads this from the inifiles.} +\item{plantInput}{Via planting parameter, you can tell the modell where are the data files, which contains the planting informations. As default it reads this from the iniFiles.} -\item{thininput}{Via thining parameter, you can tell the modell where are the data files, which contains the thining informations. As default it reads this from the inifiles.} +\item{thinInput}{Via thining parameter, you can tell the modell where are the data files, which contains the thining informations. As default it reads this from the iniFiles.} -\item{mowinput}{Via mowing parameter, you can tell the modell where are the data files, which contains the mowing informations. As default it reads this from the inifiles.} +\item{mowInput}{Via mowing parameter, you can tell the modell where are the data files, which contains the mowing informations. As default it reads this from the iniFiles.} -\item{grazinput}{Via grazing parameter, you can tell the modell where are the data files, which contains the grazing informations. As default it reads this from the inifiles.} +\item{grazInput}{Via grazing parameter, you can tell the modell where are the data files, which contains the grazing informations. As default it reads this from the iniFiles.} -\item{harvinput}{Via harvesting parameter, you can tell the modell where are the data files, which contains the harvesting informations. As default it reads this from the inifiles.} +\item{harvInput}{Via harvesting parameter, you can tell the modell where are the data files, which contains the harvesting informations. As default it reads this from the iniFiles.} -\item{plouginput}{Via ploughing parameter, you can tell the modell where are the data files, which contains the ploughing informations. As default it reads this from the inifiles.} +\item{plougInput}{Via ploughing parameter, you can tell the modell where are the data files, which contains the ploughing informations. As default it reads this from the iniFiles.} -\item{fertinput}{Via fertilizing parameter, you can tell the modell where are the fertilizing data files, which contains the fertilizing informations. As default it reads this from the inifiles.} +\item{fertInput}{Via fertilizing parameter, you can tell the modell where are the fertilizing data files, which contains the fertilizing informations. As default it reads this from the iniFiles.} -\item{irrinput}{Via irrigation parameter, you can tell the modell where are the data files, which contains the irrigation informations. As default it reads this from the inifiles.} +\item{irrInput}{Via irrigation parameter, you can tell the modell where are the data files, which contains the irrigation informations. As default it reads this from the iniFiles.} -\item{nitinput}{Via this parameter, you can tell the modell where are the NO2 data files. As default it reads this from the inifiles.} +\item{nitInput}{Via this parameter, you can tell the modell where are the NO2 data files. As default it reads this from the iniFiles.} -\item{ininput}{Via this parameter, you can tell the modell where are the ini files. As default it reads this from the inifiles.} +\item{iniInput}{Via this parameter, you can tell the modell where are the ini files. As default it reads this from the iniFiles.} -\item{epcinput}{Via this parameter, you can tell the modell where are the epc data files. As default it reads this from the inifiles.} +\item{epcInput}{Via this parameter, you can tell the modell where are the epc data files. As default it reads this from the iniFiles.} } \value{ The output is a the modell setting list wich contains the following elements: -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, iniInput, metInput, epcInput,thinInput,CO2Input, mowInput, grazInput, harvInput, plougInput, fertInput, irrInput, nitInput, inputFiles, numData, startyear, numYears, outputVars } \description{ This funcion is fundamental for the BiomBGC-MuSo modell related functions like spinupMuso, normalMuso, rungetMuso, because it sets the modells environment. diff --git a/RBBGCMuso/src/RBBGCMuso.so b/RBBGCMuso/src/RBBGCMuso.so new file mode 100755 index 0000000..6510e17 Binary files /dev/null and b/RBBGCMuso/src/RBBGCMuso.so differ diff --git a/RBBGCMuso/src/RcppExports.cpp b/RBBGCMuso/src/RcppExports.cpp new file mode 100644 index 0000000..d0c97ad --- /dev/null +++ b/RBBGCMuso/src/RcppExports.cpp @@ -0,0 +1,41 @@ +// Generated by using Rcpp::compileAttributes() -> do not edit by hand +// Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 + +#include + +using namespace Rcpp; + +// randTypeOne +NumericMatrix randTypeOne(NumericMatrix m); +RcppExport SEXP _RBBGCMuso_randTypeOne(SEXP mSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< NumericMatrix >::type m(mSEXP); + rcpp_result_gen = Rcpp::wrap(randTypeOne(m)); + return rcpp_result_gen; +END_RCPP +} +// musoRandomizer +NumericMatrix musoRandomizer(NumericMatrix A, NumericMatrix B); +RcppExport SEXP _RBBGCMuso_musoRandomizer(SEXP ASEXP, SEXP BSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< NumericMatrix >::type A(ASEXP); + Rcpp::traits::input_parameter< NumericMatrix >::type B(BSEXP); + rcpp_result_gen = Rcpp::wrap(musoRandomizer(A, B)); + return rcpp_result_gen; +END_RCPP +} + +static const R_CallMethodDef CallEntries[] = { + {"_RBBGCMuso_randTypeOne", (DL_FUNC) &_RBBGCMuso_randTypeOne, 1}, + {"_RBBGCMuso_musoRandomizer", (DL_FUNC) &_RBBGCMuso_musoRandomizer, 2}, + {NULL, NULL, 0} +}; + +RcppExport void R_init_RBBGCMuso(DllInfo *dll) { + R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); + R_useDynamicSymbols(dll, FALSE); +} diff --git a/RBBGCMuso/src/RcppExports.o b/RBBGCMuso/src/RcppExports.o new file mode 100644 index 0000000..541628e Binary files /dev/null and b/RBBGCMuso/src/RcppExports.o differ diff --git a/RBBGCMuso/src/musoRandomizer.cpp b/RBBGCMuso/src/musoRandomizer.cpp new file mode 100644 index 0000000..67c1ce9 --- /dev/null +++ b/RBBGCMuso/src/musoRandomizer.cpp @@ -0,0 +1,142 @@ +#include +#include +#include +#include +#include +#include + + +using namespace Rcpp; +using namespace std; +// [[Rcpp::plugins(cpp11)]] + + + +NumericMatrix randTypeZero(NumericMatrix m){ + int n=m.nrow()-1; + NumericMatrix M(n+1,2); + M(_,0)=m(_,0); + for(int i=0;i<=n;++i){ + double min=m(i,2); + double max=m(i,3); + M(i,1)=runif(1,min,max)[0]; + } + return M; +} + +// [[Rcpp::export]] +NumericMatrix randTypeOne(NumericMatrix m){ + NumericVector dependence=m(_,2); + int n=m.nrow()-1; + NumericMatrix M(n+1,2); + M(_,0)=m(_,0); + M(0,1)=runif(1,m(0,2),m(0,3))[0]; + for(int i=1;i<=n;++i){ + int dep=m(i,1)-1; + double min=max(M(dep,1),m(i,2)); + double max=m(i,3); + M(i,1)=runif(1,min,max)[0]; + } + return M; +} + + + +IntegerVector orderDec(NumericVector v){ + Function f("order"); + return f(v,_["decreasing"]=1); +} + +NumericMatrix randTypeTwo(NumericMatrix m){ + int n=m.nrow()-1; + int N=n-1; + NumericMatrix mv=m(Range(0,(n-1)),_); + NumericVector dependence=m(_,2); + NumericMatrix M(n+1,2); + M(_,0)=m(_,0); + IntegerVector indexes=orderDec(mv(_,2)); + NumericVector sorban=mv(_,2); + sorban.sort(true); + NumericVector sor=cumsum(sorban); + sor.sort(true); + for(int i=0;i<=N;++i){ + if(i!=N){ + mv((indexes[i]-1),3)-= sor[i+1]; + } + } + + double rollingNumber=0; + + for(int i=0;i<=N;++i){ + double minimum=mv((indexes[i]-1),2); + double maximum=mv((indexes[i]-1),3)-rollingNumber; + M(i,1)=runif(1,minimum,maximum)[0]; + rollingNumber+=M(i,1); + // cout << "minimum:\t" << minimum << endl; + // cout << "maximum:\t" << maximum << endl; + // cout << "indexes:\t" << indexes[i] << endl; + // cout << "rollingNumber:\t" << rollingNumber << endl; + // cout << "choosen:\t" << M(i,1) < +#include +#include +#include +#include +#include + + +using namespace Rcpp; +using namespace std; +// [[Rcpp::plugins(cpp11)]] + + + +NumericMatrix randTypeZero(NumericMatrix m){ + int n=m.nrow()-1; + NumericMatrix M(n+1,2); + M(_,0)=m(_,0); + for(int i=0;i<=n;++i){ + double min=m(i,2); + double max=m(i,3); + M(i,1)=runif(1,min,max)[0]; + } + return M; +} + +// [[Rcpp::export]] +NumericMatrix randTypeOne(NumericMatrix m){ + NumericVector dependence=m(_,2); + int n=m.nrow()-1; + NumericMatrix M(n+1,2); + M(_,0)=m(_,0); + M(0,1)=runif(1,m(0,2),m(0,3))[0]; + for(int i=1;i<=n;++i){ + int dep=m(i,1)-1; + double min=max(M(dep,1),m(i,2)); + double max=m(i,3); + M(i,1)=runif(1,min,max)[0]; + } + return M; +} + + + +IntegerVector orderDec(NumericVector v){ + Function f("order"); + return f(v,_["decreasing"]=1); +} + +NumericMatrix randTypeTwo(NumericMatrix m){ + int n=m.nrow()-1; + int N=n-1; + NumericMatrix mv=m(Range(0,(n-1)),_); + NumericVector dependence=m(_,2); + NumericMatrix M(n+1,2); + M(_,0)=m(_,0); + IntegerVector indexes=orderDec(mv(_,2)); + NumericVector sorban=mv(_,2); + sorban.sort(true); + NumericVector sor=cumsum(sorban); + sor.sort(true); + for(int i=0;i<=N;++i){ + if(i!=N){ + mv((indexes[i]-1),3)-= sor[i+1]; + } + } + + double rollingNumber=0; + + for(int i=0;i<=N;++i){ + double minimum=mv((indexes[i]-1),2); + double maximum=mv((indexes[i]-1),3)-rollingNumber; + M(i,1)=runif(1,minimum,maximum)[0]; + rollingNumber+=M(i,1); + // cout << "minimum:\t" << minimum << endl; + // cout << "maximum:\t" << maximum << endl; + // cout << "indexes:\t" << indexes[i] << endl; + // cout << "rollingNumber:\t" << rollingNumber << endl; + // cout << "choosen:\t" << M(i,1) <