tests/testthat/test_shift_multi.R

In jsphdms/runchart: Run Charts with Automatic Rebasing

context("multi_shift()")

# Basic functionality ---------------------------------------------------------

test_that("multi_shift() handles basic cases", {
  expect_equal(
    multi_shift(
      val = c(rep(0, 8), rep(1, 8)),
      base = c(rep(0, 8), rep(NA, 8)),
      base_ext = rep(0, 16)
      ),
    c(rep(NA, 8), rep(1, 8))
    )

  expect_equal(
    multi_shift(
      val = c(rep(0, 8), rep(-1, 8)),
      base = c(rep(0, 8), rep(NA, 8)),
      base_ext = rep(0, 16)
      ),
    c(rep(NA, 8), rep(-1, 8))
    )

  # constant
  expect_equal(
    multi_shift(
      val = rep(0, 16),
      base = c(rep(0, 8), rep(NA, 8)),
      base_ext = rep(0, 16)
    ),
    rep(NA_real_, 16))
})

# Corner cases ----------------------------------------------------------------

test_that("multi_shift() handles corner cases", {

  # 2 consecutive shifts same side
  expect_equal(
    multi_shift(
      val = c(rep(0, 8), rep(1, 6), -1, rep(1, 6)),
      base = c(rep(0, 8), rep(NA, 13)),
      base_ext = rep(0, 21)
    ),
    c(rep(NA, 8), rep(1, 6), NA, rep(1, 6)))

  # 2 consecutive shifts different side
  expect_equal(
    multi_shift(
      val = c(rep(0, 8), rep(1, 6), rep(-1, 6)),
      base = c(rep(0, 8), rep(NA, 12)),
      base_ext = rep(0, 20)
    ),
    c(rep(NA, 8), rep(1, 6), rep(-1, 6)))

  # 2 shifts either side of sustained shift same side
  expect_equal(
    multi_shift(
      val = c(rep(0, 8), rep(1, 6), rep(2, 8), rep(3, 6)),
      base = c(rep(0, 8), rep(NA, 6), rep(2, 8), rep(NA, 6)),
      base_ext = c(rep(0, 14), rep(2, 14))
    ),
    c(rep(NA, 8), rep(1, 6), rep(NA, 8), rep(3, 6)))

  # 2 shifts either side of sustained shift different side
  expect_equal(
    multi_shift(
      val = c(rep(0, 8), rep(1, 6), rep(2, 8), rep(1, 6)),
      base = c(rep(0, 8), rep(NA, 6), rep(2, 8), rep(NA, 6)),
      base_ext = c(rep(0, 14), rep(2, 14))
    ),
    c(rep(NA, 8), rep(1, 6), rep(NA, 8), rep(1, 6)))

  # no shift
  expect_equal(
    multi_shift(
      val = c(rep(0, 8), rep(1, 5)),
      base = c(rep(0, 8), rep(NA, 5)),
      base_ext = rep(0, 13)
    ),
    rep(NA_real_, 13)
  )

  # almost shift
  expect_equal(
    multi_shift(
      val = c(rep(0, 8), rep(1, 5), NA),
      base = c(rep(0, 8), rep(NA, 6)),
      base_ext = rep(0, 14)
    ),
    rep(NA_real_, 14)
  )

  # almost shift
  expect_equal(
    multi_shift(
      val = c(rep(0, 8), rep(1, 5), 0),
      base = c(rep(0, 8), rep(NA, 6)),
      base_ext = rep(0, 14)
    ),
    rep(NA_real_, 14)
  )

  # delayed shift
  expect_equal(
    multi_shift(
      val = c(rep(0, 8), rep(1, 5), 0, 1),
      base = c(rep(0, 8), rep(NA, 7)),
      base_ext = rep(0, 15)
    ),
    c(rep(NA, 8), rep(1, 5), 0, 1)
  )

  # almost shift followed by shift different side
  expect_equal(
    multi_shift(
      val = c(rep(0, 8), rep(1, 5), rep(-1, 6)),
      base = c(rep(0, 8), rep(NA, 11)),
      base_ext = rep(0, 14)
    ),
    c(rep(NA, 13), rep(-1, 6))
  )

  # shift at end
  expect_equal(
    multi_shift(
      val = c(rep(0, 8), rep(1, 6)),
      base = c(rep(0, 8), rep(NA, 6)),
      base_ext = rep(0, 14)
    ),
    c(rep(NA, 8), rep(1, 6))
  )

})

# NAs -------------------------------------------------------------------------

test_that("multi_shift() handles NAs", {

  # all NA
  expect_equal(
    multi_shift(
      val = rep(NA, 16),
      base = rep(NA, 16),
      base_ext = rep(NA, 16)
    ),
    rep(NA_real_, 16))

  # NAs at beginning
  expect_equal(
    multi_shift(
      val = c(rep(NA, 2), rep(0, 8), rep(1, 8)),
      base = c(rep(NA, 2), rep(0, 8), rep(NA, 8)),
      base_ext = c(rep(NA, 2), rep(0, 16))
    ),
    c(rep(NA_real_, 10), rep(1, 8)))

  # constant
  expect_equal(
    multi_shift(
      val = rep(0, 16),
      base = c(rep(0, 8), rep(NA, 8)),
      base_ext = rep(0, 16)
    ),
    rep(NA_real_, 16))

  # shift followed by NAs
  expect_equal(
    multi_shift(
      val = c(rep(0, 8), rep(1, 6), NA),
      base = c(rep(0, 8), rep(NA, 7)),
      base_ext = rep(0, 15)
    ),
    c(rep(NA, 8), rep(1, 6), NA)
  )

})