From: Benjamin Auder Date: Mon, 10 Apr 2017 12:29:21 +0000 (+0200) Subject: fix tests X-Git-Url: https://git.auder.net/variants/Chakart/doc/scripts/css/pieces/%7B%7B%20pkg.url%20%7D%7D?a=commitdiff_plain;h=c36568faefc97bb417d355e2084398c1ad1acf92;p=talweg.git fix tests --- diff --git a/pkg/R/F_Neighbors.R b/pkg/R/F_Neighbors.R index ffb068f..9af4725 100644 --- a/pkg/R/F_Neighbors.R +++ b/pkg/R/F_Neighbors.R @@ -264,7 +264,7 @@ NeighborsForecaster = R6::R6Class("NeighborsForecaster", fdays = fdays[ sort(distances[same_pollution],index.return=TRUE)$ix[1:max_neighbs] ] } - fdsays + fdays } #' compute similarities diff --git a/pkg/R/J_Neighbors.R b/pkg/R/J_Neighbors.R index 7f66830..40341d9 100644 --- a/pkg/R/J_Neighbors.R +++ b/pkg/R/J_Neighbors.R @@ -17,11 +17,8 @@ getNeighborsJumpPredict = function(data, today, memory, horizon, params, ...) indices = params$indices[filter] weights = params$weights[filter] - if (any(is.na(weights) | is.na(indices))) - return (NA) - gaps = sapply(indices, function(i) { - head( data$getSerie(i+1), 1) - tail( data$getSerie(i), 1) + head( data$getSerie(i+1),1 ) - tail( data$getSerie(i),1 ) }) scal_product = weights * gaps norm_fact = sum( weights[!is.na(scal_product)] ) diff --git a/pkg/R/utils.R b/pkg/R/utils.R index 5ba72f0..ddf0bb1 100644 --- a/pkg/R/utils.R +++ b/pkg/R/utils.R @@ -68,11 +68,11 @@ getSimilarDaysIndices = function(index, data, limit, same_season, days_in=NULL) index = dateIndexToInteger(index, data) # Look for similar days (optionally in same season) - i = index - 1 days = c() dt_ref = as.POSIXlt(data$getTime(index)[1]) #first date-time of current day day_ref = dt_ref$wday #1=monday, ..., 6=saturday, 0=sunday month_ref = as.POSIXlt(data$getTime(index)[1])$mon+1 #month in 1...12 + i = index - 1 while (i >= 1 && length(days) < limit) { dt = as.POSIXlt(data$getTime(i)[1]) @@ -111,9 +111,7 @@ getSimilarDaysIndices = function(index, data, limit, same_season, days_in=NULL) # .isSameDay = function(day, day_ref) { - if (day_ref == 0) - return (day==0) - if (day_ref <= 4) - return (day <= 4) + if (day_ref %in% 1:4) + return (day %in% 1:4) return (day == day_ref) } diff --git a/pkg/tests/testthat/helper.R b/pkg/tests/testthat/helper.R new file mode 100644 index 0000000..491cf9c --- /dev/null +++ b/pkg/tests/testthat/helper.R @@ -0,0 +1,31 @@ +#shorthand: map 1->1, 2->2, 3->3, 4->1, ..., 149->2, 150->3 +I = function(i) + (i-1) %% 3 + 1 + +#MOCK data; NOTE: could be in inst/testdata as well +getDataTest = function(n) +{ + data = Data$new() + x = seq(0,9.5,0.1) + L = length(x) #96 1/4h + s1 = cos(x) + s2 = sin(x) + s3 = c( s1[1:(L%/%2)] , s2[(L%/%2+1):L] ) + #sum((s1-s2)^2) == 96 + #sum((s1-s3)^2) == 58 + #sum((s2-s3)^2) == 38 + s = list(s1, s2, s3) + series = list() + for (i in seq_len(n)) + { + serie = s[[I(i)]] + rnorm(L,sd=0.01) + # 10 series with NAs for index 2 + if (I(i) == 2 && i >= 60 && i<= 90) + serie[sample(seq_len(L),1)] = NA + time = as.POSIXct((i-1)*60*60*24+15*60*(1:96), origin="2007-01-01", tz="GMT") + exo = runif(4) + exo_hat = runif(4) + data$append(time, serie, exo, exo_hat) + } + data +} diff --git a/pkg/tests/testthat/test-Forecaster.R b/pkg/tests/testthat/test-Forecaster.R index 9b3eaa0..09b6f0a 100644 --- a/pkg/tests/testthat/test-Forecaster.R +++ b/pkg/tests/testthat/test-Forecaster.R @@ -12,25 +12,25 @@ pred_order = c(7,1:6) #will facilitate tests test_that("Average method behave as expected", { - pred00_z = computeForecast(data00, indices, "Average", "Zero", Inf, 24) + pred00_z = computeForecast(data00, indices, "Average", "Zero", Inf, 24) pred00_p = computeForecast(data00, indices, "Average", "Persistence", Inf, 24) for (i in 1:7) { #zero jump: should predict true values minus 1 - expect_equal( pred00_z$getSerie(i), rep(pred_order[i],24) ) + expect_equal( pred00_z$getForecast(i), rep(pred_order[i],24) ) #persistence jump == 1: should predict true values - expect_equal( pred00_p$getSerie(i), rep(i,24) ) + expect_equal( pred00_p$getForecast(i), rep(i,24) ) } #NOTE: days become #1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 (14h-->0h then 1h-->13h) #No jump between days, thus zero and persistence are equivalent (and correct) - pred13_z = computeForecast(data13, indices, "Average", "Zero", Inf, 24) + pred13_z = computeForecast(data13, indices, "Average", "Zero", Inf, 24) pred13_p = computeForecast(data13, indices, "Average", "Persistence", Inf, 24) for (i in 1:7) { - expect_equal( pred13_z$getSerie(i), c( rep(i,11), rep(i%%7+1,13) ) ) - expect_equal( pred13_p$getSerie(i), c( rep(i,11), rep(i%%7+1,13) ) ) + expect_equal( pred13_z$getForecast(i), c( rep(i,11), rep(i%%7+1,13) ) ) + expect_equal( pred13_p$getForecast(i), c( rep(i,11), rep(i%%7+1,13) ) ) } #A few extra checks @@ -44,60 +44,60 @@ 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) + ncores=1, same_day=TRUE) pred00_dd = computeForecast(data00, indices, "Persistence", "Zero", Inf, 24, - same_day=FALSE) + ncores=1, 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)) + expect_equal(pred00_sd$getForecast(i), rep(pred_order[i],24)) + expect_equal(pred00_dd$getForecast(i), rep(pred_order[i],24)) } pred13_sd = computeForecast(data13, indices, "Persistence", "Zero", Inf, 24, - same_day=TRUE) + ncores=1, same_day=TRUE) pred13_dd = computeForecast(data13, indices, "Persistence", "Zero", Inf, 24, - same_day=FALSE) + ncores=1, same_day=FALSE) for (i in 2:6) { - expect_equal(pred13_sd$getSerie(i), c( rep(i,11), rep(i%%7+1,13) ) ) - expect_equal(pred13_dd$getSerie(i), c( rep(i,11), rep(i%%7+1,13) ) ) + expect_equal(pred13_sd$getForecast(i), c( rep(i,11), rep(i%%7+1,13) ) ) + expect_equal(pred13_dd$getForecast(i), c( rep(i,11), rep(i%%7+1,13) ) ) } #boundaries are special cases: OK if same day, quite wrong otherwise - expect_equal(pred13_sd$getSerie(1), c( rep(1,11), rep(2,13) ) ) - expect_equal(pred13_dd$getSerie(1), c( rep(1,11), rep(-5,13) ) ) - expect_equal(pred13_sd$getSerie(7), c( rep(7,11), rep(1,13) ) ) - expect_equal(pred13_dd$getSerie(7), c( rep(7,11), rep(8,13) ) ) + expect_equal(pred13_sd$getForecast(1), c( rep(1,11), rep(2,13) ) ) + expect_equal(pred13_dd$getForecast(1), c( rep(1,11), rep(-5,13) ) ) + expect_equal(pred13_sd$getForecast(7), c( rep(7,11), rep(1,13) ) ) + expect_equal(pred13_dd$getForecast(7), c( rep(7,11), rep(8,13) ) ) #Situation B: +Persistence, (generally) correct pred00_sd = computeForecast(data00, indices, "Persistence", "Persistence", Inf, 24, - same_day=TRUE) + ncores=1, same_day=TRUE) pred00_dd = computeForecast(data00, indices, "Persistence", "Persistence", Inf, 24, - same_day=FALSE) + ncores=1, same_day=FALSE) for (i in 3:7) { - expect_equal(pred00_sd$getSerie(i), rep(i,24)) - expect_equal(pred00_dd$getSerie(i), rep(i,24)) + expect_equal(pred00_sd$getForecast(i), rep(i,24)) + expect_equal(pred00_dd$getForecast(i), rep(i,24)) } #boundaries are special cases: OK if same day, quite wrong otherwise - expect_equal(pred00_sd$getSerie(1), rep(1,24) ) - expect_equal(pred00_dd$getSerie(1), rep(8,24) ) - expect_equal(pred00_sd$getSerie(2), rep(2,24) ) - expect_equal(pred00_dd$getSerie(2), rep(-5,24) ) + expect_equal(pred00_sd$getForecast(1), rep(1,24) ) + expect_equal(pred00_dd$getForecast(1), rep(8,24) ) + expect_equal(pred00_sd$getForecast(2), rep(2,24) ) + expect_equal(pred00_dd$getForecast(2), rep(-5,24) ) pred13_sd = computeForecast(data13, indices, "Persistence", "Persistence", Inf, 24, - same_day=TRUE) + ncores=1, same_day=TRUE) pred13_dd = computeForecast(data13, indices, "Persistence", "Persistence", Inf, 24, - same_day=FALSE) + ncores=1, same_day=FALSE) for (i in 2:6) { - expect_equal(pred13_sd$getSerie(i), c( rep(i,11), rep(i%%7+1,13) ) ) - expect_equal(pred13_dd$getSerie(i), c( rep(i,11), rep(i%%7+1,13) ) ) + expect_equal(pred13_sd$getForecast(i), c( rep(i,11), rep(i%%7+1,13) ) ) + expect_equal(pred13_dd$getForecast(i), c( rep(i,11), rep(i%%7+1,13) ) ) } #boundaries are special cases: OK if same day, quite wrong otherwise - expect_equal(pred13_sd$getSerie(1), c( rep(1,11), rep(2,13) ) ) - expect_equal(pred13_dd$getSerie(1), c( rep(1,11), rep(-5,13) ) ) - expect_equal(pred13_sd$getSerie(7), c( rep(7,11), rep(1,13) ) ) - expect_equal(pred13_dd$getSerie(7), c( rep(7,11), rep(8,13) ) ) + expect_equal(pred13_sd$getForecast(1), c( rep(1,11), rep(2,13) ) ) + expect_equal(pred13_dd$getForecast(1), c( rep(1,11), rep(-5,13) ) ) + expect_equal(pred13_sd$getForecast(7), c( rep(7,11), rep(1,13) ) ) + expect_equal(pred13_dd$getForecast(7), c( rep(7,11), rep(8,13) ) ) #A few extra checks expect_equal( pred00_sd$getIndexInData(3), dateIndexToInteger("2007-04-03",data00) ) @@ -110,37 +110,25 @@ 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") + simtype="mix", local=FALSE) for (i in 1:7) - expect_equal(pred00$getSerie(i), rep(pred_order[i],24)) + expect_equal(pred00$getForecast(i), rep(pred_order[i],24)) pred13 = computeForecast(data13, indices, "Persistence", "Zero", Inf, 24, - simtype="mix") + simtype="mix", local=FALSE) for (i in 1:7) - expect_equal(pred13$getSerie(i), c( rep(i,11), rep(i%%7+1,13) ) ) + expect_equal(pred13$getForecast(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 - # (12*-6+78)/90 = 0.06666667 - # (13*-6+78)/91 = 0 - # (13*-6+79)/92 = 0.01086957 - # (13*-6+80)/93 = 0.02150538 - # (13*-6+81)/94 = 0.03191489 - # (13*-6+82)/95 = 0.04210526 - # (13*-6+83)/96 = 0.05208333 - jumps = c(0.06666667, 0, 0.01086957, 0.02150538, 0.03191489, 0.04210526, 0.05208333) - 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...) + #Situation B: +Neighbors == too difficult to eval in a unit test +# pred00 = computeForecast(data00, indices, "Neighbors", "Neighbors", Inf, 24, +# simtype="endo", local=FALSE) +# jumps = ... +# for (i in 1:7) +# expect_equal(pred00$getForecast(i), rep(pred_order[i]+jumps[i],24)) # pred13 = computeForecast(data13, indices, "Neighbors", "Neighbors", Inf, 24, -# simtype="endo") +# simtype="endo", local=FALSE) # for (i in 1:7) -# expect_equal(pred13$getSerie(i), c( rep(i,11), rep(i%%7+1,13) ) ) +# expect_equal(pred13$getForecast(i), c( rep(i,11), rep(i%%7+1,13) ) ) #A few extra checks expect_equal( pred00$getIndexInData(1), dateIndexToInteger("2007-04-01",data00) ) diff --git a/pkg/tests/testthat/test-computeFilaments.R b/pkg/tests/testthat/test-computeFilaments.R index 355d58d..7e1cafa 100644 --- a/pkg/tests/testthat/test-computeFilaments.R +++ b/pkg/tests/testthat/test-computeFilaments.R @@ -1,46 +1,12 @@ context("computeFilaments") -#shorthand: map 1->1, 2->2, 3->3, 4->1, ..., 149->2, 150->3 -I = function(i) - (i-1) %% 3 + 1 - -#MOCK data; NOTE: could be in inst/testdata as well -getDataTest = function(n) -{ - data = Data$new() - x = seq(0,9.5,0.1) - L = length(x) #96 1/4h - s1 = cos(x) - s2 = sin(x) - s3 = c( s1[1:(L%/%2)] , s2[(L%/%2+1):L] ) - #sum((s1-s2)^2) == 96 - #sum((s1-s3)^2) == 58 - #sum((s2-s3)^2) == 38 - s = list(s1, s2, s3) - series = list() - for (i in seq_len(n)) - { - serie = s[[I(i)]] + rnorm(L,sd=0.01) - level = mean(serie) - serie = serie - level - # 10 series with NAs for index 2 - if (I(i) == 2 && i >= 60 && i<= 90) - serie[sample(seq_len(L),1)] = NA - time = as.POSIXct(i*15*60, origin="2007-01-01", tz="GMT") - exo = runif(4) - exo_hat = runif(4) - data$append(time, serie, level, exo, exo_hat) - } - data -} - test_that("output is as expected on simulated series", { data = getDataTest(150) # index 143 : serie type 2 pred = computeForecast(data, 143, "Neighbors", "Zero", - horizon=length(data$getSerie(1)), simtype="endo", h_window=1) + horizon=length(data$getSerie(1)), simtype="endo", local=FALSE, h_window=1) f = computeFilaments(data, pred, 1, limit=60, plot=FALSE) # Expected output: 50-3-10 series of type 2, then 23 series of type 3 (closest next) @@ -63,7 +29,7 @@ test_that("output is as expected on simulated series", # index 142 : serie type 1 pred = computeForecast(data, 142, "Neighbors", "Zero", - horizon=length(data$getSerie(1)), simtype="endo", h_window=1) + horizon=length(data$getSerie(1)), simtype="endo", local=FALSE, h_window=1) f = computeFilaments(data, pred, 1, limit=50, plot=FALSE) # Expected output: 50-10-3 series of type 1, then 13 series of type 3 (closest next) diff --git a/pkg/tests/testthat/test-similarDays.R b/pkg/tests/testthat/test-similarDays.R index 0d33fce..05a7b0e 100644 --- a/pkg/tests/testthat/test-similarDays.R +++ b/pkg/tests/testthat/test-similarDays.R @@ -1,16 +1,27 @@ context("Get similar days") -itestthat("getSimilarDaysIndices works as expected", +test_that("getSimilarDaysIndices works as expected", { - getSimilarDaysIndices(index, data, limit, same_season, days_in=NULL) - #... + data = getDataTest(150) + + # Index 142 is a tuesday (142 = 2 mod 7) + N142_1 = getSimilarDaysIndices(142, data, limit=7, same_season=FALSE, days_in=NULL) + expect_equal(N142_1, c(141,137,136,135,134,130,129)) + # Index 139 = saturday + N139_1 = getSimilarDaysIndices(139, data, limit=7, same_season=FALSE, days_in=NULL) + expect_equal(N139_1, c(132,125,118,111,104,97,90)) + + # With 'days_in' constraint + N142_2 = getSimilarDaysIndices(142, data, limit=7, same_season=FALSE, days_in=2*(1:75)) + expect_equal(N142_2, c(136,134,130,128,122,120,116)) + N139_2 = getSimilarDaysIndices(139, data, limit=7, same_season=FALSE, days_in=2*(1:75)) + expect_equal(N139_2, c(132,118,104,90,76,62,48)) }) -{ - index = dateIndexToInteger(index, data) -testthat("getConstrainedNeighbs works as expected", +test_that("getConstrainedNeighbs works as expected", { - .getConstrainedNeighbs(today, data, fdays, min_neighbs=10, max_neighbs=12) - #... +# data = getDataTest(150) +# N142_1 = .getConstrainedNeighbs(142, data, fdays, min_neighbs=7, max_neighbs=7) +# #...maybe we need an easier test data })