use of testthat and post processing

RBBGCMuso/R/calibMuso.R

@@ -31,7 +31,8 @@ calibMuso <- function(settings=NULL, calibrationPar=NULL,
                       silent=FALSE, aggressive=FALSE,
                       keepBinary=FALSE,
                       binaryPlace="./", fileToChange="epc",
-                      skipSpinup = TRUE, modifyOriginal =FALSE, prettyOut = FALSE){
+                      skipSpinup = TRUE, modifyOriginal =FALSE, prettyOut = FALSE,
+                      postProcString = NULL){ #
 ########################################################################
 ###########################Set local variables and places###############
 ########################################################################
@@ -321,6 +322,9 @@ calibMuso <- function(settings=NULL, calibrationPar=NULL,
         stop("Modell Failure")
     }
 
+    
+
+    
     if(timee=="d"){
         if(!prettyOut){
             colnames(Reva) <- unlist(settings$outputVars[[1]])
@@ -338,7 +342,9 @@ calibMuso <- function(settings=NULL, calibrationPar=NULL,
             colnames(Reva) <- unlist(settings$outputVars[[2]])
     }
 
-
+    if(!is.null(postProcString)){
+        Reva <- postProcMuso(Reva,postProcString)
+    }
 
     ## if(leapYear){
     ##     Reva <- corrigMuso(settings,Reva)
@@ -372,5 +378,6 @@ calibMuso <- function(settings=NULL, calibrationPar=NULL,
         
     } else{
         setwd(whereAmI)
-        return(Reva)}
+        return(Reva)
+    }
 }

RBBGCMuso/R/postProc.R

@@ -0,0 +1,10 @@
+postProcMuso  <- function(modelData, procString){
+    cNames <- colnames(modelData)
+    tocalc <- gsub("(@)(\\d)","modelData[,\\2]",procString)
+    newVarName <- gsub("\\s","",unlist(strsplit(procString,"<-"))[1])
+    assign(newVarName,eval(parse(text = unlist(strsplit(tocalc,"<-"))[2])))
+    modelData <- cbind.data.frame(modelData,eval(parse(text = newVarName)))
+    colnames(modelData) <- c(cNames,newVarName)
+    modelData
+}
+

RBBGCMuso/inst/tests/test_postProcMuso.R

@@ -0,0 +1,21 @@
+context("Post processing")
+library(testthat)
+library(RBBGCMuso)
+setwd(system.file("examples/hhs","",package = "RBBGCMuso"))
+
+test_that("Post processing string",{
+    testMatrix1 <- data.frame(first = rep(1,5), second = rep(2,5), third = rep(3,5))
+    testMatrix1c <- testMatrix1 
+    testMatrix1c[,"newCol"] <- testMatrix1c[,2] + 3 * testMatrix1c[,3] 
+    expect_equal(postProcMuso(testMatrix1,"newCol <- @2 + 3*@3"),testMatrix1c)
+})
+
+test_that("calibMuso with postprocessing",{
+    model <- calibMuso(skipSpinup = FALSE, silent = TRUE)
+    modelc<- model
+    newCol <- modelc[,1]
+    modelc<- cbind.data.frame(modelc,newCol)
+    modelc[,"newCol"]<- model[,5]+3*model[,7]
+    expect_equal(calibMuso(skipSpinup = FALSE,silent = TRUE, postProcString = "newCol <- @5 + 3* @7"), modelc)
+})
+

RBBGCMuso/man/optiMuso.Rd

@@ -5,11 +5,11 @@
 \title{optiMuso}
 \usage{
 optiMuso(measuredData, parameters = NULL, startDate, endDate,
-  formatString = "\%Y-\%m-\%d", leapYear = TRUE, dataVar,
+  formatString = "\%Y-\%m-\%d", leapYearHandling = TRUE, dataVar,
   outLoc = "./calib", preTag = "cal-", settings = NULL,
   outVars = NULL, iterations = 30, skipSpinup = TRUE,
   constrains = NULL, plotName = "calib.jpg", likelihood = function(x,
-  y) {     exp(-sqrt(mean((x - y)^2))) }, calPar = 3009)
+  y) {     exp(-sqrt(mean((x - y)^2))) }, continious, modelVar = 3009)
 }
 \arguments{
 \item{parameters}{b}
@@ -20,8 +20,6 @@ optiMuso(measuredData, parameters = NULL, startDate, endDate,
 
 \item{formatString}{a}
 
-\item{leapYear}{b}
-
 \item{outLoc}{c}
 
 \item{settings}{e}
@@ -36,8 +34,6 @@ optiMuso(measuredData, parameters = NULL, startDate, endDate,
 
 \item{likelihood}{d}
 
-\item{calPar}{a}
-
 \item{measuredDataFile}{a}
 
 \item{sep}{c}
@@ -49,6 +45,10 @@ optiMuso(measuredData, parameters = NULL, startDate, endDate,
 \item{selVar}{c}
 
 \item{pretag}{a}
+
+\item{calPar}{a}
+
+\item{leapYear}{b}
 }
 \description{
 This function calculates the -users specified- likelihood for random model input.