Nothing
# Copyright 2014-2022 Google Inc. All rights reserved.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
testthat::context("Unit tests for impact_misc.R")
# Authors: kbrodersen@google.com (Kay Brodersen)
# gallusser@google.com (Fabian Gallusser)
# alhauser@google.com (Alain Hauser)
CreateDummySeries <- function() {
# Creates a dummy series for testing: 3 years of data, single variable.
#
# Returns:
# a zoo object with a single series
set.seed(42)
dates <- seq.Date(as.Date("2011-01-01"), as.Date("2013-12-31"), by = 1)
data <- zoo(rnorm(length(dates), dates))
data[10] <- 5
data[20] <- -5
return(data)
}
test_that("is.wholenumber", {
is.wholenumber <- CausalImpact:::is.wholenumber
# Test empty input
expect_error(is.wholenumber(), "missing")
# Test various standard cases
expect_error(is.wholenumber("a"), "numeric")
expect_equal(is.wholenumber(c(-1, 0, 1, 2, -1.1, 0.1, 1.1)),
c(TRUE, TRUE, TRUE, TRUE, FALSE, FALSE, FALSE))
expect_equal(is.wholenumber(NA), NA)
# Test documentation example
expect_equal(is.wholenumber(c(1, 1.0, 1.2)), c(TRUE, TRUE, FALSE))
# Test different tolerances
expect_true(is.wholenumber(3.14, tolerance = 0.2))
expect_false(is.wholenumber(3.14, tolerance = 0.1))
})
test_that("cumsum.na.rm", {
cumsum.na.rm <- CausalImpact:::cumsum.na.rm
# Test empty input
expect_error(is.wholenumber())
# Test healthy input
expect_equal(cumsum.na.rm(c(1, NA, 2)), c(1, NA, 3))
expect_equal(cumsum.na.rm(c(NA, 1, 2)), c(NA, 1, 3))
expect_equal(cumsum.na.rm(c(1, 2, NA)), c(1, 3, NA))
expect_equal(cumsum.na.rm(c(1, 2, 3, 4)), cumsum(c(1, 2, 3, 4)))
# Test degenerate input
expect_equal(cumsum.na.rm(NULL), NULL)
expect_equal(cumsum.na.rm(c(NA, NA, NA)), as.numeric(c(NA, NA, NA)))
expect_equal(cumsum.na.rm(c(NA, NA)), as.numeric(c(NA, NA)))
expect_equal(cumsum.na.rm(c(0, NA, NA, 0)), c(0, NA, NA, 0))
})
test_that("is.numerically.equal", {
is.numerically.equal <- CausalImpact:::is.numerically.equal
# Test invalid input.
expect_error(is.numerically.equal(), "missing")
expect_error(is.numerically.equal("x", 3), "numeric")
expect_error(is.numerically.equal(1, c(2, 3)), "scalar")
expect_error(is.numerically.equal(1, 2, "tol"), "numeric")
expect_error(is.numerically.equal(1, 2, -1), "tolerance")
# Test valid input with two values being 'numerically equal' within the
# specified tolerance.
expect_true(is.numerically.equal(0, 0))
expect_true(is.numerically.equal(0, 0, tolerance = 1e-20))
expect_true(is.numerically.equal(1, 1))
expect_true(is.numerically.equal(-1, -1 + 1e-9))
expect_true(is.numerically.equal(1, -1, tolerance = 2.1))
expect_true(is.numerically.equal(0, 1, tolerance = 1.01))
# Test valid input with two values not being 'numerically equal' within the
# specified tolerance.
expect_false(is.numerically.equal(-1, -1.2))
expect_false(is.numerically.equal(-1e-15, 1e-15))
expect_false(is.numerically.equal(1, 1 + 1e-9, tolerance = 1e-10))
})
test_that("ParseArguments", {
ParseArguments <- CausalImpact:::ParseArguments
# Test missing input
expect_error(ParseArguments())
# Test healthy input
args <- list(a = 10)
defaults <- list(a = 1, b = 2)
result <- ParseArguments(args, defaults)
expect_equal(result, list(a = 10, b = 2))
# Test NULL <args>
result <- ParseArguments(NULL, list(a = 1, b = 2))
expect_equal(result, list(a = 1, b = 2))
# Test <args> where an individual field is NULL
result <- ParseArguments(list(a = NULL), list(a = 1, b = 2))
expect_equal(result, list(a = 1, b = 2))
# Test bad input: NULL <defaults>
expect_error(ParseArguments(NULL, NULL))
# Test <allow.extra.args>
result <- ParseArguments(list(c = 1), list(a = 1), allow.extra.args = TRUE)
expect_equal(result, list(c = 1, a = 1))
expect_error(ParseArguments(list(c = 1), list(a = 1),
allow.extra.args = FALSE))
})
test_that("Standardize", {
Standardize <- CausalImpact:::Standardize
# Test that missing input throws an error.
expect_error(Standardize(), "missing")
# Test that an invalid fit range throws an error.
bad.fit.range <- list(c(1, NA_real_), 1, c(2, 1), c(-1, 1), c(1, 5))
invisible(lapply(bad.fit.range, function(fit.range) {
expect_error(Standardize(1 : 4, fit.range), "fit.range", fixed = TRUE)}))
# Test the basics
data <- c(-1, 0.1, 1, 2, NA, 3)
result <- Standardize(data, c(1, 5))
expect_true(is.list(result))
expect_equal(names(result), c("y", "UnStandardize"))
expect_equal(result$UnStandardize(result$y), data)
# Test the maths
expect_equal(Standardize(1 : 3)$y, c(-1, 0, 1))
expect_equal(Standardize(1 : 5, c(1, 3))$y, c(-1, 0, 1, 2, 3))
# Test that inputs are correctly recovered (including zoo input)
test.data <- list(c(1), c(1, 1, 1), as.numeric(NA), c(1, NA, 3),
zoo(c(10, 20, 30), c(1, 2, 3)))
lapply(test.data, function(data) {
result <- Standardize(data)
expect_equal(result$UnStandardize(result$y), data)
})
# Test bad input: matrix
expect_error(Standardize(matrix(rnorm(10), ncol = 2)))
})
test_that("StandardizeAllVariables", {
StandardizeAllVariables <- CausalImpact:::StandardizeAllVariables
Standardize <- CausalImpact:::Standardize
# Test that missing input throws an error.
expect_error(StandardizeAllVariables(), "missing")
# Test that an invalid fit range throws an error.
data <- matrix(0, ncol = 3, nrow = 4)
bad.fit.range <- list(c(1, NA_real_), 1, c(2, 1), c(-1, 1), c(1, 5))
invisible(lapply(bad.fit.range, function(fit.range) {
expect_error(StandardizeAllVariables(data, fit.range), "fit.range",
fixed = TRUE)}))
# Test healthy input: several columns
set.seed(1)
data <- zoo(cbind(rnorm(100, mean = 1000, sd = 100),
rnorm(100, mean = 2000, sd = 200),
rnorm(100, mean = 3000, sd = 300)))
result <- StandardizeAllVariables(data)
expect_equal(length(result), 2)
expect_equal(names(result), c("data", "UnStandardize"))
sapply(1 : ncol(result$data), function(column) {
expect_equal(mean(result$data[, column]), 0, tolerance = 0.0001);
expect_equal(sd(result$data[, column]), 1, tolerance = 0.0001)
})
expect_equal(result$UnStandardize, Standardize(data[, 1])$UnStandardize,
check.environment = FALSE)
# Test that several columns are standardized correctly when fitting mean and
# SD only over part of the rows.
result <- StandardizeAllVariables(data, c(11, 90))
sapply(1 : ncol(result$data), function(column) {
expect_equal(mean(result$data[11 : 90, column]), 0, tolerance = 0.0001);
expect_equal(sd(result$data[11 : 90, column]), 1, tolerance = 0.0001)
})
expect_equal(result$UnStandardize, Standardize(data[, 1])$UnStandardize,
check.environment = FALSE)
# Test healthy input: single series only
set.seed(1)
data <- zoo(rnorm(100) * 100 + 1000)
result <- StandardizeAllVariables(data)
expect_equal(length(result), 2)
expect_equal(names(result), c("data", "UnStandardize"))
expect_equal(mean(result$data), 0, tolerance = 0.0001)
expect_equal(sd(result$data), 1, tolerance = 0.0001)
expect_equal(result$UnStandardize, Standardize(data)$UnStandardize,
check.environment = FALSE)
# Test that a single series is standardized correctly when fitting mean and SD
# only over part of the data range.
result <- StandardizeAllVariables(data, c(11, 90))
expect_equal(mean(result$data[11: 90]), 0, tolerance = 0.0001)
expect_equal(sd(result$data[11 : 90]), 1, tolerance = 0.0001)
expect_equal(result$UnStandardize, Standardize(data)$UnStandardize,
check.environment = FALSE)
})
test_that("GetPeriodIndices.InvalidInput", {
GetPeriodIndices <- CausalImpact:::GetPeriodIndices
# Test missing input
expect_error(GetPeriodIndices(), "missing")
# Test wrong order of <period> and <times>
expect_error(GetPeriodIndices(1:200, c(101L, 200L)), "period")
# Test invalid times
times <- seq.Date(as.Date("2014-01-01"), as.Date("2014-01-01") + 199, by = 1)
bad.times <- list(NA, c(1:9, NA, 11:20), as.character(times))
invisible(lapply(bad.times, function(times) {
expect_error(GetPeriodIndices(c(101L, 200L), times), "times")
}))
# Test invalid period
bad.period <- list(NA, 1:100, 1:3, 200, c(150, 101))
invisible(lapply(bad.period, function(period) {
expect_error(GetPeriodIndices(period, 1:200), "period")
}))
# Test inconsistent period and times
times <- seq.Date(as.Date("2014-01-01"), as.Date("2014-01-01") + 199, by = 1)
period <- as.Date(c("2014-04-11", "2014-07-19")) # 100 days
expect_error(GetPeriodIndices(c(101L, 200L), times))
expect_error(GetPeriodIndices(period, 1:200))
# TODO(alhauser): check for the content of the error message again once
# assertthat produces meaningful messages under R 3.5.0; currently the error
# message under R 3.5.0 says that the actual error message is invalid.
# Test period that is completely outside the range of <times>:
# - with integer time points
expect_error(GetPeriodIndices(c(-20L, -10L), 1:200), "period")
expect_error(GetPeriodIndices(c(201L, 210L), 1:200), "period")
#
# - with Date time points
times <- seq.Date(as.Date("2014-01-01"), as.Date("2014-01-01") + 199, by = 1)
expect_error(GetPeriodIndices(as.Date(c("2013-12-24", "2013-12-31")), times),
"period")
expect_error(GetPeriodIndices(as.Date(c("2014-12-24", "2014-12-31")), times),
"period")
# Test period that is inside the range of <times>, but so short it does not
# touch a single time point
expect_error(GetPeriodIndices(c(13L, 14L), 10L*(0:9)), "one data point")
times <- seq.Date(as.Date("2015-01-01"), as.Date("2015-01-01") + 28, by = 7)
period <- as.Date(c("2015-01-03", "2015-01-04"))
expect_error(GetPeriodIndices(period, times), "one data point")
})
test_that("GetPeriodIndices.HealthyInput", {
GetPeriodIndices <- CausalImpact:::GetPeriodIndices
# Test healthy input with integer time points
period <- c(101L, 200L)
times <- 1:200
result <- GetPeriodIndices(period, times)
expect_equal(result, period)
expect_true(is.integer(result))
# Integer time points not starting at 1
period <- c(101L, 200L)
times <- 51:200
result <- GetPeriodIndices(period, times)
expect_equal(result, c(51, 150))
expect_true(is.integer(result))
# Test healthy input with Date time points
period <- as.Date(c("2014-04-11", "2014-07-19")) # 100 days
times <- seq.Date(as.Date("2014-01-01"), as.Date("2014-01-01") + 199, by = 1)
result <- GetPeriodIndices(period, times)
expect_equal(result, c(101, 200))
expect_true(is.integer(result))
# Test period consisting of one single time point, for integer time points
period <- c(21L, 21L)
times <- 11:30
result <- GetPeriodIndices(period, times)
expect_equal(result, c(11, 11))
# Test period consisting of one single time point, for Date time points
period <- as.Date(c("2014-01-10", "2014-01-10"))
times <- seq.Date(as.Date("2014-01-01"), as.Date("2014-01-31"), by = 1)
result <- GetPeriodIndices(period, times)
expect_equal(result, c(10, 10))
# Test period going beyond the range of <times>, for integer time points
expect_equal(GetPeriodIndices(c(1L, 20L), 11:30), c(1, 10))
expect_equal(GetPeriodIndices(c(21L, 40L), 11:30), c(11, 20))
expect_equal(GetPeriodIndices(c(1L, 40L), 11:30), c(1, 20))
# Test period going beyond the range of <times>, for Date time points
times <- seq.Date(as.Date("2015-03-11"), as.Date("2015-03-30"), by = 1)
expect_equal(GetPeriodIndices(as.Date(c("2015-03-01", "2015-03-20")), times),
c(1, 10))
expect_equal(GetPeriodIndices(as.Date(c("2015-03-21", "2015-04-01")), times),
c(11, 20))
expect_equal(GetPeriodIndices(as.Date(c("2015-03-01", "2015-04-01")), times),
c(1, 20))
})
test_that("InferPeriodIndicesFromData", {
InferPeriodIndicesFromData <- CausalImpact:::InferPeriodIndicesFromData
# Test missing input
expect_error(InferPeriodIndicesFromData())
# Test healthy input
expect_equal(InferPeriodIndicesFromData(c(10, 20, 30, NA, NA, NA)),
list(pre.period = c(1, 3), post.period = c(4, 6)))
expect_equal(InferPeriodIndicesFromData(c(10, NA)),
list(pre.period = c(1, 1), post.period = c(2, 2)))
expect_equal(InferPeriodIndicesFromData(c(NA, NA, 10, 20, NA, NA)),
list(pre.period = c(3, 4), post.period = c(5, 6)))
# Test bad input
expect_error(InferPeriodIndicesFromData(1))
expect_error(InferPeriodIndicesFromData(NA))
expect_error(InferPeriodIndicesFromData(c(1, 2, 3)))
expect_error(InferPeriodIndicesFromData(c(NA, NA, NA)))
expect_error(InferPeriodIndicesFromData(c(NA, NA, 1, 2, 3)))
})
test_that("PrettifyPercentage", {
PrettifyPercentage <- CausalImpact:::PrettifyPercentage
expect_equal(PrettifyPercentage(0.05), "+5%")
expect_equal(PrettifyPercentage(-0.053), "-5%")
expect_equal(PrettifyPercentage(c(0.05, 0.01)), c("+5%", "+1%"))
expect_equal(PrettifyPercentage(0.05, 1), "+5.0%")
expect_equal(PrettifyPercentage(0.1234, 1), "+12.3%")
# Test documentation example
expect_equal(PrettifyPercentage(c(-0.125, 0.2), 2), c("-12.50%", "+20.00%"))
})
test_that("PrettifyNumber", {
PrettifyNumber <- CausalImpact:::PrettifyNumber
# Test invalid input
expect_error(PrettifyNumber("3.141"), "numeric")
expect_error(PrettifyNumber(3.141, 2), "character")
expect_error(PrettifyNumber(3.141, round.digits = -2), "round.digits",
fixed = TRUE)
expect_error(PrettifyNumber(123.456, letter = "foo"), "letter")
# Test standard precision
expect_equal(PrettifyNumber(123.456), "123.5")
expect_equal(PrettifyNumber(123.456, letter = "K"), "0.1K")
input <- c(0, 0.01, 0.0123, 1, -123, 12345, -1234567, 1982345670)
output <- c("0.0", "0.01", "0.01", "1.0", "-123.0", "12.3K", "-1.2M", "2.0B")
expect_equal(PrettifyNumber(input), output)
# Test documentation examples
expect_equal(PrettifyNumber(c(0.123, 123, 123456)),
c("0.1", "123.0", "123.5K"))
expect_equal(PrettifyNumber(3995, letter = "K", round.digits = 2), "4.00K")
expect_equal(PrettifyNumber(1.234e-3, round.digits = 2), "0.0012")
# Test manually specified precision
expect_equal(PrettifyNumber(0.01, round.digits = 1), "0.01")
expect_equal(PrettifyNumber(-0.0123, round.digits = 2), "-0.012")
expect_equal(PrettifyNumber(123456, round.digits = 2), "123.46K")
expect_equal(PrettifyNumber(0, round.digits = 2), "0.00")
# Test numbers with trailing zeros
expect_equal(PrettifyNumber(0.2, round.digits = 2), "0.20")
expect_equal(PrettifyNumber(-0.2, round.digits = 4), "-0.2000")
expect_equal(PrettifyNumber(2, round.digits = 2), "2.00")
expect_equal(PrettifyNumber(-2000, round.digits = 3), "-2.000K")
# Test non-finite input
input <- c(NA, NaN, Inf, -Inf)
expect_equal(PrettifyNumber(input), c("NA", "NaN", "Inf", "-Inf"))
})
test_that("IdentifyNumberAbbreviation", {
IdentifyNumberAbbreviation <- CausalImpact:::IdentifyNumberAbbreviation
expect_equal(IdentifyNumberAbbreviation("0.1"), "none")
expect_equal(IdentifyNumberAbbreviation("0.1K"), "K")
output <- c("0", "1", "123", "12.3K", "1.2M", "2B")
letter <- c("none", "none", "none", "K", "M", "B")
expect_equal(IdentifyNumberAbbreviation(output), letter)
# Test documentation example
expect_equal(IdentifyNumberAbbreviation("123.5K"), "K")
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.