Conditional sum based on lagged rows

Viewed 113

I have a dataframe measuring logins per month. I'm trying to create a counter measuring months_since_zero_login that only adds when the logins in a month is zero. For the first month, each customer's counter will start from zero.

Here is the data:

library(tidyverse)

obs <- seq(as.Date('2020-01-01'),
           as.Date('2020-05-01'),
           by = "month")
table <- tibble(customer = seq(1:3))
#output
table <- table %>% 
  crossing(obs) %>% 
  mutate(login = c(3, 0, 0, 0, 2,
                   0, 1, 5, 0, 0,
                   1, 3, 1, 5, 0)) 

This is the expected result:

   customer obs        login months_since_zero_login
      <int> <date>     <dbl>                   <dbl>
 1        1 2020-01-01     3                       0
 2        1 2020-02-01     0                       0
 3        1 2020-03-01     0                       1
 4        1 2020-04-01     0                       2
 5        1 2020-05-01     2                       0
 6        2 2020-01-01     0                       0
 7        2 2020-02-01     1                       0
 8        2 2020-03-01     5                       0
 9        2 2020-04-01     0                       0
10        2 2020-05-01     0                       1
11        3 2020-01-01     1                       0
12        3 2020-02-01     3                       0
13        3 2020-03-01     1                       0
14        3 2020-04-01     5                       0
15        3 2020-05-01     0                       0

This is my code so far but I'm stuck on how to increase the counter by 1 when there are consecutive zeroes (in the case of customer 1)

table %>% 
  group_by(customer) %>% 
  mutate(months_since_zero_login = case_when(
    row_number() == 1 ~ 0, 
    lag(login) == 0 & login == 0 ~ 1,
    TRUE ~ 0
  ))
#does not increase counter when there are consecutive zeroes
3 Answers

This can be done with rleid. Create a temporary grouping column based on the occurence of '0' values in 'login', then grouped by 'customer', 'grp', while specifying the i as rows where 'login == 0', create the 'months_since_zero_login' as sequence of rows subtracted 1. Replace the NA elements in the same column to 0 (if needed)

library(data.table)
setDT(table)[,  grp := rleid(login == 0), .(customer)]
table[login == 0, months_since_zero_login := seq_len(.N) - 1, 
         .(customer, grp)][, grp := NULL]
table[is.na(months_since_zero_login), months_since_zero_login := 0]

-output

table
#    customer        obs login months_since_zero_login
# 1:        1 2020-01-01     3                       0
# 2:        1 2020-02-01     0                       0
# 3:        1 2020-03-01     0                       1
# 4:        1 2020-04-01     0                       2
# 5:        1 2020-05-01     2                       0
# 6:        2 2020-01-01     0                       0
# 7:        2 2020-02-01     1                       0
# 8:        2 2020-03-01     5                       0
# 9:        2 2020-04-01     0                       0
#10:        2 2020-05-01     0                       1
#11:        3 2020-01-01     1                       0
#12:        3 2020-02-01     3                       0
#13:        3 2020-03-01     1                       0
#14:        3 2020-04-01     5                       0
#15:        3 2020-05-01     0                       0

With dplyr, we can still use the rleid

library(dplyr)
table %>% 
   group_by(grp = rleid(customer, login == 0), customer) %>% 
   mutate(months_since_zero_login = if(all(login == 0)) 
         row_number() - 1 else 0) %>% 
   ungroup %>%
   select(-grp)

-output

# A tibble: 15 x 4
#   customer obs        login months_since_zero_login
#      <int> <date>     <dbl>                   <dbl>
# 1        1 2020-01-01     3                       0
# 2        1 2020-02-01     0                       0
# 3        1 2020-03-01     0                       1
# 4        1 2020-04-01     0                       2
# 5        1 2020-05-01     2                       0
# 7        2 2020-02-01     1                       0
# 8        2 2020-03-01     5                       0
# 9        2 2020-04-01     0                       0
#10        2 2020-05-01     0                       1
#11        3 2020-01-01     1                       0
#12        3 2020-02-01     3                       0
#13        3 2020-03-01     1                       0
#14        3 2020-04-01     5                       0
#15        3 2020-05-01     0                       0

Or use rle from base R

f1 <- function(x) {
   with(rle(x == 0), rep(values, lengths) * (sequence(lengths) - 1))     
}

table$months_since_zero_login <- with(table, ave(login, customer, FUN = f1))

Base R solution (where your table object == my df object):

# Function to group data by ids: grouping_func => function() 
grouping_func <- function(vec){
  # Calculate the run length encoding: r_l_e => rle
  r_l_e <- rle(vec)
  # Expand it out into the rle_id: rle_id => integer vector
  rle_id <- rep(seq_along(r_l_e$values), times = r_l_e$lengths)
  # Explicitly define the return object rle_id => GlobalEnv
  return(rle_id)
}

# Split-apply-combine the grouping function & business logic: 
# res => data.frame 
res <- do.call(rbind, lapply(with(df, split(df, customer)), function(x){
      # Apply the grouping function: rle_id => integer vector
      rle_id <- grouping_func(x$login)
      # Calculate the months since there were no logins; assign to x: 
      # months_since_zero_login => integer vector
      x$months_since_zero_login <- ifelse(x$login > 0, 0,
          cumsum(c(FALSE, rle_id[-1] == rle_id[-length(rle_id)])))
      # Return x: data.frame => Global Env
      x
    }
  )
)

Dplyr variant using the grouping_func() function:

df %>% 
  group_by(customer) %>% 
  mutate(rle_id = grouping_func(login),
         months_since_zero_login = ifelse(
           login > 0,
           0,
           cumsum(c(FALSE, rle_id[-1] == rle_id[-length(rle_id)])))) %>% 
  select(-rle_id) %>% 
  ungroup()

Here is solution using dplyr without data.table::rleid

library(dplyr, warn.conflicts = FALSE)

table %>%
  group_by(customer) %>%
  # create a break period index with group consecutive break month of customer 
  # into same group
  mutate(break_period_index =
      if_else(login == 0 & lag(login, 1,default = 1) > 0, 1L, 0L),
    break_period_index = if_else(login == 0, cumsum(break_period_index), 0L)) %>%
  # calculate the months_since_zero_login using row_number for login == 0 month
  group_by(customer, break_period_index) %>%
  mutate(months_since_zero_login = if_else(login == 0, row_number() - 1L, 0L)) %>%
  ungroup() %>%
  select(-break_period_index)
#> # A tibble: 15 x 4
#>    customer obs        login months_since_zero_login
#>       <int> <date>     <dbl>                   <int>
#>  1        1 2020-01-01     3                       0
#>  2        1 2020-02-01     0                       0
#>  3        1 2020-03-01     0                       1
#>  4        1 2020-04-01     0                       2
#>  5        1 2020-05-01     2                       0
#>  6        2 2020-01-01     0                       0
#>  7        2 2020-02-01     1                       0
#>  8        2 2020-03-01     5                       0
#>  9        2 2020-04-01     0                       0
#> 10        2 2020-05-01     0                       1
#> 11        3 2020-01-01     1                       0
#> 12        3 2020-02-01     3                       0
#> 13        3 2020-03-01     1                       0
#> 14        3 2020-04-01     5                       0
#> 15        3 2020-05-01     0                       0

Created on 2021-04-19 by the reprex package (v2.0.0)

Related