mirror of
https://github.com/saymrwulf/prophet.git
synced 2026-05-26 22:35:48 +00:00
95fa4460a9
* Allow both both hoidays and append holidays Match holidays in predict and fit Add test for append_holiday features; minor fixes Add column name validation for append_holidays names; allow only one country Fix bug about holiday year different from input year and also other bugs Change function description Add append holiday feature for R * Add test for R/Pyrhon; fix bugs
686 lines
23 KiB
R
686 lines
23 KiB
R
library(prophet)
|
|
context("Prophet tests")
|
|
|
|
DATA <- read.csv('data.csv')
|
|
N <- nrow(DATA)
|
|
train <- DATA[1:floor(N / 2), ]
|
|
future <- DATA[(ceiling(N/2) + 1):N, ]
|
|
|
|
DATA2 <- read.csv('data2.csv')
|
|
|
|
DATA$ds <- prophet:::set_date(DATA$ds)
|
|
DATA2$ds <- prophet:::set_date(DATA2$ds)
|
|
|
|
test_that("fit_predict", {
|
|
skip_if_not(Sys.getenv('R_ARCH') != '/i386')
|
|
m <- prophet(train)
|
|
expect_error(predict(m, future), NA)
|
|
})
|
|
|
|
test_that("fit_predict_no_seasons", {
|
|
skip_if_not(Sys.getenv('R_ARCH') != '/i386')
|
|
m <- prophet(train, weekly.seasonality = FALSE, yearly.seasonality = FALSE)
|
|
expect_error(predict(m, future), NA)
|
|
})
|
|
|
|
test_that("fit_predict_no_changepoints", {
|
|
skip_if_not(Sys.getenv('R_ARCH') != '/i386')
|
|
expect_warning({
|
|
# warning from prophet(), error from predict()
|
|
m <- prophet(train, n.changepoints = 0)
|
|
expect_error(predict(m, future), NA)
|
|
})
|
|
})
|
|
|
|
test_that("fit_predict_changepoint_not_in_history", {
|
|
skip_if_not(Sys.getenv('R_ARCH') != '/i386')
|
|
train_t <- dplyr::mutate(DATA, ds=prophet:::set_date(ds))
|
|
train_t <- dplyr::filter(train_t,
|
|
(ds < prophet:::set_date('2013-01-01')) |
|
|
(ds > prophet:::set_date('2014-01-01')))
|
|
future <- data.frame(ds=DATA$ds)
|
|
expect_warning({
|
|
# warning from prophet(), error from predict()
|
|
m <- prophet(train_t, changepoints=c('2013-06-06'))
|
|
expect_error(predict(m, future), NA)
|
|
})
|
|
})
|
|
|
|
test_that("fit_predict_duplicates", {
|
|
skip_if_not(Sys.getenv('R_ARCH') != '/i386')
|
|
train2 <- train
|
|
train2$y <- train2$y + 10
|
|
train_t <- rbind(train, train2)
|
|
m <- prophet(train_t)
|
|
expect_error(predict(m, future), NA)
|
|
})
|
|
|
|
test_that("fit_predict_constant_history", {
|
|
skip_if_not(Sys.getenv('R_ARCH') != '/i386')
|
|
train2 <- train
|
|
train2$y <- 20
|
|
m <- prophet(train2)
|
|
fcst <- predict(m, future)
|
|
expect_equal(tail(fcst$yhat, 1), 20)
|
|
train2$y <- 0
|
|
m <- prophet(train2)
|
|
fcst <- predict(m, future)
|
|
expect_equal(tail(fcst$yhat, 1), 0)
|
|
})
|
|
|
|
test_that("setup_dataframe", {
|
|
history <- train
|
|
m <- prophet(history, fit = FALSE)
|
|
|
|
out <- prophet:::setup_dataframe(m, history, initialize_scales = TRUE)
|
|
history <- out$df
|
|
|
|
expect_true('t' %in% colnames(history))
|
|
expect_equal(min(history$t), 0)
|
|
expect_equal(max(history$t), 1)
|
|
|
|
expect_true('y_scaled' %in% colnames(history))
|
|
expect_equal(max(history$y_scaled), 1)
|
|
})
|
|
|
|
test_that("logistic_floor", {
|
|
skip_if_not(Sys.getenv('R_ARCH') != '/i386')
|
|
skip_on_os('mac') # Resolves mysterious CRAN build issue
|
|
m <- prophet(growth = 'logistic')
|
|
history <- train
|
|
history$floor <- 10.
|
|
history$cap <- 80.
|
|
future1 <- future
|
|
future1$cap <- 80.
|
|
future1$floor <- 10.
|
|
m <- fit.prophet(m, history, algorithm = 'Newton')
|
|
expect_true(m$logistic.floor)
|
|
expect_true('floor' %in% colnames(m$history))
|
|
expect_equal(m$history$y_scaled[1], 1., tolerance = 1e-6)
|
|
fcst1 <- predict(m, future1)
|
|
|
|
m2 <- prophet(growth = 'logistic')
|
|
history2 <- history
|
|
history2$y <- history2$y + 10.
|
|
history2$floor <- history2$floor + 10.
|
|
history2$cap <- history2$cap + 10.
|
|
future1$cap <- future1$cap + 10.
|
|
future1$floor <- future1$floor + 10.
|
|
m2 <- fit.prophet(m2, history2, algorithm = 'Newton')
|
|
expect_equal(m2$history$y_scaled[1], 1., tolerance = 1e-6)
|
|
fcst2 <- predict(m, future1)
|
|
fcst2$yhat <- fcst2$yhat - 10.
|
|
# Check for approximate shift invariance
|
|
expect_true(all(abs(fcst1$yhat - fcst2$yhat) < 1))
|
|
})
|
|
|
|
test_that("get_changepoints", {
|
|
history <- train
|
|
m <- prophet(history, fit = FALSE)
|
|
|
|
out <- prophet:::setup_dataframe(m, history, initialize_scales = TRUE)
|
|
history <- out$df
|
|
m <- out$m
|
|
m$history <- history
|
|
|
|
m <- prophet:::set_changepoints(m)
|
|
|
|
cp <- m$changepoints.t
|
|
expect_equal(length(cp), m$n.changepoints)
|
|
expect_true(min(cp) > 0)
|
|
expect_true(max(cp) <= history$t[ceiling(0.8 * length(history$t))])
|
|
})
|
|
|
|
test_that("set_changepoint_range", {
|
|
history <- train
|
|
m <- prophet(history, fit = FALSE, changepoint.range = 0.4)
|
|
|
|
out <- prophet:::setup_dataframe(m, history, initialize_scales = TRUE)
|
|
history <- out$df
|
|
m <- out$m
|
|
m$history <- history
|
|
|
|
m <- prophet:::set_changepoints(m)
|
|
|
|
cp <- m$changepoints.t
|
|
expect_equal(length(cp), m$n.changepoints)
|
|
expect_true(min(cp) > 0)
|
|
expect_true(max(cp) <= history$t[ceiling(0.4 * length(history$t))])
|
|
expect_error(prophet(history, changepoint.range = -0.1))
|
|
expect_error(prophet(history, changepoint.range = 2))
|
|
})
|
|
|
|
test_that("get_zero_changepoints", {
|
|
history <- train
|
|
m <- prophet(history, n.changepoints = 0, fit = FALSE)
|
|
|
|
out <- prophet:::setup_dataframe(m, history, initialize_scales = TRUE)
|
|
m <- out$m
|
|
history <- out$df
|
|
m$history <- history
|
|
|
|
m <- prophet:::set_changepoints(m)
|
|
cp <- m$changepoints.t
|
|
expect_equal(length(cp), 1)
|
|
expect_equal(cp[1], 0)
|
|
})
|
|
|
|
test_that("override_n_changepoints", {
|
|
history <- train[1:20,]
|
|
m <- prophet(history, fit = FALSE)
|
|
|
|
out <- prophet:::setup_dataframe(m, history, initialize_scales = TRUE)
|
|
m <- out$m
|
|
history <- out$df
|
|
m$history <- history
|
|
|
|
m <- prophet:::set_changepoints(m)
|
|
expect_equal(m$n.changepoints, 15)
|
|
cp <- m$changepoints.t
|
|
expect_equal(length(cp), 15)
|
|
})
|
|
|
|
test_that("fourier_series_weekly", {
|
|
true.values <- c(0.7818315, 0.6234898, 0.9749279, -0.2225209, 0.4338837,
|
|
-0.9009689)
|
|
mat <- prophet:::fourier_series(DATA$ds, 7, 3)
|
|
expect_equal(true.values, mat[1, ], tolerance = 1e-6)
|
|
})
|
|
|
|
test_that("fourier_series_yearly", {
|
|
true.values <- c(0.7006152, -0.7135393, -0.9998330, 0.01827656, 0.7262249,
|
|
0.6874572)
|
|
mat <- prophet:::fourier_series(DATA$ds, 365.25, 3)
|
|
expect_equal(true.values, mat[1, ], tolerance = 1e-6)
|
|
})
|
|
|
|
test_that("growth_init", {
|
|
history <- DATA[1:468, ]
|
|
history$cap <- max(history$y)
|
|
m <- prophet(history, growth = 'logistic', fit = FALSE)
|
|
|
|
out <- prophet:::setup_dataframe(m, history, initialize_scales = TRUE)
|
|
m <- out$m
|
|
history <- out$df
|
|
|
|
params <- prophet:::linear_growth_init(history)
|
|
expect_equal(params[1], 0.3055671, tolerance = 1e-6)
|
|
expect_equal(params[2], 0.5307511, tolerance = 1e-6)
|
|
|
|
params <- prophet:::logistic_growth_init(history)
|
|
|
|
expect_equal(params[1], 1.507925, tolerance = 1e-6)
|
|
expect_equal(params[2], -0.08167497, tolerance = 1e-6)
|
|
})
|
|
|
|
test_that("piecewise_linear", {
|
|
t <- seq(0, 10)
|
|
m <- 0
|
|
k <- 1.0
|
|
deltas <- c(0.5)
|
|
changepoint.ts <- c(5)
|
|
|
|
y <- prophet:::piecewise_linear(t, deltas, k, m, changepoint.ts)
|
|
y.true <- c(0, 1, 2, 3, 4, 5, 6.5, 8, 9.5, 11, 12.5)
|
|
expect_equal(y, y.true)
|
|
|
|
t <- t[8:length(t)]
|
|
y.true <- y.true[8:length(y.true)]
|
|
y <- prophet:::piecewise_linear(t, deltas, k, m, changepoint.ts)
|
|
expect_equal(y, y.true)
|
|
})
|
|
|
|
test_that("piecewise_logistic", {
|
|
t <- seq(0, 10)
|
|
cap <- rep(10, 11)
|
|
m <- 0
|
|
k <- 1.0
|
|
deltas <- c(0.5)
|
|
changepoint.ts <- c(5)
|
|
|
|
y <- prophet:::piecewise_logistic(t, cap, deltas, k, m, changepoint.ts)
|
|
y.true <- c(5.000000, 7.310586, 8.807971, 9.525741, 9.820138, 9.933071,
|
|
9.984988, 9.996646, 9.999252, 9.999833, 9.999963)
|
|
expect_equal(y, y.true, tolerance = 1e-6)
|
|
|
|
t <- t[8:length(t)]
|
|
y.true <- y.true[8:length(y.true)]
|
|
cap <- cap[8:length(cap)]
|
|
y <- prophet:::piecewise_logistic(t, cap, deltas, k, m, changepoint.ts)
|
|
expect_equal(y, y.true, tolerance = 1e-6)
|
|
})
|
|
|
|
test_that("holidays", {
|
|
holidays <- data.frame(ds = c('2016-12-25'),
|
|
holiday = c('xmas'),
|
|
lower_window = c(-1),
|
|
upper_window = c(0))
|
|
df <- data.frame(
|
|
ds = seq(prophet:::set_date('2016-12-20'),
|
|
prophet:::set_date('2016-12-31'), by='d'))
|
|
m <- prophet(train, holidays = holidays, fit = FALSE)
|
|
out <- prophet:::make_holiday_features(m, df$ds)
|
|
feats <- out$holiday.features
|
|
priors <- out$prior.scales
|
|
names <- out$holiday.names
|
|
expect_equal(nrow(feats), nrow(df))
|
|
expect_equal(ncol(feats), 2)
|
|
expect_equal(sum(colSums(feats) - c(1, 1)), 0)
|
|
expect_true(all(priors == c(10., 10.)))
|
|
expect_equal(names, c('xmas'))
|
|
|
|
holidays <- data.frame(ds = c('2016-12-25'),
|
|
holiday = c('xmas'),
|
|
lower_window = c(-1),
|
|
upper_window = c(10))
|
|
m <- prophet(train, holidays = holidays, fit = FALSE)
|
|
out <- prophet:::make_holiday_features(m, df$ds)
|
|
feats <- out$holiday.features
|
|
priors <- out$prior.scales
|
|
names <- out$holiday.names
|
|
expect_equal(nrow(feats), nrow(df))
|
|
expect_equal(ncol(feats), 12)
|
|
expect_true(all(priors == rep(10, 12)))
|
|
expect_equal(names, c('xmas'))
|
|
# Check prior specifications
|
|
holidays <- data.frame(
|
|
ds = prophet:::set_date(c('2016-12-25', '2017-12-25')),
|
|
holiday = c('xmas', 'xmas'),
|
|
lower_window = c(-1, -1),
|
|
upper_window = c(0, 0),
|
|
prior_scale = c(5., 5.)
|
|
)
|
|
m <- prophet(holidays = holidays, fit = FALSE)
|
|
out <- prophet:::make_holiday_features(m, df$ds)
|
|
priors <- out$prior.scales
|
|
names <- out$holiday.names
|
|
expect_true(all(priors == c(5., 5.)))
|
|
expect_equal(names, c('xmas'))
|
|
# 2 different priors
|
|
holidays2 <- data.frame(
|
|
ds = prophet:::set_date(c('2012-06-06', '2013-06-06')),
|
|
holiday = c('seans-bday', 'seans-bday'),
|
|
lower_window = c(0, 0),
|
|
upper_window = c(1, 1),
|
|
prior_scale = c(8, 8)
|
|
)
|
|
holidays2 <- rbind(holidays, holidays2)
|
|
m <- prophet(holidays = holidays2, fit = FALSE)
|
|
out <- prophet:::make_holiday_features(m, df$ds)
|
|
priors <- out$prior.scales
|
|
names <- out$holiday.names
|
|
expect_true(all(priors == c(8, 8, 5, 5)))
|
|
expect_true(all(sort(names) == c('seans-bday', 'xmas')))
|
|
holidays2 <- data.frame(
|
|
ds = prophet:::set_date(c('2012-06-06', '2013-06-06')),
|
|
holiday = c('seans-bday', 'seans-bday'),
|
|
lower_window = c(0, 0),
|
|
upper_window = c(1, 1)
|
|
)
|
|
# manual coercions to avoid below bind_rows() warning
|
|
holidays$holiday <- as.character(holidays$holiday)
|
|
holidays2$holiday <- as.character(holidays2$holiday)
|
|
holidays2 <- dplyr::bind_rows(holidays, holidays2)
|
|
# manual factorizing to avoid above bind_rows() warning
|
|
holidays2$holiday <- factor(holidays2$holiday)
|
|
m <- prophet(holidays = holidays2, fit = FALSE, holidays.prior.scale = 4)
|
|
out <- prophet:::make_holiday_features(m, df$ds)
|
|
priors <- out$prior.scales
|
|
expect_true(all(priors == c(4, 4, 5, 5)))
|
|
# Check incompatible priors
|
|
holidays <- data.frame(
|
|
ds = prophet:::set_date(c('2016-12-25', '2016-12-27')),
|
|
holiday = c('xmasish', 'xmasish'),
|
|
lower_window = c(-1, -1),
|
|
upper_window = c(0, 0),
|
|
prior_scale = c(5., 6.)
|
|
)
|
|
m <- prophet(holidays = holidays, fit = FALSE)
|
|
expect_error(prophet:::make_holiday_features(m, df$ds))
|
|
})
|
|
|
|
test_that("fit_with_holidays", {
|
|
skip_if_not(Sys.getenv('R_ARCH') != '/i386')
|
|
holidays <- data.frame(ds = c('2012-06-06', '2013-06-06'),
|
|
holiday = c('seans-bday', 'seans-bday'),
|
|
lower_window = c(0, 0),
|
|
upper_window = c(1, 1))
|
|
m <- prophet(DATA, holidays = holidays, uncertainty.samples = 0)
|
|
expect_error(predict(m), NA)
|
|
})
|
|
|
|
test_that("fit_with_append_holidays", {
|
|
skip_if_not(Sys.getenv('R_ARCH') != '/i386')
|
|
holidays <- data.frame(ds = c('2012-06-06', '2013-06-06'),
|
|
holiday = c('seans-bday', 'seans-bday'),
|
|
lower_window = c(0, 0),
|
|
upper_window = c(1, 1))
|
|
append.holidays = 'US'
|
|
# Test with holidays and append_holidays
|
|
m <- prophet(DATA,
|
|
holidays = holidays,
|
|
append.holidays = append.holidays,
|
|
uncertainty.samples = 0)
|
|
expect_error(predict(m), NA)
|
|
# There are training holidays missing in the test set
|
|
train2 <- DATA %>% head(155)
|
|
future2 <- DATA %>% tail(355)
|
|
model <- prophet(train2,
|
|
append.holidays = append.holidays,
|
|
uncertainty.samples = 0)
|
|
expect_error(predict(m, future2), NA)
|
|
# There are test holidays missing in the training set
|
|
train2 <- DATA %>% tail(355)
|
|
future2 <- DATA2
|
|
model <- prophet(train2,
|
|
append.holidays = append.holidays,
|
|
uncertainty.samples = 0)
|
|
expect_error(predict(m, future2), NA)
|
|
# Append_holidays with non-existing year
|
|
max.year <- generated_holidays %>%
|
|
dplyr::filter(country==append.holidays) %>%
|
|
dplyr::select(year) %>%
|
|
max()
|
|
train2 <- data.frame('ds'=c(paste(max.year+1, "-01-01", sep=''),
|
|
paste(max.year+1, "-01-02", sep='')),
|
|
'y'=1)
|
|
expect_warning(prophet(train2,
|
|
append.holidays = append.holidays))
|
|
# Append_holidays with non-existing country
|
|
append.holidays = 'Utopia'
|
|
expect_error(prophet(DATA,
|
|
append.holidays = append.holidays))
|
|
})
|
|
|
|
test_that("make_future_dataframe", {
|
|
skip_if_not(Sys.getenv('R_ARCH') != '/i386')
|
|
train.t <- DATA[1:234, ]
|
|
m <- prophet(train.t)
|
|
future <- make_future_dataframe(m, periods = 3, freq = 'day',
|
|
include_history = FALSE)
|
|
correct <- prophet:::set_date(c('2013-04-26', '2013-04-27', '2013-04-28'))
|
|
expect_equal(future$ds, correct)
|
|
|
|
future <- make_future_dataframe(m, periods = 3, freq = 'month',
|
|
include_history = FALSE)
|
|
correct <- prophet:::set_date(c('2013-05-25', '2013-06-25', '2013-07-25'))
|
|
expect_equal(future$ds, correct)
|
|
})
|
|
|
|
test_that("auto_weekly_seasonality", {
|
|
skip_if_not(Sys.getenv('R_ARCH') != '/i386')
|
|
# Should be enabled
|
|
N.w <- 15
|
|
train.w <- DATA[1:N.w, ]
|
|
m <- prophet(train.w, fit = FALSE)
|
|
expect_equal(m$weekly.seasonality, 'auto')
|
|
m <- fit.prophet(m, train.w)
|
|
expect_true('weekly' %in% names(m$seasonalities))
|
|
true <- list(
|
|
period = 7, fourier.order = 3, prior.scale = 10, mode = 'additive')
|
|
for (name in names(true)) {
|
|
expect_equal(m$seasonalities$weekly[[name]], true[[name]])
|
|
}
|
|
# Should be disabled due to too short history
|
|
N.w <- 9
|
|
train.w <- DATA[1:N.w, ]
|
|
m <- prophet(train.w)
|
|
expect_false('weekly' %in% names(m$seasonalities))
|
|
expect_warning({
|
|
# prophet warning: non-zero return code in optimizing
|
|
m <- prophet(train.w, weekly.seasonality = TRUE)
|
|
expect_true('weekly' %in% names(m$seasonalities))
|
|
})
|
|
# Should be False due to weekly spacing
|
|
train.w <- DATA[seq(1, nrow(DATA), 7), ]
|
|
m <- prophet(train.w)
|
|
expect_false('weekly' %in% names(m$seasonalities))
|
|
m <- prophet(DATA, weekly.seasonality = 2, seasonality.prior.scale = 3)
|
|
true <- list(
|
|
period = 7, fourier.order = 2, prior.scale = 3, mode = 'additive')
|
|
for (name in names(true)) {
|
|
expect_equal(m$seasonalities$weekly[[name]], true[[name]])
|
|
}
|
|
})
|
|
|
|
test_that("auto_yearly_seasonality", {
|
|
skip_if_not(Sys.getenv('R_ARCH') != '/i386')
|
|
# Should be enabled
|
|
m <- prophet(DATA, fit = FALSE)
|
|
expect_equal(m$yearly.seasonality, 'auto')
|
|
m <- fit.prophet(m, DATA)
|
|
expect_true('yearly' %in% names(m$seasonalities))
|
|
true <- list(
|
|
period = 365.25, fourier.order = 10, prior.scale = 10, mode = 'additive')
|
|
for (name in names(true)) {
|
|
expect_equal(m$seasonalities$yearly[[name]], true[[name]])
|
|
}
|
|
# Should be disabled due to too short history
|
|
N.w <- 240
|
|
train.y <- DATA[1:N.w, ]
|
|
m <- prophet(train.y)
|
|
expect_false('yearly' %in% names(m$seasonalities))
|
|
m <- prophet(train.y, yearly.seasonality = TRUE)
|
|
expect_true('yearly' %in% names(m$seasonalities))
|
|
m <- prophet(DATA, yearly.seasonality = 7, seasonality.prior.scale = 3)
|
|
true <- list(
|
|
period = 365.25, fourier.order = 7, prior.scale = 3, mode = 'additive')
|
|
for (name in names(true)) {
|
|
expect_equal(m$seasonalities$yearly[[name]], true[[name]])
|
|
}
|
|
})
|
|
|
|
test_that("auto_daily_seasonality", {
|
|
skip_if_not(Sys.getenv('R_ARCH') != '/i386')
|
|
# Should be enabled
|
|
m <- prophet(DATA2, fit = FALSE)
|
|
expect_equal(m$daily.seasonality, 'auto')
|
|
m <- fit.prophet(m, DATA2)
|
|
expect_true('daily' %in% names(m$seasonalities))
|
|
true <- list(
|
|
period = 1, fourier.order = 4, prior.scale = 10, mode = 'additive')
|
|
for (name in names(true)) {
|
|
expect_equal(m$seasonalities$daily[[name]], true[[name]])
|
|
}
|
|
# Should be disabled due to too short history
|
|
N.d <- 430
|
|
train.y <- DATA2[1:N.d, ]
|
|
m <- prophet(train.y)
|
|
expect_false('daily' %in% names(m$seasonalities))
|
|
m <- prophet(train.y, daily.seasonality = TRUE)
|
|
expect_true('daily' %in% names(m$seasonalities))
|
|
m <- prophet(DATA2, daily.seasonality = 7, seasonality.prior.scale = 3)
|
|
true <- list(
|
|
period = 1, fourier.order = 7, prior.scale = 3, mode = 'additive')
|
|
for (name in names(true)) {
|
|
expect_equal(m$seasonalities$daily[[name]], true[[name]])
|
|
}
|
|
m <- prophet(DATA)
|
|
expect_false('daily' %in% names(m$seasonalities))
|
|
})
|
|
|
|
test_that("test_subdaily_holidays", {
|
|
skip_if_not(Sys.getenv('R_ARCH') != '/i386')
|
|
holidays <- data.frame(ds = c('2017-01-02'),
|
|
holiday = c('special_day'))
|
|
m <- prophet(DATA2, holidays=holidays)
|
|
fcst <- predict(m)
|
|
expect_equal(sum(fcst$special_day == 0), 575)
|
|
})
|
|
|
|
test_that("custom_seasonality", {
|
|
skip_if_not(Sys.getenv('R_ARCH') != '/i386')
|
|
holidays <- data.frame(ds = c('2017-01-02'),
|
|
holiday = c('special_day'),
|
|
prior_scale = c(4))
|
|
m <- prophet(holidays=holidays)
|
|
m <- add_seasonality(m, name='monthly', period=30, fourier.order=5)
|
|
true <- list(
|
|
period = 30, fourier.order = 5, prior.scale = 10, mode = 'additive')
|
|
for (name in names(true)) {
|
|
expect_equal(m$seasonalities$monthly[[name]], true[[name]])
|
|
}
|
|
expect_error(
|
|
add_seasonality(m, name='special_day', period=30, fourier_order=5)
|
|
)
|
|
expect_error(
|
|
add_seasonality(m, name='trend', period=30, fourier_order=5)
|
|
)
|
|
m <- add_seasonality(m, name='weekly', period=30, fourier.order=5)
|
|
# Test priors
|
|
m <- prophet(
|
|
holidays = holidays, yearly.seasonality = FALSE,
|
|
seasonality.mode = 'multiplicative')
|
|
m <- add_seasonality(
|
|
m, name='monthly', period=30, fourier.order=5, prior.scale = 2,
|
|
mode = 'additive')
|
|
m <- fit.prophet(m, DATA)
|
|
expect_equal(m$seasonalities$monthly$mode, 'additive')
|
|
expect_equal(m$seasonalities$weekly$mode, 'multiplicative')
|
|
out <- prophet:::make_all_seasonality_features(m, m$history)
|
|
prior.scales <- out$prior.scales
|
|
component.cols <- out$component.cols
|
|
expect_equal(sum(component.cols$monthly), 10)
|
|
expect_equal(sum(component.cols$special_day), 1)
|
|
expect_equal(sum(component.cols$weekly), 6)
|
|
expect_equal(sum(component.cols$additive_terms), 10)
|
|
expect_equal(sum(component.cols$multiplicative_terms), 7)
|
|
expect_equal(sum(component.cols$monthly[1:11]), 10)
|
|
expect_equal(sum(component.cols$weekly[11:17]), 6)
|
|
expect_true(all(prior.scales == c(rep(2, 10), rep(10, 6), 4)))
|
|
})
|
|
|
|
test_that("added_regressors", {
|
|
skip_if_not(Sys.getenv('R_ARCH') != '/i386')
|
|
m <- prophet()
|
|
m <- add_regressor(m, 'binary_feature', prior.scale=0.2)
|
|
m <- add_regressor(m, 'numeric_feature', prior.scale=0.5)
|
|
m <- add_regressor(
|
|
m, 'numeric_feature2', prior.scale=0.5, mode = 'multiplicative')
|
|
m <- add_regressor(m, 'binary_feature2', standardize=TRUE)
|
|
df <- DATA
|
|
df$binary_feature <- c(rep(0, 255), rep(1, 255))
|
|
df$numeric_feature <- 0:509
|
|
df$numeric_feature2 <- 0:509
|
|
# Require all regressors in df
|
|
expect_error(
|
|
fit.prophet(m, df)
|
|
)
|
|
df$binary_feature2 <- c(rep(1, 100), rep(0, 410))
|
|
m <- fit.prophet(m, df)
|
|
# Check that standardizations are correctly set
|
|
true <- list(
|
|
prior.scale = 0.2, mu = 0, std = 1, standardize = 'auto', mode = 'additive'
|
|
)
|
|
for (name in names(true)) {
|
|
expect_equal(true[[name]], m$extra_regressors$binary_feature[[name]])
|
|
}
|
|
true <- list(prior.scale = 0.5, mu = 254.5, std = 147.368585)
|
|
for (name in names(true)) {
|
|
expect_equal(true[[name]], m$extra_regressors$numeric_feature[[name]],
|
|
tolerance = 1e-5)
|
|
}
|
|
expect_equal(m$extra_regressors$numeric_feature2$mode, 'multiplicative')
|
|
true <- list(prior.scale = 10., mu = 0.1960784, std = 0.3974183)
|
|
for (name in names(true)) {
|
|
expect_equal(true[[name]], m$extra_regressors$binary_feature2[[name]],
|
|
tolerance = 1e-5)
|
|
}
|
|
# Check that standardization is done correctly
|
|
df2 <- prophet:::setup_dataframe(m, df)$df
|
|
expect_equal(df2$binary_feature[1], 0)
|
|
expect_equal(df2$numeric_feature[1], -1.726962, tolerance = 1e-4)
|
|
expect_equal(df2$binary_feature2[1], 2.022859, tolerance = 1e-4)
|
|
# Check that feature matrix and prior scales are correctly constructed
|
|
out <- prophet:::make_all_seasonality_features(m, df2)
|
|
seasonal.features <- out$seasonal.features
|
|
prior.scales <- out$prior.scales
|
|
component.cols <- out$component.cols
|
|
modes <- out$modes
|
|
expect_equal(ncol(seasonal.features), 30)
|
|
r_names <- c('binary_feature', 'numeric_feature', 'binary_feature2')
|
|
true.priors <- c(0.2, 0.5, 10.)
|
|
for (i in seq_along(r_names)) {
|
|
name <- r_names[i]
|
|
expect_true(name %in% colnames(seasonal.features))
|
|
expect_equal(sum(component.cols[[name]]), 1)
|
|
expect_equal(sum(prior.scales * component.cols[[name]]), true.priors[i])
|
|
}
|
|
# Check that forecast components are reasonable
|
|
future <- data.frame(
|
|
ds = c('2014-06-01'),
|
|
binary_feature = c(0),
|
|
numeric_feature = c(10),
|
|
numeric_feature2 = c(10)
|
|
)
|
|
expect_error(predict(m, future))
|
|
future$binary_feature2 <- 0.
|
|
fcst <- predict(m, future)
|
|
expect_equal(ncol(fcst), 37)
|
|
expect_equal(fcst$binary_feature[1], 0)
|
|
expect_equal(fcst$extra_regressors_additive[1],
|
|
fcst$numeric_feature[1] + fcst$binary_feature2[1])
|
|
expect_equal(fcst$extra_regressors_multiplicative[1],
|
|
fcst$numeric_feature2[1])
|
|
expect_equal(fcst$additive_terms[1],
|
|
fcst$yearly[1] + fcst$weekly[1]
|
|
+ fcst$extra_regressors_additive[1])
|
|
expect_equal(fcst$multiplicative_terms[1],
|
|
fcst$extra_regressors_multiplicative[1])
|
|
expect_equal(
|
|
fcst$yhat[1],
|
|
fcst$trend[1] * (1 + fcst$multiplicative_terms[1]) + fcst$additive_terms[1]
|
|
)
|
|
# Check works with constant extra regressor of 0
|
|
df$constant_feature <- 0
|
|
m <- prophet()
|
|
m <- add_regressor(m, 'constant_feature', standardize = TRUE)
|
|
m <- fit.prophet(m, df)
|
|
expect_equal(m$extra_regressors$constant_feature$std, 1)
|
|
})
|
|
|
|
test_that("set_seasonality_mode", {
|
|
skip_if_not(Sys.getenv('R_ARCH') != '/i386')
|
|
m <- prophet()
|
|
expect_equal(m$seasonality.mode, 'additive')
|
|
m <- prophet(seasonality.mode = 'multiplicative')
|
|
expect_equal(m$seasonality.mode, 'multiplicative')
|
|
expect_error(prophet(seasonality.mode = 'batman'))
|
|
})
|
|
|
|
test_that("seasonality_modes", {
|
|
skip_if_not(Sys.getenv('R_ARCH') != '/i386')
|
|
holidays <- data.frame(ds = c('2016-12-25'),
|
|
holiday = c('xmas'),
|
|
lower_window = c(-1),
|
|
upper_window = c(0))
|
|
m <- prophet(seasonality.mode = 'multiplicative', holidays = holidays)
|
|
m <- add_seasonality(
|
|
m, name = 'monthly', period = 30, fourier.order = 3, mode = 'additive')
|
|
m <- add_regressor(m, name = 'binary_feature', mode = 'additive')
|
|
m <- add_regressor(m, name = 'numeric_feature')
|
|
# Construct seasonal features
|
|
df <- DATA
|
|
df$binary_feature <- c(rep(0, 255), rep(1, 255))
|
|
df$numeric_feature <- 0:509
|
|
out <- prophet:::setup_dataframe(m, df, initialize_scales = TRUE)
|
|
df <- out$df
|
|
m <- out$m
|
|
m$history <- df
|
|
m <- prophet:::set_auto_seasonalities(m)
|
|
out <- prophet:::make_all_seasonality_features(m, df)
|
|
component.cols <- out$component.cols
|
|
modes <- out$modes
|
|
expect_equal(sum(component.cols$additive_terms), 7)
|
|
expect_equal(sum(component.cols$multiplicative_terms), 29)
|
|
expect_equal(
|
|
sort(modes$additive),
|
|
c('additive_terms', 'binary_feature', 'extra_regressors_additive',
|
|
'monthly')
|
|
)
|
|
expect_equal(
|
|
sort(modes$multiplicative),
|
|
c('extra_regressors_multiplicative', 'holidays', 'multiplicative_terms',
|
|
'numeric_feature', 'weekly', 'xmas', 'yearly')
|
|
)
|
|
})
|