Nothing
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))
)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.