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个10天长的连续日期样本，而无需替换。例如，一个有效的样本将是从2015-04-01到2015-04-10的十天，因为这完全属于我的dates数据框中的date_data列。然后，每个样本都会在sample_id的{{1}}列中获得一个唯一的（非零）数字，例如date_data。

需要明确的是，我的要求是：

每个样本将连续10天。
采样必须为而不是。因此，如果1:10是2015年4月1日至2015年4月10日，则这些日期不能成为另一个10天的示例的一部分。
每个10天的样本不能包含不在sample_id == 1内的任何日期。

最后，date_data$dates将具有唯一的数字，代表每个10天的样本，可能还有许多date_data$sample_id剩余，它们不属于任何样本（并且将有200个行-每个样本10个-其中0）。

我知道sample_id != 0，但是它不对连续值进行采样，并且我不知道如何设计一种方式来“记住”已经采样的日期。 ..

执行此操作的好方法是什么？ dplyr::sample_n()循环？！？！或许还有for？非常感谢您的帮助。

更新：由于@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))})
}

R-在时间序列中采样连续的日期系列而不进行替换？

1 个答案:

版本快一些