From f677995038aca5d42f1a85e386ebd2f74dcf4633 Mon Sep 17 00:00:00 2001 From: Hollos Roland Date: Tue, 2 Jun 2020 20:45:07 +0200 Subject: [PATCH 1/2] progression toward the new data format --- RBBGCMuso/R/calibMuso.R | 52 +++------------------------------------ RBBGCMuso/R/calibration.R | 24 +++++++++--------- 2 files changed, 16 insertions(+), 60 deletions(-) diff --git a/RBBGCMuso/R/calibMuso.R b/RBBGCMuso/R/calibMuso.R index 73264c2..aa086dd 100644 --- a/RBBGCMuso/R/calibMuso.R +++ b/RBBGCMuso/R/calibMuso.R @@ -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) { diff --git a/RBBGCMuso/R/calibration.R b/RBBGCMuso/R/calibration.R index 085df9b..5ac112b 100644 --- a/RBBGCMuso/R/calibration.R +++ b/RBBGCMuso/R/calibration.R @@ -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){ } } - From 0e50f0c1f07296c912d542f1f812a46de81fed1e Mon Sep 17 00:00:00 2001 From: Hollos Roland Date: Tue, 2 Jun 2020 22:07:27 +0200 Subject: [PATCH 2/2] changeing the input method is no longer necessary --- RBBGCMuso/R/calibMuso.R | 8 ++++-- RBBGCMuso/R/changeMuso.R | 53 ++++++++++++++-------------------------- 2 files changed, 25 insertions(+), 36 deletions(-) diff --git a/RBBGCMuso/R/calibMuso.R b/RBBGCMuso/R/calibMuso.R index aa086dd..f0826f7 100644 --- a/RBBGCMuso/R/calibMuso.R +++ b/RBBGCMuso/R/calibMuso.R @@ -113,10 +113,14 @@ calibMuso <- function(settings=setupMuso(), calibrationPar=NULL, ##change the epc file if and only if there are given parameters if(!is.null(parameters)){ - changemulline(filePaths = epcInput, + changemulline(filePaths = epc[2], calibrationPar = calibrationPar, contents = parameters, - fileOut = toModif, + src = if(file.exists(bck)){ + bck + } else { + NULL + }) # fileToChange = fileToChange,) } diff --git a/RBBGCMuso/R/changeMuso.R b/RBBGCMuso/R/changeMuso.R index d772223..97b70e7 100644 --- a/RBBGCMuso/R/changeMuso.R +++ b/RBBGCMuso/R/changeMuso.R @@ -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 +}