R сократить даты с использованием позиции, а не фактической даты

Question

Я понимаю, что могу вырезать даты следующим образом:

library(tidyverse)
dates <- parse_date(c("2018-02-01", "2018-02-15", "2018-02-20", "2018-03-20"))
cut.dates <- cut(dates, breaks = parse_date(c("2018-01-01", "2018-02-10", "2018-12-31")))
table(cut.dates)

Но как мне вырезать даты на основе позиции каждой соответствующей даты в списке, а не фактической даты?Я хочу заменить мою третью строку, показанную выше, на что-то вроде:

cut.dates <- cut(dates, c(0, 2, nrow(dates))

0 будет исходной позицией для начала резки

2 будет разрезом между 1-й и 2-й запись в списке

nrow(dates) будет окончательным сокращением - последняя позиция в моем списке

Answer 1

Я думаю, что вам нужно, чтобы даты, используемые для вырезания, определялись динамически по данным, а не указывались вручную.

Я сгенерирую еще несколько дат, так как трудно тестировать четыре даты ежеквартально, когда они все в одном квартале.

set.seed(2)
( dates <- sort(Sys.Date() + sample(365, size=20)) )
#  [1] "2018-06-12" "2018-07-03" "2018-07-17" "2018-07-20" "2018-07-24"
#  [6] "2018-08-04" "2018-08-10" "2018-10-07" "2018-10-19" "2018-11-01"
# [11] "2018-11-29" "2018-11-30" "2018-12-12" "2019-01-28" "2019-02-10"
# [16] "2019-03-12" "2019-04-22" "2019-04-23" "2019-05-10" "2019-05-13"

Придумайте даты начала и окончания:

( start <- lubridate::floor_date(min(dates), unit="quarter") )
# [1] "2018-04-01"
( end <- lubridate::ceiling_date(max(dates), unit="quarter") )
# [1] "2019-07-01"

Нас интересуют кварталы:

( brks <- seq(start, end, by="quarter") )
# [1] "2018-04-01" "2018-07-01" "2018-10-01" "2019-01-01" "2019-04-01"
# [6] "2019-07-01"
cut(dates, breaks=brks)
#  [1] 2018-04-01 2018-07-01 2018-07-01 2018-07-01 2018-07-01 2018-07-01
#  [7] 2018-07-01 2018-10-01 2018-10-01 2018-10-01 2018-10-01 2018-10-01
# [13] 2018-10-01 2019-01-01 2019-01-01 2019-01-01 2019-04-01 2019-04-01
# [19] 2019-04-01 2019-04-01
# Levels: 2018-04-01 2018-07-01 2018-10-01 2019-01-01 2019-04-01

Если вам не нужно выравнивать по календарным кварталам - просто группируйте данные по трем месяцам за раз - тогда вы можете вместо этого сделать:

( start_m <- lubridate::floor_date(min(dates), unit="month") )
# [1] "2018-06-01"
( end_m <- lubridate::ceiling_date(max(dates) + 93L, unit="month") )
# [1] "2019-09-01"
( brks_m <- seq(start_m, end_m, by="quarter") )
# [1] "2018-06-01" "2018-09-01" "2018-12-01" "2019-03-01" "2019-06-01"
# [6] "2019-09-01"

(Магия 93L заключается в том, чтобы гарантировать, что у нас есть по крайней мере еще один квартал за пределами текущего месяца, что необходимо только потому, что ceiling(month) может не пойти достаточно далеко, чтобы захватить три месяца из предыдущего нестандартного квартала. Создание слишком большого количества разрывов неплохо, дополнения просто останутся неиспользованными.)