R - 在没有替换的情况下对时间序列中的连续日期系列进行采样?

R - Sample consecutive series of dates in time series without replacement?

我在 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 的十天,因为它完全属于我的 date_data 数据框中的 dates 列。然后每个样本将在 date_datasample_id 列中获得一个唯一的(非零)数字,例如 1:10.

说清楚,我的要求是:

  1. 每个样本将是 10 连续 天。

  2. 采样必须替换。因此,如果 sample_id == 1 是 2015-04-01 到 2015-04-10 期间,这些日期不能是另一个 10 天长样本的一部分。

  3. 每个为期 10 天的样本不能包括任何不在 date_data$dates.

    [=58 内的日期=]

最后,date_data$sample_id 将有代表每个 10 天长样本的唯一数字,可能还有很多 0 剩余的不属于任何样本的部分(并且会有为 200 行 - 每个样本 10 行 - 其中 sample_id != 0).

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

执行此操作的好方法是什么? for 循环?!?!或者可能是 purrr 的东西?非常感谢您的帮助。

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

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

基本前提是选取 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))})
}