tests/testthat/test-plot.R

context("Test plotting")

test_that("plot for incidence object", {
  skip_on_cran()

  set.seed(1)
  # dat <- sample(1:50, 200, replace = TRUE, prob = 1 + exp(1:50 * 0.1))
  dat <- readRDS("data_cache/mfdat.rds")[1:200]
  dat2 <- as.Date("2016-01-02") + dat
  dat3 <- as.POSIXct(dat2)
  sex <- c(1, 1, 2, 1, 1, 2, 2, 1, 1, 2, 2, 1, 2, 2, 2, 1, 2, 2, 2, 1, 1, 1, 1,
           2, 2, 2, 1, 1, 1, 2, 1, 1, 1, 2, 1, 2, 2, 2, 1, 1, 1, 2, 2, 1, 1, 1,
           1, 1, 1, 2, 2, 2, 1, 2, 1, 1, 1, 1, 1, 2, 2, 1, 1, 2, 2, 1, 1, 2, 2,
           1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1,
           2, 1, 2, 2, 1, 1, 1, 2, 2, 1, 1, 1, 1, 2, 1, 2, 1, 1, 1, 1, 2, 2, 1,
           1, 1, 1, 2, 2, 2, 1, 1, 2, 2, 2, 2, 2, 1, 2, 2, 1, 1, 2, 1, 1, 1, 1,
           2, 2, 2, 1, 2, 1, 2, 1, 1, 1, 1, 2, 1, 1, 2, 1, 2, 1, 2, 1, 2, 1, 1,
           1, 2, 1, 2, 2, 1, 2, 2, 1, 1, 2, 2, 1, 1, 1, 1, 2, 1, 1, 1, 2, 2, 2,
           1, 1, 2, 2, 1, 2, 1, 1, 2, 2, 1, 1, 2, 1, 1, 1)
  sex <- ifelse(sex == 1, "female", "male")
  dat4 <- c(dat2,
            sample(dat2, replace = TRUE) + 50,
            sample(dat2, replace = TRUE) + 100
           )

  # constructing data
  i <- incidence(dat)
  iog <- incidence(dat, groups = rep("this group", 200))
  i.3 <- incidence(dat, 3L)
  i.14 <- incidence(dat, 14L)
  i.sex <- incidence(dat, 7L, groups = sex)

  # Dates ---------------------------------------------------------------------
  i.POSIX <- incidence(as.POSIXct(dat2, tz = "GMT"))
  i.isoweek <- incidence(dat2, 7L, standard = TRUE)

  # character intervals -------------------------------------------------------
  # Weekly intervals ------------------------------------------
  i.epiweek <- incidence(dat2, "1 epiweek", standard = TRUE)
  i.twoepiweek <- incidence(dat2, "2 epiweeks", standard = TRUE)
  i.sunweek <- incidence(dat2, "1 sunday week")
  i.monweek <- incidence(dat2, "1 monday week")
  i.tueweek <- incidence(dat2, "1 tuesday week")
  i.wedweek <- incidence(dat2, "1 wednesday week")
  i.thuweek <- incidence(dat2, "1 thursday week")
  i.friweek <- incidence(dat2, "1 friday week")
  i.satweek <- incidence(dat2, "1 saturday week")

  expect_identical(i.epiweek, i.sunweek)
  expect_identical(i.isoweek$weeks, i.monweek$weeks)
  expect_identical(get_counts(i.isoweek), get_counts(i.monweek))

  # months and quarters ---------------------------------------
  i.sexmonth <- incidence(dat4, "1 month", groups = rep(sex, 3))
  i.sexquarter <- incidence(dat4, "1 quarter", groups = rep(sex, 3))
  # special case for fit_optim_split:
  i.sex.o <- incidence(c(dat, abs(dat - 45) + 45), 7L, groups = c(sex, rev(sex)))

  fit.i <- suppressWarnings(fit(i))
  fit.i.2 <- suppressWarnings(fit(i, split = 30))
  fit.i.3 <- suppressWarnings(fit(i.3[5:13]))
  fit.POSIX <- suppressWarnings(fit(i.POSIX))
  fit.sex <- suppressWarnings(fit(i.sex))
  fit.sex.o <- suppressWarnings(fit_optim_split(i.sex.o))
  fit.o <- suppressWarnings(fit_optim_split(pool(i.sex.o)))
  p.fit.i <- plot(fit.i)
  p.fit.i.2 <- plot(i, fit = fit.i.2, color = "lightblue")
  p.fit.sex <- plot(fit.sex)
  p.optim.sex   <- fit.sex.o$plot
  p.optim.sex.fit <- plot(fit.sex.o$fit)
  p.optim   <- fit.o$plot
  p.i <- plot(i)
  p.i.cum <- plot(cumulate(i))
  p.i.square <- plot(i, show_cases = TRUE)
  

  p.i.14 <- plot(i.14)
  p.i.2 <- plot(i, color = "blue", alpha = .2)
  p.i.3 <- plot(i.3, fit = fit.i.3, color = "red")
  p.sex <- plot(i.sex)
  p.sex.cum <- plot(cumulate(i.sex))
  p.sex.2 <- plot(i.sex, fit = fit.sex)
  suppressMessages(p.sex.o <- plot(i.sex, fit = fit.sex.o$fit))
  p.sex.3 <- plot(i.sex, fit = fit.sex, col_pal = rainbow)
  p.sex.4 <- plot(i.sex, fit = fit.sex,
                  color = c(male = "salmon3", female = "gold2"))
  p.isoweek   <- plot(i.isoweek)
  p.isoweek.2 <- plot(i.isoweek, labels_week = FALSE)
  p.epiweek   <- plot(i.epiweek)
  p.epiweek.2 <- plot(i.epiweek, labels_week = FALSE)
  p.epiweek.b <- plot(i.epiweek, labels_week = FALSE, n_breaks = nrow(i.epiweek))
  p.twoepiweek <- plot(i.twoepiweek, n_breaks = nrow(i.twoepiweek))
  
  p.sunweek   <- plot(i.sunweek)
  expect_warning({
    p.sunweek.2 <- plot(i.sunweek, labels_iso = FALSE)
  }, "labels_iso is deprecated. Use `labels_week` instead")
  p.monweek   <- plot(i.monweek)
  expect_warning({
    p.monweek.2 <- plot(i.monweek, labels_week = FALSE, labels_iso = TRUE)
  }, "labels_iso is deprecated. The value of `labels_week` will be used")
  p.tueweek   <- plot(i.tueweek)
  p.tueweek.2 <- plot(i.tueweek, labels_week = FALSE)
  p.wedweek   <- plot(i.wedweek)
  p.wedweek.2 <- plot(i.wedweek, labels_week = FALSE)
  p.thuweek   <- plot(i.thuweek)
  p.thuweek.2 <- plot(i.thuweek, labels_week = FALSE)
  p.friweek   <- plot(i.friweek)
  p.friweek.2 <- plot(i.friweek, labels_week = FALSE)
  p.satweek   <- plot(i.satweek)
  p.satweek.2 <- plot(i.satweek, labels_week = FALSE)
  
  p.POSIX     <- plot(i.POSIX)
  p.POSIX.f   <- plot(i.POSIX, fit = fit.POSIX)
  p.month     <- plot(i.sexmonth)
  p.quarter   <- plot(i.sexquarter)

  ## messages
  expect_message(plot(i.sex, show_cases = TRUE, stack = FALSE),
                 "`show_cases` requires the argument `stack = TRUE`")
  expect_message(p.iog <- plot(iog, color = c("this group" = "blue", "that group" = "red")), 
                 "1 colors were not used: \"that group\" = \"red\"")

  ## errors
  expect_error(plot(i, fit = "tamere"),
               "Fit must be a 'incidence_fit' object, or a list of these")
  expect_error(plot(i, fit = list(fit.i, "tamere")),
               "The 2-th item in 'fit' is not an 'incidence_fit' object, but a character")

  ## Normal plots
  vdiffr::expect_doppelganger("incidence fit", p.fit.i)
  vdiffr::expect_doppelganger("incidence plot with two fitting models", p.fit.i.2)
  vdiffr::expect_doppelganger("grouped incidence fit", p.fit.sex)
  vdiffr::expect_doppelganger("incidence plot with default interval", p.i)
  vdiffr::expect_doppelganger("incidence plot with default interval, cumulative", p.i.cum)
  vdiffr::expect_doppelganger("incidence plot with interval of 14 days", p.i.14)
  vdiffr::expect_doppelganger("incidence plot with specified color and alpha", p.i.2)
  vdiffr::expect_doppelganger("incidence plot with interval of 3 days, fit and specified color", p.i.3)
  vdiffr::expect_doppelganger("grouped incidence plot", p.sex)
  vdiffr::expect_doppelganger("grouped incidence plot with one group", p.iog)
  vdiffr::expect_doppelganger("grouped incidence plot, cumulative", p.sex.cum)
  vdiffr::expect_doppelganger("grouped incidence plot with fit", p.sex.2)
  vdiffr::expect_doppelganger("grouped incidence plot with color palette", p.sex.3)
  vdiffr::expect_doppelganger("grouped incidence plot with specified color", p.sex.4)
  vdiffr::expect_doppelganger("incidence plot from POSIXct data", p.POSIX)
  vdiffr::expect_doppelganger("incidence plot from POSIXct data with fit", p.POSIX.f)
  vdiffr::expect_doppelganger("incidence plot with isoweek labels", p.isoweek)
  vdiffr::expect_doppelganger("incidence plot without isoweek labels", p.isoweek.2)
  vdiffr::expect_doppelganger("incidence plot by month", p.month)
  vdiffr::expect_doppelganger("incidence plot by quarter", p.quarter)
  vdiffr::expect_doppelganger("incidence fit plot with split", p.sex.o)
  vdiffr::expect_doppelganger("incidence fit list plot with split", p.optim.sex.fit)
  vdiffr::expect_doppelganger("split optimum plot", p.optim.sex)
  vdiffr::expect_doppelganger("split optimum plot pooled", p.optim)
  vdiffr::expect_doppelganger("epiquares single plot", p.i.square)

  ## Weekly plots
  vdiffr::expect_doppelganger("sun weekly incidence with labels", p.sunweek)
  vdiffr::expect_doppelganger("sun weekly incidence with labels", p.epiweek)
  vdiffr::expect_doppelganger("sun weekly incidence with dates", p.sunweek.2)
  vdiffr::expect_doppelganger("sun weekly incidence with dates", p.epiweek.2)
  vdiffr::expect_doppelganger("sun weekly incidence with dates and full breaks", p.epiweek.b)
  vdiffr::expect_doppelganger("sun semi-weekly incidence with dates and full breaks", p.twoepiweek)


  vdiffr::expect_doppelganger("mon weekly incidence with labels", p.monweek)
  vdiffr::expect_doppelganger("mon weekly incidence with dates", p.monweek.2)

  vdiffr::expect_doppelganger("tue weekly incidence with labels", p.tueweek)
  vdiffr::expect_doppelganger("tue weekly incidence with dates", p.tueweek.2)
  
  vdiffr::expect_doppelganger("wed weekly incidence with labels", p.wedweek)
  vdiffr::expect_doppelganger("wed weekly incidence with dates", p.wedweek.2)
  
  vdiffr::expect_doppelganger("thu weekly incidence with labels", p.thuweek)
  vdiffr::expect_doppelganger("thu weekly incidence with dates", p.thuweek.2)
  
  vdiffr::expect_doppelganger("fri weekly incidence with labels", p.friweek)
  vdiffr::expect_doppelganger("fri weekly incidence with dates", p.friweek.2)
  
  vdiffr::expect_doppelganger("sat weekly incidence with labels", p.satweek)
  vdiffr::expect_doppelganger("sat weekly incidence with dates", p.satweek.2)
})
OutbreakResources/incidence documentation built on Nov. 13, 2020, 2:49 a.m.