musoMonte function

This commit is contained in:
hollorol 2018-04-18 01:03:17 +02:00
parent a5873da2c6
commit 5156c7e0a5
23 changed files with 1091 additions and 29 deletions

View File

@ -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 <hollorol@gmail.com>
RoxygenNote: 6.0.1
Suggests: knitr,

View File

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

121
RBBGCMuso/R/#musoMonte.R# Normal file
View File

@ -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")
}

256
RBBGCMuso/R/#setupMuso.R# Normal file
View File

@ -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)
}

50
RBBGCMuso/R/OtableMaker.R Normal file
View File

@ -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))
}

20
RBBGCMuso/R/RcppExports.R Normal file
View File

@ -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)
}

View File

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

121
RBBGCMuso/R/musoMonte.R Normal file
View File

@ -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")
}

123
RBBGCMuso/R/musoMonte.R~ Normal file
View File

@ -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")
}

0
RBBGCMuso/R/package.R Normal file
View File

Binary file not shown.

View File

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

View File

@ -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.}

View File

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

View File

@ -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.
}

View File

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

BIN
RBBGCMuso/src/RBBGCMuso.so Executable file

Binary file not shown.

View File

@ -0,0 +1,41 @@
// Generated by using Rcpp::compileAttributes() -> do not edit by hand
// Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
#include <Rcpp.h>
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);
}

BIN
RBBGCMuso/src/RcppExports.o Normal file

Binary file not shown.

View File

@ -0,0 +1,142 @@
#include <Rcpp.h>
#include <numeric>
#include <iostream>
#include <algorithm>
#include <numeric>
#include <ctime>
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) <<endl;
// cout << "sor:\t" << sor <<endl;
// cout << "\n\n\n" << mv;
}
M(n,1)=1-rollingNumber;
return M;
}
NumericMatrix copyMatSpec(NumericMatrix A, NumericMatrix B, int u, int v){
int k=0;
for(int i=u;i<=v;++i){
A(i,_)=B(k,_);
k+=1;
}
return A;
}
//' 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
// [[Rcpp::export]]
NumericMatrix musoRandomizer(NumericMatrix A, NumericMatrix B){
NumericMatrix M(A.nrow(),2);
int nGroup = B.nrow()-1;
int k=0;
for(int i=0;i<=nGroup;++i)
{
int b=B(i,0)-1;
int till=b+k;
int t=B(i,1);
// cout << b << "\t" << t <<endl;
switch(t){
case 0:
M=copyMatSpec(M,randTypeZero(A(Range(k,till),_)),k,till);
// cout << M << endl;
break;
case 1:
M=copyMatSpec(M,randTypeOne(A(Range(k,till),_)),k,till);
// cout << M << endl;
break;
case 2:
M=copyMatSpec(M,randTypeTwo(A(Range(k,till),_)),k,till);
// cout << M << endl;
break;
}
k=till+1;
// cout << k << endl;
}
return M;
}
std::string concatenate(std::string A, std::string B){
std::string C = A + B;
return C;
}

Binary file not shown.

Binary file not shown.

142
musoRandomizer.cpp Normal file
View File

@ -0,0 +1,142 @@
#include <Rcpp.h>
#include <numeric>
#include <iostream>
#include <algorithm>
#include <numeric>
#include <ctime>
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) <<endl;
// cout << "sor:\t" << sor <<endl;
// cout << "\n\n\n" << mv;
}
M(n,1)=1-rollingNumber;
return M;
}
NumericMatrix copyMatSpec(NumericMatrix A, NumericMatrix B, int u, int v){
int k=0;
for(int i=u;i<=v;++i){
A(i,_)=B(k,_);
k+=1;
}
return A;
}
//' 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
// [[Rcpp::export]]
NumericMatrix musoRandomizer(NumericMatrix A, NumericMatrix B){
NumericMatrix M(A.nrow(),2);
int nGroup = B.nrow()-1;
int k=0;
for(int i=0;i<=nGroup;++i)
{
int b=B(i,0)-1;
int till=b+k;
int t=B(i,1);
// cout << b << "\t" << t <<endl;
switch(t){
case 0:
M=copyMatSpec(M,randTypeZero(A(Range(k,till),_)),k,till);
// cout << M << endl;
break;
case 1:
M=copyMatSpec(M,randTypeOne(A(Range(k,till),_)),k,till);
// cout << M << endl;
break;
case 2:
M=copyMatSpec(M,randTypeTwo(A(Range(k,till),_)),k,till);
// cout << M << endl;
break;
}
k=till+1;
// cout << k << endl;
}
return M;
}
std::string concatenate(std::string A, std::string B){
std::string C = A + B;
return C;
}