X-Git-Url: https://git.auder.net/doc/screen_ranking.png?a=blobdiff_plain;f=pkg%2Ftests%2Ftestthat%2Ftest.Forecaster.R;h=945320c7018594e2d474a47bb6dfc49ce215a88f;hb=defcae035f2e26fd8568cedb27040b173811b246;hp=b20f104f72a5b4b14107f6775d41c904cd5de36f;hpb=6d97bfecf7310ed6682eecce1b7aa2f8185d4742;p=talweg.git

diff --git a/pkg/tests/testthat/test.Forecaster.R b/pkg/tests/testthat/test.Forecaster.R
index b20f104..945320c 100644
--- a/pkg/tests/testthat/test.Forecaster.R
+++ b/pkg/tests/testthat/test.Forecaster.R
@@ -1,35 +1,91 @@
 context("Check that forecasters behave as expected")
 
-test_that("Average+Zero method behave as expected",
-{
-
-test_that("Persistence+Zero method behave as expected",
-{
+ts_data = system.file("testdata","ts_test.csv",package="talweg")
+exo_data = system.file("testdata","exo_test.csv",package="talweg")
+data00 <<- getData(ts_data, exo_data, input_tz="GMT", date_format="%Y-%m-%d %H:%M",
+	working_tz="GMT", predict_at=0, limit=Inf)
+data13 <<- getData(ts_data, exo_data, input_tz="GMT", date_format="%Y-%m-%d %H:%M",
+	working_tz="GMT", predict_at=13, limit=Inf)
+#Forecast at sunday to saturday (series 7 to 1), for monday to sunday (series 1 to 7)
+indices <<- seq(as.Date("2007-04-01"),as.Date("2007-04-07"),"days")
+pred_order = c(7,1:6) #will facilitate tests
 
-test_that("Neighbors+Zero method behave as expected",
+test_that("Average method behave as expected",
 {
+	pred00_z = getForecast(data00, indices, "Average", "Zero",        Inf, 24)
+	pred00_p = getForecast(data00, indices, "Average", "Persistence", Inf, 24)
+	for (i in seq_along(indices))
+	{
+		#zero jump: should predict true values minus 1
+		expect_equal(pred00_z$getSerie(i), rep(pred_order[i],24))
+		#persistence jump == 1: should predict true values
+		expect_equal(pred00_p$getSerie(i), rep(i,24))
+	}
 
-test_that("Neighbors+Neighbors method behave as expected",
-{
+	#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 wrong)
+	pred13_z = getForecast(data13, indices, "Average", "Zero",        Inf, 24)
+	pred13_p = getForecast(data13, indices, "Average", "Persistence", Inf, 24)
+	prediction = c(rep(-13/24,11),rep(11/24,13))
+	for (i in seq_along(indices))
+	{
+		expect_equal(pred13_z$getSerie(i), prediction ) ##TODO: prendre en compte recollement
+		expect_equal(pred13_p$getSerie(i), prediction )
+	}
 
+	#A few extra checks
+	expect_identical( pred00_sd$getIndexInData(1), dateIndexToInteger("2007-04-01",data00) )
+	expect_identical( pred13_dd$getIndexInData(3), dateIndexToInteger("2007-04-03",data13) )
+	expect_identical( pred00_dd$getIndexInData(5), dateIndexToInteger("2007-04-05",data00) )
+})
 
+test_that("Persistence method behave as expected",
+{
+	#Situation A: +Zero; always wrong
+	pred00_sd = getForecast(data00, indices, "Persistence", "Zero", Inf, 24, same_day=TRUE)
+	pred00_dd = getForecast(data00, indices, "Persistence", "Zero", Inf, 24, same_day=FALSE)
+	for (i in seq_along(indices))
+	{
+		expect_identical(pred00_sd$getSerie(i), rep(i,24))
+		expect_identical(pred00_dd$getSerie(i), rep(i,24))
+	}
 
-#TODO: with and without shift at origin (so series values at least forst ones are required)
+	pred13_sd = getForecast(data13, indices, "Persistence", "Zero", Inf, 24, same_day=TRUE)
+	pred13_dd = getForecast(data13, indices, "Persistence", "Zero", Inf, 24, same_day=FALSE)
+	for (i in seq_along(indices))
+	{
+		expect_identical(pred13_sd$getSerie(i), c( rep(i,11), rep(i%%7+1,13) ) )
+		expect_identical(pred13_dd$getSerie(i), c( rep(i,11), rep(i%%7+1,13) ) )
+	}
 
+	#Situation B: +Persistence, correct when predict_at==0
+	pred00_sd = getForecast(data00, indices, "Persistence", "Persistence", Inf, 24, same_day=TRUE)
+	pred00_dd = getForecast(data00, indices, "Persistence", "Persistence", Inf, 24, same_day=FALSE)
+	for (i in seq_along(indices))
+	{
+		expect_identical(pred00_sd$getSerie(i), rep(i%%7+1,24))
+		expect_identical(pred00_dd$getSerie(i), rep(i%%7+1,24))
+	}
 
-	n = 1500
-	series = list()
-	for (i in seq_len(n))
+	pred13_sd = getForecast(data13, indices, "Persistence", "Persistence", Inf, 24, same_day=TRUE)
+	pred13_dd = getForecast(data13, indices, "Persistence", "Persistence", Inf, 24, same_day=FALSE)
+	for (i in seq_along(indices))
 	{
-		index = (i%%3) + 1
-		level = mean(s[[index]])
-		serie = s[[index]] - level + rnorm(L,sd=0.05)
-		# 10 series with NAs for index 2
-		if (index == 2 && i >= 60 && i<= 90)
-			serie[sample(seq_len(L),1)] = NA
-		series[[i]] = list("level"=level,"serie"=serie) #no need for more :: si : time !!!
+		expect_identical(pred13_sd$getSerie(i), c( rep(i,11), rep(i%%7+1,13) ) )
+		expect_identical(pred13_dd$getSerie(i), c( rep(i,11), rep(i%%7+1,13) ) )
 	}
-	data = new("Data", data=series)
 
-	dateIndexToInteger = function(index, data)
+	#A few extra checks
+	expect_identical( pred13_sd$getIndexInData(1), dateIndexToInteger("2007-04-01",data12) )
+	expect_identical( pred00_dd$getIndexInData(3), dateIndexToInteger("2007-04-03",data00) )
+	expect_identical( pred13_dd$getIndexInData(5), dateIndexToInteger("2007-04-05",data13) )
+})
+
+test_that("Neighbors+Zero method behave as expected",
+{
+})
+
+test_that("Neighbors+Neighbors method behave as expected",
+{
 })