# Copyright 2014-2025 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. # Author: kbrodersen@google.com (Kay Brodersen) # Tests that two plots are visually equal. # # Args: # plot1: A ggplot object. # plot2: A ggplot object. # # Returns: # TRUE if the plots are visually equal, FALSE otherwise. IsVisuallyEqual <- function(plot1, plot2) { plot_dir <- tempdir() # Save standardized plot images. file1_path <- file.path(plot_dir, "plot1.svg") file2_path <- file.path(plot_dir, "plot2.svg") suppressWarnings(vdiffr::write_svg(plot1, file1_path)) suppressWarnings(vdiffr::write_svg(plot2, file2_path)) # Read and compare contents of the two files. content1 <- readLines(file1_path) content2 <- readLines(file2_path) return(identical(content1, content2)) } test_that("CreatePeriodMarkers", { CreatePeriodMarkers <- CausalImpact:::CreatePeriodMarkers # Creates a time series with integer time points, and specifies a pre- and # post-period that together cover all time points. Test that only one period # marker is created, specifying the last time point of the pre-period. times <- 1:50 pre.period <- c(1L, 30L) post.period <- c(31L, 50L) markers <- CreatePeriodMarkers(pre.period, post.period, times) expect_equal(markers, 30) # Creates a time series with numeric time points, and specifies a pre- and # post-period that together cover all time points, but whose end points do not # match any time points in the series. Test that only one period marker is # created. times <- as.numeric(1:50) pre.period <- c(0.5, 30.2) post.period <- c(30.7, 50.5) markers <- CreatePeriodMarkers(pre.period, post.period, times) expect_equal(markers, 30) # Creates a time series with numeric time points. Specifies a pre-period that # starts after the beginning of the time series, a gap between pre- and # post-period, and a post-period that does not last until the end of the data. # Tests that four period markers are created. times <- 1:50 pre.period <- c(11L, 20L) post.period <- c(31L, 40L) markers <- CreatePeriodMarkers(pre.period, post.period, times) expect_equal(markers, c(11, 20, 31, 40)) # Creates a daily time series, and specifies a pre- and post-period that # together cover all time points. Test that only one period marker is created. times <- seq.Date(as.Date("2014-01-01"), by = 1, length.out = 50) # Time series runs from 2014-01-01 till 2014-02-19. pre.period <- as.Date(c("2014-01-01", "2014-01-30")) post.period <- as.Date(c("2014-01-31", "2014-02-19")) markers <- CreatePeriodMarkers(pre.period, post.period, times) expect_equal(markers, as.numeric(as.Date("2014-01-30"))) # Creates a weekly time series, and specifies a pre- and post-period that # together cover all time points, but whose end points do not match any time # points in the series. Test that only one period marker is created. times <- seq.Date(as.Date("2014-01-01"), by = 7, length.out = 50) pre.period <- c(times[1] - 1, times[30] + 1) post.period <- c(times[31] - 2, times[50] + 1) markers <- CreatePeriodMarkers(pre.period, post.period, times) expect_equal(markers, as.numeric(times[30])) # Creates an hourly time series. Specifies a pre-period that starts after the # beginning of the time series, a gap between pre- and post-period, and a # post-period that does not last until the end of the data. Tests that four # period markers are created. times <- seq.POSIXt(strptime("2014-01-01 00:00:00", format = "%Y-%m-%d %H:%M:%S"), by = 3600, length.out = 48) # Time series runs from 2014-01-01 00:00:00 till 2014-01-02 23:00:00. pre.period <- as.POSIXct(strptime(c("2014-01-01 10:00:00", "2014-01-01 20:00:00"), format = "%Y-%m-%d %H:%M:%S")) post.period <- as.POSIXct(strptime(c("2014-01-02 10:00:00", "2014-01-02 20:00:00"), format = "%Y-%m-%d %H:%M:%S")) markers <- CreatePeriodMarkers(pre.period, post.period, times) expect_equal(markers, as.numeric(strptime(c("2014-01-01 10:00:00", "2014-01-01 20:00:00", "2014-01-02 10:00:00", "2014-01-02 20:00:00"), format = "%Y-%m-%d %H:%M:%S"))) }) test_that("CreateImpactPlot", { CreateImpactPlot <- CausalImpact:::CreateImpactPlot # Test empty input expect_error(CreateImpactPlot()) # Test input with integer time indices x <- 1 : 20 y <- x + rnorm(20) + c(rep(0, 10), rep(10, 10)) data <- zoo(cbind(y, x)) pre.period <- c(1, 10) post.period <- c(11, 20) model.args <- list(niter = 500) suppressWarnings(impact <- CausalImpact(data, pre.period, post.period, model.args)) q <- CreateImpactPlot(impact) expect_true(is_ggplot(q)) expect_no_error(suppressWarnings(plot(q))) # Test input with Date time indices data <- zoo(cbind(y, x), seq.Date(as.Date("2014-01-01"), as.Date("2014-01-20"), by = 1)) pre.period <- as.Date(c("2014-01-01", "2014-01-10")) post.period <- as.Date(c("2014-01-11", "2014-01-20")) suppressWarnings(impact <- CausalImpact(data, pre.period, post.period, model.args)) q <- CreateImpactPlot(impact) expect_true(is_ggplot(q)) expect_no_error(suppressWarnings(plot(q))) # Test plot.CausalImpact() generic q1 <- CreateImpactPlot(impact) q2 <- plot(impact) # dispatched to plot.CausalImpact() expect_true(IsVisuallyEqual(q1, q2)) # Test plotting different metrics q1 <- plot(impact) q2 <- plot(impact, c("original", "pointwise", "cumulative")) q3 <- plot(impact, c("o", "point", "c")) q4 <- plot(impact, c("pointwise", "cumulative")) expect_true(IsVisuallyEqual(q1, q2)) expect_true(IsVisuallyEqual(q1, q3)) expect_false(IsVisuallyEqual(q1, q4)) # Test different order q1 <- plot(impact, c("p", "c")) q2 <- plot(impact, c("c", "p")) expect_false(IsVisuallyEqual(q1, q2)) })