tests/testthat/test-indexby.R

idx_second <- seq(
  ymd_hms("2017-01-01 00:00:01"),
  ymd_hms("2017-01-01 00:00:05"),
  by = 1
)
dat_x <- tibble(
  date_time = idx_second,
  value = 1
)
tsbl1 <- as_tsibble(dat_x, index = date_time)

test_that("illegal input in index_by()", {
  expect_identical(group_vars(tsbl1 %>% index_by()), "date_time")
  expect_error(tsbl1 %>% index_by("date_time"), "Unsupported index type:")
  expect_error(tsbl1 %>% index_by(date_time = date_time), "be overwritten.")
  expect_error(
    tsbl1 %>% index_by(as.Date(date_time), yearmonth(date_time)),
    "only accepts one expression or empty."
  )
})

test_that("From seconds to higher date", {
  res1 <- tsbl1 %>%
    index_by(date_min = ceiling_date(date_time, unit = "min")) %>%
    summarise(value = sum(value))
  expect_equal(
    as_tibble(res1),
    tibble(date_min = ymd_hm("2017-01-01 00:01"), value = 5)
  )
  res2 <- tsbl1 %>%
    index_by(date_min = ceiling_date(date_time, unit = "hour")) %>%
    summarise(value = sum(value))
  expect_equal(
    as_tibble(res2),
    tibble(date_min = ymd_h("2017-01-01 01"), value = 5)
  )
  res3 <- tsbl1 %>%
    index_by(date_min = floor_date(date_time, unit = "day")) %>%
    summarise(value = sum(value))
  expect_equal(
    as_tibble(res3),
    tibble(date_min = ymd_h("2017-01-01 0"), value = 5)
  )
})

idx_day <- seq.Date(ymd("2017-01-01"), ymd("2017-01-20"), by = 4)
dat_x <- tibble(
  date = idx_day,
  value = 1
)
tsbl2 <- as_tsibble(dat_x, index = date)

test_that("From Date to year-week, year-month, year-quarter and year", {
  res0 <- tsbl2 %>%
    index_by(yrwk = yearweek(date)) %>%
    summarise(value = sum(value))
  expect_equal(
    as_tibble(res0),
    tibble(yrwk = yearweek(ymd(idx_day[-4])), value = c(1, 1, 2, 1))
  )
  res1 <- tsbl2 %>%
    index_by(yrmth = yearmonth(date)) %>%
    summarise(value = sum(value))
  expect_equal(
    as_tibble(res1),
    tibble(yrmth = yearmonth(ymd("2017-01-01")), value = 5)
  )
  res2 <- tsbl2 %>%
    index_by(yrqtr = yearquarter(date)) %>%
    summarise(value = sum(value))
  expect_equal(
    as_tibble(res2),
    tibble(yrqtr = yearquarter(ymd("2017-01-01")), value = 5)
  )
  res3 <- tsbl2 %>%
    index_by(yr = year(date)) %>%
    summarise(value = sum(value))
  expect_equal(
    as_tibble(res3),
    tibble(yr = year(ymd("2017-01-01")), value = 5)
  )
  res4 <- res1 %>%
    index_by(yrqtr = yearquarter(yrmth)) %>%
    summarise(value = sum(value))
  expect_equal(res2, res4)
  res5 <- res2 %>%
    index_by(yr = year(yrqtr)) %>%
    summarise(value = sum(value))
  expect_equal(res3, res5)
})

dat_x <- tibble(
  date = rep(idx_day, 2),
  group = rep(letters[1:2], each = 5),
  value = rep(1:2, each = 5)
)
tsbl3 <- as_tsibble(dat_x, key = group, index = date)

test_that("index_by() with group_by()", {
  res1 <- tsbl3 %>%
    group_by(group) %>%
    index_by(yrmth = yearmonth(date)) %>%
    summarise(value = sum(value))
  expect_s3_class(res1, "tbl_ts")
  expect_equal(
    as_tibble(res1),
    tibble(
      group = c("a", "b"),
      yrmth = yearmonth(ymd("2017-01-01")),
      value = c(5L, 10L)
    )
  )
})

