Combining observations based on multiple conditions

Viewed 92

Currently I am writing my master's thesis, however, I have some issues with combining rows on multiple conditions. I have illustrated my problem and desired outcome below. I hope you can help me :).

This is an example of how my dataset looks like:

df <- data.frame(
  userID = c(1, 1, 1, 1, 1, 2, 2, 3, 3, 3, 3),
  sessionID = c(1, 2, 3, 4, 5, 1, 2, 1, 2, 3, 4),
  date = as.Date(c("2019-03-15", "2019-03-18", "2019-03-19", "2019-03-21","2019-03-30", "2019-04-05", 
                   "2019-06-06", "2019-11-22", "2019-12-22", "2019-12-24", "2020-01-15"), 
                 format = "%Y-%m-%d"),
  purchase=c(0,1,0,0,0,0,0,0,0,1,0))

Now, I have calculated the difference via diff via dplyr:

library(dplyr)
df <- df %>%
  group_by(userID) %>%
  mutate(diff = date - lag(date))

However, I want to combine the rows if there is < 10 days of difference between them. I would like that the 10 days window resets every time there is an activity (a new sessionID). Furthermore, when purchase is 1 then it stops, and the 10 day window will start again when there is a new sessionID.

I have tried many things with the functions filter and summarise in dplyr, but it gives not the desired result. Besides, I do not really know how to include the purchase condition.

My desired outcome would look like this:

df2 <- data.frame(
  userID = c(1, 1, 2, 2, 3, 3, 3),
  sessionID = c("1 + 2", "3 + 4 + 5", "1", "2", "1", "2 + 3", "4"),
  date.start = as.Date(c("2019-03-15","2019-03-19", "2019-04-05", 
                   "2019-06-06", "2019-11-22", "2019-12-22", "2020-01-15"), 
                 format = "%Y-%m-%d"),
  date.end = as.Date(c("2019-03-18", "2019-03-30", "2019-04-05", "2019-06-06", 
                     "2019-11-22", "2019-12-24", "2020-01-15"), format = "%Y-%m-%d"),  
  purchase=c(1,0,0,0,0,1,0))

I hope you can help me :) Thanks in advance!

3 Answers

Grouped by 'userID', create a new group based on the occurrence of 1 in 'purchase' by doing the cumulative sum on the lag of 'purchase', then create another grouping based on the difference in adjacent 'date' values i.e. checking if the difference is greater than or equal to 10 days, do a cumulative sum, and summarise the 'sessionID' by pasting (str_c), get the first element of 'date' and last of 'date' and any value of 1 in 'purchase' as summary columns

library(dplyr)
library(stringr)
df %>% 
    group_by(userID) %>%
    group_by( grp = cumsum(lag(purchase, 
        default = first(purchase))), .add = TRUE) %>%
    group_by(cat = cumsum(difftime(date, 
      lag(date, default = first(date)), units = 'day') >= 10), .add = TRUE ) %>%
    summarise(sessionID = str_c(sessionID, collapse= ' + '), 
              date.start = first(date), date.end = last(date), 
               purchase = +(any(purchase == 1)), .groups = 'drop' ) %>%
    select(-grp, -cat)

-output

# A tibble: 7 x 5
  userID sessionID date.start date.end   purchase
   <dbl> <chr>     <date>     <date>        <int>
1      1 1 + 2     2019-03-15 2019-03-18        1
2      1 3 + 4 + 5 2019-03-19 2019-03-30        0
3      2 1         2019-04-05 2019-04-05        0
4      2 2         2019-06-06 2019-06-06        0
5      3 1         2019-11-22 2019-11-22        0
6      3 2 + 3     2019-12-22 2019-12-24        1
7      3 4         2020-01-15 2020-01-15        0

Another tidyverse strategy using accumulate2

df <- data.frame(
  userID = c(1, 1, 1, 1, 1, 2, 2, 3, 3, 3, 3),
  sessionID = c(1, 2, 3, 4, 5, 1, 2, 1, 2, 3, 4),
  date = as.Date(c("2019-03-15", "2019-03-18", "2019-03-19", "2019-03-21","2019-03-30", "2019-04-05", 
                   "2019-06-06", "2019-11-22", "2019-12-22", "2019-12-24", "2020-01-15"), 
                 format = "%Y-%m-%d"),
  purchase=c(0,1,0,0,0,0,0,0,0,1,0))
library(tidyverse)

df %>%
  group_by(userID, grp = cumsum(sessionID == 1) ) %>%
  mutate(diff = as.numeric(date - lag(date, default = first(date)))) %>%
  group_by(grp2 = accumulate2(diff, purchase[-n()], ~if(..2 > 10 | ..3 == 1) ..1 + 1 else ..1), .add = T) %>%
  summarise(sessionID = paste(sessionID, collapse = ' + '),
            start_date = first(date),
            end_date = last(date), .groups = 'drop') %>%
  select(!starts_with('grp'))

#> # A tibble: 7 x 4
#>   userID sessionID start_date end_date  
#>    <dbl> <chr>     <date>     <date>    
#> 1      1 1 + 2     2019-03-15 2019-03-18
#> 2      1 3 + 4 + 5 2019-03-19 2019-03-30
#> 3      2 1         2019-04-05 2019-04-05
#> 4      2 2         2019-06-06 2019-06-06
#> 5      3 1         2019-11-22 2019-11-22
#> 6      3 2 + 3     2019-12-22 2019-12-24
#> 7      3 4         2020-01-15 2020-01-15

Created on 2021-06-10 by the reprex package (v2.0.0)

Dedicated to my dear friend @akrun Here is just another way of achieving the final output, It is not as elegant and as concise as the one dear @akrun proposed. In fact I spent a couple hours on this and It was very important to me to see the end of it. However I was greatly inspired by dear @Akrun as always. I hope it works for you:

library(dplyr)
library(purrr)

df %>%
  mutate(cum = cumsum(purchase == 1),
         cum = ifelse(cum - lag(cum, default = 0) == 1, lag(cum), cum), 
         Days = as.numeric(date - lag(date, default = first(date)))) %>%
  group_by(cum) %>%
  mutate(diff = ifelse(Days < 10, 0, 1)) %>%
  ungroup() %>%
  mutate(diff = cumsum(diff), 
         start = date, 
         end = date) %>%
  mutate(across(sessionID, as.character)) %>%
  group_split(userID, cum, diff) %>%
  map_dfr(~ add_row(.x, userID = .x$userID[1], 
                    sessionID = paste(.x$sessionID, collapse = "+"), 
                    start = .x$date[1], end = .x$date[length(.x$date)])) %>%
  filter(if_any(date:diff, ~ is.na(.x))) %>%
  select(!date:diff)

# A tibble: 7 x 4
  userID sessionID start      end       
   <dbl> <chr>     <date>     <date>    
1      1 1+2       2019-03-15 2019-03-18
2      1 3+4+5     2019-03-19 2019-03-30
3      2 1         2019-04-05 2019-04-05
4      2 2         2019-06-06 2019-06-06
5      3 1         2019-11-22 2019-11-22
6      3 2+3       2019-12-22 2019-12-24
7      3 4         2020-01-15 2020-01-15
Related