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

varfix

Browse Source
This commit is contained in:
Hollos Roland 2022-05-11 18:18:24 +02:00
parent 0d9e2fe557
commit 6e5d96fe4e
1 changed files with 16 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
RBBGCMuso/R/multiSite.R
View File

@ -171,10 +171,11 @@ multiSiteCalib <- function(measurements,
multiSiteThread(measuredData = measurements, parameters = parameters, calTable=calTable, multiSiteThread(measuredData = measurements, parameters = parameters, calTable=calTable,
dataVar = dataVar, iterations = threadCount[i], dataVar = dataVar, iterations = threadCount[i],
likelihood = likelihood, threadNumber= i, constraints=constraints, th=th) likelihood = likelihood, threadNumber= i, constraints=constraints, th=th)
# setwd("../") ##setwd("../")
} }
, error = function(e){ , error = function(e){
saveRDS(e,"error.RDS") saveRDS(e,"error.RDS")
writeLines(as.character(iterations),"progress.txt") writeLines(as.character(iterations),"progress.txt")
}) })
@ -226,6 +227,7 @@ multiSiteCalib <- function(measurements,
# | | / _ \| '_ ` _ \| '_ \| | '_ \ / _ \ # | | / _ \| '_ ` _ \| '_ \| | '_ \ / _ \
# | |__| (_) | | | | | | |_) | | | | | __/ # | |__| (_) | | | | | | |_) | | | | | __/
# \____\___/|_| |_| |_|_.__/|_|_| |_|\___| # \____\___/|_| |_| |_|_.__/|_|_| |_|\___|
if(!is.null(constraints)){ if(!is.null(constraints)){
constRes <- file.path(list.dirs("tmp", recursive=FALSE), "const_results.data") constRes <- file.path(list.dirs("tmp", recursive=FALSE), "const_results.data")
constRes <- lapply(constRes, function(f){read.csv(f, stringsAsFactors=FALSE, header=FALSE)}) constRes <- lapply(constRes, function(f){read.csv(f, stringsAsFactors=FALSE, header=FALSE)})
@ -248,12 +250,17 @@ multiSiteCalib <- function(measurements,
treeData <- results[,-notForTree] treeData <- results[,-notForTree]
treeData["failType"] <- as.factor(results$failType) treeData["failType"] <- as.factor(results$failType)
if(ncol(treeData) > 4){ if(ncol(treeData) > 4){
tryCatch({
rp <- rpart(failType ~ .,data=treeData,control=treeControl) rp <- rpart(failType ~ .,data=treeData,control=treeControl)
svg("treeplot.svg") svg("treeplot.svg")
tryCatch(rpart.plot(rp), error = function(e){ rpart.plot(rp)
dev.off()
}
, error = function(e){
print(e) print(e)
}) })
dev.off()
} }
} }
origModOut <- future::value(fut[[1]], stdout = FALSE, signal=FALSE)[["origModOut"]] origModOut <- future::value(fut[[1]], stdout = FALSE, signal=FALSE)[["origModOut"]]
@ -285,9 +292,11 @@ multiSiteCalib <- function(measurements,
nameGroupTable <- calTable nameGroupTable <- calTable
nameGroupTable[,1] <- tools::file_path_sans_ext(basename(nameGroupTable[,1])) nameGroupTable[,1] <- tools::file_path_sans_ext(basename(nameGroupTable[,1]))
res <- list() res <- list()
res[["calibrationPar"]] <- calibrationPar res[["calibrationPar"]] <- calibrationPar
res[["parameters"]] <- parameters res[["parameters"]] <- parameters
res[["comparison"]] <- compareCalibratedWithOriginal(key = "grainDM", modOld=origModOut, modNew=aposteriori, mes=measurements, # browser()
res[["comparison"]] <- compareCalibratedWithOriginal(key = names(dataVar)[1], modOld=origModOut, modNew=aposteriori, mes=measurements,
likelihoods = likelihood, likelihoods = likelihood,
alignIndexes = alignIndexes, alignIndexes = alignIndexes,
musoCodeToIndex = musoCodeToIndex, musoCodeToIndex = musoCodeToIndex,