我有以下数据:
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"的新列..."第10周"、"第n周".
- 在第一行的每组中,我判断该行在哪几周是"活跃的",即从第2周开始,到第4周停止,因此该行在第2、3、4周是活跃的.现在我想用1填充相应的week列.
- 在除最后一行之外的所有其他行的每个组中,我执行相同的判断,但现在根据该行的"取消停止"值和下一行的"停止"值进行填充.
- 在最后一行的每个组中,我进行相同的判断,但现在根据unstop到10的范围进行填充(在我的例子中,这是最后一周).
我有一个理论方法.问题是,我的真实数据有8万行(由6万个组组成),我需要创建大约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/200col数据集,它将运行一个月.
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,
.)))