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_data
的 sample_id
列中获得一个唯一的(非零)数字,例如 1:10
.
说清楚,我的要求是:
每个样本将是 10 连续 天。
采样必须无替换。因此,如果 sample_id == 1
是 2015-04-01 到 2015-04-10 期间,这些日期不能是另一个 10 天长样本的一部分。
每个为期 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))})
}
我在 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_data
的 sample_id
列中获得一个唯一的(非零)数字,例如 1:10
.
说清楚,我的要求是:
每个样本将是 10 连续 天。
采样必须无替换。因此,如果
sample_id == 1
是 2015-04-01 到 2015-04-10 期间,这些日期不能是另一个 10 天长样本的一部分。每个为期 10 天的样本不能包括任何不在
[=58 内的日期=]date_data$dates
.
最后,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))})
}