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

progression toward the new data format

Browse Source
This commit is contained in:
Hollos Roland 2020-06-02 20:45:07 +02:00
parent c73d397dbe
commit f677995038
2 changed files with 16 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
RBBGCMuso/R/calibMuso.R
View File

@ -109,65 +109,19 @@ calibMuso <- function(settings=setupMuso(), calibrationPar=NULL,
cleanupMuso(location = outputLoc,deep = TRUE)
}
toModif <- c(epc[2],iniInput[2])
names(toModif) <- c("epc","ini")
# if(!modifyOriginal & (!is.null(parameters) | !is.null(outVars)))
# {
toModif <- sapply(toModif, function (x){
paste0(tools::file_path_sans_ext(basename(x)),
"-tmp.",
tools::file_ext(x))
})
# }
origsourceFiles <- sourceFiles <- c(epc=epc[2], ini=iniInput[2])
names(origsourceFiles) <- names(sourceFiles) <- c("epc","ini")
if(file.exists(bck)){
sourceFiles[fileToChange] <- bck
}
##change the epc file if and only if there are given parameters
if(!is.null(parameters)){
changemulline(filePaths = sourceFiles,
changemulline(filePaths = epcInput,
calibrationPar = calibrationPar,
contents = parameters,
fileOut = toModif,
fileToChange = fileToChange,
modifyOriginal = modifyOriginal)
# fileToChange = fileToChange,)
}
##We change the working directory becase of the model, but we want to avoid sideeffects, so we save the current location and after that we will change everything to it.
if(!modifyOriginal & (!is.null(parameters) | !is.null(outVars))){
epc[2]<-file.path(dirname(epc[2]),toModif[1]) # Writing back the lost path
toModif[2]<-file.path(dirname(iniInput[2]),toModif[2]) #for the Initmp, also
if((!is.null(outVars) | !file.exists(toModif[2])) & !modifyOriginal){
file.copy(iniInput[2],toModif[2],overwrite = TRUE)
}
iniInput[2] <- toModif[2]}
if(!is.null(parameters) & ((fileToChange == "epc") | (fileToChange == "both")) & !modifyOriginal){
tmp<-readLines(iniInput[2])
tmpInd<-grep("EPC_FILE",tmp)+1
tmp[tmpInd]<-file.path(dirname(tmp[tmpInd]),basename(epc[2]))
writeLines(tmp,iniInput[2])
rm(list=c("tmp","tmpInd"))
}
if(!is.null(outVars)){
outputVarChanges <- putOutVars(iniInput[2], outputVars = outVars, modifyOriginal = !modifyOriginal)
settings$outputVars[[1]]<-outputVarChanges[[1]]
settings$numData <- round(settings$numData*outputVarChanges[[2]])
if(modifyOriginal){
iniInput[2] <- toModif[2]
}
}
if(modifyOriginal && (!is.null(parameters) || !is.null(outVars))){
file.copy(toModif[fileToChange], origsourceFiles[fileToChange], overwrite = TRUE)
}
if(!skipSpinup) {

24
RBBGCMuso/R/calibration.R
View File

@ -32,7 +32,7 @@ optiMuso <- function(measuredData, parameters = NULL, startDate = NULL,
preTag = "cal-", settings = setupMuso(),
outVars = NULL, iterations = 30,
skipSpinup = TRUE, plotName = "calib.jpg",
modifyOriginal=TRUE, likelihood,
modifyOriginal=TRUE, likelihood, uncertainity,
naVal = NULL, postProcString = NULL, w=NULL) {
# Exanding likelihood
likelihoodFull <- as.list(rep(NA,length(dataVar)))
@ -117,14 +117,16 @@ optiMuso <- function(measuredData, parameters = NULL, startDate = NULL,
}
alignIndexes <- alignMuso(settings,measuredData)
if(!is.null(uncertainity)){
uncert <- measuredData[alignIndexes$measIndex,uncertainity]
}
origModellOut <- calibMuso(settings=settings, silent=TRUE, skipSpinup = skipSpinup, postProcString=postProcString, modifyOriginal=modifyOriginal)
partialResult[,resultRange] <- calcLikelihoodsAndRMSE(dataVar=dataVar,
mod=origModellOut,
mes=measuredData,
likelihoods=likelihood,
alignIndexes=alignIndexes,
musoCodeToIndex = musoCodeToIndex)
musoCodeToIndex = musoCodeToIndex,uncert=uncert)
write.csv(x=origModellOut, file=paste0(pretag, 1, ".csv"))
print("Running the model with the random epc values...", quote = FALSE)
@ -134,6 +136,7 @@ optiMuso <- function(measuredData, parameters = NULL, startDate = NULL,
write.csv(x=partialResult, file="preservedCalib.csv",row.names=FALSE)
for(i in 2:(iterations+1)){
browser()
tmp <- tryCatch(calibMuso(settings = settings,
parameters = randValues[(i-1),],
silent= TRUE,
@ -146,7 +149,7 @@ optiMuso <- function(measuredData, parameters = NULL, startDate = NULL,
mes=measuredData,
likelihoods=likelihood,
alignIndexes=alignIndexes,
musoCodeToIndex = musoCodeToIndex)
musoCodeToIndex = musoCodeToIndex, uncert = uncert)
}
@ -166,10 +169,10 @@ optiMuso <- function(measuredData, parameters = NULL, startDate = NULL,
alignMuso <- 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)
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)
measuredDates <- apply(measuredData,1,function(xrow){
sprintf("%s-%s-%s",xrow[1],xrow[2],xrow[3])
@ -181,14 +184,14 @@ alignMuso <- function (settings,measuredData) {
cbind.data.frame(model=modIndex,meas=measIndex)
}
calcLikelihoodsAndRMSE <- function(dataVar, mod, mes, likelihoods, alignIndexes, musoCodeToIndex){
calcLikelihoodsAndRMSE <- function(dataVar, mod, mes, likelihoods, alignIndexes, musoCodeToIndex, uncert){
likelihoodRMSE <- sapply(names(dataVar),function(key){
modelled <- mod[alignIndexes$mod,musoCodeToIndex[key]]
measured <- mes[alignIndexes$meas,key]
modelled <- modelled[!is.na(measured)]
measured <- measured[!is.na(measured)]
res <- c(likelihoods[[key]](modelled,measured),
res <- c(likelihoods[[key]](modelled, measured, uncert),
sqrt(mean((modelled-measured)^2))
)
res
@ -268,4 +271,3 @@ generateOptEpc <- function(optRanges,delta, maxLikelihood=FALSE){
}
}