| 1 | context("Check that forecasters behave as expected") |
| 2 | |
| 3 | ts_data = system.file("testdata","ts_test.csv",package="talweg") |
| 4 | exo_data = system.file("testdata","exo_test.csv",package="talweg") |
| 5 | data_p <<- getData(ts_data, exo_data, date_format="%Y-%m-%d %H:%M", limit=Inf) |
| 6 | #Forecasts from monday to sunday (series 1 to 7) |
| 7 | indices <<- seq(as.Date("2007-04-02"),as.Date("2007-04-08"),"days") |
| 8 | pred_order = c(7,1:6) #will facilitate tests |
| 9 | |
| 10 | test_that("Average method behave as expected", |
| 11 | { |
| 12 | pred00_z = computeForecast(data_p, indices, "Average", "LastValue", 1, Inf, 24, ncores=1) |
| 13 | pred00_p = computeForecast(data_p, indices, "Average", "Persistence", 1, Inf, 24) |
| 14 | for (i in 1:7) |
| 15 | { |
| 16 | #zero jump: should predict true values minus 1 |
| 17 | expect_equal( pred00_z$getForecast(i), rep(pred_order[i],24) ) |
| 18 | #persistence jump == 1: should predict true values |
| 19 | expect_equal( pred00_p$getForecast(i), rep(i,24) ) |
| 20 | } |
| 21 | |
| 22 | #NOTE: 24h-block become |
| 23 | #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) |
| 24 | #No jump between days, thus zero and persistence are equivalent (and correct) |
| 25 | pred13_z = computeForecast(data_p, indices, "Average", "LastValue", 14, Inf, 24) |
| 26 | pred13_p = computeForecast(data_p, indices, "Average", "Persistence", 14, Inf, 24) |
| 27 | for (i in 1:7) |
| 28 | { |
| 29 | expect_equal( pred13_z$getForecast(i), rep(i,24) ) |
| 30 | expect_equal( pred13_p$getForecast(i), rep(i,24) ) |
| 31 | } |
| 32 | |
| 33 | #A few extra checks |
| 34 | expect_equal( pred00_p$getIndexInData(2), dateIndexToInteger("2007-04-03",data_p) ) |
| 35 | expect_equal( pred00_z$getIndexInData(2), dateIndexToInteger("2007-04-03",data_p) ) |
| 36 | expect_equal( pred13_p$getIndexInData(5), dateIndexToInteger("2007-04-06",data_p) ) |
| 37 | expect_equal( pred13_z$getIndexInData(5), dateIndexToInteger("2007-04-06",data_p) ) |
| 38 | }) |
| 39 | |
| 40 | test_that("Persistence method behave as expected", |
| 41 | { |
| 42 | #Situation A: +Zero; (generally) correct if jump, wrong otherwise |
| 43 | pred00_sd = computeForecast(data_p, indices, "Persistence", "LastValue", 1, Inf, 24, |
| 44 | ncores=1, same_day=TRUE) |
| 45 | pred00_dd = computeForecast(data_p, indices, "Persistence", "LastValue", 1, Inf, 24, |
| 46 | ncores=1, same_day=FALSE) |
| 47 | for (i in 1:7) |
| 48 | { |
| 49 | expect_equal(pred00_sd$getForecast(i), rep(pred_order[i],24)) |
| 50 | expect_equal(pred00_dd$getForecast(i), rep(pred_order[i],24)) |
| 51 | } |
| 52 | |
| 53 | pred13_sd = computeForecast(data_p, indices, "Persistence", "LastValue", 14, Inf, 24, |
| 54 | ncores=1, same_day=TRUE) |
| 55 | pred13_dd = computeForecast(data_p, indices, "Persistence", "LastValue", 14, Inf, 24, |
| 56 | ncores=1, same_day=FALSE) |
| 57 | for (i in 1:7) |
| 58 | { |
| 59 | expect_equal(pred13_sd$getForecast(i), rep(i,24) ) |
| 60 | expect_equal(pred13_dd$getForecast(i), rep(i,24) ) |
| 61 | } |
| 62 | |
| 63 | #Situation B: +Persistence, (generally) correct |
| 64 | pred00_sd = computeForecast(data_p, indices, "Persistence", "Persistence", 1, Inf, 24, |
| 65 | ncores=1, same_day=TRUE) |
| 66 | pred00_dd = computeForecast(data_p, indices, "Persistence", "Persistence", 1, Inf, 24, |
| 67 | ncores=1, same_day=FALSE) |
| 68 | for (i in 3:7) |
| 69 | { |
| 70 | expect_equal(pred00_sd$getForecast(i), rep(i,24)) |
| 71 | expect_equal(pred00_dd$getForecast(i), rep(i,24)) |
| 72 | } |
| 73 | #boundaries are special cases: OK if same day, quite wrong otherwise |
| 74 | expect_equal(pred00_sd$getForecast(1), rep(1,24) ) |
| 75 | expect_equal(pred00_dd$getForecast(1), rep(8,24) ) |
| 76 | expect_equal(pred00_sd$getForecast(2), rep(2,24) ) |
| 77 | expect_equal(pred00_dd$getForecast(2), rep(-5,24) ) |
| 78 | |
| 79 | pred13_sd = computeForecast(data_p, indices, "Persistence", "Persistence", 14, Inf, 24, |
| 80 | ncores=1, same_day=TRUE) |
| 81 | pred13_dd = computeForecast(data_p, indices, "Persistence", "Persistence", 14, Inf, 24, |
| 82 | ncores=1, same_day=FALSE) |
| 83 | for (i in 1:7) |
| 84 | { |
| 85 | expect_equal(pred13_sd$getForecast(i), rep(i,24) ) |
| 86 | expect_equal(pred13_dd$getForecast(i), rep(i,24) ) |
| 87 | } |
| 88 | |
| 89 | #A few extra checks |
| 90 | expect_equal( pred00_sd$getIndexInData(3), dateIndexToInteger("2007-04-04",data_p) ) |
| 91 | expect_equal( pred00_dd$getIndexInData(6), dateIndexToInteger("2007-04-07",data_p) ) |
| 92 | expect_equal( pred13_sd$getIndexInData(3), dateIndexToInteger("2007-04-04",data_p) ) |
| 93 | expect_equal( pred13_dd$getIndexInData(6), dateIndexToInteger("2007-04-07",data_p) ) |
| 94 | }) |
| 95 | |
| 96 | test_that("Neighbors method behave as expected", |
| 97 | { |
| 98 | #Situation A: +Zero; correct if jump, wrong otherwise |
| 99 | pred00 = computeForecast(data_p, indices, "Neighbors", "LastValue", 1, Inf, 24, |
| 100 | simtype="mix", local=FALSE, window=c(1,1)) |
| 101 | for (i in 1:7) |
| 102 | expect_equal(pred00$getForecast(i), rep(pred_order[i],24)) |
| 103 | |
| 104 | pred13 = computeForecast(data_p, indices, "Persistence", "LastValue", 14, Inf, 24, |
| 105 | simtype="mix", local=FALSE, window=c(1,1)) |
| 106 | for (i in 1:7) |
| 107 | expect_equal(pred13$getForecast(i), rep(i,24) ) |
| 108 | |
| 109 | #Situation B: +Neighbors == too difficult to eval in a unit test |
| 110 | # pred00 = computeForecast(data_p, indices, "Neighbors", "Neighbors", 1, Inf, 24, |
| 111 | # simtype="endo", local=FALSE) |
| 112 | # jumps = ... |
| 113 | # for (i in 1:7) |
| 114 | # expect_equal(pred00$getForecast(i), rep(pred_order[i]+jumps[i],24)) |
| 115 | # pred13 = computeForecast(data_p, indices, "Neighbors", "Neighbors", 14, Inf, 24, |
| 116 | # simtype="endo", local=FALSE) |
| 117 | # for (i in 1:7) |
| 118 | # expect_equal(pred13$getForecast(i), c( rep(i,11), rep(i%%7+1,13) ) ) |
| 119 | |
| 120 | #A few extra checks |
| 121 | expect_equal( pred00$getIndexInData(1), dateIndexToInteger("2007-04-02",data_p) ) |
| 122 | expect_equal( pred00$getIndexInData(4), dateIndexToInteger("2007-04-05",data_p) ) |
| 123 | expect_equal( pred13$getIndexInData(1), dateIndexToInteger("2007-04-02",data_p) ) |
| 124 | expect_equal( pred13$getIndexInData(4), dateIndexToInteger("2007-04-05",data_p) ) |
| 125 | }) |