Merge branch 'feature/modifyinput'
This commit is contained in:
Hollos Roland
commit
ea788d0083
@ -109,65 +109,23 @@ 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 = epc[2],
|
||||
calibrationPar = calibrationPar,
|
||||
contents = parameters,
|
||||
fileOut = toModif,
|
||||
fileToChange = fileToChange,
|
||||
modifyOriginal = modifyOriginal)
|
||||
src = if(file.exists(bck)){
|
||||
bck
|
||||
} else {
|
||||
NULL
|
||||
})
|
||||
# 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) {
|
||||
|
||||
|
||||
@ -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){
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
@ -7,45 +7,30 @@
|
||||
#' @keywords internal
|
||||
#'
|
||||
|
||||
changemulline <- function(filePaths, calibrationPar, contents, fileOut, fileToChange, modifyOriginal=FALSE){
|
||||
selectFileToWrite <- function(filePaths, fileTochange){
|
||||
if(fileToChange == "epc"){
|
||||
return(1)
|
||||
} else{
|
||||
return(2)
|
||||
}
|
||||
|
||||
changemulline <- function(filePaths, calibrationPar, contents, src){
|
||||
# browser()
|
||||
if(is.null(src)){
|
||||
src <- filePaths
|
||||
}
|
||||
|
||||
if(xor(is.list(calibrationPar), is.list(contents)) ){
|
||||
stop("If you change epc and ini files also, you have to use list for calibrationPar, and paramateters.")
|
||||
}
|
||||
|
||||
if(!is.element(fileToChange,c("ini","epc","both"))){
|
||||
stop("RBBGCMuso can only change ini or epc file, so fileToChange can be 'epc/ini/both'")
|
||||
}
|
||||
fileStringVector <- readLines(src)
|
||||
Map(function(index, content){
|
||||
fileStringVector <<- changeByIndex(index, content, fileStringVector)
|
||||
|
||||
if(fileToChange == "epc" | fileToChange == "ini"){
|
||||
parMat<-matrix(c(calibrationPar, contents),nrow=length(calibrationPar))
|
||||
if(nrow(parMat)!=1){
|
||||
parMat <- parMat[order(parMat[,1]),]
|
||||
}
|
||||
changeMusoC(inFile = filePaths[selectFileToWrite(filePaths, fileToChange)],
|
||||
outFile = fileOut[selectFileToWrite(filePaths, fileToChange)],
|
||||
parMat)
|
||||
}
|
||||
}, calibrationPar, contents)
|
||||
writeLines(fileStringVector, filePaths)
|
||||
|
||||
if(fileToChange == "both"){
|
||||
parMat[[1]]<-cbind(calibrationPar[[1]], contents[[1]])
|
||||
parMat[[1]]<- parMat[[1]][order(parMat[[1]][,1]),]
|
||||
parMat[[2]]<-cbind(calibrationPar[[2]], contents[[2]])
|
||||
parmat[[2]]<- parMat[[2]][order(parMat[[2]][,1]),]
|
||||
|
||||
browser()
|
||||
changeMusoC(filePaths[1],fileOut[1],parMat[[1]] )
|
||||
changeMusoC(filePaths[2],fileOut[2],parMat[[2]] )
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
changeNth <- function (string,place,replacement) {
|
||||
trimws(gsub(sprintf("^((.*?\\s+){%s})(.*?\\s+)", place), sprintf("\\1%s ", replacement), paste0(string," "), perl=TRUE),
|
||||
which="right")
|
||||
}
|
||||
|
||||
changeByIndex <- function (rowIndex, parameter, fileStringVector){
|
||||
h <- round((rowIndex*100) %% 10)
|
||||
i <- as.integer(rowIndex)
|
||||
fileStringVector[i] <- changeNth(fileStringVector[i], h, parameter)
|
||||
fileStringVector
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user