TODO: unit tests for simil days

diff --git a/pkg/R/Data.R b/pkg/R/Data.R
index c193f7d..92ba2c1 100644 (file)
--- a/pkg/R/Data.R
+++ b/pkg/R/Data.R
@@ -25,7 +25,8 @@
 #' \item{\code{getStdHorizon()}}{
 #'   Number of time steps from serie[1] until midnight}
 #' \item{\code{append(time, serie, exo, exo_hat)}}{
-#'   Measured data for given vector of times + exogenous predictions from last midgnight.
+#'   Measured data for given vector of times + exogenous predictions from
+#'   last midgnight.}
 #' \item{\code{getTime(index)}}{
 #'   Times (vector) at specified index.}
 #' \item{\code{getCenteredSerie(index)}}{

diff --git a/pkg/R/F_Average.R b/pkg/R/F_Average.R
index 8a33111..8f81747 100644 (file)
--- a/pkg/R/F_Average.R
+++ b/pkg/R/F_Average.R
@@ -9,7 +9,7 @@
 #'
 #' @docType class
 #' @format R6 class, inherits Forecaster
-#' @alias F_Average
+#' @aliases F_Average
 #'
 AverageForecaster = R6::R6Class("AverageForecaster",
        inherit = Forecaster,

diff --git a/pkg/R/F_Neighbors.R b/pkg/R/F_Neighbors.R
index 12595d9..ffb068f 100644 (file)
--- a/pkg/R/F_Neighbors.R
+++ b/pkg/R/F_Neighbors.R
@@ -30,7 +30,7 @@
 #'
 #' @docType class
 #' @format R6 class, inherits Forecaster
-#' @alias F_Neighbors
+#' @aliases F_Neighbors
 #'
 NeighborsForecaster = R6::R6Class("NeighborsForecaster",
        inherit = Forecaster,
@@ -46,7 +46,7 @@ NeighborsForecaster = R6::R6Class("NeighborsForecaster",
                                return (NA)
 
                        # Determine indices of no-NAs days followed by no-NAs tomorrows
-                       fdays = getNoNA2(data, max(today-memory,1), today-1)
+                       fdays = .getNoNA2(data, max(today-memory,1), today-1)
 
                        # Get optional args
                        local = ifelse(hasArg("local"), list(...)$local, TRUE) #same level + season?
@@ -118,33 +118,14 @@ NeighborsForecaster = R6::R6Class("NeighborsForecaster",
 
                        if (local)
                        {
-                               # Neighbors: days in "same season"; TODO: 60 == magic number...
+                               # TODO: 60 == magic number
                                fdays = getSimilarDaysIndices(today, data, limit=60, same_season=TRUE,
                                        days_in=fdays_cut)
                                if (length(fdays) <= 1)
                                        return (NA)
-                               levelToday = data$getLevel(today)
-                               distances = sapply(fdays, function(i) abs(data$getLevel(i)-levelToday))
-                               #TODO: 2, 10, 3, 12 magic numbers here...
-                               dist_thresh = 2
-                               min_neighbs = min(10,length(fdays))
-                               repeat
-                               {
-                                       same_pollution = (distances <= dist_thresh)
-                                       nb_neighbs = sum(same_pollution)
-                                       if (nb_neighbs >= min_neighbs) #will eventually happen
-                                               break
-                                       dist_thresh = dist_thresh + 3
-                               }
-                               fdays = fdays[same_pollution]
-                               max_neighbs = 12
-                               if (nb_neighbs > max_neighbs)
-                               {
-                                       # Keep only max_neighbs closest neighbors
-                                       fdays = fdays[
-                                               sort(distances[same_pollution],index.return=TRUE)$ix[1:max_neighbs] ]
-                               }
-                               if (length(fdays) == 1) #the other extreme...
+                               # TODO: 10, 12 == magic numbers
+                               fdays = .getConstrainedNeighbs(today,data,fdays,min_neighbs=10,max_neighbs=12)
+                               if (length(fdays) == 1)
                                {
                                        if (final_call)
                                        {
@@ -170,13 +151,7 @@ NeighborsForecaster = R6::R6Class("NeighborsForecaster",
                                        mean(delta^2)
                                })
 
-                               sd_dist = sd(distances2)
-                               if (sd_dist < .25 * sqrt(.Machine$double.eps))
-                               {
-#                                      warning("All computed distances are very close: stdev too small")
-                                       sd_dist = 1 #mostly for tests... FIXME:
-                               }
-                               simils_endo = exp(-distances2/(sd_dist*window_endo^2))
+                               simils_endo <- .computeSimils(distances2, window_endo)
                        }
 
                        if (simtype == "exo" || simtype == "mix")
@@ -203,13 +178,7 @@ NeighborsForecaster = R6::R6Class("NeighborsForecaster",
                                        delta %*% sigma_inv %*% delta
                                })
 
-                               sd_dist = sd(distances2)
-                               if (sd_dist < .25 * sqrt(.Machine$double.eps))
-                               {
-#                                      warning("All computed distances are very close: stdev too small")
-                                       sd_dist = 1 #mostly for tests... FIXME:
-                               }
-                               simils_exo = exp(-distances2/(sd_dist*window_exo^2))
+                               simils_exo <- .computeSimils(distances2, window_exo)
                        }
 
                        similarities =
@@ -246,3 +215,72 @@ NeighborsForecaster = R6::R6Class("NeighborsForecaster",
                }
        )
 )
+
+#' getNoNA2
+#'
+#' Get indices in data of no-NA series followed by no-NA, within [first,last] range.
+#'
+#' @inheritParams dateIndexToInteger
+#' @param first First index (included)
+#' @param last Last index (included)
+#'
+.getNoNA2 = function(data, first, last)
+{
+       (first:last)[ sapply(first:last, function(i)
+               !any( is.na(data$getCenteredSerie(i)) | is.na(data$getCenteredSerie(i+1)) )
+       ) ]
+}
+
+#' getConstrainedNeighbs
+#'
+#' Get indices of neighbors of similar pollution level (among same season + day type).
+#'
+#' @param today Index of current day
+#' @param data Object of class Data
+#' @param fdays Current set of "first days" (no-NA pairs)
+#' @param min_neighbs Minimum number of points in a neighborhood
+#' @param max_neighbs Maximum number of points in a neighborhood
+#'
+.getConstrainedNeighbs = function(today, data, fdays, min_neighbs=10, max_neighbs=12)
+{
+       levelToday = data$getLevel(today)
+       distances = sapply(fdays, function(i) abs(data$getLevel(i)-levelToday))
+       #TODO: 2, +3 : magic numbers
+       dist_thresh = 2
+       min_neighbs = min(min_neighbs,length(fdays))
+       repeat
+       {
+               same_pollution = (distances <= dist_thresh)
+               nb_neighbs = sum(same_pollution)
+               if (nb_neighbs >= min_neighbs) #will eventually happen
+                       break
+               dist_thresh = dist_thresh + 3
+       }
+       fdays = fdays[same_pollution]
+       max_neighbs = 12
+       if (nb_neighbs > max_neighbs)
+       {
+               # Keep only max_neighbs closest neighbors
+               fdays = fdays[
+                       sort(distances[same_pollution],index.return=TRUE)$ix[1:max_neighbs] ]
+       }
+       fdsays
+}
+
+#' compute similarities
+#'
+#' Apply the gaussian kernel on computed squared distances.
+#'
+#' @param distances2 Squared distances
+#' @param window Window parameter for the kernel
+#'
+.computeSimils <- function(distances2, window)
+{
+       sd_dist = sd(distances2)
+       if (sd_dist < .25 * sqrt(.Machine$double.eps))
+       {
+#              warning("All computed distances are very close: stdev too small")
+               sd_dist = 1 #mostly for tests... FIXME:
+       }
+       exp(-distances2/(sd_dist*window^2))
+}

diff --git a/pkg/R/F_Persistence.R b/pkg/R/F_Persistence.R
index eaeca98..fa5f99f 100644 (file)
--- a/pkg/R/F_Persistence.R
+++ b/pkg/R/F_Persistence.R
@@ -10,7 +10,7 @@
 #'
 #' @docType class
 #' @format R6 class, inherits Forecaster
-#' @alias F_Persistence
+#' @aliases F_Persistence
 #'
 PersistenceForecaster = R6::R6Class("PersistenceForecaster",
        inherit = Forecaster,

diff --git a/pkg/R/F_Zero.R b/pkg/R/F_Zero.R
index 977cba9..2c9a7b7 100644 (file)
--- a/pkg/R/F_Zero.R
+++ b/pkg/R/F_Zero.R
@@ -5,7 +5,7 @@
 #'
 #' @docType class
 #' @format R6 class, inherits Forecaster
-#' @alias F_Zero
+#' @aliases F_Zero
 #'
 ZeroForecaster = R6::R6Class("ZeroForecaster",
        inherit = Forecaster,

diff --git a/pkg/R/J_Neighbors.R b/pkg/R/J_Neighbors.R
index 5a818ca..7f66830 100644 (file)
--- a/pkg/R/J_Neighbors.R
+++ b/pkg/R/J_Neighbors.R
@@ -8,7 +8,7 @@
 #' @inheritParams computeForecast
 #' @inheritParams getZeroJumpPredict
 #'
-#' @alias J_Neighbors
+#' @aliases J_Neighbors
 #'
 getNeighborsJumpPredict = function(data, today, memory, horizon, params, ...)
 {

diff --git a/pkg/R/J_Persistence.R b/pkg/R/J_Persistence.R
index 37d05fe..9e56742 100644 (file)
--- a/pkg/R/J_Persistence.R
+++ b/pkg/R/J_Persistence.R
@@ -8,7 +8,7 @@
 #' @inheritParams computeForecast
 #' @inheritParams getZeroJumpPredict
 #'
-#' @alias J_Persistence
+#' @aliases J_Persistence
 #'
 getPersistenceJumpPredict = function(data, today, memory, horizon, params, ...)
 {

diff --git a/pkg/R/J_Zero.R b/pkg/R/J_Zero.R
index 065226e..fb15e3d 100644 (file)
--- a/pkg/R/J_Zero.R
+++ b/pkg/R/J_Zero.R
@@ -6,7 +6,7 @@
 #' @param today Index of the current day (predict tomorrow)
 #' @param params Optional parameters computed by the main forecaster
 #'
-#' @alias J_Zero
+#' @aliases J_Zero
 #'
 getZeroJumpPredict = function(data, today, memory, horizon, params, ...)
 {

diff --git a/pkg/R/computeForecast.R b/pkg/R/computeForecast.R
index 23ccb04..a4a539a 100644 (file)
--- a/pkg/R/computeForecast.R
+++ b/pkg/R/computeForecast.R
@@ -31,9 +31,10 @@
 #' @examples
 #' ts_data <- system.file("extdata","pm10_mesures_H_loc.csv",package="talweg")
 #' exo_data <- system.file("extdata","meteo_extra_noNAs.csv",package="talweg")
-#' data <- getData(ts_data, exo_data, input_tz="GMT", working_tz="GMT", predict_at=7)
-#' pred <- computeForecast(data, 2200:2230, "Persistence", "Zero",
-#'   memory=500, horizon=12, ncores=1)
+#' data <- getData(ts_data, exo_data, input_tz="GMT", working_tz="GMT",
+#'   predict_at=7, limit=200)
+#' pred <- computeForecast(data, 100:130, "Persistence", "Zero",
+#'   memory=50, horizon=12, ncores=1)
 #' \dontrun{#Sketch for real-time mode:
 #' data <- Data$new()
 #' forecaster <- MyForecaster$new(myJumpPredictFunc)

diff --git a/pkg/R/utils.R b/pkg/R/utils.R
index 3124881..5ba72f0 100644 (file)
--- a/pkg/R/utils.R
+++ b/pkg/R/utils.R
@@ -117,19 +117,3 @@ getSimilarDaysIndices = function(index, data, limit, same_season, days_in=NULL)
                return (day <= 4)
        return (day == day_ref)
 }
-
-#' getNoNA2
-#'
-#' Get indices in data of no-NA series followed by no-NA, within [first,last] range.
-#'
-#' @inheritParams dateIndexToInteger
-#' @param first First index (included)
-#' @param last Last index (included)
-#'
-#' @export
-getNoNA2 = function(data, first, last)
-{
-       (first:last)[ sapply(first:last, function(i)
-               !any( is.na(data$getCenteredSerie(i)) | is.na(data$getCenteredSerie(i+1)) )
-       ) ]
-}

diff --git a/pkg/tests/testthat.R b/pkg/tests/testthat.R
index 2a60ff4..97e5ad5 100644 (file)
--- a/pkg/tests/testthat.R
+++ b/pkg/tests/testthat.R
@@ -1,4 +1,6 @@
 library(testthat)
-library(talweg)
+
+load_all() #because some non-exported functions
+#library(talweg)
 
 test_check("talweg")

diff --git a/pkg/tests/testthat/test.dateIndexToInteger.R b/pkg/tests/testthat/test-DateIntegerConv.R
similarity index 68%
rename from pkg/tests/testthat/test.dateIndexToInteger.R
rename to pkg/tests/testthat/test-DateIntegerConv.R
index d3c014a..99e5fa5 100644 (file)
--- a/pkg/tests/testthat/test.dateIndexToInteger.R
+++ b/pkg/tests/testthat/test-DateIntegerConv.R
@@ -1,4 +1,4 @@
-context("Check that date <--> integer indexes conversions work")
+context("Date <--> integer conversions")
 
 ts_data = system.file("testdata","ts_test.csv",package="talweg")
 exo_data = system.file("testdata","exo_test.csv",package="talweg")
@@ -7,7 +7,7 @@ data0 <<- getData(ts_data, exo_data, input_tz="GMT", date_format="%Y-%m-%d %H:%M
 data7 <<- getData(ts_data, exo_data, input_tz="GMT", date_format="%Y-%m-%d %H:%M",
        working_tz="GMT", predict_at=7, limit=Inf)
 
-test_that("dateIndexToInteger",
+test_that("dateIndexToInteger works as expected",
 {
        expect_identical( dateIndexToInteger("2007-01-01",data0),   1 )
        expect_identical( dateIndexToInteger("2007-01-02",data0),   2 )
@@ -22,7 +22,7 @@ test_that("dateIndexToInteger",
        expect_identical( dateIndexToInteger("2007-05-31",data7), 151 )
 })
 
-test_that("integerIndexToDate",
+test_that("integerIndexToDate works as expected",
 {
        expect_identical( integerIndexToDate(  1,data0), as.Date("2007-01-01") )
        expect_identical( integerIndexToDate(  2,data0), as.Date("2007-01-02") )
@@ -53,24 +53,24 @@ test_that("dateIndexToInteger(integerIndexToDate) == Id",
 
 test_that("integerIndexToDate(dateIndexToInteger) == Id",
 {
-       expect_identical(
-               integerIndexToDate(dateIndexToInteger("2007-01-01",data0),data0), as.Date("2007-01-01") )
-       expect_identical(
-               integerIndexToDate(dateIndexToInteger("2007-01-01",data7),data7), as.Date("2007-01-01") )
-       expect_identical(
-               integerIndexToDate(dateIndexToInteger("2007-01-02",data0),data0), as.Date("2007-01-02") )
-       expect_identical(
-               integerIndexToDate(dateIndexToInteger("2007-01-02",data7),data7), as.Date("2007-01-02") )
-       expect_identical(
-               integerIndexToDate(dateIndexToInteger("2007-02-01",data0),data0), as.Date("2007-02-01") )
-       expect_identical(
-               integerIndexToDate(dateIndexToInteger("2007-02-01",data0),data0), as.Date("2007-02-01") )
-       expect_identical(
-               integerIndexToDate(dateIndexToInteger("2007-03-01",data0),data0), as.Date("2007-03-01") )
-       expect_identical(
-               integerIndexToDate(dateIndexToInteger("2007-03-01",data0),data0), as.Date("2007-03-01") )
-       expect_identical(
-               integerIndexToDate(dateIndexToInteger("2007-05-31",data0),data0), as.Date("2007-05-31") )
-       expect_identical(
-               integerIndexToDate(dateIndexToInteger("2007-05-31",data0),data0), as.Date("2007-05-31") )
+       expect_identical(integerIndexToDate(dateIndexToInteger("2007-01-01",data0),data0),
+               as.Date("2007-01-01") )
+       expect_identical(integerIndexToDate(dateIndexToInteger("2007-01-01",data7),data7),
+               as.Date("2007-01-01") )
+       expect_identical(integerIndexToDate(dateIndexToInteger("2007-01-02",data0),data0),
+               as.Date("2007-01-02") )
+       expect_identical(integerIndexToDate(dateIndexToInteger("2007-01-02",data7),data7),
+               as.Date("2007-01-02") )
+       expect_identical(integerIndexToDate(dateIndexToInteger("2007-02-01",data0),data0),
+               as.Date("2007-02-01") )
+       expect_identical(integerIndexToDate(dateIndexToInteger("2007-02-01",data0),data0),
+               as.Date("2007-02-01") )
+       expect_identical(integerIndexToDate(dateIndexToInteger("2007-03-01",data0),data0),
+               as.Date("2007-03-01") )
+       expect_identical(integerIndexToDate(dateIndexToInteger("2007-03-01",data0),data0),
+               as.Date("2007-03-01") )
+       expect_identical(integerIndexToDate(dateIndexToInteger("2007-05-31",data0),data0),
+               as.Date("2007-05-31") )
+       expect_identical(integerIndexToDate(dateIndexToInteger("2007-05-31",data0),data0),
+               as.Date("2007-05-31") )
 })

diff --git a/pkg/tests/testthat/test.Forecaster.R b/pkg/tests/testthat/test-Forecaster.R
similarity index 93%
rename from pkg/tests/testthat/test.Forecaster.R
rename to pkg/tests/testthat/test-Forecaster.R
index a02e6e9..9b3eaa0 100644 (file)
--- a/pkg/tests/testthat/test.Forecaster.R
+++ b/pkg/tests/testthat/test-Forecaster.R
@@ -43,16 +43,20 @@ test_that("Average method behave as expected",
 test_that("Persistence method behave as expected",
 {
        #Situation A: +Zero; (generally) correct if jump, wrong otherwise
-       pred00_sd = computeForecast(data00, indices, "Persistence", "Zero", Inf, 24, same_day=TRUE)
-       pred00_dd = computeForecast(data00, indices, "Persistence", "Zero", Inf, 24, same_day=FALSE)
+       pred00_sd = computeForecast(data00, indices, "Persistence", "Zero", Inf, 24,
+               same_day=TRUE)
+       pred00_dd = computeForecast(data00, indices, "Persistence", "Zero", Inf, 24,
+               same_day=FALSE)
        for (i in 1:7)
        {
                expect_equal(pred00_sd$getSerie(i), rep(pred_order[i],24))
                expect_equal(pred00_dd$getSerie(i), rep(pred_order[i],24))
        }
 
-       pred13_sd = computeForecast(data13, indices, "Persistence", "Zero", Inf, 24, same_day=TRUE)
-       pred13_dd = computeForecast(data13, indices, "Persistence", "Zero", Inf, 24, same_day=FALSE)
+       pred13_sd = computeForecast(data13, indices, "Persistence", "Zero", Inf, 24,
+               same_day=TRUE)
+       pred13_dd = computeForecast(data13, indices, "Persistence", "Zero", Inf, 24,
+               same_day=FALSE)
        for (i in 2:6)
        {
                expect_equal(pred13_sd$getSerie(i), c( rep(i,11), rep(i%%7+1,13) ) )
@@ -105,18 +109,21 @@ test_that("Persistence method behave as expected",
 test_that("Neighbors method behave as expected",
 {
        #Situation A: +Zero; correct if jump, wrong otherwise
-       pred00 = computeForecast(data00, indices, "Neighbors", "Zero", Inf, 24, simtype="mix")
+       pred00 = computeForecast(data00, indices, "Neighbors", "Zero", Inf, 24,
+               simtype="mix")
        for (i in 1:7)
                expect_equal(pred00$getSerie(i), rep(pred_order[i],24))
 
-       pred13 = computeForecast(data13, indices, "Persistence", "Zero", Inf, 24, simtype="mix")
+       pred13 = computeForecast(data13, indices, "Persistence", "Zero", Inf, 24,
+               simtype="mix")
        for (i in 1:7)
                expect_equal(pred13$getSerie(i), c( rep(i,11), rep(i%%7+1,13) ) )
 
        #Situation B: +Neighbors, always predict bad (small, averaged) jump
-       pred00 = computeForecast(data00, indices, "Neighbors", "Neighbors", Inf, 24, simtype="endo")
-       #Concerning weights, there are 12+(1 if i>=2) gaps at -6 and 90-12+(i-2 if i>=3) gaps at 1
-       #Thus, predicted jump is respectively
+       pred00 = computeForecast(data00, indices, "Neighbors", "Neighbors", Inf, 24,
+               simtype="endo")
+       #Concerning weights, there are 12+(1 if i>=2) gaps at -6 and 90-12+(i-2 if i>=3) gaps
+       #at 1. Thus, predicted jump is respectively
        #  (12*-6+78)/90 = 0.06666667
        #  (13*-6+78)/91 = 0
        #  (13*-6+79)/92 = 0.01086957
@@ -128,8 +135,10 @@ test_that("Neighbors method behave as expected",
        for (i in 1:7)
                expect_equal(pred00$getSerie(i), rep(pred_order[i]+jumps[i],24))
 
-       #Next lines commented out because too unpredictable results (tendency to flatten everything...)
-#      pred13 = computeForecast(data13, indices, "Neighbors", "Neighbors", Inf, 24, simtype="endo")
+       #Next lines commented out because too unpredictable results
+       #(tendency to flatten everything...)
+#      pred13 = computeForecast(data13, indices, "Neighbors", "Neighbors", Inf, 24,
+#              simtype="endo")
 #      for (i in 1:7)
 #              expect_equal(pred13$getSerie(i), c( rep(i,11), rep(i%%7+1,13) ) )
 

diff --git a/pkg/tests/testthat/test.computeFilaments.R b/pkg/tests/testthat/test-computeFilaments.R
similarity index 97%
rename from pkg/tests/testthat/test.computeFilaments.R
rename to pkg/tests/testthat/test-computeFilaments.R
index ec39340..355d58d 100644 (file)
--- a/pkg/tests/testthat/test.computeFilaments.R
+++ b/pkg/tests/testthat/test-computeFilaments.R
@@ -1,4 +1,4 @@
-context("Check that computeFilaments behaves as expected")
+context("computeFilaments")
 
 #shorthand: map 1->1, 2->2, 3->3, 4->1, ..., 149->2, 150->3
 I = function(i)

diff --git a/pkg/tests/testthat/test-similarDays.R b/pkg/tests/testthat/test-similarDays.R
new file mode 100644 (file)
index 0000000..0d33fce
--- /dev/null
+++ b/pkg/tests/testthat/test-similarDays.R
@@ -0,0 +1,16 @@
+context("Get similar days")
+
+itestthat("getSimilarDaysIndices works as expected",
+{
+       getSimilarDaysIndices(index, data, limit, same_season, days_in=NULL)
+       #...
+})
+{
+       index = dateIndexToInteger(index, data)
+
+testthat("getConstrainedNeighbs works as expected",
+{
+       .getConstrainedNeighbs(today, data, fdays, min_neighbs=10, max_neighbs=12)
+       #...
+})
+