tsbl4 <- tsibble(
  date = rep(idx_day, 2),
  group = rep(letters[1:2], each = 5),
  value1 = rep(1:2, each = 5),
  value2 = rnorm(10),
  value3 = rnorm(10),
  key = group, index = date
)

test_that("summarise() with across()", {
  ts_if <- tsbl4 %>%
    index_by(date2 = yearmonth(date)) %>%
    summarise(across(where(is.numeric), mean))
  expect_s3_class(ts_if[["date2"]], "yearmonth")
  expect_named(ts_if, c("date2", "value1", "value2", "value3"))
  expect_equal(nrow(ts_if), 1)
  ts_at <- tsbl4 %>%
    index_by(date2 = yearmonth(date)) %>%
    summarise(across(c("value1", "value3"), mean))
  expect_s3_class(ts_at[["date2"]], "yearmonth")
  expect_named(ts_at, c("date2", "value1", "value3"))
  expect_equal(nrow(ts_at), 1)
})

test_that("scoped variants with group_by()", {
  ts_if <- tsbl4 %>%
    group_by(group) %>%
    index_by(yrmth = yearmonth(date)) %>%
    summarise(across(where(is.numeric), mean))
  expect_named(ts_if, c("group", "yrmth", "value1", "value2", "value3"))
  expect_equal(nrow(ts_if), 2)
  ts_at <- tsbl4 %>%
    group_by(group) %>%
    index_by(yrmth = yearmonth(date)) %>%
    summarise(across(c("value1", "value3"), mean))
  expect_named(ts_at, c("group", "yrmth", "value1", "value3"))
  expect_equal(nrow(ts_at), 2)
  tbl <- tourism %>%
    group_by(Region, State) %>%
    index_by(Year = year(Quarter)) %>%
    summarise(across(where(is.numeric), mean))
  expect_named(tbl, c("Region", "State", "Year", "Trips"))
})

test_that("index_by() with pedestrian", {
  ped_idx <- pedestrian %>%
    index_by(yrmth = yearmonth(Date))
  expect_s3_class(ped_idx, "grouped_ts")
  expect_identical(index2(ped_idx), rlang::sym("yrmth"))
  expect_named(ped_idx, c(names(pedestrian), "yrmth"))
  ped_fil <- ped_idx %>%
    filter(Date_Time == min(Date_Time))
  ped_ref <- as_tibble(pedestrian) %>%
    group_by(yrmth = yearmonth(Date)) %>%
    filter(Date_Time == min(Date_Time))
  expect_equal(ped_fil, ped_ref, ignore_attr = TRUE)
  ped_ren <- ped_fil %>%
    rename(yrmth2 = yrmth)
  expect_identical(index2(ped_ren), rlang::sym("yrmth2"))
  ped_sum <- ped_ren %>%
    summarise(Total = sum(Count))
  expect_named(ped_sum, c("yrmth2", "Total"))
  expect_identical(index(ped_sum), rlang::sym("yrmth2"))
  expect_identical(index2(ped_sum), index(ped_sum))
  ped_sum2 <- ped_ren %>%
    group_by(Sensor) %>%
    summarise(Total = sum(Count))
  expect_named(ped_sum2, c("Sensor", "yrmth2", "Total"))
  expect_identical(index(ped_sum2), rlang::sym("yrmth2"))
  expect_identical(index2(ped_sum2), index(ped_sum2))
  expect_identical(groups(ped_sum2), list())
  ped_mut <- pedestrian %>%
    index_by(Date) %>%
    mutate(ttl = sum(Count), prop = Count / ttl)
  expect_identical(group_vars(ped_mut), "Date")
  ped_sum3 <- ped_mut %>%
    summarise(ttl_prop = sum(prop))
  expect_equal(format(interval(ped_sum3)), "1D")
})

test_that("index_by() with lambda expression", {
  expect_identical(
    pedestrian %>% index_by(yrmth = ~ yearmonth(.)),
    pedestrian %>% index_by(yrmth = yearmonth(Date_Time))
  )
})

Try the tsibble package in your browser

Any scripts or data that you put into this service are public.

tsibble documentation built on Oct. 9, 2022, 9:05 a.m.