tests/testthat/test-9-plotting.R

In getspanel: General-to-Specific Modelling of Panel Data

# save_png <- function(code, width = 1000, height = 600) {
#   path <- tempfile(fileext = ".png")
#   grDevices::png(path, width = width, height = height)
#   on.exit(dev.off())
#   code
#
#   path
# }




##############
#### I M P O R T A N T ###
##############
# This will only work by using the "Build" and then "Run Tests" Buttons. when doing this
# our snapshots will work. They will not be the same if we use
# the console and there use devtools::test() or devtools::test_active_file() then
# the snapshots will be a tiny bit different
# so we need to be consistent when snapshotting plots


###
# Generate Three Unit Example
###
set.seed(123)
# Generate some random data for the two control countries
xA <- rnorm(50, mean = 100)
xB <- rnorm(50, mean = 30)
xC <- rnorm(50, mean = 70)

epA <- rnorm(50, sd = 0.2)
epB <- rnorm(50, sd = 0.2)
epC <- rnorm(50, sd = 0.2)

trend <- 1951:2000
trendbreak <- c(rep(0,19),1:31) # impose a trendbreak from 1975

yA <- 10 + 0.5 * xA + 0.2 * trend - 0.3 * trendbreak + epA
yB <- 0.5 * xB + 0.1 * trend + epB
yC <- 0.5 * xC + 0.1 + epC

trial_df <- data.frame(year = rep(1951:2000,3),
                       id = c(rep("A",50),rep("B",50),rep("C",50)),
                       x = c(xA, xB, xC),
                       y = c(yA,yB,yC))


# Introduce a step shift in A from 40
trial_df_step <- trial_df
trial_df_step$y[40:50] <- trial_df_step$y[40:50]*1.02

# Do the same with a date object
trial_df_date <- trial_df_step
trial_df_date$year <- rep(seq.Date(from = as.Date("2000-01-01"), length.out = 50, by = "month"),3)

outcome1 <- isatpanel(trial_df_step, formula = y ~ x, index = c("id","year"), print.searchinfo = FALSE, tis = TRUE) # TIS approximates step shift
outcome2 <- isatpanel(trial_df_step, formula = y ~ x, index = c("id","year"), print.searchinfo = FALSE, fesis = TRUE) # Step Shift approximates trend (esp in B)
outcome3 <- isatpanel(trial_df_step, formula = y ~ x, index = c("id","year"), print.searchinfo = FALSE, fesis = TRUE, tis = TRUE) # correct specification

outcome4 <- isatpanel(trial_df, formula = y ~ x, index = c("id","year"), print.searchinfo = FALSE, cfesis_time = 1960:1990, cfesis = TRUE)
outcome5 <- isatpanel(trial_df_date, formula = y ~ x, index = c("id","year"), print.searchinfo = FALSE, cfesis = TRUE,
                      cfesis_time = list(A = seq.Date(from = as.Date("2000-01-01"), length.out = 10, by = "month"),
                                         B = seq.Date(from = as.Date("2003-01-01"), length.out = 12, by = "month"),
                                         C = seq.Date(from = as.Date("2000-01-01"), length.out = 50, by = "month")))


# To use expect_snapshot_file() you'll typically need to start by writing
# a helper function that creates a file from your code, returning a path
save_png <- function(code, width = 400, height = 400) {
  path <- tempfile(fileext = ".png")

  if(ggplot2::is_ggplot(code)){
    ggplot2::ggsave(filename = path, plot = code, width = 7, height = 5)
  } else {
    png(path, width = width, height = height)
    on.exit(dev.off())
    code
  }
  path
}

# You'd then also provide a helper that skips tests where you can't
# be sure of producing exactly the same output
expect_snapshot_plot <- function(name, code) {
  # Other packages might affect results
  skip_if_not_installed("ggplot2", "2.0.0")
  # Or maybe the output is different on some operation systems
  #skip_on_os("windows")
  skip_on_ci()
  # You'll need to carefully think about and experiment with these skips

  name <- paste0(name, ".png")
  # Announce the file before touching `code`. This way, if `code`
  # unexpectedly fails or skips, testthat will not auto-delete the
  # corresponding snapshot file.
  announce_snapshot_file(name = name)

  path <- save_png(code)
  expect_snapshot_file(path, name)
}


test_that("Standard Plot",{
  skip_on_ci()
  skip_on_cran()
  expect_snapshot_plot("Standard_plot_outcome1", code = plot(outcome1))
  expect_snapshot_plot("Standard_plot_outcome2", code = plot(outcome2))
  expect_snapshot_plot("Standard_plot_outcome3", code = plot(outcome3))
  expect_snapshot_plot("Standard_plot_outcome4", code = plot(outcome4))
  expect_snapshot_plot("Standard_plot_outcome5", code = plot(outcome5))
})


test_that("Grid Plot",{
  skip_on_ci()
  skip_on_cran()
  expect_snapshot_plot("Grid_plot_outcome1", code = plot_grid(outcome1))
  expect_snapshot_plot("Grid_plot_outcome2", code = plot_grid(outcome2))
  expect_snapshot_plot("Grid_plot_outcome3", code = plot_grid(outcome3))
  expect_snapshot_plot("Grid_plot_outcome4", code = plot_grid(outcome4))
  expect_snapshot_plot("Grid_plot_outcome5", code = plot_grid(outcome5))

  expect_snapshot_plot("Grid_plot_outcome4_regex", code = plot_grid(outcome4, regex_exclude_indicators = "cfesisC"))


})


test_that("Counterfactual Plot",{
  skip_on_ci()
  skip_on_cran()
  # only carry out on FESIS objects
  expect_snapshot_plot("counterfactual_plot_outcome2", code = plot_counterfactual(outcome2))
  expect_snapshot_plot("counterfactual_plot_outcome3", code = plot_counterfactual(outcome3))

  expect_snapshot_plot("counterfactual_plot_outcome2_regex", code = plot_grid(outcome2, regex_exclude_indicators = "fesisA"))
  expect_snapshot_plot("counterfactual_plot_outcome3_regex", code = plot_grid(outcome3, , regex_exclude_indicators = "fesisA"))
})



test_that("Residuals Plot",{
  skip_on_ci()
  skip_on_cran()
  expect_snapshot_plot("Residuals_plot_outcome1", code = plot_residuals(outcome1))
  expect_snapshot_plot("Residuals_plot_outcome2", code = plot_residuals(outcome2))
  expect_snapshot_plot("Residuals_plot_outcome3", code = plot_residuals(outcome3))
})


# test functionality of plotting functions (like regex_exclude_indicators, main_title, etc.)

test_that("plotting functions work with regex_exclude_indicators", {

  expect_silent(plot_grid(outcome4, regex_exclude_indicators = "cfesisC"))
  expect_silent(plot_grid(outcome4, regex_exclude_indicators = NULL))

  expect_silent(plot_counterfactual(outcome2, regex_exclude_indicators = "cfesisC"))
  expect_silent(plot_counterfactual(outcome3, regex_exclude_indicators = NULL))

  expect_snapshot_plot("plot_grid_outcome4_regex", code = plot_grid(outcome4, regex_exclude_indicators = "cfesisC"))
  expect_snapshot_plot("plot_counterfactual_outcome2_regex", code = plot_counterfactual(outcome2, regex_exclude_indicators = "fesisA"))
})