tidyverse combine a lagged row value + certain character if condition is met

user_2725773 0
Viewed 140

Assume the following data:

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

I now want to go through my data frame row by row after grouping by name and when the condition is met I want to add an asterisk (*) to the name column. If the condition is not met I want to replace the name value by the previous name value.

  • So in row 2, I'd like to change "b" to "b*".
  • In row 5, I want to change "b*" (because that's what we already changed row 2 to) to "b**".
  • In row 8, the condition is not met, so I just like to keep the previous b value, which is "b**".

I thought I can outsmart R by using a simple case_when solution, but apparently I failed with the code below. Any ideas?

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()

This code adds an asterisk when the condition is met, but it doesn't take the previous/lagged name value if the condition is not met. I guess the problem is that the case_when doesn't go through the whole thing row by row.

rowwise tidyverse r
3 Answers

After grouping by 'name', do the cumsum on 'condition', use that to replicate the * (strrep) and create the new column

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

-output

# 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*

Or using 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*
user_37322710

Just for the sake of experimentation:

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*
user_143145200

I thought I'd do the fun and compare the solutions with each other, since my real data set could have thousands of rows. I also added my own solution inspired by the one from @akrun, since I thought it might be a good idea to do the cumsum calculation within group, but the text concatenation after ungrouping.

Bottomline:

  • 27phi9's solution is the fastest one.
  • Doing the ungrouping before the text concatenation slightly beats akrun's solution (although not to an extent where it would matter).
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
user_27257730
Related