progression toward the new data format
This commit is contained in:
parent
c73d397dbe
commit
f677995038
@ -109,65 +109,19 @@ calibMuso <- function(settings=setupMuso(), calibrationPar=NULL,
|
|||||||
cleanupMuso(location = outputLoc,deep = TRUE)
|
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
|
##change the epc file if and only if there are given parameters
|
||||||
|
|
||||||
if(!is.null(parameters)){
|
if(!is.null(parameters)){
|
||||||
changemulline(filePaths = sourceFiles,
|
changemulline(filePaths = epcInput,
|
||||||
calibrationPar = calibrationPar,
|
calibrationPar = calibrationPar,
|
||||||
contents = parameters,
|
contents = parameters,
|
||||||
fileOut = toModif,
|
fileOut = toModif,
|
||||||
fileToChange = fileToChange,
|
# fileToChange = fileToChange,)
|
||||||
modifyOriginal = modifyOriginal)
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
##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.
|
##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) {
|
if(!skipSpinup) {
|
||||||
|
|
||||||
|
|||||||
@ -32,7 +32,7 @@ optiMuso <- function(measuredData, parameters = NULL, startDate = NULL,
|
|||||||
preTag = "cal-", settings = setupMuso(),
|
preTag = "cal-", settings = setupMuso(),
|
||||||
outVars = NULL, iterations = 30,
|
outVars = NULL, iterations = 30,
|
||||||
skipSpinup = TRUE, plotName = "calib.jpg",
|
skipSpinup = TRUE, plotName = "calib.jpg",
|
||||||
modifyOriginal=TRUE, likelihood,
|
modifyOriginal=TRUE, likelihood, uncertainity,
|
||||||
naVal = NULL, postProcString = NULL, w=NULL) {
|
naVal = NULL, postProcString = NULL, w=NULL) {
|
||||||
# Exanding likelihood
|
# Exanding likelihood
|
||||||
likelihoodFull <- as.list(rep(NA,length(dataVar)))
|
likelihoodFull <- as.list(rep(NA,length(dataVar)))
|
||||||
@ -117,14 +117,16 @@ optiMuso <- function(measuredData, parameters = NULL, startDate = NULL,
|
|||||||
}
|
}
|
||||||
|
|
||||||
alignIndexes <- alignMuso(settings,measuredData)
|
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)
|
origModellOut <- calibMuso(settings=settings, silent=TRUE, skipSpinup = skipSpinup, postProcString=postProcString, modifyOriginal=modifyOriginal)
|
||||||
partialResult[,resultRange] <- calcLikelihoodsAndRMSE(dataVar=dataVar,
|
partialResult[,resultRange] <- calcLikelihoodsAndRMSE(dataVar=dataVar,
|
||||||
mod=origModellOut,
|
mod=origModellOut,
|
||||||
mes=measuredData,
|
mes=measuredData,
|
||||||
likelihoods=likelihood,
|
likelihoods=likelihood,
|
||||||
alignIndexes=alignIndexes,
|
alignIndexes=alignIndexes,
|
||||||
musoCodeToIndex = musoCodeToIndex)
|
musoCodeToIndex = musoCodeToIndex,uncert=uncert)
|
||||||
write.csv(x=origModellOut, file=paste0(pretag, 1, ".csv"))
|
write.csv(x=origModellOut, file=paste0(pretag, 1, ".csv"))
|
||||||
print("Running the model with the random epc values...", quote = FALSE)
|
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)
|
write.csv(x=partialResult, file="preservedCalib.csv",row.names=FALSE)
|
||||||
for(i in 2:(iterations+1)){
|
for(i in 2:(iterations+1)){
|
||||||
|
browser()
|
||||||
tmp <- tryCatch(calibMuso(settings = settings,
|
tmp <- tryCatch(calibMuso(settings = settings,
|
||||||
parameters = randValues[(i-1),],
|
parameters = randValues[(i-1),],
|
||||||
silent= TRUE,
|
silent= TRUE,
|
||||||
@ -146,7 +149,7 @@ optiMuso <- function(measuredData, parameters = NULL, startDate = NULL,
|
|||||||
mes=measuredData,
|
mes=measuredData,
|
||||||
likelihoods=likelihood,
|
likelihoods=likelihood,
|
||||||
alignIndexes=alignIndexes,
|
alignIndexes=alignIndexes,
|
||||||
musoCodeToIndex = musoCodeToIndex)
|
musoCodeToIndex = musoCodeToIndex, uncert = uncert)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
@ -181,14 +184,14 @@ alignMuso <- function (settings,measuredData) {
|
|||||||
cbind.data.frame(model=modIndex,meas=measIndex)
|
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){
|
likelihoodRMSE <- sapply(names(dataVar),function(key){
|
||||||
modelled <- mod[alignIndexes$mod,musoCodeToIndex[key]]
|
modelled <- mod[alignIndexes$mod,musoCodeToIndex[key]]
|
||||||
measured <- mes[alignIndexes$meas,key]
|
measured <- mes[alignIndexes$meas,key]
|
||||||
modelled <- modelled[!is.na(measured)]
|
modelled <- modelled[!is.na(measured)]
|
||||||
measured <- measured[!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))
|
sqrt(mean((modelled-measured)^2))
|
||||||
)
|
)
|
||||||
res
|
res
|
||||||
@ -268,4 +271,3 @@ generateOptEpc <- function(optRanges,delta, maxLikelihood=FALSE){
|
|||||||
}
|
}
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user