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

filepath bug in calibration

Browse Source
This commit is contained in:
Hollos Roland 2020-09-28 07:02:39 +02:00
parent 33abd4dff3
commit aff72cc6e8
1 changed files with 9 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
RBBGCMuso/R/calibrateMuso.R
View File

@ -14,7 +14,7 @@ calibrateMuso <- function(measuredData, parameters = NULL, startDate = NULL,
naVal = NULL, postProcString = NULL, naVal = NULL, postProcString = NULL,
thread_prefix="thread", numCores = (parallel::detectCores()-1), pb = txtProgressBar(min=0, max=iterations, style=3), thread_prefix="thread", numCores = (parallel::detectCores()-1), pb = txtProgressBar(min=0, max=iterations, style=3),
maxLikelihoodEpc=TRUE, maxLikelihoodEpc=TRUE,
pbUpdate = setTxtProgressBar, method="GLUE",lg = FALSE, w=NULL, ...){ pbUpdate = setTxtProgressBar, outputLoc="./", method="GLUE",lg = FALSE, w=NULL, ...){
future::plan(future::multisession) future::plan(future::multisession)
file.remove(list.files(path = settings$inputLoc, pattern="progress.txt", recursive = TRUE, full.names=TRUE)) file.remove(list.files(path = settings$inputLoc, pattern="progress.txt", recursive = TRUE, full.names=TRUE))
@ -42,14 +42,16 @@ calibrateMuso <- function(measuredData, parameters = NULL, startDate = NULL,
fut <- lapply(1:numCores, function(i) { fut <- lapply(1:numCores, function(i) {
# browser() # browser()
future({ future({
tryCatch(musoSingleThread(measuredData, parameters, startDate, tryCatch(
musoSingleThread(measuredData, parameters, startDate,
endDate, formatString, endDate, formatString,
dataVar, outLoc, dataVar, outLoc,
preTag, settings, preTag, settings,
outVars, iterations = threadCount[i], outVars, iterations = threadCount[i],
skipSpinup, plotName, skipSpinup, plotName,
modifyOriginal, likelihood, uncertainity, modifyOriginal, likelihood, uncertainity,
naVal, postProcString, i), error = function(e){ naVal, postProcString, i)
, error = function(e){
writeLines(as.character(iterations),"progress.txt") writeLines(as.character(iterations),"progress.txt")
}) })
@ -109,7 +111,6 @@ calibrateMuso <- function(measuredData, parameters = NULL, startDate = NULL,
# | | / _ \| '_ ` _ \| '_ \| | '_ \ / _ \ # | | / _ \| '_ ` _ \| '_ \| | '_ \ / _ \
# | |__| (_) | | | | | | |_) | | | | | __/ # | |__| (_) | | | | | | |_) | | | | | __/
# \____\___/|_| |_| |_|_.__/|_|_| |_|\___| # \____\___/|_| |_| |_|_.__/|_|_| |_|\___|
resultFiles <- list.files(pattern="preservedCalib.*csv$",recursive=TRUE) resultFiles <- list.files(pattern="preservedCalib.*csv$",recursive=TRUE)
res0 <- read.csv(grep("thread_1/",resultFiles, value=TRUE),stringsAsFactors=FALSE) res0 <- read.csv(grep("thread_1/",resultFiles, value=TRUE),stringsAsFactors=FALSE)
resultFilesSans0 <- grep("thread_1/", resultFiles, value=TRUE, invert=TRUE) resultFilesSans0 <- grep("thread_1/", resultFiles, value=TRUE, invert=TRUE)
@ -129,8 +130,8 @@ calibrateMuso <- function(measuredData, parameters = NULL, startDate = NULL,
epcVals <- results[which.max(liks),1:length(epcIndexes)] epcVals <- results[which.max(liks),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 = settings$epcInput[2], epcVals, src =epcPlace,# settings$epcInput[2],
outFiles = "maxLikelihood_epc.epc") outFiles = file.path(outputLoc, "maxLikelihood_epc.epc"))
names(epcVals) <- epcIndexes names(epcVals) <- epcIndexes
xdate <- as.Date(measuredData$date) xdate <- as.Date(measuredData$date)
meanM <- measuredData[,sprintf("mean.%s", names(likelihood))] meanM <- measuredData[,sprintf("mean.%s", names(likelihood))]
@ -156,19 +157,6 @@ calibrateMuso <- function(measuredData, parameters = NULL, startDate = NULL,
}, },
stop(sprintf("method: %s not found, please choose from {GLUE, agromo}. See more about this in the documentation of the function!", method)) stop(sprintf("method: %s not found, please choose from {GLUE, agromo}. See more about this in the documentation of the function!", method))
) )
# Here starts maxLikelihoodAgroMo: parameters
# Here ends maxLikelihoodAgromo
# return(epcVals)
# ____ _ _ _ _____
# / ___| | | | | | ____|
# | | _| | | | | | _|
# | |_| | |__| |_| | |___
# \____|_____\___/|_____|
# musoGlue("preservedCalib.csv",w=w, lg = lg)
} }
copyToThreadDirs <- function(prefix="thread", numcores=parallel::detectCores()-1, runDir="."){ copyToThreadDirs <- function(prefix="thread", numcores=parallel::detectCores()-1, runDir="."){
@ -195,6 +183,7 @@ musoSingleThread <- function(measuredData, parameters = NULL, startDate = NULL,
if(length(iniFiles)==1){ if(length(iniFiles)==1){
iniFiles <- rep(iniFiles, 2) iniFiles <- rep(iniFiles, 2)
} }
iniFiles <- iniFiles[1:2]
settings <- setupMuso(iniInput = iniFiles) settings <- setupMuso(iniInput = iniFiles)
# Exanding likelihood # Exanding likelihood
likelihoodFull <- as.list(rep(NA,length(dataVar))) likelihoodFull <- as.list(rep(NA,length(dataVar)))
@ -305,7 +294,6 @@ musoSingleThread <- function(measuredData, parameters = NULL, startDate = NULL,
for(i in 2:(iterations+1)){ for(i in 2:(iterations+1)){
tmp <- tryCatch(calibMuso(settings = settings, tmp <- tryCatch(calibMuso(settings = settings,
parameters = randValues[(i-1),], parameters = randValues[(i-1),],
silent= TRUE, silent= TRUE,
@ -321,7 +309,6 @@ musoSingleThread <- function(measuredData, parameters = NULL, startDate = NULL,
musoCodeToIndex = musoCodeToIndex, uncert = uncert) musoCodeToIndex = musoCodeToIndex, uncert = uncert)
} }
partialResult[1:numParameters] <- randValues[(i-1),] partialResult[1:numParameters] <- randValues[(i-1),]
write.table(x=partialResult, file="preservedCalib.csv", append=TRUE, row.names=FALSE, write.table(x=partialResult, file="preservedCalib.csv", append=TRUE, row.names=FALSE,
sep=",", col.names=FALSE) sep=",", col.names=FALSE)
@ -356,7 +343,7 @@ calcLikelihoodsAndRMSE <- function(dataVar, mod, mes, likelihoods, alignIndexes,
# NOT COMPATIBLE WITH OLD MEASUREMENT DATA, mes have to be a matrix # NOT COMPATIBLE WITH OLD MEASUREMENT DATA, mes have to be a matrix
likelihoodRMSE <- sapply(names(dataVar),function(key){ likelihoodRMSE <- sapply(names(dataVar),function(key){
# browser() # browser()
modelled <- mod[alignIndexes$mod,musoCodeToIndex[key]] modelled <- mod[alignIndexes$mod,musoCodeToIndex[key]]
selected <- grep(sprintf("%s$", key), colnames(mes)) selected <- grep(sprintf("%s$", key), colnames(mes))
# browser() # browser()