spatial calibration
This commit is contained in:
Hollos Roland
parent
e3d447c5b1
commit
c178e76f2a
@ -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)
|
||||
|
||||
@ -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"))]]
|
||||
}
|
||||
|
||||
268
RBBGCMuso/R/flat.R
Normal file
268
RBBGCMuso/R/flat.R
Normal file
@ -0,0 +1,268 @@
|
||||
options(RMuso_depTree = read.csv("~/projects/RBBGCMuso/RBBGCMuso/inst/data/depTree.csv", stringsAsFactors = FALSE))
|
||||
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])
|
||||
}
|
||||
|
||||
|
||||
509
RBBGCMuso/R/multiSite.R
Normal file
509
RBBGCMuso/R/multiSite.R
Normal file
@ -0,0 +1,509 @@
|
||||
|
||||
|
||||
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))))
|
||||
})
|
||||
|
||||
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 for all selected parameters.
|
||||
#' @author Roland HOLLOS
|
||||
#' @importFrom future future
|
||||
#' @export
|
||||
multiSiteCalib <- function(measurements,
|
||||
calTable,
|
||||
parameters,
|
||||
dataVar,
|
||||
iterations = 100,
|
||||
likelihood,
|
||||
execPath,
|
||||
thread_prefix="thread",
|
||||
numCores = (parallel::detectCores()-1),
|
||||
pb = txtProgressBar(min=0, max=iterations, style=3),
|
||||
pbUpdate = setTxtProgressBar){
|
||||
|
||||
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))
|
||||
unlink("tmp",recursive=TRUE)
|
||||
|
||||
# ____ _ _ _ _
|
||||
# / ___|_ __ ___ __ _| |_ ___ | |_| |__ _ __ ___ __ _ __| |___
|
||||
# | | | '__/ _ \/ _` | __/ _ \ | __| '_ \| '__/ _ \/ _` |/ _` / __|
|
||||
# | |___| | | __/ (_| | || __/ | |_| | | | | | __/ (_| | (_| \__ \
|
||||
# \____|_| \___|\__,_|\__\___| \__|_| |_|_| \___|\__,_|\__,_|___/
|
||||
|
||||
|
||||
copyToThreadDirs2(iniSource=calTable$site_id, numCores=numCores, execPath=execPath)
|
||||
|
||||
# ____ _ _ _
|
||||
# | _ \ _ _ _ __ | |_| |__ _ __ ___ __ _ __| |___
|
||||
# | |_) | | | | '_ \ | __| '_ \| '__/ _ \/ _` |/ _` / __|
|
||||
# | _ <| |_| | | | | | |_| | | | | | __/ (_| | (_| \__ \
|
||||
# |_| \_\\__,_|_| |_| \__|_| |_|_| \___|\__,_|\__,_|___/
|
||||
|
||||
threadCount <- distributeCores(iterations, numCores)
|
||||
fut <- lapply(1:numCores, function(i) {
|
||||
# browser()
|
||||
future({
|
||||
tryCatch(
|
||||
|
||||
multiSiteThread(measuredData = measurements, parameters = parameters, calTable=calTable,
|
||||
dataVar = dataVar, iterations = threadCount[i],
|
||||
likelihood = likelihood, threadNumber= i)
|
||||
, error = function(e){
|
||||
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)
|
||||
}
|
||||
|
||||
# ____ _ _
|
||||
# / ___|___ _ __ ___ | |__ (_)_ __ ___
|
||||
# | | / _ \| '_ ` _ \| '_ \| | '_ \ / _ \
|
||||
# | |__| (_) | | | | | | |_) | | | | | __/
|
||||
# \____\___/|_| |_| |_|_.__/|_|_| |_|\___|
|
||||
|
||||
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"]]
|
||||
origModOut <- future::value(fut[[1]], stdout = FALSE, signal=FALSE)[["origModOut"]]
|
||||
# Just single objective version TODO:Multiobjective
|
||||
bestCase <- which.max(results[,ncol(results)-1])
|
||||
parameters <- results[bestCase,1:(ncol(results)-2)] # 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
|
||||
res[["comparison"]] <- compareCalibratedWithOriginal(key="grainDM", modOld=origModOut, modNew=aposteriori, mes=measurements,
|
||||
likelihoods=likelihood,
|
||||
alignIndexes=alignIndexes,
|
||||
musoCodeToIndex = musoCodeToIndex,
|
||||
nameGroupTable = nameGroupTable, mean)
|
||||
res[["likelihood"]] <- results[bestCase,ncol(results)-1]
|
||||
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)]
|
||||
res[["originalRMSE"]] <- sqrt(mean((comp[,1]-comp[,3])^2))
|
||||
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[C]~m^-2)),
|
||||
ylab=expression("simulated "~(kg[C]~m^-2)),
|
||||
cex.lab=1.3,
|
||||
pty="s"
|
||||
)
|
||||
points(measured,calibrated,pch=20)
|
||||
abline(0,1)
|
||||
legend(x="top",
|
||||
pch=c(1,19),
|
||||
inset=c(0,-0.1),
|
||||
legend=c("original","calibrated"),
|
||||
ncol=2,
|
||||
box.lty=0,
|
||||
xpd=TRUE
|
||||
)
|
||||
})
|
||||
dev.off()
|
||||
return(res)
|
||||
}
|
||||
|
||||
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,
|
||||
naVal = NULL, postProcString = NULL, threadNumber) {
|
||||
|
||||
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)
|
||||
if(iterations < 3000){
|
||||
randVals <- musoRand(parameters = parameters,constrains = NULL, iterations = 3000)
|
||||
randVals[[2]]<- randVals[[2]][sample(1:3000,iterations),]
|
||||
} else {
|
||||
randVals <- musoRand(parameters = parameters,constrains = NULL, iterations = iterations)
|
||||
}
|
||||
|
||||
origEpc <- readValuesFromFile(epcFile, randVals[[1]])
|
||||
partialResult <- matrix(ncol=length(randVals[[1]])+2*length(dataVar))
|
||||
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)))
|
||||
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, mean)
|
||||
|
||||
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)){
|
||||
# browser()
|
||||
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, mean)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
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)
|
||||
}
|
||||
}
|
||||
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){
|
||||
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,]
|
||||
|
||||
# measured <- measured[!is.na(measured)]
|
||||
res <- c(likelihoods[[key]](modelled, measured),
|
||||
sqrt(mean((modelled-measured$mean)^2))
|
||||
)
|
||||
print(abs(mean(modelled)-mean(measured$mean)))
|
||||
# browser()
|
||||
res
|
||||
})
|
||||
names(likelihoodRMSE) <- c(sprintf("%s_likelihood",dataVar), sprintf("%s_rmse",dataVar))
|
||||
return(c(likelihoodRMSE[1,],likelihoodRMSE[2,]))
|
||||
}
|
||||
|
||||
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))
|
||||
}
|
||||
|
||||
# plotDiff(key="grainDM",
|
||||
# modOld=origModOut,
|
||||
# modNew=tmp,
|
||||
# # mes=measuredData,
|
||||
# mes=mes,
|
||||
# likelihoods=likelihood,
|
||||
# alignIndexes=alignIndexes,
|
||||
# musoCodeToIndex = musoCodeToIndex,nameGroupTable = nameGroupTable, mean)
|
||||
#
|
||||
#
|
||||
# comp <- compareCalibratedWithOriginal(key="grainDM",
|
||||
# modOld=origModOut,
|
||||
# modNew=tmp,
|
||||
# # mes=measuredData,
|
||||
# mes=mes,
|
||||
# likelihoods=likelihood,
|
||||
# alignIndexes=alignIndexes,
|
||||
# musoCodeToIndex = musoCodeToIndex,nameGroupTable = nameGroupTable, mean)
|
||||
#
|
||||
#
|
||||
#
|
||||
#
|
||||
#
|
||||
# plotDiff <- function(key, modOld, modNew, mes,
|
||||
# likelihoods, alignIndexes, musoCodeToIndex, nameGroupTable,
|
||||
# groupFun){
|
||||
# compme <- compareCalibratedWithOriginal(key,modOld,modNew,mes,
|
||||
# likelihoods,alignIndexes,musoCodeToIndex,nameGroupTable,groupFun)
|
||||
#
|
||||
# with(data=compme, {
|
||||
# plot(measured,original,ylim=c(min(measured),max(measured)))
|
||||
# points(measured,calibrated,pch=20)
|
||||
# abline(0,1)
|
||||
# })}
|
||||
#
|
||||
# likelihood <- list(grainDM=function(x,y){exp(-1./2.*sqrt(mean((x-y$mean)^2.)))})
|
||||
# likelihood <- list(grainDM=agroLikelihood)
|
||||
|
||||
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
|
||||
}
|
||||
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"
|
||||
|
@ -866,8 +866,8 @@
|
||||
"MIN": 0,
|
||||
"MAX": 0.1,
|
||||
"DEPENDENCE": 0,
|
||||
"GROUP": 22,
|
||||
"TYPE": 1
|
||||
"GROUP": 0,
|
||||
"TYPE": 0
|
||||
},
|
||||
{
|
||||
"X": 85,
|
||||
@ -877,8 +877,8 @@
|
||||
"MIN": 0,
|
||||
"MAX": 0.1,
|
||||
"DEPENDENCE": 1,
|
||||
"GROUP": 22,
|
||||
"TYPE": 1
|
||||
"GROUP": 0,
|
||||
"TYPE": 0
|
||||
},
|
||||
{
|
||||
"X": 86,
|
||||
|
||||
@ -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
|
||||
}
|
||||
26
RBBGCMuso/man/multiSiteCalib.Rd
Normal file
26
RBBGCMuso/man/multiSiteCalib.Rd
Normal file
@ -0,0 +1,26 @@
|
||||
% 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,
|
||||
likelihood,
|
||||
execPath,
|
||||
thread_prefix = "thread",
|
||||
numCores = (parallel::detectCores() - 1),
|
||||
pb = txtProgressBar(min = 0, max = iterations, style = 3),
|
||||
pbUpdate = setTxtProgressBar
|
||||
)
|
||||
}
|
||||
\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 for all selected parameters.
|
||||
}
|
||||
\author{
|
||||
Roland HOLLOS
|
||||
}
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user