test_that("regression calculates the right coeffs", {
set.seed(5)
mensualts <- ts(diffinv(rnorm(120,1,1)),start=2010,freq=12)
annualts <- ts(diffinv(rnorm(9,12,1)),start=2010,freq=1)
expect_equal(unname(coef(twoStepsBenchmark(hfserie = mensualts,
lfserie = annualts,
include.differenciation = FALSE))),
c(-4.42319837305,0.07996253268))
expect_equal(unname(coef(twoStepsBenchmark(hfserie = mensualts,
lfserie = annualts,
include.differenciation = FALSE,
set.const=-4.42319837305,set.coeff=0.07996253268))),
c(-4.42319837305,0.07996253268))
expect_equal(unname(coef(twoStepsBenchmark(hfserie = mensualts,
lfserie = annualts,
include.differenciation = FALSE,
set.const=-3))),
c(-3,0.07851836099))
expect_equal(unname(coef(twoStepsBenchmark(hfserie = mensualts,
lfserie = annualts,
include.differenciation = FALSE,
set.const=10))),
c(10,0.06532678329))
expect_equal(unname(coef(twoStepsBenchmark(hfserie = mensualts,
lfserie = annualts,
include.differenciation = FALSE,
set.coeff=-3))),
c(2264.800948259,-3))
expect_equal(unname(coef(twoStepsBenchmark(hfserie = mensualts,
lfserie = annualts,
include.differenciation = FALSE,
set.coeff=10))),
c(-7313.2096909,10))
expect_equal(unname(coef(twoStepsBenchmark(hfserie = mensualts,
lfserie = annualts,
include.differenciation = FALSE,
set.const=10))),
c(10,0.06532678329))
expect_equal(unname(coef(twoStepsBenchmark(hfserie = mensualts,
lfserie = annualts,
include.differenciation = TRUE))),
c(13.268370447389,-0.008573728055))
expect_equal(unname(coef(twoStepsBenchmark(hfserie = mensualts,
lfserie = annualts,
include.differenciation = TRUE,
set.const=-3))),
c(-3,0.0964113832))
expect_equal(unname(coef(twoStepsBenchmark(hfserie = mensualts,
lfserie = annualts,
include.differenciation = TRUE,
set.const=10))),
c(10,0.0125181346))
expect_equal(unname(coef(twoStepsBenchmark(hfserie = mensualts,
lfserie = annualts,
include.differenciation = TRUE,
set.coeff=-3))),
c(458.8907581,-3))
expect_equal(unname(coef(twoStepsBenchmark(hfserie = mensualts,
lfserie = annualts,
include.differenciation = TRUE,
set.coeff=10))),
c(-1477.674115137,10))
expect_equal(unname(coef(twoStepsBenchmark(hfserie = mensualts,
lfserie = annualts,
include.differenciation = TRUE,
set.const=10))),
c(10.00000000,0.0125181346))
expect_equal(unname(coef(twoStepsBenchmark(hfserie = mensualts,
lfserie = annualts,
include.differenciation = TRUE))),
c(13.268370447389,-0.008573728055))
expect_equal(unname(coef(twoStepsBenchmark(hfserie = mensualts,
lfserie = annualts,
include.differenciation = TRUE,
set.const=-3))),
c(-3,0.0964113832))
expect_equal(unname(coef(twoStepsBenchmark(hfserie = mensualts,
lfserie = annualts,
include.differenciation = TRUE,
set.const=10))),
c(10,0.0125181346))
expect_equal(unname(coef(twoStepsBenchmark(hfserie = mensualts,
lfserie = annualts,
include.differenciation = TRUE,
set.coeff=-3))),
c(458.890758064,-3))
expect_equal(unname(coef(twoStepsBenchmark(hfserie = mensualts,
lfserie = annualts,
include.differenciation = TRUE,
set.coeff=10))),
c(-1477.674115137,10))
expect_equal(unname(coef(twoStepsBenchmark(hfserie = mensualts,
lfserie = annualts,
include.differenciation = TRUE,
set.const=10))),
c(10,0.0125181346))
expect_equal(unname(coef(twoStepsBenchmark(hfserie = mensualts,
lfserie = annualts,
include.rho = TRUE))),
c(-4.39884838,0.07989426))
expect_equal(unname(coef(twoStepsBenchmark(hfserie = mensualts,
lfserie = annualts,
include.rho = TRUE,
set.const=-3))),
c(-3,0.07853606978))
expect_equal(unname(coef(twoStepsBenchmark(hfserie = mensualts,
lfserie = annualts,
include.rho = TRUE,
set.const=10))),
c(10,0.06933153642))
expect_equal(unname(coef(twoStepsBenchmark(hfserie = mensualts,
lfserie = annualts,
include.rho = TRUE,
set.coeff = c(constant=10)))),
c(10,0.06933153642))
expect_equal(unname(coef(twoStepsBenchmark(hfserie = mensualts,
lfserie = annualts,
include.rho = TRUE,
set.coeff=-3))),
c(2259.176133,-3))
expect_equal(unname(coef(twoStepsBenchmark(hfserie = mensualts,
lfserie = annualts,
include.rho = TRUE,
set.coeff=10))),
c(-7296.108579,10))
expect_equal(unname(coef(twoStepsBenchmark(hfserie = mensualts,
lfserie = annualts,
include.rho = TRUE,
set.const=10))),
c(10,0.06933153642))
})
test_that("Error if any missing value between the coefficient calc",{
set.seed(5)
mensualts <- ts(diffinv(rnorm(30,1,1)),start=c(2010,3),freq=12)
annualts <- ts(diffinv(rnorm(2,12,1)),start=2011,freq=1)
expect_error(twoStepsBenchmark(mensualts,annualts,include.differenciation = TRUE))
mensualts <- ts(diffinv(rnorm(30,1,1)),start=c(2010,3),freq=12)
annualts <- ts(diffinv(rnorm(2,12,1)),start=2010,freq=1)
expect_error(twoStepsBenchmark(mensualts,annualts,include.differenciation = TRUE))
mensualts <- ts(diffinv(rnorm(36,1,1)),start=c(2010,1),freq=12)
annualts <- ts(diffinv(rnorm(2,12,1)),start=2010,freq=1)
expect_s4_class(twoStepsBenchmark(mensualts,annualts,include.differenciation = TRUE),"twoStepsBenchmark")
mensualts[10] <- NA
expect_error(twoStepsBenchmark(mensualts,annualts,include.differenciation = TRUE))
})
test_that("twoStepsBenchmark works",
{
set.seed(5)
mensualts <- ts(diffinv(rnorm(30,1,1)),start=c(2010,4),freq=12)
trimts <- ts(diffinv(rnorm(2,12,1)),start=2011,freq=4)
expect_snapshot(print(twoStepsBenchmark(mensualts,trimts,include.differenciation = TRUE),
digits = 4L),
cran = FALSE)
set.seed(32)
mensualts <- ts(diffinv(rnorm(30,1,1)),start=c(2010,3),freq=12)
trimts <- ts(diffinv(rnorm(2,12,1)),start=2011,freq=4)
bn <- twoStepsBenchmark(mensualts,trimts,include.differenciation = TRUE)
expect_snapshot(print(bn, digits = 4L), cran = FALSE)
expect_equal(aggregate(window(as.ts(bn),start=c(2010,4)),nf=4)-trimts,ts(c(0,0,0),start=2011,freq=4))
expect_snapshot(print(twoStepsBenchmark(turnover,construction,
include.differenciation = TRUE,
include.rho = TRUE),
digits = 4L),
cran = FALSE)
})
test_that("colname is taken even with ncol = 1",
{
turnover_modif <- turnover
dim(turnover_modif) <- c(length(turnover),1L)
colnames(turnover_modif) <- "test"
expect_identical(names(coef(twoStepsBenchmark(turnover_modif,construction)))[2L],
"test")
})
test_that("standard errors are the same that the vcov diag",{
set.seed(5)
mensualts <- ts(diffinv(rnorm(120,1,1)),start=2010,freq=12)
annualts <- ts(diffinv(rnorm(9,12,1)),start=2010,freq=1)
bn <- twoStepsBenchmark(hfserie = mensualts,
lfserie = annualts,
include.differenciation = FALSE)
stderror <- se(bn)
stderror <- stderror[!is.na(stderror)]
expect_equal(unname(stderror),unname(sqrt(abs(diag(vcov(bn))))))
set.seed(20)
mensualts <- ts(diffinv(rnorm(240,1,1)),start=2010,freq=12)
annualts <- ts(diffinv(rnorm(18,12,1)),start=2010,freq=1)
bn <- twoStepsBenchmark(hfserie = mensualts,
lfserie = annualts,
include.differenciation = TRUE)
stderror <- se(bn)
stderror <- stderror[!is.na(stderror)]
expect_equal(unname(stderror),unname(sqrt(abs(diag(vcov(bn))))))
bn <- twoStepsBenchmark(hfserie = mensualts,
lfserie = annualts,
include.differenciation = TRUE,set.coeff = 3)
stderror <- se(bn)
stderror <- stderror[!is.na(stderror)]
expect_equal(unname(stderror),unname(sqrt(abs(diag(vcov(bn))))))
})
test_that("mts works",{
bn <- twoStepsBenchmark(ts(matrix(rnorm(900,0,100) ,ncol=3),start=c(2000,1),freq=12) %>%
`colnames<-`(c("a","b","c")),construction)
expect_snapshot(print(bn, digits = 4L), cran = FALSE)
expect_identical(names(coef(bn)),c("constant","a","b","c"))
mat <- cbind(turnover,lag(turnover))
colnames(mat) <- c("turnover","lag turnover")
bn <- twoStepsBenchmark(mat,construction,include.differenciation=TRUE,
set.coeff = c(turnover=0.1),set.const=0)
expect_equal(coef(bn)[c("constant","turnover")],c(constant=0, turnover=0.1))
bn <- twoStepsBenchmark(mat,construction,include.differenciation=TRUE,
set.coeff = c(turnover=0.1,`lag turnover`=0.05),set.const=0)
expect_equal(coef(bn),c(constant=0, turnover=0.1,`lag turnover`=0.05))
})
test_that("The classes in the bn object are the good ones",{
set.seed(18)
mensualts <- ts(diffinv(rnorm(120,1,1)),start=2010,freq=12)
trimts <- ts(diffinv(rnorm(36,12,1)),start=2010,freq=4)
bn <- twoStepsBenchmark(hfserie = mensualts,
lfserie = trimts,
include.differenciation = TRUE)
expect_s4_class(bn,"twoStepsBenchmark")
expect_true(is.ts(bn$benchmarked.serie))
expect_true(is.ts(bn$fitted.values))
expect_s3_class(bn$regression,"praislm")
expect_true(is.list(bn$model.list))
expect_true(is.call(bn$call))
expect_true(is.ts(bn$model.list$hfserie))
expect_true(is.ts(bn$model.list$lfserie))
expect_true(is.logical(bn$model.list$include.rho))
expect_true(is.logical(bn$model.list$include.differenciation))
expect_true(is.numeric(bn$model.list$set.coefficients))
expect_true(is.null(bn$model.list$start.coeff.calc))
expect_true(is.null(bn$model.list$end.coeff.calc))
expect_true(is.numeric(bn$regression$coefficients))
expect_true(is.ts(bn$regression$residuals))
expect_true(is.ts(bn$regression$fitted.values))
expect_true(is.numeric(bn$regression$se))
expect_true(is.numeric(bn$regression$df.residual))
expect_true(is.numeric(bn$regression$rho))
expect_true(is.ts(bn$regression$residuals.decorrelated))
expect_true(is.ts(bn$regression$fitted.values.decorrelated))
})
test_that("windows and extraps works",{
set.seed(27)
mensualts <- ts(diffinv(rnorm(120,1,1)),start=2010,freq=12)
trimts <- ts(diffinv(rnorm(36,12,1)),start=2010,freq=4)
bn <- twoStepsBenchmark(hfserie = mensualts,
lfserie = trimts,
include.rho = TRUE,
start.coeff.calc = c(2012,2),
start.domain = c(2011,3))
asp <- aggregate(smoothed.part(bn),nf=4)
extrap <- asp/lag(asp,-1)
expect_equal(as.numeric(window(extrap,start=c(2011,2),end=c(2011,2),extend=TRUE)),
rho(bn))
expect_equal(as.numeric(window(extrap,start=c(2019,2))),
rep(rho(bn),4))
bn <- twoStepsBenchmark(hfserie = mensualts,
lfserie = trimts,
include.rho = TRUE,
include.differenciation = TRUE,
start.coeff.calc = c(2012,2),
start.domain = c(2011,3))
asp <- aggregate(smoothed.part(bn),nf=4)
extrap <- diff(asp)/lag(diff(asp),-1)
expect_equal(as.numeric(window(extrap,start=c(2011,3),end=c(2011,3),extend=TRUE)),
rho(bn))
expect_equal(as.numeric(window(extrap,start=c(2019,2))),
rep(rho(bn),4))
expect_equal(tsp(as.ts(bn)),tsp(window(mensualts,start=c(2011,3))))
bn <- twoStepsBenchmark(hfserie = mensualts,
lfserie = trimts,
include.rho = TRUE,
end.coeff.calc = c(2014,2),
end.domain = c(2015,5))
asp <- aggregate(smoothed.part(bn),nf=4)
extrap <- asp/lag(asp,-1)
expect_equal(as.numeric(window(extrap,start=c(2015,2))),
rho(bn))
expect_equal(tsp(as.ts(bn)),tsp(window(mensualts,end=c(2015,5))))
bn <- twoStepsBenchmark(hfserie = mensualts,
lfserie = trimts,
include.rho = FALSE,
include.differenciation = FALSE,
start.benchmark = c(2012,1),
end.benchmark = c(2014,3))
asp <- aggregate(smoothed.part(bn),nf=4)
residextrap <- window(window(residuals(bn),start=c(2012,1),end=c(2014,3),extend=TRUE),
start=start(asp),end=end(asp),extend=TRUE)
residextrap[is.na(residextrap)] <- 0
expect_equal(asp,residextrap)
})
test_that("errors",{
set.seed(5L)
wrong_name_mts <- structure(
ts(matrix(rnorm(500L),ncol = 2L),
frequency = 12, start=2000),
dimnames = list(NULL,c("test","constant"))
)
expect_error(twoStepsBenchmark(wrong_name_mts,construction),
regexp = "Invalid colnames")
expect_error(twoStepsBenchmark(turnover,construction,
outliers = list(AO2000=rep(0.1,12),
AO2000=1:12)),
regexp = "Invalid colnames")
wrong_rank_mts <- cbind(turnover,turnover)
colnames(wrong_rank_mts) <- c("a","b")
expect_error(twoStepsBenchmark(wrong_rank_mts,construction),
regexp = "perfect rank")
set.seed(2L)
correct_names_mts <- ts(matrix(rnorm(900,0,100) ,ncol=3),
start=c(2000,1),
freq=12)
colnames(correct_names_mts) <- c("a","b","c")
expect_error(twoStepsBenchmark(correct_names_mts,construction,
set.coeff = c(test=1)),
"These names of the set.coeff argument are not found : test")
expect_error(twoStepsBenchmark(correct_names_mts,construction,set.coeff = c(a=NA)),
regexp = "be set to NA")
expect_error(twoStepsBenchmark(1:10,construction),
regexp = "Not a ts object")
expect_error(twoStepsBenchmark(matrix(1:9,3,3),construction),
regexp = "Not a ts object")
expect_error(twoStepsBenchmark(turnover,1:10),
regexp = "Not a ts object")
expect_error(twoStepsBenchmark(window(turnover,start=2001),construction),
regexp = "must have values")
expect_error(twoStepsBenchmark(turnover,construction,set.const=c(1,2)),
regexp = "single value")
expect_error(twoStepsBenchmark(ts(matrix(rnorm(900,0,100) ,ncol=3),start=c(2000,1),freq=12) %>%
`unname`,construction),
regexp = "column names")
expect_error(twoStepsBenchmark(ts(matrix(rnorm(900,0,100) ,ncol=3),start=c(2000,1),freq=12) %>%
`colnames<-`(c("a","b","c")),
construction,
set.coeff=1:4),
regexp = "empty or have names")
expect_error(twoStepsBenchmark(turnover,construction,
outlier=list(AO2006=ts(rep(0.1,12),start=c(2005,1),frequency=12))),
"windows or frequencies")
expect_error(twoStepsBenchmark(turnover,construction,
outlier=list(AO2006=ts(rep(0.1,12),start=c(2006,1),frequency=4))),
"windows or frequencies")
expect_equal(as.ts(twoStepsBenchmark(turnover,construction,
outlier=list(AO2006=ts(rep(0.1,12),start=c(2006,1),frequency=12)))),
as.ts(twoStepsBenchmark(turnover,construction,
outlier=list(AO2006=rep(0.1,12)))))
expect_error(twoStepsBenchmark_impl(turnover,construction,
start.coeff.calc = 2000,
end.coeff.calc = 2010,
start.domain = 2000,
end.domain= 2020.333,
include.rho=FALSE,
include.differenciation = TRUE,
set_coefficients = numeric(),
maincl = NULL),
regexp = "Not a matrix")
expect_error(twoStepsBenchmark(turnover,construction,set.smoothed.part=pi),
regexp = "univariate time-serie")
expect_error(twoStepsBenchmark(turnover,cbind(construction,construction)),
regexp = "one-dimensional")
expect_error(twoStepsBenchmark(turnover,ts(1:700,start=2000,frequency=7)),
regexp = "should divide")
expect_error(twoStepsBenchmark(ts(1:10,frequency=0.5),ts(1:10,frequency=0.25)),
regexp = "integer")
set.seed(20)
expect_error(twoStepsBenchmark(hfserie = ts(diffinv(rnorm(240,1,1)),start=2010.1,freq=12),
lfserie = ts(diffinv(rnorm(18,12,1)),start=2010,freq=1),
include.differenciation = TRUE),
"time-serie phase")
expect_error(twoStepsBenchmark(hfserie = ts(diffinv(rnorm(240,1,1)),start=2010,freq=12),
lfserie = ts(diffinv(rnorm(18,12,1)),start=2010.1,freq=1),
include.differenciation = TRUE),
"time-serie phase")
})
test_that("reUseBenchmark works",{
benchmark1 <- twoStepsBenchmark(turnover,construction,include.rho = TRUE,
start.coeff.calc=2001,end.coeff.calc=2015,
start.benchmark=2002,end.benchmark=2018,
start.domain = c(2000,2),end.domain=c(2020,12))
adjusted_turnover <- window(turnover-decompose(turnover,type = "additive")$seasonal,start=2006)
adjusted_turnover <- adjusted_turnover + ts_expand(aggregate(turnover-adjusted_turnover),nfrequency = 12)
benchmark2 <- reUseBenchmark(adjusted_turnover,benchmark1)
benchmark3 <- reUseBenchmark(adjusted_turnover,benchmark1,reeval.smoothed.part = TRUE)
m1 <- model.list(benchmark1)
m2 <- model.list(benchmark2)
m3 <- model.list(benchmark3)
expect_equal(window(aggregate(window(benchmark2,start=2006,extend = TRUE)),end=2018),
window(construction,start=2006,end = 2018),
ignore_attr = TRUE,
tolerance = 10^-6)
expect_equal(m2$hfserie[,"constant"],
window(m1$hfserie[,"constant"],start=2006,end = c(2019,12)),
ignore_attr = TRUE,
tolerance = 10^-6)
expect_identical(smoothed.part(benchmark2),smoothed.part(benchmark1))
expect_identical(coefficients(benchmark1),coefficients(benchmark2))
expect_identical(m1$include.rho,m2$include.rho)
expect_identical(m1$include.differenciation,m2$include.differenciation)
expect_identical(m1$start.coeff.calc,m2$start.coeff.calc)
expect_identical(m1$end.coeff.calc,m2$end.coeff.calc)
expect_identical(m1$start.benchmark,m2$start.benchmark)
expect_identical(m1$end.benchmark,m2$end.benchmark)
expect_identical(m1$start.domain,m2$start.domain)
expect_identical(m1$end.domain,m2$end.domain)
expect_identical(smoothed.part(benchmark1),m2$set.smoothed.part)
expect_false(identical(smoothed.part(benchmark3),smoothed.part(benchmark1)))
expect_identical(coefficients(benchmark1),coefficients(benchmark3))
expect_identical(m1$include.rho,m3$include.rho)
expect_identical(m1$include.differenciation,m3$include.differenciation)
expect_identical(m1$start.coeff.calc,m3$start.coeff.calc)
expect_identical(m1$end.coeff.calc,m3$end.coeff.calc)
expect_identical(m1$start.benchmark,m3$start.benchmark)
expect_identical(m1$end.benchmark,m3$end.benchmark)
expect_identical(m1$start.domain,m3$start.domain)
expect_identical(m1$end.domain,m3$end.domain)
expect_null(m1$set.smoothed.part)
expect_null(m3$set.smoothed.part)
expect_false(identical(as.ts(benchmark3),as.ts(benchmark2)))
benchmark <- twoStepsBenchmark(turnover,construction)
turnover_modif <- turnover
turnover_modif[1] <- turnover[1]+pi
benchmark2 <- reUseBenchmark(turnover_modif,benchmark)
coefficients <- coef(benchmark)
expect_equal((as.ts(benchmark2)-as.ts(benchmark))[1],pi*coefficients[2],
ignore_attr = TRUE)
benchmark1 <- twoStepsBenchmark(turnover,construction,
include.differenciation = TRUE,
outliers = list(LS2009 = 1:12))
adjusted_turnover <- window(turnover-decompose(turnover,type = "additive")$seasonal,start=2006)
adjusted_turnover <- adjusted_turnover + ts_expand(aggregate(turnover-adjusted_turnover),nfrequency = 12)
benchmark2 <- reUseBenchmark(adjusted_turnover,benchmark1)
benchmark3 <- reUseBenchmark(adjusted_turnover,benchmark1,reeval.smoothed.part = TRUE)
m1 <- model.list(benchmark1)
m2 <- model.list(benchmark2)
m3 <- model.list(benchmark3)
expect_equal(window(aggregate(window(benchmark2,start=2006,extend = TRUE)),end=2018),
window(construction,start=2006,end = 2018),
ignore_attr = TRUE,
tolerance = 10^-6)
expect_equal(m2$hfserie[,"constant"],
window(m1$hfserie[,"constant"],start=2006,end = c(2019,12)),
ignore_attr = TRUE,
tolerance = 10^-6)
expect_identical(smoothed.part(benchmark2),smoothed.part(benchmark1))
expect_identical(coefficients(benchmark1),coefficients(benchmark2))
expect_identical(outliers(benchmark1),outliers(benchmark2))
expect_identical(m1$include.rho,m2$include.rho)
expect_identical(m1$include.differenciation,m2$include.differenciation)
expect_identical(m1$start.coeff.calc,m2$start.coeff.calc)
expect_identical(m1$end.coeff.calc,m2$end.coeff.calc)
expect_identical(m1$start.benchmark,m2$start.benchmark)
expect_identical(m1$end.benchmark,m2$end.benchmark)
expect_identical(m1$start.domain,m2$start.domain)
expect_identical(m1$end.domain,m2$end.domain)
expect_identical(smoothed.part(benchmark1),m2$set.smoothed.part)
expect_false(identical(smoothed.part(benchmark3),smoothed.part(benchmark1)))
expect_identical(coefficients(benchmark1),coefficients(benchmark3))
expect_identical(outliers(benchmark1),outliers(benchmark3))
expect_identical(m1$include.rho,m3$include.rho)
expect_identical(m1$include.differenciation,m3$include.differenciation)
expect_identical(m1$start.coeff.calc,m3$start.coeff.calc)
expect_identical(m1$end.coeff.calc,m3$end.coeff.calc)
expect_identical(m1$start.benchmark,m3$start.benchmark)
expect_identical(m1$end.benchmark,m3$end.benchmark)
expect_identical(m1$start.domain,m3$start.domain)
expect_identical(m1$end.domain,m3$end.domain)
expect_null(m1$set.smoothed.part)
expect_null(m3$set.smoothed.part)
expect_false(identical(as.ts(benchmark3),as.ts(benchmark2)))
expect_snapshot(print(benchmark2, digits = 4L),cran = FALSE)
expect_snapshot(print(benchmark3, digits = 4L),cran = FALSE)
})
test_that("residuals extrap sequence doesn't bug if rho==1 and include.differenciation=TRUE",{
sequence <- residuals_extrap_sequence(1,3,1,10,TRUE)
expect_equal(sequence[-1]-sequence[-length(sequence)],rep(2,9))
})
test_that("annualBenchmark",{
set.seed(27)
mensualts <- ts(diffinv(rnorm(120,1,1)),start=2010,freq=12)
trimts <- ts(diffinv(rnorm(36,12,1)),start=2010,freq=4)
expect_error(annualBenchmark(mensualts,trimts),
"annual time series")
expect_snapshot(print(annualBenchmark(turnover,construction,
end.coeff.calc = 2018),
digits = 4L),
cran = FALSE)
expect_equal(as.ts(annualBenchmark(turnover,construction,
end.coeff.calc = 2018)),
as.ts(twoStepsBenchmark(turnover,construction,
end.coeff.calc = 2018,
end.benchmark = 2019,
end.domain = c(2021,12))))
set.seed(5)
mensualts <- ts(diffinv(rnorm(120,1,1)),start=2010,freq=12)
annualts <- ts(diffinv(rnorm(9,12,1)),start=2010,freq=1)
expect_equal(unname(coef(annualBenchmark(hfserie = mensualts,
lfserie = annualts,
include.differenciation = FALSE))),
c(-4.42319837305,0.07996253268))
expect_equal(unname(coef(annualBenchmark(hfserie = mensualts,
lfserie = annualts,
include.differenciation = FALSE,
set.const=-4.42319837305,set.coeff=0.07996253268))),
c(-4.42319837305,0.07996253268))
expect_equal(unname(coef(annualBenchmark(hfserie = mensualts,
lfserie = annualts,
include.differenciation = FALSE,
set.coeff=c(hfserie=0.07996253268,constant=-4.42319837305)))),
c(-4.42319837305,0.07996253268))
expect_equal(unname(coef(annualBenchmark(hfserie = mensualts,
lfserie = annualts,
include.differenciation = FALSE,
set.const=-3))),
c(-3,0.07851836099))
expect_equal(unname(coef(annualBenchmark(hfserie = mensualts,
lfserie = annualts,
include.differenciation = FALSE,
set.const=10))),
c(10,0.06532678329))
expect_equal(unname(coef(annualBenchmark(hfserie = mensualts,
lfserie = annualts,
include.differenciation = FALSE,
set.coeff=-3))),
c(2264.800948259,-3))
expect_equal(as.ts(annualBenchmark(mensualts,annualts,end.coeff.calc = 2019)),
as.ts(annualBenchmark(mensualts,annualts,end.coeff.calc = c(2019,1))))
})
test_that("ts eps",{
turnover_tspmodif <- turnover
tsp(turnover_tspmodif)[2L] <- tsp(turnover)[2L]+getOption("ts.eps")/24
tsp(turnover_tspmodif)[1L] <- tsp(turnover)[1L]-getOption("ts.eps")/24
construction_tspmodif <- construction
tsp(construction_tspmodif)[2L] <- tsp(construction)[2L]+getOption("ts.eps")/24
tsp(construction_tspmodif)[1L] <- tsp(construction)[1L]-getOption("ts.eps")/24
expect_identical(as.ts(twoStepsBenchmark(turnover_tspmodif,construction_tspmodif)),
as.ts(twoStepsBenchmark(disaggR::turnover,disaggR::construction)))
expect_identical(as.ts(twoStepsBenchmark(turnover_tspmodif,construction)),
as.ts(twoStepsBenchmark(disaggR::turnover,disaggR::construction)))
expect_identical(as.ts(twoStepsBenchmark(turnover,construction_tspmodif)),
as.ts(twoStepsBenchmark(disaggR::turnover,disaggR::construction)))
turnover_tspmodif <- turnover
tsp(turnover_tspmodif)[2L] <- tsp(turnover)[2L]-getOption("ts.eps")/24
tsp(turnover_tspmodif)[1L] <- tsp(turnover)[1L]+getOption("ts.eps")/24
construction_tspmodif <- construction
tsp(construction_tspmodif)[2L] <- tsp(construction)[2L]-getOption("ts.eps")/24
tsp(construction_tspmodif)[1L] <- tsp(construction)[1L]+getOption("ts.eps")/24
expect_identical(as.ts(twoStepsBenchmark(turnover_tspmodif,construction_tspmodif)),
as.ts(twoStepsBenchmark(disaggR::turnover,disaggR::construction)))
expect_identical(as.ts(twoStepsBenchmark(turnover_tspmodif,construction)),
as.ts(twoStepsBenchmark(disaggR::turnover,disaggR::construction)))
expect_identical(as.ts(twoStepsBenchmark(turnover,construction_tspmodif)),
as.ts(twoStepsBenchmark(disaggR::turnover,disaggR::construction)))
})
test_that("test outliers",
{
expect_error(twoStepsBenchmark(turnover,construction,outliers = list(AO2020 = rep(0.1,12))),
"perfect rank")
expect_error(twoStepsBenchmark(turnover,construction,outliers = c(AO2008=rep(0.1,12))),
"named list")
expect_error(twoStepsBenchmark(turnover,construction,outliers = list(rep(0.1,12))),
"must have names")
expect_error(twoStepsBenchmark(turnover,construction,outliers = list(Aqdqsd = rep(0.1,12))),
"be interpreted")
expect_error(twoStepsBenchmark(turnover,construction,outliers = list(AO2008 = rep(0.1,11))),
"length")
expect_error(twoStepsBenchmark(turnover,construction,outliers = list(AO2008 = rep(0.1,13))),
"length")
expected <- as.ts(twoStepsBenchmark(cbind(turnover,
ts(c(rep(0,96L),1:24,rep(0,125L)),start = 2000,frequency = 12),
ts(c(rep(0,12L),12:1,rep(1,221L)),start = 2000,frequency = 12)),
construction))
object <- as.ts(twoStepsBenchmark(turnover,construction,
outliers = list(AO2008 = 1:24,
LS2001 = 12:1)))
expect_equal(expected,object)
expected <- as.ts(twoStepsBenchmark(`colnames<-`(cbind(turnover,
ts(c(rep(0,240L),rep(0.1,5L)),
start = 2000,
frequency = 12)),
c("hfserie","outlier")),
construction,
set.coeff = c(outlier=1)))
object <- as.ts(twoStepsBenchmark(turnover,construction,outliers = list(AO2020 = rep(0.1,12)),
set.coeff = c(AO2020=1)))
expect_equal(expected,object)
object <- model.list(twoStepsBenchmark(window(turnover,start=c(2003,3)),
window(construction,start=2004),
outliers=list(AO2006T1=rep(0.1,12))))$hfserie[,"AO2006T1"]
expected <- ts(c(rep(0,34L),
rep(0.1,12L),
rep(0,161)),start=c(2003,3),frequency=12)
expect_equal(object,expected)
object <- coefficients(twoStepsBenchmark(window(turnover,start=c(2003,3)),
window(construction,start=2004),
outliers=list(AO2020=rep(0.1,12)),
set.coeff = c(hfserie = 1,
AO2020 = 2)))[c("hfserie","AO2020")]
expected <- c(hfserie = 1,
AO2020 = 2)
expect_equal(object,expected)
object <- model.list(annualBenchmark(window(turnover,start=c(2003,3)),
window(construction,start=2004),
outliers=list(AO2006T1=rep(0.1,12))))$hfserie[,"AO2006T1"]
expected <- ts(c(rep(0,34L),
rep(0.1,12L),
rep(0,161)),start=c(2003,3),frequency=12)
expect_equal(object,expected)
set.seed(27)
mensualts <- ts(diffinv(rnorm(120,1,1)),start=2010,freq=12)
trimts <- ts(diffinv(rnorm(36,12,1)),start=2010,freq=4)
object <- model.list(twoStepsBenchmark(mensualts,
trimts,
outliers=list(AO2011T2=rep(0.1,6L))))$hfserie[,"AO2011T2"]
expected <- ts(c(rep(0,15L),
rep(0.1,6L),
rep(0,100L)),start=2010,frequency=12)
expect_equal(object,expected)
})
test_that("smooted.part is based at 0 in 2000 if include.differenciation = TRUE",{
mensualts <- ts(diffinv(rnorm(300,1,1)),start=c(1999,2),freq=12)
trimts <- ts(diffinv(rnorm(2,12,1)),start=2011,freq=4)
bn <- twoStepsBenchmark(mensualts,trimts,include.differenciation = TRUE)
expect_equal(aggregate(window(model.list(bn)$hfserie[,"constant"],start=2000,end=c(2000,3)),nfrequency = 4),
0,
tolerance = 10^-6,
ignore_attr = TRUE)
set.seed(2L)
mensualts <- ts(rnorm(240),frequency=12,start=c(1993,4))
annualts <- ts(rnorm(10L),frequency=1,start=1995)
bn <- twoStepsBenchmark(mensualts,annualts,include.differenciation = TRUE)
expect_equal(aggregate(window(model.list(bn)$hfserie[,"constant"],start=2000,end=c(2000,12)),nfrequency = 1),
0,
tolerance = 10^-6,
ignore_attr = TRUE)
bn <- twoStepsBenchmark(window(turnover,start=2001),window(construction,start=2001),include.differenciation = TRUE)
expect_equal(aggregate(window(model.list(bn)$hfserie[,"constant"],start=2001,end=c(2001,12)),nfrequency = 1),
1,
tolerance = 10^-6,
ignore_attr = TRUE)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.