Merge branch 'feature/modifyinput'

RBBGCMuso/R/calibMuso.R

@@ -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,
+                      src = if(file.exists(bck)){
-                      fileToChange = fileToChange,
+                          bck
-                      modifyOriginal = modifyOriginal)
+                      } 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) {
 

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)), 
+        modelDates <- seq(from= as.Date(sprintf("%s-01-01",settings$startYear)), 
-             by="days",
+            by="days",
-             to=as.Date(sprintf("%s-12-31",settings$startYear+settings$numYears-1)))
+            to=as.Date(sprintf("%s-12-31",settings$startYear+settings$numYears-1)))
-         modelDates <- grep("-02-29",modelDates,invert=TRUE, value=TRUE)
+        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){
     }
     
 }
-

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)) ){
+    fileStringVector <- readLines(src)
-        stop("If you change epc and ini files also, you have to use list for calibrationPar, and paramateters.")
+    Map(function(index, content){
-    }
+           fileStringVector <<- changeByIndex(index, content, fileStringVector)
-     
-    if(!is.element(fileToChange,c("ini","epc","both"))){
-        stop("RBBGCMuso can only change ini or epc file, so fileToChange can be 'epc/ini/both'")
-    }
 
-    if(fileToChange == "epc" | fileToChange == "ini"){
+    }, calibrationPar, contents)
-        parMat<-matrix(c(calibrationPar, contents),nrow=length(calibrationPar))
+    writeLines(fileStringVector, filePaths)
-        if(nrow(parMat)!=1){
-            parMat <- parMat[order(parMat[,1]),]
-        }
-        changeMusoC(inFile = filePaths[selectFileToWrite(filePaths, fileToChange)],
-                    outFile = fileOut[selectFileToWrite(filePaths, fileToChange)],
-                    parMat)
-    }
     
-    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
+}