我有以下数据:

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,
                          .)))

推荐答案

现在测试代码. comments 中描述的战略实施:

我会用名称和列组成一个矩阵,并用行和列索引赋值.然后,可以将其附加为矩阵,也可以将其转换为数据帧.

Mat <- matrix(0, nrow(df), 10) # 200 for real case
maxwk <- 10
colnames(Mat) <- paste0("week", 1:maxwk)

# Add extra column that marks condition 
# If there are always exactly 3 row per group just rep(1:3, ngrps)

# Need to define a value for cond that identifies the three possibilities:

df$cond <- rep(1:3, length=nrow(df))  # assume all groups have exactly 3:

for ( r in 1:nrow(df) ) {
          # for first row in group
  if( df$cond[r] == 1){
     Idx <-  paste0("week", df$start[r]:df$stop[r] ) #start:stop
     Mat[r, Idx] <- 1; next}
          # second
  if( df$cond[r] == 2){ 
     Idx <-  paste0("week" , df$stop[r]:df$unstop[r] )#  stop:unstop
     Mat[r, Idx] <- 1; next}
          # third
  if( df$cond[r] == 3){
    Idx  <- paste0("week", df$unstop[r]:maxwk )    # unstop:max
    Mat[r, Idx] <- 1; next}
  }
df
  group start stop unstop cond
1     1     2    4      5    1
2     1     2    7      7    2
3     1     2    8     10    3
4     2     7    6      7    1
5     2     7    8      9    2
6     2     7    9     10    3
> Mat
     week1 week2 week3 week4 week5 week6 week7 week8 week9 week10
[1,]     0     1     1     1     0     0     0     0     0      0
[2,]     0     0     0     0     0     0     1     0     0      0
[3,]     0     0     0     0     0     0     0     0     0      1
[4,]     0     0     0     0     0     1     1     0     0      0
[5,]     0     0     0     0     0     0     0     1     1      0
[6,]     0     0     0     0     0     0     0     0     0      1

你可以买cbind个.

可能会有性能改进.可以使用switch(cond, ...)来分派到正确的逻辑,而不是if( cond == .){ ., next}方法.这应该比使用ifelseif_else的代码快得多.如果你想看看它是如何实现的,那么用一个复选标记来认可一般策略,我会花时间添加替代代码.

  • 在设置两种方法最多100周后运行基准测试.*警告来自问题中的代码:
> perf_results <- microbenchmark(
+     first.method    = do_first(df), sec.method=do_second(df), times=10)
There were 50 or more warnings (use warnings() to see the first 50)
> perf_results
Unit: microseconds
         expr         min        lq         mean       median          uq        max neval
 first.method 4385001.123 4416568.8 4581549.9624 4450691.5455 4615753.753 5350416.80    10
   sec.method     146.432     149.6     181.6137     188.2125     193.307     243.47    10

我想看看为一行 Select 合适算法的switch种方法是否能提高性能.的确如此,而且在某种程度上让我感到惊讶.switch函数类似于Pascal和许多其他语言中的case函数.它有两种形式,其行为因第一个参数EXPR是数字还是字符而不同.这里 Select "dispatch"版本是因为"cond"列是数字.

do_third= function(df){ Mat <- matrix(0, nrow(df), 100) # 200 for real case
maxwk <- 100
colnames(Mat) <- paste0("week", 1:maxwk)
df$cond <- rep(1:3, length=nrow(df))  # assume all groups have exactly 3: 
for( r in 1:nrow(df)) { switch( df[r,"cond"],      
         { # for first row in each group of 3
     Idx <-  paste0("week", df$start[r]:df$stop[r] ) #start:stop
     Mat[r, Idx] <- 1 }, 
          
          { # second row in group
     Idx <-  paste0("week" , df$stop[r]:df$unstop[r] )#  stop:unstop
     Mat[r, Idx] <- 1 },
          
          {# third
     Idx  <- paste0("week", df$unstop[r]:maxwk )    # unstop:max
     Mat[r, Idx] <- 1 } ) }
   }

新微基准:

perf_results
Unit: nanoseconds
         expr        min         lq         mean     median         uq        max neval cld
 first.method 4304901359 4351893534 4387626725.8 4372151785 4416247096 4543314742    10   b
   sec.method     162803     173855    2588492.1     215309     216878   24081195    10  a 
   third.meth         34         53        610.6        877        940        963    10  a 

R相关问答推荐

如何根据R中其他列的值有条件地从列中提取数据?

提取具有连续零值的行,如果它们前面有R中的有效值

使用R中的正则表达式将一列分割为多列

根据1个变量绘制 colored颜色 发散的 map ,由另一个变量绘制饱和度,ggplot2不工作

将多个列值转换为二进制

安全地测试文件是否通过R打开

在生成打印的自定义函数中,可以通过变量将线型或 colored颜色 设置为NULL吗?

使用函数从R中的列中删除标高

R try Catch in the loop-跳过缺少的值并创建一个DF,显示跳过的内容

Data.table::Shift type=允许扩展数据(&Q;LAG&Q;)

在GT()中的列之间添加空格

按两个条件自动过滤数据

从字符串列中的向量中查找第一个匹配的单词

在子图内和子图之间对齐行数不均匀的表格罗布对

如何在网页抓取中自动更改页码?

从字符数据列中删除符号

CLUSTER_Leiden(),我在结果对象中找到值$Quality的含义是什么/在哪里?

使用用户定义模板的rmarkdown书目

try 将R tibble中的多行字符串合并为一行字符串

在GROUP_BY之前删除NAS并在用户定义的函数中汇总