Merge branch 'master' of github.com:hollorol/RBBGCMuso
This commit is contained in:
Roland Hollós
commit
942a8603f9
3
.gitignore
vendored
3
.gitignore
vendored
@ -5,4 +5,5 @@
|
||||
*.o
|
||||
*.a
|
||||
*~
|
||||
*.dll
|
||||
*.dll
|
||||
RBBGCMuso/R/tags
|
||||
|
||||
@ -1 +0,0 @@
|
||||
This is the unstable development branch of the RBBGCMuso package. --->outDated
|
||||
@ -32,7 +32,10 @@ Imports:
|
||||
ncdf4,
|
||||
future,
|
||||
httr,
|
||||
tcltk
|
||||
tcltk,
|
||||
Boruta,
|
||||
rpart,
|
||||
rpart.plot
|
||||
Maintainer: Roland Hollo's <hollorol@gmail.com>
|
||||
RoxygenNote: 7.1.0
|
||||
Suggests: knitr,
|
||||
|
||||
@ -3,17 +3,22 @@
|
||||
export(calibMuso)
|
||||
export(calibrateMuso)
|
||||
export(changemulline)
|
||||
export(checkFileSystem)
|
||||
export(checkMeteoBGC)
|
||||
export(cleanupMuso)
|
||||
export(compareMuso)
|
||||
export(copyMusoExampleTo)
|
||||
export(corrigMuso)
|
||||
export(createSoilFile)
|
||||
export(flatMuso)
|
||||
export(getAnnualOutputList)
|
||||
export(getConstMatrix)
|
||||
export(getDailyOutputList)
|
||||
export(getFilePath)
|
||||
export(getFilesFromIni)
|
||||
export(getyearlycum)
|
||||
export(getyearlymax)
|
||||
export(multiSiteCalib)
|
||||
export(musoDate)
|
||||
export(musoGlue)
|
||||
export(musoMapping)
|
||||
@ -81,6 +86,9 @@ importFrom(magrittr,'%>%')
|
||||
importFrom(openxlsx,read.xlsx)
|
||||
importFrom(rmarkdown,pandoc_version)
|
||||
importFrom(rmarkdown,render)
|
||||
importFrom(rpart,rpart)
|
||||
importFrom(rpart,rpart.control)
|
||||
importFrom(rpart.plot,rpart.plot)
|
||||
importFrom(scales,percent)
|
||||
importFrom(stats,approx)
|
||||
importFrom(tcltk,tk_choose.files)
|
||||
|
||||
@ -23,9 +23,13 @@
|
||||
RMuso_varTable[[version]] <<- varTable
|
||||
})
|
||||
|
||||
RMuso_depTree<- read.csv(file.path(system.file("data",package="RBBGCMuso"),"depTree.csv"), stringsAsFactors=FALSE)
|
||||
|
||||
|
||||
options(RMuso_version=RMuso_version,
|
||||
RMuso_constMatrix=RMuso_constMatrix,
|
||||
RMuso_varTable=RMuso_varTable)
|
||||
RMuso_varTable=RMuso_varTable,
|
||||
RMuso_depTree=RMuso_depTree
|
||||
)
|
||||
# getOption("RMuso_constMatrix")$soil[[as.character(getOption("RMuso_version"))]]
|
||||
}
|
||||
|
||||
@ -56,13 +56,13 @@ calibrateMuso <- function(measuredData, parameters =read.csv("parameters.csv", s
|
||||
})
|
||||
|
||||
# musoSingleThread(measuredData, parameters, startDate,
|
||||
# endDate, formatString,
|
||||
# dataVar, outLoc,
|
||||
# preTag, settings,
|
||||
# outVars, iterations = threadCount[i],
|
||||
# skipSpinup, plotName,
|
||||
# modifyOriginal, likelihood, uncertainity,
|
||||
# naVal, postProcString, i)
|
||||
# endDate, formatString,
|
||||
# dataVar, outLoc,
|
||||
# preTag, settings,
|
||||
# outVars, iterations = threadCount[i],
|
||||
# skipSpinup, plotName,
|
||||
# modifyOriginal, likelihood, uncertainity,
|
||||
# naVal, postProcString, i)
|
||||
})
|
||||
})
|
||||
|
||||
|
||||
267
RBBGCMuso/R/flat.R
Normal file
267
RBBGCMuso/R/flat.R
Normal file
@ -0,0 +1,267 @@
|
||||
getQueue <- function(depTree=options("RMuso_depTree")[[1]], startPoint){
|
||||
|
||||
if(length(startPoint) == 0){
|
||||
return(c())
|
||||
}
|
||||
parent <- depTree[depTree[,"name"] == startPoint,"parent"]
|
||||
c(getQueue(depTree, depTree[depTree[,"child"] == depTree[depTree[,"name"] == startPoint,"parent"],"name"]),parent)
|
||||
}
|
||||
|
||||
isRelative <- function(path){
|
||||
substr(path,1,1) != '/'
|
||||
}
|
||||
|
||||
#' getFilePath
|
||||
#'
|
||||
#' This function reads the ini file and for a chosen fileType it gives you the filePath
|
||||
#' @param iniName The name of the ini file
|
||||
#' @param filetype The type of the choosen file. For options see options("RMuso_depTree")[[1]]$name
|
||||
#' @param depTree The file dependency defining dataframe. At default it is: options("RMuso_depTree")[[1]]
|
||||
#' @export
|
||||
|
||||
getFilePath <- function(iniName, fileType, execPath = "./", depTree=options("RMuso_depTree")[[1]]){
|
||||
if(!file.exists(iniName) || dir.exists(iniName)){
|
||||
stop(sprintf("Cannot find iniFile: %s", iniName))
|
||||
}
|
||||
|
||||
startPoint <- fileType
|
||||
startRow <- depTree[depTree[,"name"] == startPoint,]
|
||||
startExt <- startRow$child
|
||||
|
||||
parentFile <- Reduce(function(x,y){
|
||||
tryCatch(file.path(execPath,gsub(sprintf("\\.%s.*",y),
|
||||
sprintf("\\.%s",y),
|
||||
grep(sprintf("\\.%s",y),readLines(x),value=TRUE,perl=TRUE))), error = function(e){
|
||||
stop(sprintf("Cannot find %s",x))
|
||||
})
|
||||
},
|
||||
getQueue(depTree,startPoint)[-1],
|
||||
init=iniName)
|
||||
if(startRow$mod > 0){
|
||||
tryCatch(
|
||||
gsub(sprintf("\\.%s.*", startExt),
|
||||
sprintf("\\.%s", startExt),
|
||||
grep(sprintf("\\.%s",startExt),readLines(parentFile),value=TRUE,perl=TRUE))[startRow$mod]
|
||||
,error = function(e){stop(sprintf("Cannot read %s",parentFile))})
|
||||
} else {
|
||||
res <- tryCatch(
|
||||
gsub(sprintf("\\.%s.*", startExt),
|
||||
sprintf("\\.%s",startExt),
|
||||
grep(sprintf("\\.%s",startExt),readLines(parentFile),value=TRUE, perl=TRUE))
|
||||
,error = function(e){stop(sprintf("Cannot read %s", parentFile))})
|
||||
unique(gsub(".*\\t","",res))
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
#' getFilesFromIni
|
||||
#'
|
||||
#' This function reads the ini file and gives yout back the path of all file involved in model run
|
||||
#' @param iniName The name of the ini file
|
||||
#' @param depTree The file dependency defining dataframe. At default it is: options("RMuso_depTree")[[1]]
|
||||
#' @export
|
||||
|
||||
getFilesFromIni <- function(iniName, execPath = "./", depTree=options("RMuso_depTree")[[1]]){
|
||||
res <- lapply(depTree$name,function(x){
|
||||
tryCatch(getFilePath(iniName,x,execPath,depTree), error = function(e){
|
||||
return(NA);
|
||||
})
|
||||
})
|
||||
names(res) <- depTree$name
|
||||
res
|
||||
}
|
||||
|
||||
#' flatMuso
|
||||
#'
|
||||
#' This function reads the ini file and creates a directory (named after the directory argument) with all the files the modell uses with this file. the directory will be flat.
|
||||
#' @param iniName The name of the ini file
|
||||
#' @param depTree The file dependency defining dataframe. At default it is: options("RMuso_depTree")[[1]]
|
||||
#' @param directory The destination directory for flattening. At default it will be flatdir
|
||||
#' @export
|
||||
|
||||
flatMuso <- function(iniName, execPath="./", depTree=options("RMuso_depTree")[[1]], directory="flatdir", d=TRUE,outE=TRUE){
|
||||
dir.create(directory, showWarnings=FALSE, recursive = TRUE)
|
||||
files <- getFilesFromIni(iniName,execPath,depTree)
|
||||
files <- sapply(unlist(files)[!is.na(files)], function(x){ifelse(isRelative(x),file.path(execPath,x),x)})
|
||||
file.copy(unlist(files), directory, overwrite=TRUE)
|
||||
file.copy(iniName, directory, overwrite=TRUE)
|
||||
|
||||
filesByName <- getFilesFromIni(iniName, execPath, depTree)
|
||||
for(i in seq_along(filesByName)){
|
||||
fileLines <- readLines(file.path(directory,list.files(directory, pattern = sprintf("*\\.%s", depTree$parent[i])))[1])
|
||||
|
||||
sapply(filesByName[[i]],function(origname){
|
||||
if(!is.na(origname)){
|
||||
fileLines <<- gsub(origname, basename(origname), fileLines, fixed=TRUE)
|
||||
}
|
||||
})
|
||||
|
||||
if(!is.na(filesByName[[i]][1])){
|
||||
writeLines(fileLines, file.path(directory,list.files(directory, pattern = sprintf("*\\.%s", depTree$parent[i])))[1])
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
iniLines <- readLines(file.path(directory, basename(iniName)))
|
||||
outPlace <- grep("OUTPUT_CONTROL", iniLines, perl=TRUE)+1
|
||||
if(outE){
|
||||
iniLines[outPlace] <- tools::file_path_sans_ext(basename(iniName))
|
||||
} else {
|
||||
iniLines[outPlace] <- basename(strsplit(iniLines[outPlace], split = "\\s+")[[1]][1])
|
||||
}
|
||||
if(d){
|
||||
iniLines[outPlace + 1] <- 1
|
||||
}
|
||||
writeLines(iniLines, file.path(directory, basename(iniName)))
|
||||
}
|
||||
|
||||
#' checkFileSystem
|
||||
#'
|
||||
#' This function checks the MuSo file system, if it is correct
|
||||
#' @param iniName The name of the ini file
|
||||
#' @param depTree The file dependency defining dataframe. At default it is: options("RMuso_depTree")[[1]]
|
||||
#' @export
|
||||
|
||||
checkFileSystem <- function(iniName,root = ".", depTree = options("RMuso_depTree")[[1]]){
|
||||
recoverAfterEval({
|
||||
setwd(root)
|
||||
fileNames <- getFilesFromIni(iniName, depTree)
|
||||
if(is.na(fileNames$management)){
|
||||
fileNames[getLeafs("management")] <- NA
|
||||
}
|
||||
fileNames <- fileNames[!is.na(fileNames)]
|
||||
errorFiles <- fileNames[!file.exists(unlist(fileNames))]
|
||||
})
|
||||
return(errorFiles)
|
||||
}
|
||||
|
||||
recoverAfterEval <- function(expr){
|
||||
wd <- getwd()
|
||||
tryCatch({
|
||||
eval(expr)
|
||||
setwd(wd)
|
||||
}, error=function(e){
|
||||
setwd(wd)
|
||||
stop(e)
|
||||
})
|
||||
}
|
||||
|
||||
getLeafs <- function(name, depTree=options("RMuso_depTree")[[1]]){
|
||||
|
||||
if(length(name) == 0){
|
||||
return(NULL)
|
||||
}
|
||||
|
||||
if(name[1] == "ini"){
|
||||
return(getLeafs(depTree$name))
|
||||
}
|
||||
|
||||
pname <- depTree[ depTree[,"name"] == name[1] , "child"]
|
||||
children <- depTree[depTree[,"parent"] == pname,"child"]
|
||||
|
||||
if(length(children)==0){
|
||||
if(length(name) == 1){
|
||||
return(NULL)
|
||||
} else{
|
||||
apname <- depTree[ depTree[,"name"] == name[2] , "child"]
|
||||
achildren <- depTree[depTree[,"parent"] == apname,"child"]
|
||||
if(length(achildren)!=0){
|
||||
return(c(name[1],name[2],getLeafs(name[-1])))
|
||||
} else{
|
||||
return(c(name[1], getLeafs(name[-1])))
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
childrenLogic <-depTree[,"child"] %in% children
|
||||
parentLogic <- depTree[,"parent"] ==pname
|
||||
res <- depTree[childrenLogic & parentLogic, "name"]
|
||||
getChildelem <- depTree[depTree[,"child"] == intersect(depTree[,"parent"], children), "name"]
|
||||
unique(c(res,getLeafs(getChildelem)))
|
||||
}
|
||||
|
||||
getParent <- function (name, depTree=options("RMuso_depTree")[[1]]) {
|
||||
parentExt <- depTree[depTree$name == name,"parent"]
|
||||
# if(length(parentExt) == 0){
|
||||
# browser()
|
||||
# }
|
||||
if(parentExt == "ini"){
|
||||
return("iniFile")
|
||||
}
|
||||
|
||||
depTree[depTree[,"child"] == parentExt,"name"]
|
||||
}
|
||||
|
||||
|
||||
|
||||
getFilePath2 <- function(iniName, fileType, depTree=options("RMuso_depTree")[[1]]){
|
||||
if(!file.exists(iniName) || dir.exists(iniName)){
|
||||
stop(sprintf("Cannot find iniFile: %s", iniName))
|
||||
}
|
||||
|
||||
startPoint <- fileType
|
||||
startRow <- depTree[depTree[,"name"] == startPoint,]
|
||||
startExt <- startRow$child
|
||||
|
||||
parentFile <- Reduce(function(x,y){
|
||||
tryCatch(gsub(sprintf("\\.%s.*",y),
|
||||
sprintf("\\.%s",y),
|
||||
grep(sprintf("\\.%s",y),readLines(x),value=TRUE,perl=TRUE)), error = function(e){
|
||||
stop(sprintf("Cannot find %s",x))
|
||||
})
|
||||
},
|
||||
getQueue(depTree,startPoint)[-1],
|
||||
init=iniName)
|
||||
res <- list()
|
||||
res["parent"] <- parentFile
|
||||
if(startRow$mod > 0){
|
||||
res["children"] <- tryCatch(
|
||||
gsub(sprintf("\\.%s.*", startExt),
|
||||
sprintf("\\.%s", startExt),
|
||||
grep(sprintf("\\.%s",startExt),readLines(parentFile),value=TRUE,perl=TRUE))[startRow$mod]
|
||||
,error = function(e){stop(sprintf("Cannot read %s",parentFile))})
|
||||
|
||||
} else {
|
||||
rows <- tryCatch(
|
||||
gsub(sprintf("\\.%s.*", startExt),
|
||||
sprintf("\\.%s",startExt),
|
||||
grep(sprintf("\\.%s",startExt),readLines(parentFile),value=TRUE, perl=TRUE))
|
||||
|
||||
,error = function(e){stop(sprintf("Cannot read %s", parentFile))})
|
||||
unique(gsub(".*\\t","",res))
|
||||
res["children"] <- unique(gsub(".*\\s+(.*\\.epc)","\\1",rows))
|
||||
}
|
||||
res
|
||||
}
|
||||
|
||||
getFilesFromIni2 <- function(iniName, depTree=options("RMuso_depTree")[[1]]){
|
||||
res <- lapply(depTree$name,function(x){
|
||||
tryCatch(getFilePath2(iniName,x,depTree), error = function(e){
|
||||
return(NA);
|
||||
})
|
||||
})
|
||||
names(res) <- depTree$name
|
||||
res
|
||||
}
|
||||
|
||||
checkFileSystemForNotif <- function(iniName,root = ".", depTree = options("RMuso_depTree")[[1]]){
|
||||
recoverAfterEval({
|
||||
setwd(root)
|
||||
fileNames <- suppressWarnings(getFilesFromIni2(iniName, depTree))
|
||||
if(is.atomic(fileNames$management)){
|
||||
fileNames[getLeafs("management")] <- NA
|
||||
}
|
||||
|
||||
hasparent <- sapply(fileNames, function(x){
|
||||
!is.atomic(x)
|
||||
})
|
||||
notNA <- ! sapply(fileNames[hasparent], function(x) {is.na(x$children)})
|
||||
errorIndex <- ! sapply(fileNames[hasparent & notNA], function(x) file.exists(x$children))
|
||||
|
||||
})
|
||||
return(fileNames[hasparent & notNA][errorIndex])
|
||||
}
|
||||
|
||||
|
||||
640
RBBGCMuso/R/multiSite.R
Normal file
640
RBBGCMuso/R/multiSite.R
Normal file
@ -0,0 +1,640 @@
|
||||
`%between%` <- function(x, y){
|
||||
(x <= y[2]) & (x >= y[1])
|
||||
}
|
||||
|
||||
annualAggregate <- function(x, aggFun){
|
||||
tapply(x, rep(1:(length(x)/365), each=365), aggFun)
|
||||
}
|
||||
|
||||
SELECT <- function(x, selectPart){
|
||||
if(!is.function(selectPart)){
|
||||
index <- as.numeric(selectPart)
|
||||
tapply(x,rep(1:(length(x)/365),each=365), function(y){
|
||||
y[index]
|
||||
})
|
||||
} else {
|
||||
tapply(x,rep(1:(length(x)/365),each=365), selectPart)
|
||||
}
|
||||
}
|
||||
|
||||
bVectToInt<- function(bin_vector){
|
||||
bin_vector <- rev(as.integer(bin_vector))
|
||||
packBits(as.raw(c(bin_vector,numeric(32-length(bin_vector)))),"integer")
|
||||
}
|
||||
|
||||
constMatToDec <- function(constRes){
|
||||
tab <- table(apply(constRes,2,function(x){paste(x,collapse=" ")}))
|
||||
bitvect <- strsplit(names(tab[which.max(tab)]),split=" ")[[1]]
|
||||
bVectToInt(bitvect)
|
||||
}
|
||||
|
||||
compose <- function(expr){
|
||||
splt <- strsplit(expr,split="\\|")[[1]]
|
||||
lhs <- splt[1]
|
||||
rhs <- splt[2]
|
||||
penv <- parent.frame()
|
||||
lhsv <- eval(parse(text=lhs),envir=penv)
|
||||
penv[["lhsv"]] <- lhsv
|
||||
place <- regexpr("\\.[^0-9a-zA-Z]",rhs)
|
||||
|
||||
if(place != -1){
|
||||
finalExpression <- paste0(substr(rhs, 1, place -1),"lhsv",
|
||||
substr(rhs, place + 1, nchar(rhs)))
|
||||
} else {
|
||||
finalExpression <- paste0(rhs,"(lhsv)")
|
||||
}
|
||||
eval(parse(text=finalExpression),envir=penv)
|
||||
}
|
||||
|
||||
compoVect <- function(mod, constrTable, fileToWrite = "const_results.data"){
|
||||
with(as.data.frame(mod), {
|
||||
nexpr <- nrow(constrTable)
|
||||
filtered <- numeric(nexpr)
|
||||
vali <- numeric(nexpr)
|
||||
for(i in 1:nexpr){
|
||||
val <- compose(constrTable[i,1])
|
||||
filtered[i] <- (val <= constrTable[i,3]) &&
|
||||
(val >= constrTable[i,2])
|
||||
vali[i] <- val
|
||||
}
|
||||
|
||||
write(paste(vali,collapse=","), fileToWrite, append=TRUE)
|
||||
filtered
|
||||
})
|
||||
}
|
||||
|
||||
modCont <- function(expr, datf, interval, dumping_factor){
|
||||
tryCatch({
|
||||
if((with(datf,eval(parse(text=expr))) %between% interval)){
|
||||
return(NA)
|
||||
} else{
|
||||
return(dumping_factor)
|
||||
}
|
||||
},
|
||||
error = function(e){
|
||||
stop(sprintf("Cannot find the variable names in the dataframe, detail:\n%s",
|
||||
e))
|
||||
})
|
||||
}
|
||||
|
||||
copyToThreadDirs2 <- function(iniSource, thread_prefix = "thread", numCores, execPath="./",
|
||||
|
||||
executable = ifelse(Sys.info()[1]=="Linux", file.path(execPath, "muso"),
|
||||
file.path(execPath,"muso.exe"))){
|
||||
sapply(iniSource, function(x){
|
||||
flatMuso(x, execPath,
|
||||
directory=file.path("tmp", paste0(thread_prefix,"_1"),tools::file_path_sans_ext(basename(x)),""), d =TRUE)
|
||||
file.copy(executable,
|
||||
file.path("tmp", paste0(thread_prefix,"_1"),tools::file_path_sans_ext(basename(x))))
|
||||
tryCatch(file.copy(file.path(execPath,"cygwin1.dll"),
|
||||
file.path("tmp", paste0(thread_prefix,"_1"),tools::file_path_sans_ext(basename(x)))),
|
||||
error = function(e){"If you are in Windows..."})
|
||||
})
|
||||
sapply(2:numCores,function(thread){
|
||||
dir.create(sprintf("tmp/%s_%s",thread_prefix,thread), showWarnings=FALSE)
|
||||
file.copy(list.files(sprintf("tmp/%s_1",thread_prefix),full.names = TRUE),sprintf("tmp/%s_%s/",thread_prefix,thread),
|
||||
recursive=TRUE, overwrite = TRUE)
|
||||
})
|
||||
|
||||
}
|
||||
|
||||
|
||||
#' multiSiteCalib
|
||||
#'
|
||||
#' This funtion uses the Monte Carlo technique to uniformly sample the parameter space from user defined parameters of the Biome-BGCMuSo model. The sampling algorithm ensures that the parameters are constrained by the model logic which means that parameter dependencies are fully taken into account (parameter dependency means that e.g leaf C:N ratio must be smaller than C:N ratio of litter; more complicated rules apply to the allocation parameters where the allocation fractions to different plant compartments must sum up 1). This function implements a mathematically correct solution to provide uniform distriution of the random parameters on convex polytopes.
|
||||
#' @author Roland HOLLOS
|
||||
#' @importFrom future future
|
||||
#' @importFrom rpart rpart rpart.control
|
||||
#' @importFrom rpart.plot rpart.plot
|
||||
#' @param measuremets The table which contains the measurements
|
||||
#' @param calTable A dataframe which contantains the ini file locations and the domains they belongs to
|
||||
#' @param parameters A dataframe with the name, the minimum, and the maximum value for the parameters used in MonteCarlo experiment
|
||||
#' @param dataVar A named vector where the elements are the MuSo variable codes and the names are the same as provided in measurements and likelihood
|
||||
#' @param iterations The number of MonteCarlo experiments to be executed
|
||||
#' @param burnin Currently not used, altought it is the length of burnin period of the MCMC sampling used to generate random parameters
|
||||
#' @param likelihood A list of likelihood functions which names are linked to dataVar
|
||||
#' @param execPath If you are running the calibration from different location than the MuSo executable, you have to provide the path
|
||||
#' @param thread_prefix The prefix of thread directory names in the tmp directory created during the calibrational process
|
||||
#' @param numCores The number of processes used during the calibration. At default it uses one less than the number of threads available
|
||||
#' @param pb The progress bar function. If you use (web-)GUI you can provide a different function
|
||||
#' @param pbUpdate The update function for pb (progress bar)
|
||||
#' @param copyThread A boolean, recreate tmp directory for calibration or not (case of repeating the calibration)
|
||||
#' @param contsraints A dataframe containing the constraints logic the minimum and a maximum value for the calibration.
|
||||
#' @param th A trashold value for multisite calibration. What percentage of the site should satisfy the constraints.
|
||||
#' @param treeControl A list which controls (maximal complexity, maximal depth) the details of the decession tree making.
|
||||
#' @export
|
||||
multiSiteCalib <- function(measurements,
|
||||
calTable,
|
||||
parameters,
|
||||
dataVar,
|
||||
iterations = 100,
|
||||
burnin =ifelse(iterations < 3000, 3000, NULL),
|
||||
likelihood,
|
||||
execPath,
|
||||
thread_prefix="thread",
|
||||
numCores = (parallel::detectCores()-1),
|
||||
pb = txtProgressBar(min=0, max=iterations, style=3),
|
||||
pbUpdate = setTxtProgressBar,
|
||||
copyThread = TRUE,
|
||||
constraints=NULL, th = 10, treeControl=rpart.control()
|
||||
){
|
||||
future::plan(future::multisession)
|
||||
# file.remove(list.files(path = "tmp", pattern="progress.txt", recursive = TRUE, full.names=TRUE))
|
||||
# file.remove(list.files(path = "tmp", pattern="preservedCalib.csv", recursive = TRUE, full.names=TRUE))
|
||||
|
||||
# ____ _ _ _ _
|
||||
# / ___|_ __ ___ __ _| |_ ___ | |_| |__ _ __ ___ __ _ __| |___
|
||||
# | | | '__/ _ \/ _` | __/ _ \ | __| '_ \| '__/ _ \/ _` |/ _` / __|
|
||||
# | |___| | | __/ (_| | || __/ | |_| | | | | | __/ (_| | (_| \__ \
|
||||
# \____|_| \___|\__,_|\__\___| \__|_| |_|_| \___|\__,_|\__,_|___/
|
||||
if(copyThread){
|
||||
unlink("tmp",recursive=TRUE)
|
||||
copyToThreadDirs2(iniSource=calTable$site_id, numCores=numCores, execPath=execPath)
|
||||
} else {
|
||||
print("copy skipped")
|
||||
file.remove(file.path(list.dirs("tmp",recursive=FALSE),"progress.txt"))
|
||||
file.remove(file.path(list.dirs("tmp", recursive=FALSE), "const_results.data"))
|
||||
}
|
||||
|
||||
# ____ _ _ _
|
||||
# | _ \ _ _ _ __ | |_| |__ _ __ ___ __ _ __| |___
|
||||
# | |_) | | | | '_ \ | __| '_ \| '__/ _ \/ _` |/ _` / __|
|
||||
# | _ <| |_| | | | | | |_| | | | | | __/ (_| | (_| \__ \
|
||||
# |_| \_\\__,_|_| |_| \__|_| |_|_| \___|\__,_|\__,_|___/
|
||||
|
||||
threadCount <- distributeCores(iterations, numCores)
|
||||
fut <- lapply(1:numCores, function(i) {
|
||||
future({
|
||||
tryCatch(
|
||||
|
||||
{
|
||||
result <- multiSiteThread(measuredData = measurements, parameters = parameters, calTable=calTable,
|
||||
dataVar = dataVar, iterations = threadCount[i],
|
||||
likelihood = likelihood, threadNumber= i, constraints=constraints, th=th)
|
||||
# setwd("../../")
|
||||
# return(result)
|
||||
}
|
||||
|
||||
, error = function(e){
|
||||
# browser()
|
||||
sink("error.txt")
|
||||
print(e)
|
||||
sink()
|
||||
saveRDS(e,"error.RDS")
|
||||
writeLines(as.character(iterations),"progress.txt")
|
||||
})
|
||||
})
|
||||
})
|
||||
|
||||
# _ _
|
||||
# __ ____ _| |_ ___| |__ _ __ _ __ ___ __ _ _ __ ___ ___ ___
|
||||
# \ \ /\ / / _` | __/ __| '_ \ | '_ \| '__/ _ \ / _` | '__/ _ \/ __/ __|
|
||||
# \ V V / (_| | || (__| | | | | |_) | | | (_) | (_| | | | __/\__ \__ \
|
||||
# \_/\_/ \__,_|\__\___|_| |_| | .__/|_| \___/ \__, |_| \___||___/___/
|
||||
# |_| |___/
|
||||
|
||||
getProgress <- function(){
|
||||
# threadfiles <- list.files(settings$inputLoc, pattern="progress.txt", recursive = TRUE)
|
||||
threadfiles <- list.files(pattern="progress.txt", recursive = TRUE)
|
||||
if(length(threadfiles)==0){
|
||||
return(0)
|
||||
} else {
|
||||
sum(sapply(threadfiles, function(x){
|
||||
partRes <- readLines(x)
|
||||
if(length(partRes)==0){
|
||||
return(0)
|
||||
} else {
|
||||
return(as.numeric(partRes))
|
||||
}
|
||||
|
||||
}))
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
progress <- 0
|
||||
while(progress < iterations){
|
||||
Sys.sleep(1)
|
||||
progress <- tryCatch(getProgress(), error=function(e){progress})
|
||||
if(is.null(pb)){
|
||||
pbUpdate(as.numeric(progress))
|
||||
} else {
|
||||
pbUpdate(pb,as.numeric(progress))
|
||||
}
|
||||
}
|
||||
if(!is.null(pb)){
|
||||
close(pb)
|
||||
}
|
||||
|
||||
# ____ _ _
|
||||
# / ___|___ _ __ ___ | |__ (_)_ __ ___
|
||||
# | | / _ \| '_ ` _ \| '_ \| | '_ \ / _ \
|
||||
# | |__| (_) | | | | | | |_) | | | | | __/
|
||||
# \____\___/|_| |_| |_|_.__/|_|_| |_|\___|
|
||||
|
||||
if(!is.null(constraints)){
|
||||
constRes <- file.path(list.dirs("tmp", recursive=FALSE), "const_results.data")
|
||||
constRes <- lapply(constRes, function(f){read.csv(f, stringsAsFactors=FALSE, header=FALSE)})
|
||||
constRes <- do.call(rbind,constRes)
|
||||
write.csv(constRes, "constRes.csv")
|
||||
}
|
||||
resultFiles <- list.files(pattern="preservedCalib.*csv$",recursive=TRUE)
|
||||
res0 <- read.csv(grep("thread_1/",resultFiles, value=TRUE),stringsAsFactors=FALSE)
|
||||
resultFilesSans0 <- grep("thread_1/", resultFiles, value=TRUE, invert=TRUE)
|
||||
# results <- do.call(rbind,lapply(resultFilesSans0, function(f){read.csv(f, stringsAsFactors=FALSE)}))
|
||||
resultsSans0 <- lapply(resultFilesSans0, function(f){read.csv(f, stringsAsFactors=FALSE, header=FALSE)})
|
||||
resultsSans0 <- do.call(rbind,resultsSans0)
|
||||
colnames(resultsSans0) <- colnames(res0)
|
||||
results <- (rbind(res0,resultsSans0))
|
||||
write.csv(results,"result.csv")
|
||||
calibrationPar <- future::value(fut[[1]], stdout = FALSE, signal=FALSE)[["calibrationPar"]]
|
||||
if(!is.null(constraints)){
|
||||
tryCatch({
|
||||
notForTree <- c(seq(from = (length(calibrationPar)+1), length.out=3))
|
||||
notForTree <- c(notForTree,which(sapply(seq_along(calibrationPar),function(i){sd(results[,i])==0})))
|
||||
treeData <- results[,-notForTree]
|
||||
treeData["failType"] <- as.factor(results$failType)
|
||||
if(ncol(treeData) > 4){
|
||||
rp <- rpart(failType ~ .,data=treeData,control=treeControl)
|
||||
svg("treeplot.svg")
|
||||
rpart.plot(rp)
|
||||
dev.off()
|
||||
}
|
||||
}, error = function(e){
|
||||
print(e)
|
||||
})
|
||||
}
|
||||
origModOut <- future::value(fut[[1]], stdout = FALSE, signal=FALSE)[["origModOut"]]
|
||||
# Just single objective version TODO:Multiobjective
|
||||
results <- results[results[,"Const"] == 1,]
|
||||
if(nrow(results)==0){
|
||||
stop("No simulation suitable for constraints\n Please see treeplot.png for explanation, if you have more than four parameters.")
|
||||
}
|
||||
bestCase <- which.max(results[,length(calibrationPar) + 1])
|
||||
parameters <- results[bestCase,1:length(calibrationPar)] # the last two column is the (log) likelihood and the rmse
|
||||
#TODO: Have to put that before multiSiteThread, we should not have to calculate it at every iterations
|
||||
|
||||
firstDir <- list.dirs("tmp/thread_1",full.names=TRUE,recursive =FALSE)[1]
|
||||
epcFile <- list.files(firstDir, pattern = "\\.epc",full.names=TRUE)
|
||||
settingsProto <- setupMuso(inputLoc = firstDir,
|
||||
iniInput =rep(list.files(firstDir, pattern = "\\.ini",full.names=TRUE),2))
|
||||
alignIndexes <- commonIndexes(settingsProto, measurements)
|
||||
musoCodeToIndex <- sapply(dataVar,function(musoCode){
|
||||
settingsProto$dailyOutputTable[settingsProto$dailyOutputTable$code == musoCode,"index"]
|
||||
})
|
||||
|
||||
|
||||
setwd("tmp/thread_1")
|
||||
aposteriori<- spatialRun(settingsProto, calibrationPar, parameters, calTable)
|
||||
file.copy(list.files(list.dirs(full.names=TRUE, recursive=FALSE)[1], pattern=".*\\.epc", full.names=TRUE),
|
||||
"../../multiSiteOptim.epc", overwrite=TRUE)
|
||||
setwd("../../")
|
||||
#TODO: Have to put that before multiSiteThread, we should not have to calculate it at every iterations
|
||||
nameGroupTable <- calTable
|
||||
nameGroupTable[,1] <- tools::file_path_sans_ext(basename(nameGroupTable[,1]))
|
||||
res <- list()
|
||||
|
||||
res[["calibrationPar"]] <- calibrationPar
|
||||
res[["parameters"]] <- parameters
|
||||
# browser()
|
||||
res[["comparison"]] <- compareCalibratedWithOriginal(key = names(dataVar)[1], modOld=origModOut, modNew=aposteriori, mes=measurements,
|
||||
|
||||
likelihoods = likelihood,
|
||||
alignIndexes = alignIndexes,
|
||||
musoCodeToIndex = musoCodeToIndex,
|
||||
nameGroupTable = nameGroupTable, mean)
|
||||
res[["likelihood"]] <- results[bestCase,ncol(results)-2]
|
||||
comp <- res$comparison
|
||||
res[["originalMAE"]] <- mean(abs((comp[,1]-comp[,3])))
|
||||
res[["MAE"]] <- mean(abs((comp[,2]-comp[,3])))
|
||||
res[["RMSE"]] <- results[bestCase,ncol(results)-2]
|
||||
res[["originalRMSE"]] <- sqrt(mean((comp[,1]-comp[,3])^2))
|
||||
res[["originalR2"]] <- summary(lm(measured ~ original,data=res$comparison))$r.squared
|
||||
res[["R2"]] <- summary(lm(measured ~ calibrated, data=res$comparison))$r.squared
|
||||
saveRDS(res,"results.RDS")
|
||||
png("calibRes.png")
|
||||
opar <- par(mar=c(5,5,4,2)+0.1, xpd=FALSE)
|
||||
with(data=res$comparison, {
|
||||
plot(measured,original,
|
||||
ylim=c(min(c(measured,original,calibrated)),
|
||||
max(c(measured,original,calibrated))),
|
||||
xlim=c(min(c(measured,original,calibrated)),
|
||||
max(c(measured,original,calibrated))),
|
||||
xlab=expression("measured "~(kg[DM]~m^-2)),
|
||||
ylab=expression("simulated "~(kg[DM]~m^-2)),
|
||||
cex.lab=1.3,
|
||||
col="red",
|
||||
pch=19,
|
||||
pty="s"
|
||||
)
|
||||
points(measured,calibrated, pch=19, col="blue")
|
||||
abline(0,1)
|
||||
legend(x="top",
|
||||
pch=c(19,19),
|
||||
col=c("red","blue"),
|
||||
inset=c(0,-0.1),
|
||||
legend=c("original","calibrated"),
|
||||
ncol=2,
|
||||
box.lty=0,
|
||||
xpd=TRUE
|
||||
)
|
||||
})
|
||||
dev.off()
|
||||
return(res)
|
||||
}
|
||||
|
||||
#' multiSiteThread
|
||||
#'
|
||||
#' This is an
|
||||
#' @author Roland HOLLOS
|
||||
|
||||
|
||||
multiSiteThread <- function(measuredData, parameters = NULL, startDate = NULL,
|
||||
endDate = NULL, formatString = "%Y-%m-%d", calTable,
|
||||
dataVar, outLoc = "./calib",
|
||||
outVars = NULL, iterations = 300,
|
||||
skipSpinup = TRUE, plotName = "calib.jpg",
|
||||
modifyOriginal=TRUE, likelihood, uncertainity = NULL, burnin=NULL,
|
||||
naVal = NULL, postProcString = NULL, threadNumber, constraints=NULL,th=10) {
|
||||
|
||||
originalRun <- list()
|
||||
nameGroupTable <- calTable
|
||||
nameGroupTable[,1] <- tools::file_path_sans_ext(basename(nameGroupTable[,1]))
|
||||
setwd(paste0("tmp/thread_",threadNumber))
|
||||
firstDir <- list.dirs(full.names=FALSE,recursive =FALSE)[1]
|
||||
epcFile <- list.files(firstDir, pattern = "\\.epc",full.names=TRUE)
|
||||
settingsProto <- setupMuso(inputLoc = firstDir,
|
||||
iniInput =rep(list.files(firstDir, pattern = "\\.ini",full.names=TRUE),2))
|
||||
|
||||
# Exanding likelihood
|
||||
likelihoodFull <- as.list(rep(NA,length(dataVar)))
|
||||
names(likelihoodFull) <- names(dataVar)
|
||||
if(!missing(likelihood)) {
|
||||
lapply(names(likelihood),function(x){
|
||||
likelihoodFull[[x]] <<- likelihood[[x]]
|
||||
})
|
||||
}
|
||||
|
||||
defaultLikelihood <- which(is.na(likelihood))
|
||||
if(length(defaultLikelihood)>0){
|
||||
likelihoodFull[[defaultLikelihood]] <- (function(x, y){
|
||||
exp(-sqrt(mean((x-y)^2)))
|
||||
})
|
||||
}
|
||||
|
||||
mdata <- measuredData
|
||||
if(is.null(parameters)){
|
||||
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, stringsAsFactor=FALSE), error = function (e){
|
||||
stop("Cannot find neither parameters file neither the parameters matrix")
|
||||
})
|
||||
}}
|
||||
|
||||
print("optiMuso is randomizing the epc parameters now...",quote = FALSE)
|
||||
randVals <- musoRand(parameters = parameters,constrains = NULL, iterations = iterations)
|
||||
|
||||
origEpc <- readValuesFromFile(epcFile, randVals[[1]])
|
||||
partialResult <- matrix(ncol=length(randVals[[1]])+2*length(dataVar) + 2)
|
||||
colN <- randVals[[1]]
|
||||
colN[match(parameters[,2],randVals[[1]])] <- parameters[,1]
|
||||
colN[match(parameters[,2], randVals[[1]])[!is.na(match(parameters[,2],randVals[[1]]))]] <- parameters[,1]
|
||||
colnames(partialResult) <- c(colN,sprintf("%s_likelihood",names(dataVar)),
|
||||
sprintf("%s_rmse",names(dataVar)),"Const", "failType")
|
||||
numParameters <- length(colN)
|
||||
partialResult[1:numParameters] <- origEpc
|
||||
## Prepare the preservedCalib matrix for the faster
|
||||
## run.
|
||||
musoCodeToIndex <- sapply(dataVar,function(musoCode){
|
||||
settingsProto$dailyOutputTable[settingsProto$dailyOutputTable$code == musoCode,"index"]
|
||||
})
|
||||
|
||||
resultRange <- (numParameters + 1):(ncol(partialResult))
|
||||
randValues <- randVals[[2]]
|
||||
|
||||
settingsProto$calibrationPar <- randVals[[1]]
|
||||
|
||||
if(!is.null(naVal)){
|
||||
measuredData <- as.data.frame(measuredData)
|
||||
measuredData[measuredData == naVal] <- NA
|
||||
}
|
||||
resIterate <- 1:nrow(calTable)
|
||||
names(resIterate) <- tools::file_path_sans_ext(basename(calTable[,1]))
|
||||
alignIndexes <- commonIndexes(settingsProto, measuredData)
|
||||
if(threadNumber == 1){
|
||||
originalRun[["calibrationPar"]] <- randVals[[1]]
|
||||
|
||||
origModOut <- lapply(resIterate, function(i){
|
||||
dirName <- tools::file_path_sans_ext(basename(calTable[i,1]))
|
||||
setwd(dirName)
|
||||
settings <- settingsProto
|
||||
settings$outputLoc <- settings$inputLoc <- "./"
|
||||
settings$iniInput <- settings$inputFiles <- rep(paste0(dirName,".ini"),2)
|
||||
settings$outputNames <- rep(dirName,2)
|
||||
settings$executable <- ifelse(Sys.info()[1]=="Linux","./muso","./muso.exe") # set default exe option at start wold be better
|
||||
res <- tryCatch(calibMuso(settings=settings,parameters =origEpc, silent = TRUE, skipSpinup = TRUE), error=function(e){NA})
|
||||
setwd("../")
|
||||
res
|
||||
})
|
||||
originalRun[["origModOut"]] <- origModOut
|
||||
|
||||
partialResult[,resultRange] <- calcLikelihoodsForGroups(dataVar=dataVar,
|
||||
mod=origModOut,
|
||||
mes=measuredData,
|
||||
likelihoods=likelihood,
|
||||
alignIndexes=alignIndexes,
|
||||
musoCodeToIndex = musoCodeToIndex,nameGroupTable = nameGroupTable, groupFun=mean, constraints=constraints,th=th)
|
||||
|
||||
write.csv(x=randVals[[1]],"../randIndexes.csv")
|
||||
write.csv(x=partialResult, file="preservedCalib.csv",row.names=FALSE)
|
||||
}
|
||||
|
||||
print("Running the model with the random epc values...", quote = FALSE)
|
||||
for(i in 2:(iterations+1)){
|
||||
tmp <- lapply(resIterate, function(siteI){
|
||||
dirName <- tools::file_path_sans_ext(basename(calTable[siteI,1]))
|
||||
setwd(dirName)
|
||||
settings <- settingsProto
|
||||
settings$outputLoc <- settings$inputLoc <- "./"
|
||||
settings$iniInput <- settings$inputFiles <- rep(paste0(dirName,".ini"),2)
|
||||
settings$outputNames <- rep(dirName,2)
|
||||
settings$executable <- ifelse(Sys.info()[1]=="Linux","./muso","./muso.exe") # set default exe option at start wold be better
|
||||
|
||||
res <- tryCatch(calibMuso(settings=settings,parameters=randValues[(i-1),], silent = TRUE, skipSpinup = TRUE), error=function(e){NA})
|
||||
setwd("../")
|
||||
res
|
||||
})
|
||||
|
||||
if(is.null(tmp)){
|
||||
partialResult[,resultRange] <- NA
|
||||
} else {
|
||||
partialResult[,resultRange] <- calcLikelihoodsForGroups(dataVar=dataVar,
|
||||
mod=tmp,
|
||||
mes=measuredData,
|
||||
likelihoods=likelihood,
|
||||
alignIndexes=alignIndexes,
|
||||
musoCodeToIndex = musoCodeToIndex,nameGroupTable = nameGroupTable, groupFun=mean, constraints = constraints, th=th)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
partialResult[1:numParameters] <- randValues[(i-1),]
|
||||
write.table(x=partialResult, file="preservedCalib.csv", append=TRUE, row.names=FALSE,
|
||||
sep=",", col.names=FALSE)
|
||||
# write.csv(x=tmp, file=paste0(pretag, (i+1),".csv"))
|
||||
writeLines(as.character(i-1),"progress.txt") #UNCOMMENT IMPORTANT
|
||||
}
|
||||
}
|
||||
|
||||
if(threadNumber == 1){
|
||||
return(originalRun)
|
||||
}
|
||||
|
||||
return(0)
|
||||
}
|
||||
distributeCores <- function(iterations, numCores){
|
||||
perProcess<- iterations %/% numCores
|
||||
numSimu <- rep(perProcess,numCores)
|
||||
gainers <- sample(1:numCores, iterations %% numCores)
|
||||
numSimu[gainers] <- numSimu[gainers] + 1
|
||||
numSimu
|
||||
}
|
||||
|
||||
prepareFromAgroMo <- function(fName){
|
||||
obs <- read.table(fName, stringsAsFactors=FALSE, sep = ";", header=T)
|
||||
obs <- reshape(obs, timevar="var_id", idvar = "date", direction = "wide")
|
||||
dateCols <- apply(do.call(rbind,(strsplit(obs$date, split = "-"))),2,as.numeric)
|
||||
colnames(dateCols) <- c("year", "month", "day")
|
||||
cbind.data.frame(dateCols, obs)
|
||||
}
|
||||
|
||||
calcLikelihoodsForGroups <- function(dataVar, mod, mes,
|
||||
likelihoods, alignIndexes, musoCodeToIndex,
|
||||
nameGroupTable, groupFun, constraints,
|
||||
th = 10){
|
||||
|
||||
if(!is.null(constraints)){
|
||||
constRes<- sapply(mod,function(m){
|
||||
compoVect(m,constraints)
|
||||
})
|
||||
|
||||
failType <- constMatToDec(constRes)
|
||||
}
|
||||
|
||||
likelihoodRMSE <- sapply(names(dataVar),function(key){
|
||||
modelled <- as.vector(unlist(sapply(sort(names(alignIndexes)),
|
||||
function(domain_id){
|
||||
apply(do.call(cbind,
|
||||
lapply(nameGroupTable[,1][nameGroupTable[,2] == domain_id],
|
||||
function(site){mod[[site]][alignIndexes[[domain_id]]$model,musoCodeToIndex[key]]
|
||||
})),1,groupFun)
|
||||
|
||||
|
||||
|
||||
|
||||
})))
|
||||
|
||||
|
||||
measuredGroups <- split(mes,mes$domain_id)
|
||||
measured <- do.call(rbind.data.frame, lapply(names(measuredGroups), function(domain_id){
|
||||
measuredGroups[[domain_id]][alignIndexes[[domain_id]]$meas,]
|
||||
}))
|
||||
measured <- measured[measured$var_id == key,]
|
||||
res <- c(likelihoods[[key]](modelled, measured),
|
||||
sqrt(mean((modelled-measured$mean)^2))
|
||||
)
|
||||
|
||||
|
||||
print(abs(mean(modelled)-mean(measured$mean)))
|
||||
res
|
||||
})
|
||||
|
||||
likelihoodRMSE <- c(likelihoodRMSE[1,], likelihoodRMSE[2,],
|
||||
ifelse((100 * sum(apply(constRes, 2, prod)) / ncol(constRes)) >= th,
|
||||
1,0), failType)
|
||||
names(likelihoodRMSE) <- c(sprintf("%s_likelihood",dataVar), sprintf("%s_rmse",dataVar), "Const", "failType")
|
||||
return(likelihoodRMSE)
|
||||
}
|
||||
|
||||
commonIndexes <- function (settings,measuredData) {
|
||||
# Have to fix for other starting points also
|
||||
modelDates <- seq(from= as.Date(sprintf("%s-01-01",settings$startYear)),
|
||||
by="days",
|
||||
to=as.Date(sprintf("%s-12-31",settings$startYear+settings$numYears-1)))
|
||||
modelDates <- grep("-02-29",modelDates,invert=TRUE, value=TRUE)
|
||||
|
||||
lapply(split(measuredData,measuredData$domain_id),function(x){
|
||||
measuredDates <- x$date
|
||||
modIndex <- match(as.Date(measuredDates), as.Date(modelDates))
|
||||
measIndex <- which(!is.na(modIndex))
|
||||
modIndex <- modIndex[!is.na(modIndex)]
|
||||
cbind.data.frame(model=modIndex,meas=measIndex)
|
||||
})
|
||||
}
|
||||
|
||||
agroLikelihood <- function(modVector,measured){
|
||||
mu <- measured[,grep("mean", colnames(measured))]
|
||||
stdev <- measured[,grep("^sd", colnames(measured))]
|
||||
ndata <- nrow(measured)
|
||||
sum(sapply(1:ndata, function(x){
|
||||
dnorm(modVector, mu[x], stdev[x], log = TRUE)
|
||||
}), na.rm=TRUE)
|
||||
}
|
||||
|
||||
|
||||
#' compareCalibratedWithOriginal
|
||||
#'
|
||||
#' This functions compareses the likelihood and the RMSE values of the simulations and the measurements
|
||||
#' @param key
|
||||
compareCalibratedWithOriginal <- function(key, modOld, modNew, mes,
|
||||
likelihoods, alignIndexes, musoCodeToIndex, nameGroupTable,
|
||||
groupFun){
|
||||
|
||||
original <- as.vector(unlist(sapply(sort(names(alignIndexes)),
|
||||
function(domain_id){
|
||||
apply(do.call(cbind,
|
||||
lapply(nameGroupTable$site_id[nameGroupTable$domain_id == domain_id],
|
||||
function(site){
|
||||
modOld[[site]][alignIndexes[[domain_id]]$model,musoCodeToIndex[key]]
|
||||
})),1,groupFun)
|
||||
})))
|
||||
calibrated <- as.vector(unlist(sapply(sort(names(alignIndexes)),
|
||||
function(domain_id){
|
||||
apply(do.call(cbind,
|
||||
lapply(nameGroupTable$site_id[nameGroupTable$domain_id == domain_id],
|
||||
function(site){
|
||||
modNew[[site]][alignIndexes[[domain_id]]$model,musoCodeToIndex[key]]
|
||||
})),1,groupFun)
|
||||
})))
|
||||
measuredGroups <- split(mes,mes$domain_id)
|
||||
measured <- do.call(rbind.data.frame, lapply(names(measuredGroups), function(domain_id){
|
||||
measuredGroups[[domain_id]][alignIndexes[[domain_id]]$meas,]
|
||||
}))
|
||||
measured <- measured[measured$var_id == key,]
|
||||
return(data.frame(original = original, calibrated = calibrated,measured=measured$mean))
|
||||
}
|
||||
|
||||
|
||||
spatialRun <- function(settingsProto,calibrationPar, parameters, calTable){
|
||||
resIterate <- 1:nrow(calTable)
|
||||
names(resIterate) <- tools::file_path_sans_ext(basename(calTable[,1]))
|
||||
modOut <- lapply(resIterate, function(i){
|
||||
dirName <- tools::file_path_sans_ext(basename(calTable[i,1]))
|
||||
setwd(dirName)
|
||||
settings <- settingsProto
|
||||
settings$outputLoc <- settings$inputLoc <- "./"
|
||||
settings$iniInput <- settings$inputFiles <- rep(paste0(dirName,".ini"),2)
|
||||
settings$outputNames <- rep(dirName,2)
|
||||
settings$calibrationPar <- calibrationPar
|
||||
settings$executable <- ifelse(Sys.info()[1]=="Linux","./muso","./muso.exe") # set default exe option at start wold be better
|
||||
res <- tryCatch(calibMuso(settings=settings,parameters =parameters, silent = TRUE, skipSpinup = TRUE), error=function(e){NA})
|
||||
setwd("../")
|
||||
res
|
||||
})
|
||||
modOut
|
||||
}
|
||||
@ -197,27 +197,69 @@ musoMonte <- function(settings=NULL,
|
||||
## csv files for each run
|
||||
|
||||
oneCsv <- function () {
|
||||
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]))})
|
||||
|
||||
## 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)}
|
||||
## }
|
||||
# stop("This function is not implemented yet")
|
||||
settings$iniInput[2] %>%
|
||||
(function(x) paste0(dirname(x),"/",tools::file_path_sans_ext(basename(x)),"-tmp.",tools::file_ext(x))) %>%
|
||||
unlink
|
||||
randValues <- randVals[[2]]
|
||||
settings$calibrationPar <- randVals[[1]]
|
||||
## randValues <- randValues[,randVals[[1]] %in% parameters[,2]][,rank(parameters[,2])]
|
||||
modellOut <- matrix(ncol = numVars, nrow = iterations + 1)
|
||||
|
||||
origModellOut <- calibMuso(settings=settings,silent=TRUE)
|
||||
write.csv(x=origModellOut, file=paste0(pretag,".csv"))
|
||||
|
||||
if(!is.list(fun)){
|
||||
funct <- rep(list(fun), numVars)
|
||||
}
|
||||
|
||||
## return(preservedEpc)
|
||||
## } else {
|
||||
tmp2 <- numeric(numVars)
|
||||
|
||||
for(j in 1:numVars){
|
||||
tmp2[j]<-funct[[j]](origModellOut[,j])
|
||||
}
|
||||
modellOut[1,]<- tmp2
|
||||
|
||||
for(i in 2:(iterations+1)){
|
||||
tmp <- tryCatch(calibMuso(settings = settings,
|
||||
parameters = randValues[(i-1),],
|
||||
silent= TRUE,
|
||||
skipSpinup = skipSpinup,
|
||||
keepEpc = keepEpc,
|
||||
debugging = debugging,
|
||||
outVars = outVars), error = function (e) NA)
|
||||
|
||||
## }
|
||||
if(!is.na(tmp)){
|
||||
for(j in 1:numVars){
|
||||
tmp2[j]<-funct[[j]](tmp[,j])
|
||||
}
|
||||
} else {
|
||||
for(j in 1:numVars){
|
||||
tmp2[j]<-rep(NA,length(settings$outputVars[[1]]))
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
modellOut[i,]<- tmp2
|
||||
write.table(x=tmp, file=paste0(pretag,".csv"), append = TRUE,col.names = FALSE, sep = ",")
|
||||
setTxtProgressBar(progBar,i)
|
||||
}
|
||||
|
||||
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)
|
||||
}
|
||||
|
||||
netCDF <- function () {
|
||||
|
||||
@ -8,7 +8,7 @@
|
||||
#' @importFrom limSolve xsample
|
||||
#' @export
|
||||
|
||||
musoRand <- function(parameters, iterations=3000, fileType="epc", constrains = NULL){
|
||||
musoRand <- function(parameters, iterations=3000, fileType="epc", constrains = NULL, burnin = NULL){
|
||||
if(is.null(constrains)){
|
||||
constMatrix <- constrains
|
||||
constMatrix <- getOption("RMuso_constMatrix")[[fileType]][[as.character(getOption("RMuso_version"))]]
|
||||
@ -176,7 +176,7 @@ musoRand <- function(parameters, iterations=3000, fileType="epc", constrains = N
|
||||
E <- do.call(rbind,lapply(Ef,function(x){x$E}))
|
||||
f <- do.call(c,lapply(Ef,function(x){x$f}))
|
||||
# browser()
|
||||
randVal <- suppressWarnings(limSolve::xsample(G=G,H=h,E=E,F=f,iter = iterations))$X
|
||||
randVal <- suppressWarnings(limSolve::xsample(G=G,H=h,E=E,F=f,burninlength=burnin, iter = iterations))$X
|
||||
} else{
|
||||
Gh0<-genMat0(dependences)
|
||||
randVal <- suppressWarnings(xsample(G=Gh0$G,H=Gh0$h, iter = iterations))$X
|
||||
|
||||
10
RBBGCMuso/R/postProc.R
Normal file
10
RBBGCMuso/R/postProc.R
Normal file
@ -0,0 +1,10 @@
|
||||
postProcMuso <- function(modelData, procString){
|
||||
cNames <- colnames(modelData)
|
||||
tocalc <- gsub("(@)(\\d)","modelData[,\\2]",procString)
|
||||
newVarName <- gsub("\\s","",unlist(strsplit(procString,"<-"))[1])
|
||||
assign(newVarName,eval(parse(text = unlist(strsplit(tocalc,"<-"))[2])))
|
||||
modelData <- cbind.data.frame(modelData,eval(parse(text = newVarName)))
|
||||
colnames(modelData) <- c(cNames,newVarName)
|
||||
modelData
|
||||
}
|
||||
|
||||
47
RBBGCMuso/R/setupMuso6.R
Normal file
47
RBBGCMuso/R/setupMuso6.R
Normal file
@ -0,0 +1,47 @@
|
||||
## #' setupMuso6
|
||||
## #'
|
||||
## #' This is the setup function for MuSo version: 6
|
||||
## #'
|
||||
## #' @author Roland HOLLOS
|
||||
## #' @param setupFile
|
||||
## #' @export
|
||||
|
||||
## setupMuso6<- function(setupFile){
|
||||
|
||||
## }
|
||||
|
||||
## ini <- readLines("./hhs_apriori_MuSo6_normal.ini")
|
||||
## flags <- c("MET_INPUT",
|
||||
## "RESTART",
|
||||
## "TIME_DEFINE",
|
||||
## "CO2_CONTROL",
|
||||
## "NDEP_CONTROL",
|
||||
## "SITE",
|
||||
## "SOILPROP_FILE",
|
||||
## "EPC_FILE",
|
||||
## "MANAGEMENT_FILE",
|
||||
## "SIMULATION_CONTROL",
|
||||
## "W_STATE",
|
||||
## "CN_STATE",
|
||||
## "CLIM_CHANGE",
|
||||
## "CONDITIONAL_MANAGEMENT_STRATEGIES",
|
||||
## "OUTPUT_CONTROL",
|
||||
## "DAILY_OUTPUT",
|
||||
## "ANNUAL_OUTPUT",
|
||||
## "END_INIT")
|
||||
## getSegments <- function(ini, flags){
|
||||
## output <- list()
|
||||
## flagIterator <- 1:(length(flags)-1)
|
||||
## for(i in flagIterator){
|
||||
## output[[flags[i]]] <- lapply(ini[(grep(flags[i],ini)+1):(grep(flags[i+1],ini)-2)], function(x){
|
||||
## unlist(strsplit(x,split = "\\["))[1]
|
||||
## })
|
||||
## }
|
||||
## output
|
||||
## }
|
||||
## getSegments(ini,flags)
|
||||
|
||||
## gsub("(.*\\[\\|)([a-zA-Z1-9_]*)","",ini)
|
||||
## stringi::stri_trim_right("rexamine.com/", "\\[r\\]")
|
||||
## stri_extract("asdfasdf [|Ezat|]",regex = "\\[\\|*\\]")
|
||||
## lapply(ini,function(x) gsub("\\s","",(strsplit(x,split= "T]"))[[1]][2]))
|
||||
@ -1,37 +0,0 @@
|
||||
---
|
||||
title: "An easy grouping algorithm"
|
||||
author: "Hollós Roland"
|
||||
date: "10/1/2019"
|
||||
output: pdf_document
|
||||
---
|
||||
|
||||
|
||||
|
||||
## R Markdown
|
||||
|
||||
This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see <http://rmarkdown.rstudio.com>.
|
||||
|
||||
When you click the **Knit** button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this:
|
||||
|
||||
|
||||
```r
|
||||
summary(cars)
|
||||
```
|
||||
|
||||
```
|
||||
## speed dist
|
||||
## Min. : 4.0 Min. : 2.00
|
||||
## 1st Qu.:12.0 1st Qu.: 26.00
|
||||
## Median :15.0 Median : 36.00
|
||||
## Mean :15.4 Mean : 42.98
|
||||
## 3rd Qu.:19.0 3rd Qu.: 56.00
|
||||
## Max. :25.0 Max. :120.00
|
||||
```
|
||||
|
||||
## Including Plots
|
||||
|
||||
You can also embed plots, for example:
|
||||
|
||||
|
||||
|
||||
Note that the `echo = FALSE` parameter was added to the code chunk to prevent printing of the R code that generated the plot.
|
||||
Binary file not shown.
|
Before Width: | Height: | Size: 5.4 KiB |
@ -1,27 +0,0 @@
|
||||
#' getDailyOutputList
|
||||
#'
|
||||
#' bla bla
|
||||
#' @param settings bla
|
||||
#' @export
|
||||
|
||||
|
||||
getDailyOutputList <- function(settings=NULL){
|
||||
if(is.null(settings)){
|
||||
settings<- setupMuso()
|
||||
}
|
||||
settings$dailyOutputTable
|
||||
}
|
||||
|
||||
#' getAnnualOutputList
|
||||
#'
|
||||
#' bla bla
|
||||
#' @param settings bla
|
||||
#' @export
|
||||
|
||||
|
||||
getAnnualOutputList <- function(settings=NULL){
|
||||
if(is.null(settings)){
|
||||
settings<- setupMuso()
|
||||
}
|
||||
settings$annualOutputTable
|
||||
}
|
||||
18
RBBGCMuso/inst/data/depTree.csv
Normal file
18
RBBGCMuso/inst/data/depTree.csv
Normal file
@ -0,0 +1,18 @@
|
||||
"child","parent","mod","name"
|
||||
"wth","ini",1,"weather"
|
||||
"endpoint","ini",1,"endpointIn"
|
||||
"endpoint","ini",2,"endpointOut"
|
||||
"txt","ini",1,"co2"
|
||||
"txt","ini",2,"nitrogen"
|
||||
"soi","ini",1,"soil"
|
||||
"epc","ini",1,"startEpc"
|
||||
"mgm","ini",1,"management"
|
||||
"plt","mgm",1,"planting"
|
||||
"thn","mgm",1,"thining"
|
||||
"mow","mgm",1,"mowing"
|
||||
"grz","mgm",1,"grazing"
|
||||
"hrv","mgm",1,"harvest"
|
||||
"cul","mgm",1,"cultivation"
|
||||
"frz","mgm",1,"fertilization"
|
||||
"irr","mgm",1,"irrigation"
|
||||
"epc","plt",0,"plantEpc"
|
||||
|
@ -865,6 +865,7 @@
|
||||
"UNIT": "prop",
|
||||
"MIN": 0,
|
||||
"MAX": 0.1,
|
||||
"DEPENDENCE": 0,
|
||||
"GROUP": 0,
|
||||
"TYPE": 0
|
||||
},
|
||||
@ -875,6 +876,7 @@
|
||||
"UNIT": "prop",
|
||||
"MIN": 0,
|
||||
"MAX": 0.1,
|
||||
"DEPENDENCE": 1,
|
||||
"GROUP": 0,
|
||||
"TYPE": 0
|
||||
},
|
||||
|
||||
@ -2723,6 +2723,30 @@
|
||||
"units": "kgC m-2",
|
||||
"descriptions": "SUM of C deep leaching"
|
||||
},
|
||||
{
|
||||
"codes": 564,
|
||||
"names": "cwdc_above",
|
||||
"units": "kgC m-2",
|
||||
"descriptions": "Aboveground cwdc"
|
||||
},
|
||||
{
|
||||
"codes": 565,
|
||||
"names": "litrc_above",
|
||||
"units": "kgC m-2",
|
||||
"descriptions": "Aboveground litrc"
|
||||
},
|
||||
{
|
||||
"codes": 566,
|
||||
"names": "CNratioERR",
|
||||
"units": "kgC m-2",
|
||||
"descriptions": "CN ratio error"
|
||||
},
|
||||
{
|
||||
"codes": 567,
|
||||
"names": "flowHSsnk_C",
|
||||
"units": "kgC m-2",
|
||||
"descriptions": "C loss due to flower heat stress"
|
||||
},
|
||||
{
|
||||
"codes": 600,
|
||||
"names": "m_leafc_to_litr1c",
|
||||
@ -12595,7 +12619,7 @@
|
||||
},
|
||||
{
|
||||
"codes": 2585,
|
||||
"names": "hydr_conductEND[6]",
|
||||
"names": "rootdepth5",
|
||||
"units": "ms-1",
|
||||
"descriptions": "Hydraulic conductivity at the end of the day of soil layer 7 (120-150 cm)"
|
||||
},
|
||||
|
||||
0
RBBGCMuso/inst/examples/hhs/muso
Normal file → Executable file
0
RBBGCMuso/inst/examples/hhs/muso
Normal file → Executable file
21
RBBGCMuso/inst/tests/test_postProcMuso.R
Normal file
21
RBBGCMuso/inst/tests/test_postProcMuso.R
Normal file
@ -0,0 +1,21 @@
|
||||
context("Post processing")
|
||||
library(testthat)
|
||||
library(RBBGCMuso)
|
||||
setwd(system.file("examples/hhs","",package = "RBBGCMuso"))
|
||||
|
||||
test_that("Post processing string",{
|
||||
testMatrix1 <- data.frame(first = rep(1,5), second = rep(2,5), third = rep(3,5))
|
||||
testMatrix1c <- testMatrix1
|
||||
testMatrix1c[,"newCol"] <- testMatrix1c[,2] + 3 * testMatrix1c[,3]
|
||||
expect_equal(postProcMuso(testMatrix1,"newCol <- @2 + 3*@3"),testMatrix1c)
|
||||
})
|
||||
|
||||
test_that("calibMuso with postprocessing",{
|
||||
model <- calibMuso(skipSpinup = FALSE, silent = TRUE)
|
||||
modelc<- model
|
||||
newCol <- modelc[,1]
|
||||
modelc<- cbind.data.frame(modelc,newCol)
|
||||
modelc[,"newCol"]<- model[,5]+3*model[,7]
|
||||
expect_equal(calibMuso(skipSpinup = FALSE,silent = TRUE, postProcString = "newCol <- @5 + 3* @7"), modelc)
|
||||
})
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
\usage{
|
||||
calibrateMuso(
|
||||
measuredData,
|
||||
parameters = NULL,
|
||||
parameters = read.csv("parameters.csv", stringsAsFactor = FALSE),
|
||||
startDate = NULL,
|
||||
endDate = NULL,
|
||||
formatString = "\%Y-\%m-\%d",
|
||||
@ -28,6 +28,7 @@ calibrateMuso(
|
||||
pb = txtProgressBar(min = 0, max = iterations, style = 3),
|
||||
maxLikelihoodEpc = TRUE,
|
||||
pbUpdate = setTxtProgressBar,
|
||||
outputLoc = "./",
|
||||
method = "GLUE",
|
||||
lg = FALSE,
|
||||
w = NULL,
|
||||
|
||||
16
RBBGCMuso/man/checkFileSystem.Rd
Normal file
16
RBBGCMuso/man/checkFileSystem.Rd
Normal file
@ -0,0 +1,16 @@
|
||||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/flat.R
|
||||
\name{checkFileSystem}
|
||||
\alias{checkFileSystem}
|
||||
\title{checkFileSystem}
|
||||
\usage{
|
||||
checkFileSystem(iniName, root = ".", depTree = options("RMuso_depTree")[[1]])
|
||||
}
|
||||
\arguments{
|
||||
\item{iniName}{The name of the ini file}
|
||||
|
||||
\item{depTree}{The file dependency defining dataframe. At default it is: options("RMuso_depTree")[[1]]}
|
||||
}
|
||||
\description{
|
||||
This function checks the MuSo file system, if it is correct
|
||||
}
|
||||
21
RBBGCMuso/man/compareCalibratedWithOriginal.Rd
Normal file
21
RBBGCMuso/man/compareCalibratedWithOriginal.Rd
Normal file
@ -0,0 +1,21 @@
|
||||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/multiSite.R
|
||||
\name{compareCalibratedWithOriginal}
|
||||
\alias{compareCalibratedWithOriginal}
|
||||
\title{compareCalibratedWithOriginal}
|
||||
\usage{
|
||||
compareCalibratedWithOriginal(
|
||||
key,
|
||||
modOld,
|
||||
modNew,
|
||||
mes,
|
||||
likelihoods,
|
||||
alignIndexes,
|
||||
musoCodeToIndex,
|
||||
nameGroupTable,
|
||||
groupFun
|
||||
)
|
||||
}
|
||||
\description{
|
||||
This functions compareses the likelihood and the RMSE values of the simulations and the measurements
|
||||
}
|
||||
25
RBBGCMuso/man/flatMuso.Rd
Normal file
25
RBBGCMuso/man/flatMuso.Rd
Normal file
@ -0,0 +1,25 @@
|
||||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/flat.R
|
||||
\name{flatMuso}
|
||||
\alias{flatMuso}
|
||||
\title{flatMuso}
|
||||
\usage{
|
||||
flatMuso(
|
||||
iniName,
|
||||
execPath = "./",
|
||||
depTree = options("RMuso_depTree")[[1]],
|
||||
directory = "flatdir",
|
||||
d = TRUE,
|
||||
outE = TRUE
|
||||
)
|
||||
}
|
||||
\arguments{
|
||||
\item{iniName}{The name of the ini file}
|
||||
|
||||
\item{depTree}{The file dependency defining dataframe. At default it is: options("RMuso_depTree")[[1]]}
|
||||
|
||||
\item{directory}{The destination directory for flattening. At default it will be flatdir}
|
||||
}
|
||||
\description{
|
||||
This function reads the ini file and creates a directory (named after the directory argument) with all the files the modell uses with this file. the directory will be flat.
|
||||
}
|
||||
23
RBBGCMuso/man/getFilePath.Rd
Normal file
23
RBBGCMuso/man/getFilePath.Rd
Normal file
@ -0,0 +1,23 @@
|
||||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/flat.R
|
||||
\name{getFilePath}
|
||||
\alias{getFilePath}
|
||||
\title{getFilePath}
|
||||
\usage{
|
||||
getFilePath(
|
||||
iniName,
|
||||
fileType,
|
||||
execPath = "./",
|
||||
depTree = options("RMuso_depTree")[[1]]
|
||||
)
|
||||
}
|
||||
\arguments{
|
||||
\item{iniName}{The name of the ini file}
|
||||
|
||||
\item{depTree}{The file dependency defining dataframe. At default it is: options("RMuso_depTree")[[1]]}
|
||||
|
||||
\item{filetype}{The type of the choosen file. For options see options("RMuso_depTree")[[1]]$name}
|
||||
}
|
||||
\description{
|
||||
This function reads the ini file and for a chosen fileType it gives you the filePath
|
||||
}
|
||||
20
RBBGCMuso/man/getFilesFromIni.Rd
Normal file
20
RBBGCMuso/man/getFilesFromIni.Rd
Normal file
@ -0,0 +1,20 @@
|
||||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/flat.R
|
||||
\name{getFilesFromIni}
|
||||
\alias{getFilesFromIni}
|
||||
\title{getFilesFromIni}
|
||||
\usage{
|
||||
getFilesFromIni(
|
||||
iniName,
|
||||
execPath = "./",
|
||||
depTree = options("RMuso_depTree")[[1]]
|
||||
)
|
||||
}
|
||||
\arguments{
|
||||
\item{iniName}{The name of the ini file}
|
||||
|
||||
\item{depTree}{The file dependency defining dataframe. At default it is: options("RMuso_depTree")[[1]]}
|
||||
}
|
||||
\description{
|
||||
This function reads the ini file and gives yout back the path of all file involved in model run
|
||||
}
|
||||
64
RBBGCMuso/man/multiSiteCalib.Rd
Normal file
64
RBBGCMuso/man/multiSiteCalib.Rd
Normal file
@ -0,0 +1,64 @@
|
||||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/multiSite.R
|
||||
\name{multiSiteCalib}
|
||||
\alias{multiSiteCalib}
|
||||
\title{multiSiteCalib}
|
||||
\usage{
|
||||
multiSiteCalib(
|
||||
measurements,
|
||||
calTable,
|
||||
parameters,
|
||||
dataVar,
|
||||
iterations = 100,
|
||||
burnin = ifelse(iterations < 3000, 3000, NULL),
|
||||
likelihood,
|
||||
execPath,
|
||||
thread_prefix = "thread",
|
||||
numCores = (parallel::detectCores() - 1),
|
||||
pb = txtProgressBar(min = 0, max = iterations, style = 3),
|
||||
pbUpdate = setTxtProgressBar,
|
||||
copyThread = TRUE,
|
||||
constraints = NULL,
|
||||
th = 10,
|
||||
treeControl = rpart.control()
|
||||
)
|
||||
}
|
||||
\arguments{
|
||||
\item{calTable}{A dataframe which contantains the ini file locations and the domains they belongs to}
|
||||
|
||||
\item{parameters}{A dataframe with the name, the minimum, and the maximum value for the parameters used in MonteCarlo experiment}
|
||||
|
||||
\item{dataVar}{A named vector where the elements are the MuSo variable codes and the names are the same as provided in measurements and likelihood}
|
||||
|
||||
\item{iterations}{The number of MonteCarlo experiments to be executed}
|
||||
|
||||
\item{burnin}{Currently not used, altought it is the length of burnin period of the MCMC sampling used to generate random parameters}
|
||||
|
||||
\item{likelihood}{A list of likelihood functions which names are linked to dataVar}
|
||||
|
||||
\item{execPath}{If you are running the calibration from different location than the MuSo executable, you have to provide the path}
|
||||
|
||||
\item{thread_prefix}{The prefix of thread directory names in the tmp directory created during the calibrational process}
|
||||
|
||||
\item{numCores}{The number of processes used during the calibration. At default it uses one less than the number of threads available}
|
||||
|
||||
\item{pb}{The progress bar function. If you use (web-)GUI you can provide a different function}
|
||||
|
||||
\item{pbUpdate}{The update function for pb (progress bar)}
|
||||
|
||||
\item{copyThread}{A boolean, recreate tmp directory for calibration or not (case of repeating the calibration)}
|
||||
|
||||
\item{th}{A trashold value for multisite calibration. What percentage of the site should satisfy the constraints.}
|
||||
|
||||
\item{treeControl}{A list which controls (maximal complexity, maximal depth) the details of the decession tree making.}
|
||||
|
||||
\item{measuremets}{The table which contains the measurements}
|
||||
|
||||
\item{contsraints}{A dataframe containing the constraints logic the minimum and a maximum value for the calibration.}
|
||||
}
|
||||
\description{
|
||||
This funtion uses the Monte Carlo technique to uniformly sample the parameter space from user defined parameters of the Biome-BGCMuSo model. The sampling algorithm ensures that the parameters are constrained by the model logic which means that parameter dependencies are fully taken into account (parameter dependency means that e.g leaf C:N ratio must be smaller than C:N ratio of litter; more complicated rules apply to the allocation parameters where the allocation fractions to different plant compartments must sum up 1). This function implements a mathematically correct solution to provide uniform distriution of the random parameters on convex polytopes.
|
||||
}
|
||||
\author{
|
||||
Roland HOLLOS
|
||||
}
|
||||
36
RBBGCMuso/man/multiSiteThread.Rd
Normal file
36
RBBGCMuso/man/multiSiteThread.Rd
Normal file
@ -0,0 +1,36 @@
|
||||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/multiSite.R
|
||||
\name{multiSiteThread}
|
||||
\alias{multiSiteThread}
|
||||
\title{multiSiteThread}
|
||||
\usage{
|
||||
multiSiteThread(
|
||||
measuredData,
|
||||
parameters = NULL,
|
||||
startDate = NULL,
|
||||
endDate = NULL,
|
||||
formatString = "\%Y-\%m-\%d",
|
||||
calTable,
|
||||
dataVar,
|
||||
outLoc = "./calib",
|
||||
outVars = NULL,
|
||||
iterations = 300,
|
||||
skipSpinup = TRUE,
|
||||
plotName = "calib.jpg",
|
||||
modifyOriginal = TRUE,
|
||||
likelihood,
|
||||
uncertainity = NULL,
|
||||
burnin = NULL,
|
||||
naVal = NULL,
|
||||
postProcString = NULL,
|
||||
threadNumber,
|
||||
constraints = NULL,
|
||||
th = 10
|
||||
)
|
||||
}
|
||||
\description{
|
||||
This is an
|
||||
}
|
||||
\author{
|
||||
Roland HOLLOS
|
||||
}
|
||||
@ -4,7 +4,13 @@
|
||||
\alias{musoRand}
|
||||
\title{musoRand}
|
||||
\usage{
|
||||
musoRand(parameters, iterations = 3000, fileType = "epc", constrains = NULL)
|
||||
musoRand(
|
||||
parameters,
|
||||
iterations = 3000,
|
||||
fileType = "epc",
|
||||
constrains = NULL,
|
||||
burnin = NULL
|
||||
)
|
||||
}
|
||||
\arguments{
|
||||
\item{parameters}{This is a dataframe (heterogeneous data-matrix), where the first column is the name of the parameter, the second is a numeric vector of the rownumbers of the given variable in the input EPC file, and the last two columns describe the minimum and the maximum of the parameter (i.e. the parameter ranges), defining the interval for the randomization.}
|
||||
|
||||
@ -10,7 +10,7 @@ saveAllMusoPlots(
|
||||
silent = TRUE,
|
||||
type = "line",
|
||||
outFile = "annual.csv",
|
||||
colour = NULL,
|
||||
colour = "blue",
|
||||
skipSpinup = FALSE
|
||||
)
|
||||
}
|
||||
|
||||
@ -13,7 +13,7 @@ updateMusoMapping(excelName, dest = "./", version = getOption("RMuso_version"))
|
||||
The output code-variable matrix, and also the function changes the global variable
|
||||
}
|
||||
\description{
|
||||
This function updates the Biome-BGCMuSo output code-variable matrix. Within Biome-BGCMuSo the state variables and fluxes are marked by integer numbers. In order to provide meaningful variable names (e.g. 3009 means Gross Primary Production in Biome-BGCMuSo v5) a conversion table is needed which is handled by this function.
|
||||
This function updates the Biome-BGCMuSo output code-variable matrix (creates a json file that is used internally by RBBGCMuso). Within Biome-BGCMuSo the output state variablesare marked by integer numbers (see the User's Guide). In order to provide meaningful variable names (e.g. 3009 means Gross Primary Production) a conversion table is needed which is handled by this function. The input Excel file must have the following column order: name, index, units, description (plus other optional columns line group). name refers to the abbreviation of the variable; index is the integer number of the output variable; unit is the unit of the variable; description is a meaningful text to explain the variable. The script will NOT work with other column order!
|
||||
}
|
||||
\author{
|
||||
Roland HOLLOS
|
||||
|
||||
Binary file not shown.
12
README.org
12
README.org
@ -7,7 +7,7 @@
|
||||
|
||||
*Current version: 0.7.0*
|
||||
|
||||
RBBGCMuso is an R package which supports the easy but powerful application of the [[http://agromo.agrar.mta.hu/bbgc/][Biome-BGCMuSo]] biogeochemical model in R environment. It also provides some additional tools for the model such as Biome-BGCMuSo optimized Monte-Carlo simulation and global sensitivity analysis. If you would like to use the framework, please read the following description. Note that we recommend to use [[http://agromo.agrar.mta.hu/bbgc/download.html][Biome-BGCMuSo v6.1]] with RBBGCMuSo.
|
||||
RBBGCMuso is an R package which supports the easy but powerful application of the [[http://nimbus.elte.hu/bbgc/][Biome-BGCMuSo]] biogeochemical model in R environment. It also provides some additional tools for the model such as Biome-BGCMuSo optimized Monte-Carlo simulation and global sensitivity analysis. If you would like to use the framework, please read the following description. Note that we recommend to use [[http://nimbus.elte.hu/bbgc/download.html][Biome-BGCMuSo v6.1]] with RBBGCMuSo.
|
||||
|
||||
** Installation
|
||||
You can install the RBBGCMuso package in several ways depending on the operating system you use. Up to now RBBGCMuso was tested only in Linux and MS Windows environment, so Mac OS X compatibility cannot be guaranteed yet. In MS Windows you can install the package from binary or from source installer. In Linux you can only install the software from source.
|
||||
@ -46,7 +46,7 @@ To start using RBBGCMuso you have to load the package in R with the following co
|
||||
library(RBBGCMuso)
|
||||
#+END_SRC
|
||||
|
||||
In order to use the RBBGCMuso framework, you have to set up the environment, as you would normally do when you use the model without the RBBGCMuso framework. It means that according to the Biome-BGCMuSo terminology you have to have the proper INI file set, the meteorology input file, the soil input file, and the ecophysiological constants file (EPC) as minimum input. Additional files might be included by the user including nitrogen deposition, management handlers, etc. Please read the corresponding documentation in the [[http://agromo.agrar.mta.hu/bbgc/files/Manual_BBGC_MuSo_v6.1.pdf][actual Biome-BGCMuSo User's Guide]].
|
||||
In order to use the RBBGCMuso framework, you have to set up the environment, as you would normally do when you use the model without the RBBGCMuso framework. It means that according to the Biome-BGCMuSo terminology you have to have the proper INI file set, the meteorology input file, the soil input file, and the ecophysiological constants file (EPC) as minimum input. Additional files might be included by the user including nitrogen deposition, management handlers, etc. Please read the corresponding documentation in the [[http://nimbus.elte.hu/bbgc/files/Manual_BBGC_MuSo_v6.1.pdf][actual Biome-BGCMuSo User's Guide]].
|
||||
|
||||
If you do not yet have a complete, operational model input dataset, you may want to use the so-called copyMusoExampleTo function (part of RBBGCMuso) which downloads a complete sample simulation set to your hard drive:
|
||||
|
||||
@ -87,7 +87,7 @@ In our example s.ini and n.ini follows this convention, so by default RBBGCMuso
|
||||
|
||||
*** Running the model
|
||||
|
||||
Now as we have a complete set of input data, we are ready to run the model. You can run the model in spinup mode, in normal mode, or in both phases (including the so-called transient run; see the [[http://agromo.agrar.mta.hu/bbgc/files/Manual_BBGC_MuSo_v6.1.pdf][Biome-BGCMuSo User's Guide]]). Using the runMuso function (that is part of RBBGCMuso) you will be able to execute the the model in both spinup or normal phase, and you can also simplify the execution of both phases consecutively. (Note that runMuso is the same as the obsolete calibMuso function.)
|
||||
Now as we have a complete set of input data, we are ready to run the model. You can run the model in spinup mode, in normal mode, or in both phases (including the so-called transient run; see the [[http://nimbus.elte.hu/bbgc/files/Manual_BBGC_MuSo_v6.1.pdf][Biome-BGCMuSo User's Guide]]). Using the runMuso function (that is part of RBBGCMuso) you will be able to execute the the model in both spinup or normal phase, and you can also simplify the execution of both phases consecutively. (Note that runMuso is the same as the obsolete calibMuso function.)
|
||||
|
||||
In order to execute the simulation, first you have to set the working directory in R so that RBBGCMuso will find the model and the input files. In our example this is as follows:
|
||||
|
||||
@ -109,7 +109,7 @@ If the simulation is successful, the results can be found in the C:\model direct
|
||||
|
||||
*** Visualization of the model output
|
||||
|
||||
Once the simulation is completed (hopefully without errors), we can visualize the results. Biome-BGCMuSo provides large flexibility on model output selection, which means that the results will depend on the settings of the user in the normal INI file (DAILY_OUTPUT block; see below). In our hhs example 12 variables are calculated in daily resolution. As the model is run for 9 years by the normal INI file, each output variable will be available for 9x365 days (note the handling of leap years in the [[http://agromo.agrar.mta.hu/bbgc/files/Manual_BBGC_MuSo_v6.1.pdf][Biome-BGCMuSo User's Guide]]).
|
||||
Once the simulation is completed (hopefully without errors), we can visualize the results. Biome-BGCMuSo provides large flexibility on model output selection, which means that the results will depend on the settings of the user in the normal INI file (DAILY_OUTPUT block; see below). In our hhs example 12 variables are calculated in daily resolution. As the model is run for 9 years by the normal INI file, each output variable will be available for 9x365 days (note the handling of leap years in the [[http://nimbus.elte.hu/bbgc/files/Manual_BBGC_MuSo_v6.1.pdf][Biome-BGCMuSo User's Guide]]).
|
||||
|
||||
Assume that we would like to visualize Gross Primary Production (GPP) for one simulation year (this is the 2nd variable in the n.ini file; see below). This can be achieved by the following commands. First we re-run the normal phase and redirect the output to the R variable called 'results':
|
||||
|
||||
@ -168,7 +168,7 @@ DAILY_OUTPUT
|
||||
#+END_SRC
|
||||
|
||||
Note the number right below the DAILY_OUTPUT line that indicates the number of selected output variables. If you decide to change the number of output variables, the number (currently 12) should be adjusted accordingly. At present the R package handles only daily output data, but the user should acknowledge the optional annual output set in the ini file as well.
|
||||
Biome-BGCMuSo offers a large number of posible output variables. The full list of variables are available at the website of the model as an Excel file: http://agromo.agrar.mta.hu/bbgc/files/MUSO6.1_variables.xlsx
|
||||
Biome-BGCMuSo offers a large number of posible output variables. The full list of variables are available at the website of the model as an Excel file: http://nimbus.elte.hu/bbgc/files/MUSO6.1_variables.xlsx
|
||||
|
||||
Selection of output variables is primarily driven by the need of the user: it depends on the process that the user would like to study. We made an effort to provide all possible variables that are comparable with the observations.
|
||||
One might be interested in carbon fluxes like Net Ecosystem Exchange (NEE), Gross Primary Production (GPP), total ecosystem respiation (Reco, all comparable with eddy covariance measurements), evapotransporation (ET), Net Primary Production (NPP), soil organic carbon (SOC) content, leaf area index (LAI), aboveground woody biomass and coarse woody debris in forests, crop yield, rooting depth, aoveground or total biomass for herbaceous vegetation, litter, soil respiration, soil water content for 10 soil layers, soil N2O efflux, etc.
|
||||
@ -240,7 +240,7 @@ In advanced mode there is possibility to select the parameters.csv file using th
|
||||
|
||||
*** Sensitivity analysis
|
||||
|
||||
Advanced sensitivity analysis is possible with the musoSensi function of RBBGCMuso. [[http://agromo.agrar.mta.hu/files/musoSensi_usage.html][Visit this link to read the manual of the sensitivity analysis.]]
|
||||
Advanced sensitivity analysis is possible with the musoSensi function of RBBGCMuso. [[http://nimbus.elte.hu/agromo/files/musoSensi_usage.html][Visit this link to read the manual of the sensitivity analysis.]]
|
||||
Note that parameters.csv is provided in the hhs example dataset, so you don't have to create it manually.
|
||||
|
||||
*IMPORTANT NOTE: If the result file contains only NAs it means that none of the parameters affected the output variable of interest. In this case you need to adjust the output parameter selection or the EPC parameter list. A simple example for this is soil temperature which is not affected by some of the plant parameters. [[https://github.com/hollorol/RBBGCMuso/issues/3][See this link for further details.]]
|
||||
|
||||
25554
docs/CIRM/Martonvasar.wth
Normal file
25554
docs/CIRM/Martonvasar.wth
Normal file
File diff suppressed because it is too large
Load Diff
29
docs/CIRM/Martonvasar_maize.obs
Normal file
29
docs/CIRM/Martonvasar_maize.obs
Normal file
@ -0,0 +1,29 @@
|
||||
var_id;domain_id;date;mean;sd;min;max
|
||||
fruit_DM;211;1991-10-04;6537;1012;4981;7910
|
||||
fruit_DM;211;1992-10-04;5799;2906;1071;11141
|
||||
fruit_DM;211;1993-10-04;4161;1226;1581;6409
|
||||
fruit_DM;211;1994-10-04;5335;966;3026;6860
|
||||
fruit_DM;211;1995-10-04;6359;2981;1700;10132
|
||||
fruit_DM;211;1996-10-04;8675;1085;6596;10668
|
||||
fruit_DM;211;1997-10-04;8865;995;6622;10234
|
||||
fruit_DM;211;1998-10-04;7931;1908;4046;9554
|
||||
fruit_DM;211;1999-10-04;9447;1348;7404;11535
|
||||
fruit_DM;211;2000-10-04;6614;2695;2936;11237
|
||||
fruit_DM;211;2001-10-04;8667;881;6372;10275
|
||||
fruit_DM;211;2002-10-04;6321;1034;5100;8139
|
||||
fruit_DM;211;2003-10-04;5328;1688;2508;7183
|
||||
fruit_DM;211;2004-10-04;7965;1193;5869;9690
|
||||
fruit_DM;211;2005-10-04;8543;679;7242;9439
|
||||
fruit_DM;211;2006-10-04;10124;1146;8308;12402
|
||||
fruit_DM;211;2007-10-04;4901;2088;957;7574
|
||||
fruit_DM;211;2008-10-04;10024;2012;7364;12852
|
||||
fruit_DM;211;2009-10-04;6713;1672;4601;10515
|
||||
fruit_DM;211;2010-10-04;9081;2009;6585;12011
|
||||
fruit_DM;211;2011-10-04;10536;1708;8958;13566
|
||||
fruit_DM;211;2012-10-04;5023;2072;1776;9325
|
||||
fruit_DM;211;2013-10-04;6958;2732;3729;11645
|
||||
fruit_DM;211;2014-10-04;10162;629;9444;10974
|
||||
fruit_DM;211;2015-10-04;8636;1780;5681;11586
|
||||
fruit_DM;211;2016-10-04;9904;1098;7276;11397
|
||||
fruit_DM;211;2017-10-04;6731;1351;4694;10166
|
||||
fruit_DM;211;2018-10-04;9092;1227;6746;10827
|
||||
29
docs/CIRM/Martonvasar_maize_KSH_Fejer.obs
Normal file
29
docs/CIRM/Martonvasar_maize_KSH_Fejer.obs
Normal file
@ -0,0 +1,29 @@
|
||||
var_id;domain_id;date;mean;sd;min;max
|
||||
fruit_DM;211;1991-10-04;6840;274;6019;7661
|
||||
fruit_DM;211;1992-10-04;3990;160;3511;4469
|
||||
fruit_DM;211;1993-10-04;3130;125;2754;3506
|
||||
fruit_DM;211;1994-10-04;3740;150;3291;4189
|
||||
fruit_DM;211;1995-10-04;4680;187;4118;5242
|
||||
fruit_DM;211;1996-10-04;6210;248;5465;6955
|
||||
fruit_DM;211;1997-10-04;6710;268;5905;7515
|
||||
fruit_DM;211;1998-10-04;6500;260;5720;7280
|
||||
fruit_DM;211;1999-10-04;7150;286;6292;8008
|
||||
fruit_DM;211;2000-10-04;4160;166;3661;4659
|
||||
fruit_DM;211;2001-10-04;6890;276;6063;7717
|
||||
fruit_DM;211;2002-10-04;5650;226;4972;6328
|
||||
fruit_DM;211;2003-10-04;4100;164;3608;4592
|
||||
fruit_DM;211;2004-10-04;7440;298;6547;8333
|
||||
fruit_DM;211;2005-10-04;9010;360;7929;10091
|
||||
fruit_DM;211;2006-10-04;7740;310;6811;8669
|
||||
fruit_DM;211;2007-10-04;2890;116;2543;3237
|
||||
fruit_DM;211;2008-10-04;8450;338;7436;9464
|
||||
fruit_DM;211;2009-10-04;7110;284;6257;7963
|
||||
fruit_DM;211;2010-10-04;7420;297;6530;8310
|
||||
fruit_DM;211;2011-10-04;7580;303;6670;8490
|
||||
fruit_DM;211;2012-10-04;4080;163;3590;4570
|
||||
fruit_DM;211;2013-10-04;5910;236;5201;6619
|
||||
fruit_DM;211;2014-10-04;8380;335;7374;9386
|
||||
fruit_DM;211;2015-10-04;6210;248;5465;6955
|
||||
fruit_DM;211;2016-10-04;9370;375;8246;10494
|
||||
fruit_DM;211;2017-10-04;6700;268;5896;7504
|
||||
fruit_DM;211;2018-10-04;10060;402;8853;11267
|
||||
86
docs/CIRM/README.md
Normal file
86
docs/CIRM/README.md
Normal file
@ -0,0 +1,86 @@
|
||||
This is a si
|
||||
|
||||
## Preparations
|
||||
|
||||
Before using this script, make sure, your current working directory looks like
|
||||
|
||||
```{verbatim}
|
||||
.
|
||||
├── glue.R
|
||||
├── kichen_sink.R
|
||||
├── make_individual_trees.R
|
||||
├── Martonvasar_maize_KSH_Fejer.obs
|
||||
├── Martonvasar_maize.obs
|
||||
├── README.md
|
||||
├── statistics.R
|
||||
└── tree_accuracy.R
|
||||
```
|
||||
|
||||
### Loading the RBBGCMuso package and the necessary functions
|
||||
|
||||
```{r}
|
||||
library(RBBGCMuso)
|
||||
source("make_individual_trees.R") # The DT creation and update algorithms
|
||||
source("glue.R") # GLUE optimizer algorithms
|
||||
```
|
||||
|
||||
The file containing the path to the observation files (Martonvasar_maize.obs), and the parameter intervals (Martonj)
|
||||
|
||||
### Reading the observations
|
||||
|
||||
The mean yield had to be adjust. see in art.
|
||||
|
||||
```{r}
|
||||
measureFile <- "Martonvasar_maize.obs"
|
||||
measurements <- read.csv2(measureFile, stringsAsFactors=FALSE)
|
||||
measurements$mean <- measurements$mean / 10000
|
||||
measurements$sd <- measurements$sd / 10000
|
||||
```
|
||||
|
||||
### Define conditioning functions
|
||||
|
||||
constraints.json
|
||||
|
||||
```{json}
|
||||
{
|
||||
"constraints": [
|
||||
|
||||
{
|
||||
"Expression": "SELECT(harvest_index, max)|median",
|
||||
"Min": 0.45,
|
||||
"Max": 0.55
|
||||
},
|
||||
{
|
||||
"Expression": "SELECT(proj_lai, max)|quantile(.,0.5)",
|
||||
"Min": 2.7,
|
||||
"Max": 5
|
||||
},
|
||||
{
|
||||
"Expression": "SELECT(rootdepth5, max)|quantile(.,0.5)",
|
||||
"Min": 1.40,
|
||||
"Max": 1.80
|
||||
},
|
||||
{
|
||||
"Expression": "SELECT(flower_date, max)|quantile(.,0.5)",
|
||||
"Min": 180,
|
||||
"Max": 190
|
||||
}
|
||||
],
|
||||
|
||||
"treshold": 80
|
||||
}
|
||||
```
|
||||
|
||||
```{r}
|
||||
constraints <- jsonlite::read_json("constraints.json",simplifyVector=TRUE)
|
||||
```
|
||||
|
||||
### Cal file:
|
||||
|
||||
```{verbatim}
|
||||
|
||||
Martonvasar_maize.obs
|
||||
Martonvasar_maize.set
|
||||
site
|
||||
Martonvasar_maize;211
|
||||
```
|
||||
55
docs/CIRM/glue.R
Normal file
55
docs/CIRM/glue.R
Normal file
@ -0,0 +1,55 @@
|
||||
zero_var <- function(m){
|
||||
apply(m,2, function(v){
|
||||
var(v) != 0
|
||||
})
|
||||
|
||||
}
|
||||
|
||||
|
||||
glue <- function(results="result.csv",res_r="results.RDS",output ="gplot.pdf",epcname="maize_glue.epc"){
|
||||
res <- read.csv(results)[-1]
|
||||
res <- res[-1,]
|
||||
colnames(res)
|
||||
non_zero <- res[,1:(ncol(res)-4)]
|
||||
colnames(non_zero) <- colnames(res)[1:(ncol(res)-4)]
|
||||
impvars <- zero_var(non_zero)
|
||||
nonzero <- non_zero[,impvars]
|
||||
likelihoods <- res[,(ncol(res)-3)]
|
||||
rmse <- res[,(ncol(res)-2)]
|
||||
const <- res$Const
|
||||
namess <- gsub("__.*","",colnames(nonzero))
|
||||
|
||||
|
||||
|
||||
|
||||
likelihoods <- likelihoods[res$Const==1]
|
||||
goods <- res[res$Const==1,]
|
||||
medlik <- median(likelihoods[likelihoods >= quantile(likelihoods,0.95)])
|
||||
medlik_place <- which.min(abs(likelihoods - medlik))
|
||||
parameters <- readRDS(res_r)
|
||||
glue_opt <- goods[medlik_place, 1:(ncol(res)-4)][impvars]
|
||||
nonka <- goods[likelihoods >= quantile(likelihoods,0.95),1:(ncol(res)-4)]
|
||||
med_opt <- apply(nonka,2,median)[impvars]
|
||||
# med_opt <- apply(nonka,2,mean)[impvars]
|
||||
ml_opt <- goods[which.max(likelihoods),1:(ncol(res)-4)][impvars]
|
||||
|
||||
calibrationPar <- parameters$calibrationPar[impvars]
|
||||
changemulline(src="maize.epc", calibrationPar = calibrationPar, contents=glue_opt, outFiles = epcname)
|
||||
changemulline(src="maize.epc", calibrationPar = calibrationPar, contents=med_opt, outFiles = "maize_median.epc")
|
||||
changemulline(src="maize.epc", calibrationPar = calibrationPar, contents=ml_opt, outFiles = "maize_ml.epc")
|
||||
|
||||
|
||||
|
||||
print(output)
|
||||
pdf(output)
|
||||
for(i in 1:ncol(nonzero)){
|
||||
plot(nonzero[,i],res[,(ncol(res)-3)],main="",col="lightgray", pch=20, cex=0.4, xlab=namess[i],ylab="logLikelihood")
|
||||
points(nonzero[const==1,i],res[const==1,(ncol(res)-3)],pch=20, cex=0.6, col="red",type="p",xlab=namess[i],ylab="logLikelihood")
|
||||
abline(v=glue_opt[i],col="green")
|
||||
abline(v=med_opt[i],col="blue")
|
||||
abline(v=ml_opt[i],col="black")
|
||||
}
|
||||
|
||||
dev.off()
|
||||
}
|
||||
|
||||
45
docs/CIRM/kichen_sink.R
Normal file
45
docs/CIRM/kichen_sink.R
Normal file
@ -0,0 +1,45 @@
|
||||
start_intervals <- read.csv("1/Martonvasar_maize.set",skip=1,stringsAsFactors=FALSE)
|
||||
|
||||
indices <- which(start_intervals[,3] != start_intervals[,4])
|
||||
|
||||
png("kichen_sink.png",width=30,height=30,res=600,units = "cm")
|
||||
|
||||
par(mfrow=c(5,4))
|
||||
|
||||
for(i in indices){
|
||||
ranges <- start_intervals[i,3:4]
|
||||
optimes <- numeric(10)
|
||||
for(j in 1:10){
|
||||
base_table <- read.csv(paste(j,"Martonvasar_maize_after_tree.set",sep="/"),
|
||||
skip=1, stringsAsFactors=FALSE)
|
||||
ranges <- rbind(ranges,base_table[i,3:4])
|
||||
optimes[j] <- unlist(readRDS(paste0(j,"/results.RDS"))$parameters[start_intervals[indices,1]][indices==i])
|
||||
}
|
||||
plot(ranges[,1],11:1,type="l",xlim=range(ranges),main=base_table[i,1],xlab="",ylab="iterations",yaxt="n")
|
||||
axis(2,at=11:1,labels = 0:10)
|
||||
points(optimes,10:1)
|
||||
lines(ranges[,2],11:1,type="l")
|
||||
}
|
||||
dev.off()
|
||||
|
||||
postscript("kichen_sink.eps",paper="a4")
|
||||
|
||||
par(mfrow=c(5,4))
|
||||
|
||||
for(i in indices){
|
||||
ranges <- start_intervals[i,3:4]
|
||||
optimes <- numeric(10)
|
||||
for(j in 1:10){
|
||||
base_table <- read.csv(paste(j,"Martonvasar_maize_after_tree.set",sep="/"),
|
||||
skip=1, stringsAsFactors=FALSE)
|
||||
ranges <- rbind(ranges,base_table[i,3:4])
|
||||
optimes[j] <- unlist(readRDS(paste0(j,"/results.RDS"))$parameters[start_intervals[indices,1]][indices==i])
|
||||
}
|
||||
plot(ranges[,1],11:1,type="l",xlim=range(ranges),main=base_table[i,1],xlab="",ylab="iterations",yaxt="n")
|
||||
axis(2,at=11:1,labels = 0:10)
|
||||
points(optimes,10:1)
|
||||
lines(ranges[,2],11:1,type="l")
|
||||
}
|
||||
dev.off()
|
||||
|
||||
|
||||
131
docs/CIRM/make_individual_trees.R
Normal file
131
docs/CIRM/make_individual_trees.R
Normal file
@ -0,0 +1,131 @@
|
||||
library(rpart)
|
||||
library(rpart.plot)
|
||||
zero_var <- function(m){
|
||||
apply(m,2, function(v){
|
||||
var(v) != 0
|
||||
})
|
||||
|
||||
}
|
||||
|
||||
decbin <- function(decnum){
|
||||
if(decnum < 2){
|
||||
return(decnum)
|
||||
}
|
||||
c(decbin((decnum %/% 2)),decnum %% 2)
|
||||
}
|
||||
|
||||
decpad <- function(decnum,len){
|
||||
binrep <- decbin(decnum)
|
||||
c(rep(0,len-length(binrep)),binrep)
|
||||
}
|
||||
|
||||
|
||||
tree_per_const <- function(results="result.csv",output ="tree_per_const.pdf",
|
||||
parameters_file="Martonvasar_maize.set"){
|
||||
varname <-readLines(parameters_file)[1]
|
||||
parameters <- read.csv(parameters_file,skip=1,stringsAsFactors=FALSE)
|
||||
|
||||
|
||||
results <- read.csv(results, stringsAsFactors=FALSE)
|
||||
# likelihoods <- results[,ncol(results)-3]
|
||||
# results <- results[likelihoods>=quantile(likelihoods,0.95),]
|
||||
len <- round(log(max(results$failType),2))
|
||||
failTypes <- do.call(rbind,lapply(results$failType,function(x){decpad(x,len)}))
|
||||
pdf(output)
|
||||
sapply(1:len, function(const){
|
||||
nonzero <- results[,1:(ncol(results)-4)]
|
||||
nonzero <- nonzero[,-1]
|
||||
nonzero <- nonzero[,zero_var(nonzero)]
|
||||
colnames(nonzero) <- gsub("__.*","",colnames(nonzero))
|
||||
constraint <- failTypes[,const]
|
||||
baseTable <- cbind.data.frame(nonzero,constraint = as.factor(constraint))
|
||||
try({
|
||||
rp = rpart(constraint ~ .,data = baseTable)
|
||||
})
|
||||
try({
|
||||
parameters <<- update_parameters_based_on_tree(rp, parameters)
|
||||
})
|
||||
try({
|
||||
rpart.plot(rp)
|
||||
})
|
||||
|
||||
|
||||
})
|
||||
dev.off()
|
||||
outname <- paste0(tools::file_path_sans_ext(parameters_file),"_after_tree.",
|
||||
tools::file_ext(parameters_file))
|
||||
writeLines(varname,outname)
|
||||
write.table(parameters,outname,row.names=FALSE,append=TRUE,sep=",",quote=FALSE)
|
||||
}
|
||||
update_parameters_based_on_tree <- function(rp, parameters){
|
||||
frm <- rp$frame
|
||||
nodes <- labels(rp)
|
||||
names(nodes) <- row.names(frm)
|
||||
node <- get_start_node(frm)
|
||||
parameters <- change_parameters_on_node(nodes,node,parameters)
|
||||
while(node !=1){
|
||||
node <- get_parent_node(node)
|
||||
if(node == 1){
|
||||
break()
|
||||
}
|
||||
parameters <- change_parameters_on_node(nodes,node,parameters)
|
||||
}
|
||||
parameters
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
parse_rule_row <- function(string){
|
||||
|
||||
rule_row <- regmatches(string,regexec("([a-zA-Z_0-9]+)([>=< ]+)(.*)",string,perl=TRUE))[[1]][-1]
|
||||
if(rule_row[2] == ">="){
|
||||
rule_num <- 1
|
||||
} else {
|
||||
rule_num <- 2
|
||||
}
|
||||
rule <- list(c(rule_num,as.numeric(rule_row[3])))
|
||||
names(rule) <- rule_row[1]
|
||||
return(rule)
|
||||
}
|
||||
|
||||
get_start_node <- function(frm){
|
||||
nfrm <- frm[frm$yval == 2,]
|
||||
nfrm <- nfrm[nfrm[,"var"] == "<leaf>",]
|
||||
pot_start <- as.numeric(row.names(nfrm))[which.max(nfrm$n)]
|
||||
pot_start
|
||||
}
|
||||
|
||||
get_parent_node <- function(node_id){
|
||||
as.integer(node_id/2)
|
||||
}
|
||||
|
||||
change_parameters_on_node <- function(nodes,node,parameters2){
|
||||
crule <- parse_rule_row(nodes[as.character(node)])
|
||||
minmax <- unlist(parameters2[parameters2[,1] == names(crule),c(3,4)])
|
||||
|
||||
if(crule[[1]][1] == 1){
|
||||
if(minmax[1]<=crule[[1]][2]){
|
||||
minmax[1] <- crule[[1]][2]
|
||||
if(minmax[1] <= minmax[2]){
|
||||
parameters2[parameters2[,1] == names(crule),c(3,4)] <- minmax
|
||||
} else {
|
||||
write(sprintf("WARNING: %s's minimum(%s) > maximum(%s)", parameters2[,1],
|
||||
minmax[1], minmax[2]), "errorlog.txt", append=TRUE)
|
||||
}
|
||||
}
|
||||
} else {
|
||||
if(minmax[2]>=crule[[1]][2]){
|
||||
minmax[2] <- crule[[1]][2]
|
||||
if(minmax[1] <= minmax[2]){
|
||||
parameters2[parameters2[,1] == names(crule),c(3,4)] <- minmax
|
||||
} else {
|
||||
write(sprintf("WARNING: %s's minimum(%s) > maximum(%s)", parameters2[,1],
|
||||
minmax[1], minmax[2]), "errorlog.txt", append=TRUE)
|
||||
}
|
||||
}
|
||||
}
|
||||
parameters2
|
||||
}
|
||||
|
||||
|
||||
BIN
docs/CIRM/muso
Normal file
BIN
docs/CIRM/muso
Normal file
Binary file not shown.
76
docs/CIRM/statistics.R
Normal file
76
docs/CIRM/statistics.R
Normal file
@ -0,0 +1,76 @@
|
||||
library(RBBGCMuso)
|
||||
file.copy("../../start_set/maize.epc","./start_set/maize.epc",overwrite=TRUE)
|
||||
setwd("start_set/")
|
||||
|
||||
rmse <- function(modelled, measured){
|
||||
sqrt(mean((modelled-measured)**2))
|
||||
}
|
||||
|
||||
r2 <- function(modelled, measured){
|
||||
summary(lm("mod ~ meas", data= data.frame(mod=modelled,meas=measured)))$r.squared
|
||||
}
|
||||
|
||||
modeff <- function(modelled, measured){
|
||||
1 - (sum((modelled-measured)**2) / sum((measured - mean(measured))**2))
|
||||
}
|
||||
|
||||
bias <- function(modelled, measured){
|
||||
mean(modelled) - mean(measured)
|
||||
}
|
||||
|
||||
get_stats <- function(modelled,measured){
|
||||
c(r2=r2(modelled,measured),
|
||||
rmse=rmse(modelled,measured),
|
||||
bias=bias(modelled,measured),
|
||||
modeff=modeff(modelled,measured))
|
||||
}
|
||||
|
||||
get_modelled <- function(obsTable,settings, ...){
|
||||
simulation <- runMuso(settings, ...)
|
||||
yield <- simulation[,"fruit_DM"]
|
||||
modelled <- yield[match(as.Date(obsTable$date),as.Date(names(yield),"%d.%m.%Y"))] * 10
|
||||
modelled
|
||||
}
|
||||
|
||||
obsTable <- read.csv2("Martonvasar_maize.obs",stringsAsFactors=FALSE)
|
||||
obsTable$mean <- obsTable$mean / 1000 * 0.85
|
||||
obsTable$sd <- obsTable$sd / 1000
|
||||
measured <- obsTable$mean
|
||||
|
||||
# apriori
|
||||
settings <- setupMuso(iniInput=c("n.ini","n.ini"))
|
||||
modelled <- get_modelled(obsTable, settings)
|
||||
results <- matrix(ncol=4,nrow=11)
|
||||
colnames(results) <- c("r2","rmse","bias","modeff")
|
||||
row.names(results) <- 0:10
|
||||
results[1,] <- get_stats(modelled,measured)
|
||||
# max_likelihood_stats
|
||||
for(i in 1:10){
|
||||
file.copy(sprintf("../%s/maize_ml.epc",i),"maize.epc",overwrite=TRUE)
|
||||
settings <- setupMuso(iniInput=c("n.ini","n.ini"))
|
||||
modelled <- get_modelled(obsTable, settings)
|
||||
results[i+1,] <- get_stats(modelled, measured)
|
||||
}
|
||||
# median_stats
|
||||
results_med <- results
|
||||
|
||||
for(i in 1:10){
|
||||
file.copy(sprintf("../maize_median_step%02d_corrected.epc",i),"maize.epc",overwrite=TRUE)
|
||||
settings <- setupMuso(iniInput=c("n.ini","n.ini"))
|
||||
modelled <- get_modelled(obsTable, settings)
|
||||
results_med[i+1,] <- get_stats(modelled, measured)
|
||||
}
|
||||
results_med
|
||||
|
||||
succes_ratio <- numeric(10)
|
||||
for(i in 1:10){
|
||||
succes_ratio[i] <- sum(read.csv(sprintf("../%s/result.csv",i),stringsAsFactors=FALSE)$Const[-1])/10000
|
||||
}
|
||||
names(succes_ratio) <- 1:10
|
||||
png("../success_rate.png",height=30,width=30,res=300, units="cm")
|
||||
barplot(succes_ratio,ylim=c(0,1),xlab="iteration number",ylab="Succes rate")
|
||||
dev.off()
|
||||
|
||||
postscript("../success_rate.eps")
|
||||
barplot(succes_ratio,ylim=c(0,1),xlab="iteration number",ylab="Succes rate")
|
||||
dev.off()
|
||||
70
docs/CIRM/tree_accuracy.R
Normal file
70
docs/CIRM/tree_accuracy.R
Normal file
@ -0,0 +1,70 @@
|
||||
library(rpart)
|
||||
library(rpart.plot)
|
||||
|
||||
accuracy <- function(x,rp){
|
||||
# Accuracy = (TP + TN)/(TP + TN + FP + FP)
|
||||
# TP: True Positive
|
||||
# TN: True Negative
|
||||
# FP: False Positive
|
||||
# FN: False Negative
|
||||
|
||||
predicted <- rpart.predict(rp,type = "vector")
|
||||
predicted[predicted==1] <- 0
|
||||
predicted[predicted==2] <- 1
|
||||
(sum(x*predicted) + sum((x + predicted) == 0)) / length(x)
|
||||
}
|
||||
|
||||
zero_var <- function(m){
|
||||
apply(m,2, function(v){
|
||||
var(v) != 0
|
||||
})
|
||||
|
||||
}
|
||||
|
||||
decbin <- function(decnum){
|
||||
if(decnum < 2){
|
||||
return(decnum)
|
||||
}
|
||||
c(decbin((decnum %/% 2)),decnum %% 2)
|
||||
}
|
||||
|
||||
decpad <- function(decnum,len){
|
||||
binrep <- decbin(decnum)
|
||||
c(rep(0,len-length(binrep)),binrep)
|
||||
}
|
||||
|
||||
|
||||
tree_per_const <- function(results="result.csv",output ="tree_per_const.pdf",
|
||||
parameters_file="Martonvasar_maize.set"){
|
||||
varname <-readLines(parameters_file)[1]
|
||||
parameters <- read.csv(parameters_file,skip=1,stringsAsFactors=FALSE)
|
||||
|
||||
|
||||
results <- read.csv(results, stringsAsFactors=FALSE)
|
||||
# likelihoods <- results[,ncol(results)-3]
|
||||
# results <- results[likelihoods>=quantile(likelihoods,0.95),]
|
||||
len <- round(log(max(results$failType),2))
|
||||
failTypes <- do.call(rbind,lapply(results$failType,function(x){decpad(x,len)}))
|
||||
sapply(1:len, function(const){
|
||||
nonzero <- results[,1:(ncol(results)-4)]
|
||||
nonzero <- nonzero[,-1]
|
||||
nonzero <- nonzero[,zero_var(nonzero)]
|
||||
colnames(nonzero) <- gsub("__.*","",colnames(nonzero))
|
||||
constraint <- failTypes[,const]
|
||||
baseTable <- cbind.data.frame(nonzero,constraint = as.factor(constraint))
|
||||
tryCatch({
|
||||
rp <- rpart(constraint ~ .,data = baseTable)
|
||||
accuracy(constraint, rp)
|
||||
}, error = function(e){NA})
|
||||
})
|
||||
}
|
||||
|
||||
results <- matrix(nrow=10,ncol=4)
|
||||
row.names(results) <- 1:10
|
||||
colnames(results) <- c("Harvest Index", "LAI", "Root depth in phen. 5", "Flowering date")
|
||||
for(i in 1:10){
|
||||
setwd(as.character(i))
|
||||
results[i,] <- tree_per_const(parameters_file="Martonvasar_maize_after_tree.set")
|
||||
setwd("../")
|
||||
}
|
||||
results
|
||||
18
installDeps.R
Normal file
18
installDeps.R
Normal file
@ -0,0 +1,18 @@
|
||||
(function(){
|
||||
packagesToInstall <- c("shiny","shinyjs","plotly","promises","future","data.table","rhandsontable", "dplyr", "digest", "ggplot2", "magrittr", "tibble", "limSolve", "rmarkdown")
|
||||
installedp<- sapply(packagesToInstall, function(pkgs){
|
||||
if(!is.element(pkgs,installed.packages()[,1])){
|
||||
install.packages(pkgs)
|
||||
if(!is.element(pkgs,installed.packages()[,1])){
|
||||
return(FALSE)
|
||||
} else {
|
||||
return(TRUE)
|
||||
}
|
||||
} else {
|
||||
return(TRUE)
|
||||
}
|
||||
})
|
||||
if(any(!installedp)){
|
||||
stop("The installation process was not successful. Please try rerun the installation!")
|
||||
}
|
||||
})()
|
||||
382
test.R
Normal file
382
test.R
Normal file
@ -0,0 +1,382 @@
|
||||
parameters <-
|
||||
getOption("RMuso_constMatrix")[["epc"]][["6"]]
|
||||
NAME
|
||||
yearday to start new growth
|
||||
yearday to end new growth
|
||||
transfer growth period as fraction of growing season
|
||||
litterfall as fraction of growing season
|
||||
base temperature
|
||||
minimum temperature for growth displayed on current day
|
||||
optimal1 temperature for growth displayed on current day
|
||||
optimal2 temperature for growth displayed on current day
|
||||
maxmimum temperature for growth displayed on current day
|
||||
minimum temperature for carbon assimilation displayed on current day
|
||||
optimal1 temperature for carbon assimilation displayed on current day
|
||||
optimal2 temperature for carbon assimilation displayed on current day
|
||||
maxmimum temperature for carbon assimilation displayed on current day
|
||||
annual leaf and fine root turnover fraction
|
||||
annual live wood turnover fraction
|
||||
annual fire mortality fraction
|
||||
whole-plant mortality paramter for vegetation period
|
||||
C:N of leaves
|
||||
C:N of leaf litter
|
||||
C:N of fine roots
|
||||
C:N of fruit
|
||||
C:N of softstem
|
||||
C:N of live wood
|
||||
C:N of dead wood
|
||||
dry matter content of leaves
|
||||
dry matter content of leaf litter
|
||||
dry matter content of fine roots
|
||||
dry matter content of fruit
|
||||
dry matter content of softstem
|
||||
dry matter content of live wood
|
||||
dry matter content of dead wood
|
||||
leaf litter labile proportion
|
||||
leaf litter cellulose proportion
|
||||
fine root labile proportion
|
||||
fine root cellulose proportion
|
||||
fruit labile proportion
|
||||
fruit cellulose proportion
|
||||
softstem labile proportion
|
||||
softstem cellulose proportion
|
||||
dead wood cellulose proportion
|
||||
canopy water interception coefficient
|
||||
canopy light extinction coefficient
|
||||
potential radiation use efficiency
|
||||
radiation parameter1 (Jiang et al.2015)
|
||||
radiation parameter1 (Jiang et al.2015)
|
||||
all-sided to projected leaf area ratio
|
||||
ratio of shaded SLA:sunlit SLA
|
||||
fraction of leaf N in Rubisco
|
||||
fraction of leaf N in PeP
|
||||
maximum stomatal conductance
|
||||
cuticular conductance
|
||||
boundary layer conductance
|
||||
maximum height of plant
|
||||
stem weight corresponding to maximum height
|
||||
plant height function shape parameter (slope)
|
||||
maximum depth of rooting zone
|
||||
root distribution parameter
|
||||
root weight corresponding to max root depth
|
||||
root depth function shape parameter (slope)
|
||||
root weight to rooth length conversion factor
|
||||
growth resp per unit of C grown
|
||||
maintenance respiration in kgC/day per kg of tissue N
|
||||
theoretical maximum prop. of non-structural and structural carbohydrates
|
||||
prop. of non-structural carbohydrates available for maintanance resp
|
||||
symbiotic+asymbiotic fixation of N
|
||||
time delay for temperature in photosynthesis acclimation
|
||||
critical VWCratio (prop. to FC-WP) in germination
|
||||
critical photoslow daylength
|
||||
slope of relative photoslow development rate
|
||||
critical vernalization temperature 1
|
||||
critical vernalization temperature 2
|
||||
critical vernalization temperature 3
|
||||
critical vernalization temperature 4
|
||||
slope of relative vernalization development rate
|
||||
required vernalization days (in vernalization development rate)
|
||||
critical flowering heat stress temperature 1
|
||||
critical flowering heat stress temperature 2
|
||||
theoretical maximum of flowering thermal stress mortality
|
||||
VWC ratio to calc. soil moisture limit 1 (prop. to FC-WP)
|
||||
VWC ratio to calc. soil moisture limit 2 (prop. to SAT-FC)
|
||||
minimum of soil moisture limit2 multiplicator (full anoxic stress value)
|
||||
vapor pressure deficit: start of conductance reduction
|
||||
vapor pressure deficit: complete conductance reduction
|
||||
maximum senescence mortality coefficient of aboveground plant material
|
||||
maximum senescence mortality coefficient of belowground plant material
|
||||
maximum senescence mortality coefficient of non-structured plant material
|
||||
lower limit extreme high temperature effect on senescence mortality
|
||||
upper limit extreme high temperature effect on senescence mortality
|
||||
turnover rate of wilted standing biomass to litter
|
||||
turnover rate of cut-down non-woody biomass to litter
|
||||
turnover rate of cut-down woody biomass to litter
|
||||
drought tolerance parameter (critical value of day since water stress)
|
||||
effect of soilstress factor on photosynthesis
|
||||
crit. amount of snow limiting photosyn.
|
||||
limit1 (under:full constrained) of HEATSUM index
|
||||
limit2 (above:unconstrained) of HEATSUM index
|
||||
limit1 (under:full constrained) of TMIN index
|
||||
limit2 (above:unconstrained) of TMIN index
|
||||
limit1 (above:full constrained) of VPD index
|
||||
limit2 (under:unconstrained) of VPD index
|
||||
limit1 (under:full constrained) of DAYLENGTH index
|
||||
limit2 (above:unconstrained) of DAYLENGTH index
|
||||
moving average (to avoid the effects of extreme events)
|
||||
GSI limit1 (greater that limit -> start of vegper)
|
||||
GSI limit2 (less that limit -> end of vegper)
|
||||
length of phenophase (GDD)-0
|
||||
leaf ALLOCATION -0
|
||||
fine root ALLOCATION-0
|
||||
fruit ALLOCATION -0
|
||||
soft stem ALLOCATION-0
|
||||
live woody stem ALLOCATION -0
|
||||
dead woody stem ALLOCATION -0
|
||||
live coarse root ALLOCATION-0
|
||||
dead coarse root ALLOCATION -0
|
||||
canopy average specific leaf area-0
|
||||
current growth proportion-0
|
||||
maximal lifetime of plant tissue-0
|
||||
length of phenophase (GDD)-1
|
||||
leaf ALLOCATION -1
|
||||
fine root ALLOCATION-1
|
||||
fruit ALLOCATION -1
|
||||
soft stem ALLOCATION-1
|
||||
live woody stem ALLOCATION -1
|
||||
dead woody stem ALLOCATION -1
|
||||
live coarse root ALLOCATION-1
|
||||
dead coarse root ALLOCATION -1
|
||||
canopy average specific leaf area-1
|
||||
current growth proportion-1
|
||||
maximal lifetime of plant tissue-1
|
||||
length of phenophase (GDD)-2
|
||||
leaf ALLOCATION -2
|
||||
fine root ALLOCATION-2
|
||||
fruit ALLOCATION -2
|
||||
soft stem ALLOCATION-2
|
||||
live woody stem ALLOCATION -2
|
||||
dead woody stem ALLOCATION -2
|
||||
live coarse root ALLOCATION-2
|
||||
dead coarse root ALLOCATION -2
|
||||
canopy average specific leaf area-2
|
||||
current growth proportion-2
|
||||
maximal lifetime of plant tissue-2
|
||||
length of phenophase (GDD)-3
|
||||
leaf ALLOCATION -3
|
||||
fine root ALLOCATION-3
|
||||
fruit ALLOCATION -3
|
||||
soft stem ALLOCATION-3
|
||||
live woody stem ALLOCATION -3
|
||||
dead woody stem ALLOCATION -3
|
||||
live coarse root ALLOCATION-3
|
||||
dead coarse root ALLOCATION -3
|
||||
canopy average specific leaf area-3
|
||||
current growth proportion-3
|
||||
maximal lifetime of plant tissue-3
|
||||
length of phenophase (GDD)-4
|
||||
leaf ALLOCATION -4
|
||||
fine root ALLOCATION-4
|
||||
fruit ALLOCATION -4
|
||||
soft stem ALLOCATION-4
|
||||
live woody stem ALLOCATION -4
|
||||
dead woody stem ALLOCATION -4
|
||||
live coarse root ALLOCATION-4
|
||||
dead coarse root ALLOCATION -4
|
||||
canopy average specific leaf area-4
|
||||
current growth proportion-4
|
||||
maximal lifetime of plant tissue-4
|
||||
length of phenophase (GDD)-5
|
||||
leaf ALLOCATION -5
|
||||
fine root ALLOCATION-5
|
||||
fruit ALLOCATION -5
|
||||
soft stem ALLOCATION-5
|
||||
live woody stem ALLOCATION -5
|
||||
dead woody stem ALLOCATION -5
|
||||
live coarse root ALLOCATION-5
|
||||
dead coarse root ALLOCATION -5
|
||||
canopy average specific leaf area-5
|
||||
current growth proportion-5
|
||||
maximal lifetime of plant tissue-5
|
||||
length of phenophase (GDD)-6
|
||||
leaf ALLOCATION -6
|
||||
fine root ALLOCATION-6
|
||||
fruit ALLOCATION -6
|
||||
soft stem ALLOCATION-6
|
||||
live woody stem ALLOCATION -6
|
||||
dead woody stem ALLOCATION -6
|
||||
live coarse root ALLOCATION-6
|
||||
dead coarse root ALLOCATION -6
|
||||
canopy average specific leaf area-6
|
||||
current growth proportion-6
|
||||
maximal lifetime of plant tissue-6
|
||||
INDEX UNIT DEPENDENCE MIN MAX GROUP TYPE
|
||||
9.00 yday NA 0.00000 364.0000 0 0
|
||||
10.00 yday NA 0.00000 364.0000 0 0
|
||||
11.00 prop NA 0.00000 1.0000 0 0
|
||||
12.00 prop NA 0.00000 1.0000 0 0
|
||||
13.00 Celsius NA 0.00000 12.0000 0 0
|
||||
14.00 Celsius 0 0.00000 10.0000 1 1
|
||||
15.00 Celsius 1 10.00000 20.0000 1 1
|
||||
16.00 Celsius 2 20.00000 40.0000 1 1
|
||||
17.00 Celsius 3 30.00000 50.0000 1 1
|
||||
18.00 Celsius 0 0.00000 10.0000 2 1
|
||||
19.00 Celsius 1 10.00000 20.0000 2 1
|
||||
20.00 Celsius 2 20.00000 40.0000 2 1
|
||||
21.00 Celsius 3 30.00000 50.0000 2 1
|
||||
22.00 1/yr NA 0.10000 0.4000 0 0
|
||||
23.00 1/yr NA 0.50000 1.0000 0 0
|
||||
24.00 1/yr NA 0.00000 1.0000 0 0
|
||||
25.00 1/vegper NA 0.00000 0.5000 0 0
|
||||
26.00 kgC/kgN 0 10.00000 100.0000 3 1
|
||||
27.00 kgC/kgN 1 10.00000 60.0000 3 1
|
||||
28.00 kgC/kgN 1 10.00000 60.0000 3 1
|
||||
29.00 kgC/kgN 1 10.00000 60.0000 3 1
|
||||
30.00 kgC/kgN 1 10.00000 60.0000 3 1
|
||||
31.00 kgC/kgN 0 50.00000 100.0000 4 1
|
||||
32.00 kgC/kgN 1 300.00000 800.0000 4 1
|
||||
33.00 kgC/kgDM NA 0.20000 0.6000 0 0
|
||||
34.00 kgC/kgDM NA 0.20000 0.6000 0 0
|
||||
35.00 kgC/kgDM NA 0.20000 0.6000 0 0
|
||||
36.00 kgC/kgDM NA 0.20000 0.6000 0 0
|
||||
37.00 kgC/kgDM NA 0.20000 0.6000 0 0
|
||||
38.00 kgC/kgDM NA 0.20000 0.6000 0 0
|
||||
39.00 kgC/kgDM NA 0.20000 0.6000 0 0
|
||||
40.00 prop 1 0.10000 0.6000 5 2
|
||||
41.00 prop 1 0.10000 0.6000 5 2
|
||||
42.00 prop 1 0.10000 0.6000 6 2
|
||||
43.00 prop 1 0.10000 0.6000 6 2
|
||||
44.00 prop 1 0.10000 0.6000 7 2
|
||||
45.00 prop 1 0.10000 0.6000 7 2
|
||||
46.00 prop 1 0.10000 0.6000 8 2
|
||||
47.00 prop 1 0.10000 0.6000 8 2
|
||||
48.00 prop NA 0.50000 0.9000 0 0
|
||||
49.00 1/LAI/d NA 0.01000 0.1000 0 0
|
||||
50.00 dimless NA 0.20000 0.8000 0 0
|
||||
51.00 g/MJ NA 2.00000 2.0000 0 0
|
||||
52.00 dimless NA 0.78100 0.7810 0 0
|
||||
53.00 dimless NA -13.59600 -13.5960 0 0
|
||||
54.00 dimless NA 2.00000 2.0000 0 0
|
||||
55.00 dimless NA 2.00000 2.0000 0 0
|
||||
56.00 dimless NA 0.01000 0.2000 0 0
|
||||
57.00 dimless NA 0.04240 0.0424 0 0
|
||||
58.00 m/s NA 0.00100 0.1000 0 0
|
||||
59.00 m/s NA 0.00001 0.0001 0 0
|
||||
60.00 m/s NA 0.01000 0.0900 0 0
|
||||
61.00 m NA 0.10000 10.0000 0 0
|
||||
62.00 kgC NA 0.10000 100.0000 0 0
|
||||
63.00 dimless NA 0.50000 0.5000 0 0
|
||||
64.00 m NA 0.10000 10.0000 0 0
|
||||
65.00 prop NA 3.67000 3.6700 0 0
|
||||
66.00 kgC/m2 NA 0.40000 0.4000 0 0
|
||||
67.00 prop NA 0.50000 0.5000 0 0
|
||||
68.00 m/kg NA 1000.00000 1000.0000 0 0
|
||||
69.00 prop NA 0.10000 0.5000 0 0
|
||||
70.00 kgC/kgN/d NA 0.10000 0.5000 0 0
|
||||
71.00 dimless NA 0.00000 1.0000 0 0
|
||||
72.00 dimless NA 0.00000 1.0000 0 0
|
||||
73.00 kgN/m2/yr NA 0.00000 0.0010 0 0
|
||||
74.00 day NA 0.00000 50.0000 0 0
|
||||
79.00 prop NA 0.00000 1.0000 0 0
|
||||
81.00 hour NA 14.00000 18.0000 0 0
|
||||
82.00 dimless NA 0.00500 0.0050 0 0
|
||||
84.00 Celsius 0 -5.00000 5.0000 9 1
|
||||
85.00 Celsius 1 0.00000 10.0000 9 1
|
||||
86.00 Celsius 2 5.00000 15.0000 9 1
|
||||
87.00 Celsius 3 10.00000 20.0000 9 1
|
||||
88.00 dimless NA 0.04000 0.0400 0 0
|
||||
89.00 dimless NA 30.00000 70.0000 0 0
|
||||
91.00 Celsius 0 30.00000 40.0000 10 1
|
||||
92.00 Celsius 1 30.00000 50.0000 10 1
|
||||
93.00 prop NA 0.00000 0.4000 0 0
|
||||
96.00 prop NA 0.50000 1.0000 0 0
|
||||
97.00 prop NA 0.50000 1.0000 0 0
|
||||
98.00 prop NA 0.00000 1.0000 0 0
|
||||
99.00 Pa NA 500.00000 1500.0000 0 0
|
||||
100.00 Pa NA 1500.00000 3500.0000 0 0
|
||||
101.00 prop 0 0.00000 0.1000 0 0
|
||||
102.00 prop 1 0.00000 0.1000 0 0
|
||||
103.00 prop NA 0.00000 0.1000 0 0
|
||||
104.00 Celsius NA 30.00000 40.0000 0 0
|
||||
105.00 Celsius NA 30.00000 50.0000 0 0
|
||||
106.00 prop NA 0.00000 0.1000 0 0
|
||||
107.00 prop NA 0.00000 0.1000 0 0
|
||||
108.00 prop NA 0.00000 0.1000 0 0
|
||||
109.00 n_day NA 0.00000 100.0000 0 0
|
||||
110.00 dimless NA 0.00000 1.0000 0 0
|
||||
113.00 kg/m2 NA 0.00000 20.0000 0 0
|
||||
114.00 Celsius 0 0.00000 50.0000 11 1
|
||||
115.00 Celsius 1 0.00000 100.0000 11 1
|
||||
116.00 Celsius 0 -5.00000 5.0000 12 1
|
||||
117.00 Celsius 1 0.00000 10.0000 12 1
|
||||
118.00 Pa 0 2000.00000 600.0000 13 1
|
||||
119.00 Pa 1 500.00000 1500.0000 13 1
|
||||
120.00 s 0 0.00000 0.0000 14 1
|
||||
121.00 s 1 0.00000 0.0000 14 1
|
||||
122.00 n_day NA 2.00000 20.0000 0 0
|
||||
123.00 dimless NA 0.00000 0.2000 0 0
|
||||
124.00 dimless NA 0.00000 0.1000 0 0
|
||||
128.60 Celsius NA 0.00000 10000.0000 0 0
|
||||
129.60 prop 1 0.00000 1.0000 15 -3
|
||||
130.60 prop 1 0.00000 1.0000 15 -3
|
||||
131.60 prop 1 0.00000 1.0000 15 -3
|
||||
132.60 prop 1 0.00000 1.0000 15 -3
|
||||
133.60 prop 1 0.00000 1.0000 15 -3
|
||||
134.60 prop 1 0.00000 1.0000 15 -3
|
||||
135.60 prop 1 0.00000 1.0000 15 -3
|
||||
136.60 prop 1 0.00000 1.0000 15 -3
|
||||
137.60 m2/kg NA 0.00000 2.0000 0 0
|
||||
138.60 prop NA 0.00000 0.0000 0 0
|
||||
139.60 Celsius NA 1.00000 20000.0000 0 0
|
||||
128.61 Celsius NA 0.00000 10000.0000 0 0
|
||||
129.61 prop 1 0.00000 1.0000 16 -3
|
||||
130.61 prop 1 0.00000 1.0000 16 -3
|
||||
131.61 prop 1 0.00000 1.0000 16 -3
|
||||
132.61 prop 1 0.00000 1.0000 16 -3
|
||||
133.61 prop 1 0.00000 1.0000 16 -3
|
||||
134.61 prop 1 0.00000 1.0000 16 -3
|
||||
135.61 prop 1 0.00000 1.0000 16 -3
|
||||
136.61 prop 1 0.00000 1.0000 16 -3
|
||||
137.61 m2/kg NA 0.00000 2.0000 0 0
|
||||
138.61 prop NA 0.00000 0.0000 0 0
|
||||
139.61 Celsius NA 1.00000 20000.0000 0 0
|
||||
128.62 Celsius NA 0.00000 10000.0000 0 0
|
||||
129.62 prop 1 0.00000 1.0000 17 -3
|
||||
130.62 prop 1 0.00000 1.0000 17 -3
|
||||
131.62 prop 1 0.00000 1.0000 17 -3
|
||||
132.62 prop 1 0.00000 1.0000 17 -3
|
||||
133.62 prop 1 0.00000 1.0000 17 -3
|
||||
134.62 prop 1 0.00000 1.0000 17 -3
|
||||
135.62 prop 1 0.00000 1.0000 17 -3
|
||||
136.62 prop 1 0.00000 1.0000 17 -3
|
||||
137.62 m2/kg NA 0.00000 2.0000 0 0
|
||||
138.62 prop NA 0.00000 0.0000 0 0
|
||||
139.62 Celsius NA 1.00000 20000.0000 0 0
|
||||
128.63 Celsius NA 0.00000 10000.0000 0 0
|
||||
129.63 prop 1 0.00000 1.0000 18 -3
|
||||
130.63 prop 1 0.00000 1.0000 18 -3
|
||||
131.63 prop 1 0.00000 1.0000 18 -3
|
||||
132.63 prop 1 0.00000 1.0000 18 -3
|
||||
133.63 prop 1 0.00000 1.0000 18 -3
|
||||
134.63 prop 1 0.00000 1.0000 18 -3
|
||||
135.63 prop 1 0.00000 1.0000 18 -3
|
||||
136.63 prop 1 0.00000 1.0000 18 -3
|
||||
137.63 m2/kg NA 0.00000 2.0000 0 0
|
||||
138.63 prop NA 0.00000 0.0000 0 0
|
||||
139.63 Celsius NA 1.00000 20000.0000 0 0
|
||||
128.64 Celsius NA 0.00000 10000.0000 0 0
|
||||
129.64 prop 1 0.00000 1.0000 19 -3
|
||||
130.64 prop 1 0.00000 1.0000 19 -3
|
||||
131.64 prop 1 0.00000 1.0000 19 -3
|
||||
132.64 prop 1 0.00000 1.0000 19 -3
|
||||
133.64 prop 1 0.00000 1.0000 19 -3
|
||||
134.64 prop 1 0.00000 1.0000 19 -3
|
||||
135.64 prop 1 0.00000 1.0000 19 -3
|
||||
136.64 prop 1 0.00000 1.0000 19 -3
|
||||
137.64 m2/kg NA 0.00000 2.0000 0 0
|
||||
138.64 prop NA 0.00000 0.0000 0 0
|
||||
139.64 Celsius NA 1.00000 20000.0000 0 0
|
||||
128.65 Celsius NA 0.00000 10000.0000 0 0
|
||||
129.65 prop 1 0.00000 1.0000 20 -3
|
||||
130.65 prop 1 0.00000 1.0000 20 -3
|
||||
131.65 prop 1 0.00000 1.0000 20 -3
|
||||
132.65 prop 1 0.00000 1.0000 20 -3
|
||||
133.65 prop 1 0.00000 1.0000 20 -3
|
||||
134.65 prop 1 0.00000 1.0000 20 -3
|
||||
135.65 prop 1 0.00000 1.0000 20 -3
|
||||
136.65 prop 1 0.00000 1.0000 20 -3
|
||||
137.65 m2/kg NA 0.00000 2.0000 0 0
|
||||
138.65 prop NA 0.00000 0.0000 0 0
|
||||
139.65 Celsius NA 1.00000 20000.0000 0 0
|
||||
128.66 Celsius NA 0.00000 10000.0000 0 0
|
||||
129.66 prop 1 0.00000 1.0000 21 -3
|
||||
130.66 prop 1 0.00000 1.0000 21 -3
|
||||
131.66 prop 1 0.00000 1.0000 21 -3
|
||||
132.66 prop 1 0.00000 1.0000 21 -3
|
||||
133.66 prop 1 0.00000 1.0000 21 -3
|
||||
134.66 prop 1 0.00000 1.0000 21 -3
|
||||
135.66 prop 1 0.00000 1.0000 21 -3
|
||||
136.66 prop 1 0.00000 1.0000 21 -3
|
||||
137.66 m2/kg NA 0.00000 2.0000 0 0
|
||||
138.66 prop NA 0.00000 0.0000 0 0
|
||||
139.66 Celsius NA 1.00000 20000.0000 0 0
|
||||
@ -1,4 +0,0 @@
|
||||
musoFilter <- function(text){
|
||||
eval(parse(paste0("filter(.,",text,")"))) %>%
|
||||
tbl_df
|
||||
}
|
||||
@ -1,72 +0,0 @@
|
||||
## #' musoGlue
|
||||
## #'
|
||||
## #' This ...
|
||||
## #' #' @author Roland Hollos
|
||||
## #' @param monteCarloFile If you run musoMonte function previously, you did not have to rerun the monteCarlo, just provide the preservedEpc.csv file with its path. If you do not set this parameter, musoSensi will fun the musoMonte function to get all of the information.
|
||||
## #' @param outputFile The filename in which the output of musoSensi function will be saved. It's default value is: "sensitivity.csv"
|
||||
## #' @param plotName The name of the output barplot. It's default value is: "sensitivity.jpg"
|
||||
## #' @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 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
|
||||
## #' @export
|
||||
|
||||
## musoGLUE <- function(monteCarloFile = NULL,
|
||||
## parameters = NULL,
|
||||
## settings = NULL,
|
||||
## inputDir = "./",
|
||||
## outLoc = "./calib",
|
||||
## filterCol=8,
|
||||
## filterFlag=1,
|
||||
## iterations = 30,
|
||||
## preTag = "mont-",
|
||||
## outputType = "moreCsv",
|
||||
## fun = mean,
|
||||
## varIndex = 1,
|
||||
## obsIndex =
|
||||
## outputFile = "sensitivity.csv",
|
||||
## plotName = "sensitivity.png",
|
||||
## plotTitle = "Sensitivity",
|
||||
## skipSpinup = FALSE,
|
||||
## dpi=300){
|
||||
|
||||
|
||||
## rmse <- function(modelled, observed){
|
||||
## (modelled-observed) %>%
|
||||
## (function(x) {x*x}) %>% # It is more clear than `^`(.,2) form, even it is longer
|
||||
## sum %>%
|
||||
## sqrt
|
||||
## }
|
||||
|
||||
|
||||
|
||||
## likelihoodNormal <- function(modelled, observed){
|
||||
## if (sd <= 0){
|
||||
## return(-Inf)
|
||||
## } else {
|
||||
## filtered <- observed[,filterCol]!=filterFlag
|
||||
|
||||
|
||||
## }
|
||||
|
||||
|
||||
## }
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
## }
|
||||
Loading…
Reference in New Issue
Block a user