hollorol/RBBGCMuso
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fixing the importation warning bug

Browse Source
This commit is contained in:
Roland Hollós 2019-01-09 15:21:18 +01:00
parent 2cc7e7ceb1
commit 55d79854b6
19 changed files with 179 additions and 533 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
RBBGCMuso/DESCRIPTION
View File

@ -11,6 +11,7 @@ Packaged: 2017-07-19 14:00:04 UTC; hollorol
Author: Roland Hollo's [aut, cre]
Imports:
grDevices,
limSolve,
stats,
utils,
graphics,

32
RBBGCMuso/NAMESPACE
View File

@ -1,6 +1,5 @@
# Generated by roxygen2: do not edit by hand
export(OtableMaker)
export(calibMuso)
export(changeMusoC)
export(cleanupMuso)
@ -26,15 +25,34 @@ export(setupMuso)
export(spinupMuso)
export(supportedMuso)
export(updateMusoMapping)
import(dplyr)
import(ggplot2)
import(grDevices)
import(graphics)
import(magrittr)
import(stats)
import(tidyr)
import(utils)
importFrom(Rcpp,evalCpp)
importFrom(digest,digest)
importFrom(dplyr,'%>%')
importFrom(dplyr,filter)
importFrom(dplyr,group_by)
importFrom(dplyr,mutate)
importFrom(dplyr,summarize)
importFrom(ggplot2,aes)
importFrom(ggplot2,aes_string)
importFrom(ggplot2,element_blank)
importFrom(ggplot2,element_text)
importFrom(ggplot2,facet_wrap)
importFrom(ggplot2,geom_bar)
importFrom(ggplot2,geom_line)
importFrom(ggplot2,geom_point)
importFrom(ggplot2,ggplot)
importFrom(ggplot2,ggsave)
importFrom(ggplot2,ggtitle)
importFrom(ggplot2,labs)
importFrom(ggplot2,scale_y_continuous)
importFrom(ggplot2,theme)
importFrom(ggplot2,xlab)
importFrom(ggplot2,ylab)
importFrom(limSolve,xsample)
importFrom(rmarkdown,render)
importFrom(scales,percent)
importFrom(tibble,rownames_to_column)
importFrom(tidyr,separate)
useDynLib(RBBGCMuso)

40
RBBGCMuso/R/.Rhistory
View File

@ -1,40 +0,0 @@
list.files()
sumDaysOfPeriod(1990,5)
ls()
rm(list=ls)
rm(list=ls())
ls()
stop("asdf")
ls()
?registerDoParallel
getDoParallel()
?clusterExport
vignette(parallel)
vignette("parallel")
stopCluster(cl)
?registerDoParallel
list.files()
list.files()
?intersect
library(hash)
hash(list.files())
hash(1
)
?hash
hash( a=1, b=2, c=3 )
list.files()
setwd("~/Documents/tmp")
list.files()
list.files()
list.files()
list.files()
list.files()
paste("a","b",collapse = "/")
paste("a","b",sep = "/")
list.files()
24000*100000
24000*100000/1000000
exit())
exit()
quit()
y

58
RBBGCMuso/R/OtableMaker.R
View File

@ -1,58 +0,0 @@
#'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)
if(nrow(OT0)!=nrow(OTF)){
sliced <- constMatrix %>%
dplyr::filter(GROUP %in% groupIDs)
slicedIndexes<- which(sliced[,"INDEX"] %in% intersect(sliced[,"INDEX"],otfIndexes))
sliced[slicedIndexes,c("MIN","MAX")] <- OTF[which(OTF["GROUP"] == groupIDs),c("MIN","MAX")]
OTbig <- rbind(OT0,sliced) %>% data.frame()
} else {
OTbig <- OT0 %>% 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))
}

29
RBBGCMuso/R/musoExample.R
View File

