R - Пример последовательного ряда дат во временных рядах без замены?

Question

У меня есть фрейм данных в R, содержащий серию дат. Самая ранняя дата (формат ISO) 2015-03-22, а самая поздняя дата - 2016-01-03, но в данных есть два перерыва. Вот как это выглядит:

library(tidyverse)
library(lubridate)

date_data <- tibble(dates = c(seq(ymd("2015-03-22"),
                                  ymd("2015-07-03"),
                                  by = "days"),
                              seq(ymd("2015-08-09"),
                                  ymd("2015-10-01"),
                                  by = "days"),
                              seq(ymd("2015-11-12"),
                                  ymd("2016-01-03"),
                                  by = "days")),
                    sample_id = 0L)

т.е:.

> date_data
# A tibble: 211 x 2
   dates      sample_id
   <date>         <int>
 1 2015-03-22         0
 2 2015-03-23         0
 3 2015-03-24         0
 4 2015-03-25         0
 5 2015-03-26         0
 6 2015-03-27         0
 7 2015-03-28         0
 8 2015-03-29         0
 9 2015-03-30         0
10 2015-03-31         0
# … with 201 more rows

Что я хочу сделать, так это взять десять 10-дневных выборок непрерывных дат из этого временного ряда без замены . Например, допустимым образцом будут десять дней с 2015-04-01 по 2015-04-10, потому что он полностью попадает в столбец dates в моем фрейме данных date_data. Затем каждый образец получит уникальное (ненулевое) число в столбце sample_id в date_data, например 1:10.

Для ясности, мои требования:

1. Каждый образец будет 10 подряд дней.

2. Выборка должна быть без замены. Поэтому, если sample_id == 1 - период с 2015-04-01 по 2015-04-10, эти даты не могут быть частью другой 10-дневной выборки.

3. Каждый 10-дневный образец не может включать любую дату, которая не находится в пределах date_data$dates.

В конце, date_data$sample_id будет иметь уникальные числа, представляющие каждую 10-дневную выборку, вероятно, с большим количеством оставшихся 0 с, которые не были частью какой-либо выборки (и будет 200 строк - 10 для каждый образец - где sample_id != 0).

Я знаю о dplyr::sample_n(), но он не производит выборку последовательных значений, и я не знаю, как придумать способ "запомнить", какие даты уже были выбраны ...

Какой хороший способ сделать это? for петля?!?! Или, может быть, что-то с purrr? Большое спасибо за вашу помощь.

ОБНОВЛЕНИЕ: Благодаря решению @ gfgm, оно напомнило мне, что производительность является важным фактором. Мой реальный набор данных немного больше, и в некоторых случаях я хотел бы взять более 20 сэмплов вместо 10-ти. В идеале размер выборки также можно изменить, т. Е. Не обязательно 10-дневный.

Answer 1

Это сложно, как вы ожидали, из-за необходимости отбора проб без замены.Ниже приведено рабочее решение, которое позволяет получить случайную выборку и быстро решить проблему масштаба, приведенную в примере с вашей игрушкой.Это также должно быть хорошо с большим количеством наблюдений, но будет действительно очень медленным, если вам нужно выбрать много точек относительно размера выборки.

Основная предпосылка состоит в том, чтобы выбрать n = 10 баллов, сгенерировать 10векторы из этих точек вперед, и если векторы пересекаются, отбросьте их и выберите снова.Это просто и отлично работает, учитывая, что 10*n << nrow(df).Если вы хотите получить 15 подвекторов из ваших 200 наблюдений, это будет намного медленнее.

library(tidyverse)
library(lubridate)

date_data <- tibble(dates = c(seq(ymd("2015-03-22"),
                                  ymd("2015-07-03"),
                                  by = "days"),
                              seq(ymd("2015-08-09"),
                                  ymd("2015-10-01"),
                                  by = "days"),
                              seq(ymd("2015-11-12"),
                                  ymd("2016-01-03"),
                                  by = "days")),
                    sample_id = 0L)

# A function that picks n indices, projects them forward 10,
# and if any of the segments overlap resamples
pick_n_vec <- function(df, n = 10, out = 10) {
  points <- sample(nrow(df) - (out - 1), n, replace = F)
  vecs <- lapply(points, function(i){i:(i+(out - 1))})

  while (max(table(unlist(vecs))) > 1) {
    points <- sample(nrow(df) - (out - 1), n, replace = F)
    vecs <- lapply(points, function(i){i:(i+(out - 1))})
  }

  vecs
 }

# demonstrate
set.seed(42)
indices <- pick_n_vec(date_data)

for (i in 1:10) {
  date_data$sample_id[indices[[i]]] <- i
}

date_data[indices[[1]], ]
#> # A tibble: 10 x 2
#>         dates sample_id
#>        <date>     <int>
#>  1 2015-05-31         1
#>  2 2015-06-01         1
#>  3 2015-06-02         1
#>  4 2015-06-03         1
#>  5 2015-06-04         1
#>  6 2015-06-05         1
#>  7 2015-06-06         1
#>  8 2015-06-07         1
#>  9 2015-06-08         1
#> 10 2015-06-09         1
table(date_data$sample_id)
#> 
#>   0   1   2   3   4   5   6   7   8   9  10 
#> 111  10  10  10  10  10  10  10  10  10  10

^{Создано в 2019-01-16 с помощью пакета Представить (v0.2.1)}

немного более быстрая версия

pick_n_vec2 <- function(df, n = 10, out = 10) {
  points <- sample(nrow(df) - (out - 1), n, replace = F)
  while (min(diff(sort(points))) < 10) {
    points <- sample(nrow(df) - (out - 1), n, replace = F)
  }
  lapply(points, function(i){i:(i+(out - 1))})
}