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 年 4 月 1 日到 2015 年 4 月 10 日的十天，因为这完全属于我的 date_data 数据框中的 dates 列。然后，每个样本将在date_data 的sample_id 列中获得一个唯一（非零）数字，例如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 天样本的唯一编号，可能还有很多 0s 不属于任何样本（并且将有 200 行 - 10 用于每个样本 - sample_id != 0)。

我知道dplyr::sample_n()，但它不会对 连续 值进行采样，而且我不知道如何设计一种方法来“记住”哪些日期已经被采样...

有什么好的方法可以做到这一点？ for 循环？！？！或者可能是purrr？非常感谢您的帮助。

更新：感谢@gfgm 的解决方案，它提醒我性能是一个重要的考虑因素。我的真实数据集要大得多，在某些情况下，我希望采集 20 多个样本而不是 10 个。理想情况下，样本的大小也可以更改，即不一定要 10 天。

Answer 1

正如您所料，这很棘手，因为需要在没有替换的情况下进行抽样。我在下面有一个可行的解决方案，它可以实现随机样本，并且可以快速解决您的玩具示例中给出的规模问题。更多的观察也应该没问题，但如果你需要选择相对于样本量的很多点，它会变得非常慢。

基本前提是选取 n=10 个点，从这些点向前生成 10 个向量，如果向量重叠，则丢弃它们并重新选取。鉴于10*n << nrow(df)，这很简单并且工作正常。如果你想从 200 个观察中得到 15 个子向量，这会慢很多。

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

^{由reprex package (v0.2.1) 于 2019-01-16 创建}

略快的版本

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))})
}