@ -3,31 +3,32 @@
#'With this function you can copy RBBGCMuso example library whereever you want
#'
#'@param example The name of the example file, if it is NULL tcl/tk menu will pop up to select.
#'@param destination The destination where the example files will be copied.
#'@param destination The destination where the example files will be copied.
#'@importFrom tcltk tclRequire tktoplevel tktoplevel tcl tclVar tclvalue tkwidget tk_choose.dir tktitle
#'@export
copyMusoExamleTo <- function(example = NULL, destination = NULL){
WindowsP <- Sys.info()[1] == "Windows"
chooseExample <- function(){
choiceWin <- tcltk::tktoplevel()
tcltk::tclRequire("BWidget")
tcltk::tktitle(choiceWin) <- "Choose an example!"
tcltk::tcl("wm","geometry",choiceWin,"200x50")
tcltk::tcl("wm", "attributes", choiceWin, topmost=TRUE)
choiceWin <- tktoplevel()
tclRequire("BWidget")
tktitle(choiceWin) <- "Choose an example!"
tcl("wm","geometry",choiceWin,"200x50")
tcl("wm", "attributes", choiceWin, topmost=TRUE)
choiceValues <- basename(list.dirs(system.file("examples","",package = "RBBGCMuso"),recursive = FALSE))
choices <- tcltk::tkwidget(choiceWin,"ComboBox",
choices <- tkwidget(choiceWin,"ComboBox",
editable = FALSE, values = choiceValues,
textvariable = tcltk::tclVar(choiceValues[1]))
textvariable = tclVar(choiceValues[1]))
tcltk::tkpack(choices)
choiceValue <- NA
closeSelection <- tcltk::tkwidget(choiceWin,"button",text ="Select", command =function (){
choiceValue <<- tcltk::tclvalue(tcltk::tcl(choices,"get"))
tcltk::tkdestroy(choiceWin)
closeSelection <- tkwidget(choiceWin,"button",text ="Select", command =function (){
choiceValue <<- tclvalue(tcl(choices,"get"))
tkdestroy(choiceWin)
})
tcltk::tkpack(closeSelection)
while(as.numeric(tcltk::tclvalue(tcltk::tcl("winfo","exists",choiceWin)))){
while(as.numeric(tclvalue(tcl("winfo","exists",choiceWin)))){
}
return(choiceValue)
@ -40,7 +41,7 @@ copyMusoExamleTo <- function(example = NULL, destination = NULL){
}
if(is.null(destination)){
destination<-tcltk::tk_choose.dir(getwd(), "Choose folder to copy the examples!")
destination<-tk_choose.dir(getwd(), "Choose folder to copy the examples!")
}
currDir <- getwd()
@ -53,4 +54,4 @@ copyMusoExamleTo <- function(example = NULL, destination = NULL){
}
file.copy(grep("bin", list.files(), value = TRUE, invert = TRUE),destination)
setwd(currDir)
}
}

208
RBBGCMuso/R/musoMont.R ~
View File

@ -1,208 +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,
...){
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 likely to not to be used
inputDir <- normalizePath(inputDir) # Where are the model files.
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
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)
}

211
RBBGCMuso/R/musoMonte.R
View File

@ -24,85 +24,85 @@ musoMonte <- function(settings=NULL,
outputType = "moreCsv",
fun=mean,
varIndex = 1,
outVars = NULL,
silent = TRUE,
skipSpinup = FALSE,
skipSpinup = TRUE,
debugging = FALSE,
keepEpc = FALSE,
constrains = NULL,
...){
readValuesFromEpc <- function(epc, linums){
epcFile <- readLines(epc)
rows <- numeric(2)
values <- sapply(linums, function(x){
rows[1] <- as.integer(x)
rows[2] <- as.integer(round(100*x)) %% 10 + 1
epcFile <- readLines(epc)
selRow <- unlist(strsplit(epcFile[rows[1]], split= "[\t ]"))
selRow <- selRow[selRow!=""]
return(as.numeric(selRow[rows[2]]))
})
return(values)
}
if(is.null(parameters)){
parameters <- tryCatch(read.csv("parameters.csv"), error = function (e) {
parameters <- tryCatch(read.csv("parameters.csv", stringsAsFactor=FALSE), 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){
parameters <- tryCatch(read.csv(parameters, stringsAsFactor=FALSE), error = function (e){
stop("Cannot find neither parameters file neither the parameters matrix")
})
}}
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()
}
if(is.null(outVars)){
numVars <- length(settings$outputVars[[1]])
outVarNames <- settings$outputVars[[1]]
} else {
numVars <- length(outVars)
outVarNames <- sapply(outVars, musoMapping)
}
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]
# settings$calibrationPar <- A[,1] #:LATER:
pretag <- file.path(outLoc,preTag)
npar <- length(settings$calibrationPar)
##reading the original epc file at the specified
## row numbers
if(iterations < 3000){
randVals <- musoRand(parameters = parameters,constrains = constrains, iterations = 3000)
randVals[[2]]<- randVals[[2]][sample(1:3000,iterations),]
} else {
randVals <- musoRand(parameters = parameters,constrains = constrains, iterations = iterations)
}
origEpcFile <- readLines(settings$epcInput[2])
origEpc <- unlist(lapply(settings$calibrationPar, function (x) {
as.numeric(unlist(strsplit(origEpcFile[x],split="[\t ]"))[1])
}))
origEpc <- readValuesFromEpc(settings$epc[2],parameters[,2])
## 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
@ -110,49 +110,59 @@ musoMonte <- function(settings=NULL,
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(){
randValues <- randVals[[2]]
settings$calibrationPar <- randVals[[1]]
## randValues <- randValues[,randVals[[1]] %in% parameters[,2]][,rank(parameters[,2])]
modellOut <- matrix(ncol = numVars, nrow = iterations + 1)
if(skipSpinup){#skipSpinup is boolean
spinupMuso(settings = settings , silent = silent)
origModellOut <- calibMuso(silent=TRUE)
write.csv(x=origModellOut, file=paste0(pretag,1,".csv"))
if(!is.list(fun)){
funct <- rep(list(fun), numVars)
}
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=",")
tmp2 <- numeric(numVars)
for(j in 1:numVars){
tmp2[j]<-funct[[j]](origModellOut[,j])
}
modellOut[1,]<- tmp2
for(i in 2:(iterations+1)){
tmp <- calibMuso(settings = settings,
parameters = randValues[(i-1),],
silent= TRUE,
skipSpinup = skipSpinup,
keepEpc = keepEpc,
debugging = debugging,
outVars = outVars)
for(j in 1:numVars){
tmp2[j]<-funct[[j]](tmp[,j])
}
modellOut[i,]<- tmp2
write.csv(x=tmp, file=paste0(pretag,(i+1),".csv"))
setTxtProgressBar(progBar,i)
}
cat("\n")
paramLines <- parameters[,2]
paramLines <- order(paramLines)
randInd <- randVals[[1]][(randVals[[1]] %in% parameters[,2])]
randInd <- order(randInd)
epcStrip <- rbind(origEpc[order(parameters[,2])],
randValues[,randVals[[1]] %in% parameters[,2]][,randInd])
preservedEpc <- cbind(epcStrip,
modellOut)
colnames(preservedEpc) <- c(parameterNames[paramLines], sapply(outVarNames, function (x) paste0("mod.", x)))
return(preservedEpc)
}
@ -160,26 +170,27 @@ musoMonte <- function(settings=NULL,
## csv files for each run
oneCsv <- function () {
numDays <- settings$numdata[1]
if(!onDisk){
for(i in 1:iterations){
stop("This function is not implemented yet")
## 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]))})
## 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)}
}
## 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 {
## return(preservedEpc)
## } else {
}
## }
}
netCDF <- function () {
@ -191,18 +202,8 @@ musoMonte <- function(settings=NULL,
"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)
write.csv(a,"preservedEpc.csv")
setwd(currDir)
file.copy("savedEpc",settings$epc[2],overwrite = TRUE)
return(a)
}

5
RBBGCMuso/R/musoRand.R
View File

@ -4,7 +4,8 @@
#' @author Roland Hollos
#' @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 input-file, the last two column consist the endpont of the parameter-ranges, where the parameters will be randomized.
#' @param constrains This is a matrics wich specify the constrain rules for the sampling. Further informations coming son.
#' @param iteration The number of sample-s. It is adviced to use at least 3000 iteration, because it is generally fast and it can be subsampled later at any time.
#' @param iteration The number of sample-s. It is adviced to use at least 3000 iteration, because it is generally fast and it can be subsampled later at any time.
#' @importFrom limSolve xsample
#' @export
musoRand <- function(parameters, constrains = NULL, iterations=3000){
@ -163,7 +164,7 @@ musoRand <- function(parameters, constrains = NULL, iterations=3000){
randVal <- suppressWarnings(limSolve::xsample(G=G,H=h,E=E,F=f,iter = iterations))$X
} else{
Gh0<-genMat0(dependences)
randVal <- suppressWarnings(limSolve::xsample(G=Gh0$G,H=Gh0$h, iter = iterations))$X
randVal <- suppressWarnings(xsample(G=Gh0$G,H=Gh0$h, iter = iterations))$X
}
results <- list(INDEX =dependences$INDEX, randVal=randVal)

12
RBBGCMuso/R/musoSensi.R
View File

@ -15,10 +15,8 @@
#' @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 skipSpinup With this parameter, you can turn of the spinup phase after the first spinup. I will decrease the time significantly.
#' @import dplyr
#' @import graphics
#' @import grDevices
#' @import ggplot2
#' @importFrom ggplot2 geom_bar ggplot aes theme element_text xlab ylab ggtitle ggsave scale_y_continuous
#' @importFrom scales percent
#' @export
musoSensi <- function(monteCarloFile = NULL,
@ -76,7 +74,7 @@ musoSensi <- function(monteCarloFile = NULL,
xlab(NULL)+
ylab(NULL)+
ggtitle("Sensitivity")+
scale_y_continuous(labels = scales::percent,limits=c(0,1))
scale_y_continuous(labels = percent,limits=c(0,1))
print(sensiPlot)
ggsave(plotName,dpi=dpi)
return(S)
@ -85,7 +83,7 @@ musoSensi <- function(monteCarloFile = NULL,
if(is.null(monteCarloFile)){
M <- musoMont(parameters = parameters,
M <- musoMonte(parameters = parameters,
settings = settings,
inputDir = inputDir,
outLoc = outLoc,
@ -105,7 +103,7 @@ musoSensi <- function(monteCarloFile = NULL,
} else {
M <- read.csv(monteCarloFile)
yInd <- grep("mod.", colnames(M))[varIndex]
yInd <- grep("mod.", colnames(M))[varIndex]
parNames <- grep("mod.",colnames(M), invert=TRUE, value = TRUE)
M <- M[,c(grep("mod.", colnames(M),invert=TRUE),yInd)]
return(doSensi(M))

0
RBBGCMuso/R/package.R
View File

3
RBBGCMuso/R/parametersweep.R
View File

@ -10,6 +10,7 @@
#' @param htmlOutName The name of the rendered html file
#' @importFrom rmarkdown render
#' @importFrom digest digest
#' @importFrom tcltk tk_choose.files
#' @export
paramSweep <- function(inputDir="./",
@ -38,7 +39,7 @@ paramSweep <- function(inputDir="./",
if(is.null(parameters)){
parameters <- tcltk::tk_choose.files(caption = "Please select a file with the parameters and the ranges")
parameters <- tk_choose.files(caption = "Please select a file with the parameters and the ranges")
}
rmdFile <- "---\ntitle: \"ParameterSweep basic\"\n---\n```{r setup, include=FALSE}\nknitr::opts_chunk$set(echo = TRUE)\n```\n```{r, echo=FALSE}\nsuppressWarnings(library(RBBGCMuso))\n```\n```{r, echo=FALSE}\nparameters <- read.csv(\"parameters.csv\")\n```\n```{r,fig.width=10, fig.height=3, echo=FALSE}\nnumPar\nfor(i in 1:numPar){\n suppressWarnings(musoQuickEffect(calibrationPar=parameters[i,2],startVal = parameters[i,3], endVal = parameters[i,4],\nnSteps = 9,\noutVar = \"daily_gpp\",\nparName = parameters[i,1]))\n}\n```"

25
RBBGCMuso/R/plotMuso.R
View File

@ -21,9 +21,10 @@
#' debugging=FALSE, keepEpc=FALSE,
#' logfilename=NULL, aggressive=FALSE,
#' leapYear=FALSE, export=FALSE)
#' @import ggplot2
#' @import dplyr
#' @import tidyr
#' @importFrom ggplot2 ggplot aes_string geom_line geom_point aes labs theme ggsave element_blank facet_wrap
#' @importFrom dplyr filter group_by summarize mutate '%>%'
#' @importFrom tibble rownames_to_column
#' @importFrom tidyr separate
#' @export
plotMuso <- function(settings=NULL,
@ -96,11 +97,11 @@ plotMuso <- function(settings=NULL,
if(!is.element("cum_yieldC_HRV",unlist(settings$outputVars[[1]]))){
musoData <- calibMuso(settings,silent = TRUE,skipSpinup=skipSpinup) %>%
as.data.frame() %>%
tibble::rownames_to_column("date") %>%
rownames_to_column("date") %>%
mutate(date2=date,date=as.Date(date,"%d.%m.%Y")) %>%
tidyr::separate(date2,c("day","month","year"),sep="\\.")
separate(date2,c("day","month","year"),sep="\\.")
if(!is.null(selectYear)){
musoData <- musoData %>% dplyr::filter(year == get("selectYear"))
musoData <- musoData %>% filter(year == get("selectYear"))
}
if(timeFrame!="day"){
@ -109,12 +110,12 @@ plotMuso <- function(settings=NULL,
}} else {
musoData <- calibMuso(settings,silent = TRUE,skipSpinup=skipSpinup,parameters = parameters, calibrationPar = calibrationPar,fileToChange = fileToChange) %>%
as.data.frame() %>%
tibble::rownames_to_column("date") %>%
rownames_to_column("date") %>%
mutate(date2=date,date=as.Date(date,"%d.%m.%Y"),
yearDay=rep(1:365,numberOfYears), cum_yieldC_HRV=cum_yieldC_HRV*22.22) %>%
tidyr::separate(date2,c("day","month","year"),sep="\\.")
separate(date2,c("day","month","year"),sep="\\.")
if(!is.null(selectYear)){
musoData <- musoData %>% dplyr::filter(year == get("selectYear"))
musoData <- musoData %>% filter(year == get("selectYear"))
}
@ -276,9 +277,9 @@ plotMusoWithData <- function(csvFile, variable, NACHAR=NA, settings=NULL, sep=",
baseData <- calibMuso(settings,silent=TRUE) %>%
as.data.frame() %>%
tibble::rownames_to_column("date") %>%
dplyr::mutate(date2=date,date=as.Date(date,"%d.%m.%Y"),yearDay=rep(1:365,numberOfYears)) %>%
tidyr::separate(date2,c("day","month","year"),sep="\\.")
rownames_to_column("date") %>%
mutate(date2=date,date=as.Date(date,"%d.%m.%Y"),yearDay=rep(1:365,numberOfYears)) %>%
separate(date2,c("day","month","year"),sep="\\.")
baseData <- cbind(baseData,data)
colnames(baseData)[ncol(baseData)] <- "measuredData"

57
RBBGCMuso/R/quickeffect.R~
View File

@ -1,57 +0,0 @@
#' musoQuickEffect
#'
#' This function changes a choosen parameter, and visualize the effect of the change on a chosen variable.
#' @author Roland Hollos
#' @param settings The settings from setupMuso output
#' @param startVal The oroginal parameterValue
#' @param endVal The goal value while the function pass
#' @param nSteps How many steps 'till you reach the endVal
#' @param fileTochange Please choose "epc" "ini" or "both". This is the place of the orininal variable.
#' @return An effect plot
#' @export
musoQuickEffect <- function(settings = NULL,calibrationPar = NULL, startVal, endVal, nSteps = 1, fileTochange="epc", outVar, parName = "parVal"){
if(is.character(outVar)){
varNames <- as.data.frame(musoMappingFind(outVar))
if(nrow(varNames)!=1){
warning("There are more than one output variable in conection with ", outVar, ". The first possibility were choosen.")
print(varNames)
outVarIndex <- unlist(varNames[1,1])
varNames <- as.character(unlist(varNames[1,2]))
} else {
outVarIndex <- unlist(varNames[1,1])
varNames <- as.character(unlist(varNames[1,2]))
}
} else {
varNames <- musoMapping(outVar)
outVarIndex<-outVar
}
if(is.null(settings)){
settings <- setupMuso()
}
if(is.null(calibrationPar)){
calibrationPar <- settings$calibrationPar
}
parVals <- seq(startVal, endVal, length = (nSteps + 1))
a <- do.call(rbind,lapply(parVals, function(parVal){
calResult <- tryCatch(calibMuso(settings = settings,calibrationPar = calibrationPar, parameters = parVal, outVars = outVarIndex, silent = TRUE), error = function(e){NA})
if(all(is.na(calResult))){
b <- cbind(rep(NA,365),parVal)
rownames(b) <- tail(musoDate(startYear = settings$startYear, numYears = settings$numYears),365)
colnames(b)[1] <- varNames
return(b)
} else {
return(cbind(tail(calResult,365), parVal))
}
}))
a %<>%
tbl_df %>%
mutate(date=as.Date(rownames(a),"%d.%m.%Y")) %>%
select(date,varNames,parVal)
print(ggplot(data = a, aes_string(x= "date", y= varNames))+geom_line(aes(alpha = factor(round(parVal,2)))) + labs(y=varNames, alpha = parName) + scale_alpha_discrete(range=c(0.4,1)))
}

17
RBBGCMuso/man/OtableMaker.Rd
View File

@ -1,17 +0,0 @@
% 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
}

2
RBBGCMuso/man/calibMuso.Rd
View File

@ -35,6 +35,8 @@ keepEpc=FALSE, export=FALSE, silent=FALSE, aggressive=FALSE, leapYear=FALSE)
\item{fileToChange}{You can change any line of the epc or the ini file, you just have to specify with this variable which file you van a change. Two options possible: "epc", "ini"}
\item{skipSpinup}{If TRUE, calibMuso wont do spinup simulation}
\item{prettyOut}{date ad Date type, separate year, month, day vectors}
}
\value{
No return, outputs are written to file

10
RBBGCMuso/man/musoMonte.Rd
View File

@ -6,13 +6,15 @@
\usage{
musoMonte(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, ...)
outputType = "moreCsv", fun = mean, varIndex = 1, outVars = NULL,
silent = TRUE, skipSpinup = TRUE, debugging = FALSE,
keepEpc = FALSE, constrains = NULL, ...)
musoMonte(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, ...)
outputType = "moreCsv", fun = mean, varIndex = 1, outVars = NULL,
silent = TRUE, skipSpinup = TRUE, debugging = FALSE,
keepEpc = FALSE, constrains = NULL, ...)
}
\arguments{
\item{settings}{A list of montecarlos environmental variables. It is generated by the setupMuso() function. In default the settings parameter is generated automatically.}

2
RBBGCMuso/man/musoQuickEffect.Rd
View File

@ -5,7 +5,7 @@
\title{musoQuickEffect}
\usage{
musoQuickEffect(settings = NULL, calibrationPar = NULL, startVal,
endVal, nSteps = 1, fileTochange = "epc", outVar,
endVal, nSteps = 1, fileToChange = "epc", outVar,
parName = "parVal")
}
\arguments{

0
RBBGCMuso/R/musoFilter.R → untestedFunctions/musoFilter.R
View File

0
RBBGCMuso/R/musoGLUE.R → untestedFunctions/musoGLUE.R
View File