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

fixing calibration bug

Browse Source
This commit is contained in:
Hollos Roland 2023-06-20 15:13:41 +02:00
parent 47b9a0eb09
commit 26db1a93fd
1 changed files with 9 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
RBBGCMuso/R/calibrateMuso.R
View File

@ -45,6 +45,7 @@ calibrateMuso <- function(measuredData, parameters =read.csv("parameters.csv", s
future({ future({
tryCatch( tryCatch(
musoSingleThread(measuredData, parameters, startDate, musoSingleThread(measuredData, parameters, startDate,
sourceFile=settings$epc[2], # EPC SPECIFIC
endDate, formatString, endDate, formatString,
dataVar, outLoc, dataVar, outLoc,
preTag, settings, preTag, settings,
@ -53,6 +54,7 @@ calibrateMuso <- function(measuredData, parameters =read.csv("parameters.csv", s
modifyOriginal, likelihood, uncertainity, modifyOriginal, likelihood, uncertainity,
naVal, postProcString, i) naVal, postProcString, i)
, error = function(e){ , error = function(e){
# browser()
writeLines(as.character(iterations),"progress.txt") writeLines(as.character(iterations),"progress.txt")
}) })
@ -130,7 +132,12 @@ calibrateMuso <- function(measuredData, parameters =read.csv("parameters.csv", s
musoGlue(results, parameters=parameters,settings=settings, w=w, lg=lg) musoGlue(results, parameters=parameters,settings=settings, w=w, lg=lg)
liks <- results[,sprintf("%s_likelihood",names(likelihood))] liks <- results[,sprintf("%s_likelihood",names(likelihood))]
epcIndexes <- future::value(fut[[1]], stdout = FALSE, signal=FALSE) epcIndexes <- future::value(fut[[1]], stdout = FALSE, signal=FALSE)
epcVals <- results[which.max(liks),1:length(epcIndexes)] if(ncol(liks) == 1){
ml_place <- which.max(liks)
} else {
ml_place <- which.max(as.matrix(liks) %*% as.matrix(w))
}
epcVals <- results[ml_place,1:length(epcIndexes)]
epcPlace <- file.path(dirname(settings$inputFiles),settings$epc)[2] epcPlace <- file.path(dirname(settings$inputFiles),settings$epc)[2]
changemulline(filePaths= epcPlace, epcIndexes, changemulline(filePaths= epcPlace, epcIndexes,
epcVals, src =epcPlace,# settings$epcInput[2], epcVals, src =epcPlace,# settings$epcInput[2],
@ -183,6 +190,7 @@ copyToThreadDirs <- function(prefix="thread", numcores=parallel::detectCores()-1
} }
musoSingleThread <- function(measuredData, parameters = NULL, startDate = NULL, musoSingleThread <- function(measuredData, parameters = NULL, startDate = NULL,
sourceFile=NULL,
endDate = NULL, formatString = "%Y-%m-%d", endDate = NULL, formatString = "%Y-%m-%d",
dataVar, outLoc = "./calib", dataVar, outLoc = "./calib",
preTag = "cal-", settings = setupMuso(), preTag = "cal-", settings = setupMuso(),