我有以下数据:
df <- data.frame(group = c(1, 1, 1, 2, 2, 2),
start = c(2, 2, 2, 7, 7, 7),
stop = c(4, 7, 8, 7, 8, 9),
unstop = c(5, 7, 10, 7, 9, 10))
我现在想做以下事情:
- 创建名为 "week_1","week_2",...,"week_10","week_n" 的新列。
- 对于 FIRST ROW 中的每个组,检查该行在哪些周内“活动”,例如它从第 2 周开始,在第 4 周停止,则该行在第 2、3、4 周处于活动状态。我现在希望在相应的周列中填充 1。
- 对于除了最后一行以外的所有其他行,我执行相同的检查,但现在是基于该行的 unstop 值和下一行的 stop 值进行填充。
- 对于每个组的 LAST ROW,我执行相同的检查,但现在是基于从 unstop 到 10(在我的情况下是最后一周)的范围进行填充。
我有一种理论上的方法。问题是我的实际数据有 80k 行(由 60k 个组成),我需要创建大约 200 个这样的周列。即使仅对 10 行进行过滤,下面的代码也需要大约 30 秒。
因此,我正在寻找更优雅/更智能/更快速的解决方案。
预期结果:
# A tibble: 6 × 14
# Groups: group [2]
group start stop unstop week_1 week_2 week_3 week_4 week_5 week_6 week_7 week_8 week_9 week_10
<dbl> <dbl> <dbl> <dbl> <int> <int> <int> <int> <int> <int> <int> <int> <int> <int>
1 1 2 4 5 0 1 1 1 0 0 0 0 0 0
2 1 2 7 7 0 0 0 0 0 0 1 1 0 0
3 1 2 8 10 0 0 0 0 0 0 0 0 0 1
4 2 7 7 7 0 0 0 0 0 0 1 0 0 0
5 2 7 8 9 0 0 0 0 0 0 0 1 1 0
6 2 7 9 10 0 0 0 0 0 0 0 0 0 1
以下是我通常会采用的方法(当然不是手动定义每个行号)。除此之外,这段代码也是错误的,并且不能给出预期的0/1值。它还会抛出许多警告。最后,即使是针对这小测试数据,该代码也需要运行几秒钟。而对于我的 80k/200 列数据集,则需要运行一个月。
add_weeks <- as_tibble(as.list(setNames(rep(0L, 10),
paste0("week_", 1:10))))
df |>
bind_cols(add_weeks) |>
group_by(group) |>
mutate(across(num_range("week_", 1:10),
~ if_else(row_number() == 1 & str_extract(cur_column(), "\\d+$") %in% start:stop,
1L,
.)),
across(num_range("week_", 1:10),
~ if_else(row_number() == 2 & str_extract(cur_column(), "\\d+$") %in% unstop:lead(stop),
1L,
.)),
across(num_range("week_", 1:10),
~ if_else(row_number() == 3 & str_extract(cur_column(), "\\d+$") %in% unstop:10,
1L,
.)))