如果满足条件，tidyverse 结合滞后行值 + 某些字符

Question

假设以下数据：

set.seed(1)
df <- data.frame(name      = rep(letters[1:3], 5),
                 condition = sample(0:1 , 15, replace = TRUE))

df

   name condition
1     a         0
2     b         1
3     c         0
4     a         0
5     b         1
6     c         0
7     a         0
8     b         0
9     c         1
10    a         1
11    b         0
12    c         0
13    a         0
14    b         0
15    c         0

我现在想在按名称分组后逐行浏览我的数据框，当满足条件时，我想在名称列中添加一个星号 (*)。如果不满足条件，我想用之前的名称值替换名称值。

• 所以在第 2 行，我想将“b”更改为“b*”。
• 在第 5 行中，我想将“b*”（因为我们已经将第 2 行更改为）更改为“b**”。
• 在第8行中，条件不满足，所以我只想保留之前的b值，即“b**”。

我认为我可以通过使用简单的case_when 解决方案来超越 R，但显然我在下面的代码中失败了。有什么想法吗？

library(tidyverse)
df %>%
  group_by(name) %>%
  mutate(helper_id   = 1:n(),
         name        = case_when(condition == 1 & helper_id == 1 ~ paste0(name, "*"),
                                 condition != 1 & helper_id == 1 ~ name,
                                 condition == 1 & helper_id != 1 ~ paste0(lag(name), "*"),
                                 condition != 1 & helper_id != 1 ~ lag(name))) %>%
  ungroup()

此代码在满足条件时添加一个星号，但如果不满足条件，则不采用前一个/滞后名称值。我想问题是case_when 没有逐行遍历整个事情。

Answer 1

只是为了实验：

library(dplyr)
library(purrr)

df %>%
  group_by(name) %>%
  mutate(name2 = if_else(condition[1] == 1, paste(name[1], "*", sep = ""), name[1]),
         name2 = accumulate(condition[-1], .init = tibble(name2 = name2[1]), 
                            ~ if(.y == 1) {
                              paste(.x, "*", sep = "")
                            } else {
                              .x
                            })) %>%
  unnest(cols = name2)

# A tibble: 15 x 3
# Groups:   name [3]
   name  condition name2
   <chr>     <int> <chr>
 1 a             0 a    
 2 b             1 b*   
 3 c             0 c    
 4 a             0 a    
 5 b             1 b**  
 6 c             0 c    
 7 a             0 a    
 8 b             0 b**  
 9 c             1 c*   
10 a             1 a*   
11 b             0 b**  
12 c             0 c*   
13 a             0 a*   
14 b             0 b**  
15 c             0 c*  

Answer 2

按“名称”分组后，在“条件”上执行cumsum，用它来复制*（strrep）并创建新列

library(stringr)
library(dplyr)
df %>% 
   group_by(name) %>%
   mutate(name1 = str_c(name, strrep("*", cumsum(condition)))) %>%
   ungroup

-输出

# A tibble: 15 x 3
   name  condition name1
   <chr>     <int> <chr>
 1 a             0 a    
 2 b             1 b*   
 3 c             0 c    
 4 a             0 a    
 5 b             1 b**  
 6 c             0 c    
 7 a             0 a    
 8 b             0 b**  
 9 c             1 c*   
10 a             1 a*   
11 b             0 b**  
12 c             0 c*   
13 a             0 a*   
14 b             0 b**  
15 c             0 c*   

---

或使用collapse

library(collapse)
tfm(df, name1 = fcumsum(condition, g = name)) %>% 
     tfm(name1 = str_c(name, strrep("*", name1)))
   name condition name1
1     a         0     a
2     b         1    b*
3     c         0     c
4     a         0     a
5     b         1   b**
6     c         0     c
7     a         0     a
8     b         0   b**
9     c         1    c*
10    a         1    a*
11    b         0   b**
12    c         0    c*
13    a         0    a*
14    b         0   b**
15    c         0    c*

Answer 3

我想我会玩得开心并相互比较解决方案，因为我的真实数据集可能有数千行。我还添加了受@akrun 启发的解决方案，因为我认为在组内进行cumsum 计算可能是个好主意，但在取消分组后进行文本连接。

底线：

• 27phi9 的解决方案是最快的。
• 在文本连接之前进行取消分组稍微优于 akrun 的解决方案（尽管没有达到重要的程度）。

---

set.seed(1)
df <- data.frame(name      = rep(letters, 10000),
                 condition = sample(0:1 , 26*10000, replace = TRUE))

library(tidyverse)

df_27phi9 <- function()
{
  df %>%
    group_by(name) %>%
    mutate(res = paste0(name, Reduce(paste0, ifelse(condition == 1, "*", ""), accumulate = TRUE))) %>%
    ungroup()
}
  

df_akrun <- function()
{
  df %>% 
    group_by(name) %>%
    mutate(name1 = str_c(name, strrep("*", cumsum(condition)))) %>%
    ungroup()
}

df_Anoushiravan <- function()
{
  df %>%
    group_by(name) %>%
    mutate(name2 = if_else(condition[1] == 1, paste(name[1], "*", sep = ""), name[1]),
           name2 = accumulate(condition[-1], .init = tibble(name2 = name2[1]), 
                              ~ if(.y == 1) {
                                paste(.x, "*", sep = "")
                              } else {
                                .x
                              })) %>%
    unnest(cols = name2) %>%
    ungroup(name)
}

df_deschen <- function()
{
  df %>% 
    group_by(name) %>%
    mutate(cumsum_condition = cumsum(condition)) %>%
    ungroup() %>%
    mutate(name1 = str_c(name, strrep("*", cumsum_condition)))
}

library(microbenchmark)

microbenchmark(df_27phi9 = df_27phi9(),
               df_akrun  = df_akrun(),
               df_Anoushiravan = df_Anoushiravan(),
               df_deschen = df_deschen(),
               times = 10L)

# Unit: seconds
#             expr      min       lq     mean   median       uq      max neval
#        df_27phi9 3.153200 3.296317 3.627211 3.496424 4.066584 4.615941    10
#         df_akrun 3.763212 3.949891 4.136863 4.079212 4.340091 4.663039    10
#  df_Anoushiravan 5.974054 6.882175 7.204998 7.059219 7.476390 8.551054    10
#       df_deschen 3.638056 3.755617 3.928593 3.857894 4.110398 4.350009    10