Calculate dataframe column items segments overlap (intersection of one column unique values combinations) in R

Question

I have a dataset for a campaigns workflow. Each campaign can send multiple communication elements com_elm to recipients recipient_id. I want to measure the overlap of recipients between those different campaigns.

I experimented with various ways of achieving this goal and found a solution. However the journey left me with some questions, which I am looking for answers to and which I will post at the bottom of this questions.

Here is the dataset:

datv <- structure(list(campaign = c("campaign_x", "campaign_x", "campaign_x", 
"campaign_x", "campaign_x", "campaign_x", "campaign_x", "campaign_x", 
"campaign_x", "campaign_x", "campaign_x", "campaign_x", "campaign_x", 
"campaign_x", "campaign_x", "campaign_x", "campaign_x", "campaign_x", 
"campaign_x", "campaign_x", "campaign_x", "campaign_x", "campaign_x", 
"campaign_x", "campaign_x", "campaign_x", "campaign_x", "campaign_x", 
"campaign_x", "campaign_x", "campaign_y", "campaign_y", "campaign_y", 
"campaign_y", "campaign_y", "campaign_y", "campaign_y", "campaign_y", 
"campaign_y", "campaign_y", "campaign_y", "campaign_y", "campaign_y", 
"campaign_y", "campaign_y", "campaign_y", "campaign_y", "campaign_y", 
"campaign_y", "campaign_y", "campaign_y", "campaign_y", "campaign_y", 
"campaign_y", "campaign_y", "campaign_y", "campaign_y", "campaign_y", 
"campaign_y", "campaign_y", "campaign_z", "campaign_z", "campaign_z", 
"campaign_z", "campaign_z", "campaign_z", "campaign_z", "campaign_z", 
"campaign_z", "campaign_z", "campaign_z", "campaign_z", "campaign_z", 
"campaign_z", "campaign_z", "campaign_z", "campaign_z", "campaign_z", 
"campaign_z", "campaign_z", "campaign_z", "campaign_z", "campaign_z", 
"campaign_z", "campaign_z", "campaign_z", "campaign_z", "campaign_z", 
"campaign_z", "campaign_z"), com_elm = c("campaign_x_C3", "campaign_x_B1", 
"campaign_x_B2", "campaign_x_C3", "campaign_x_C3", "campaign_x_B1", 
"campaign_x_B2", "campaign_x_C3", "campaign_x_C3", "campaign_x_B1", 
"campaign_x_B2", "campaign_x_C3", "campaign_x_B1", "campaign_x_C3", 
"campaign_x_B1", "campaign_x_A1", "campaign_x_C3", "campaign_x_B1", 
"campaign_x_B1", "campaign_x_C3", "campaign_x_B1", "campaign_x_A1", 
"campaign_x_C3", "campaign_x_C3", "campaign_x_B1", "campaign_x_B2", 
"campaign_x_C3", "campaign_x_B1", "campaign_x_C3", "campaign_x_C3", 
"campaign_y_C3", "campaign_y_B1", "campaign_y_B2", "campaign_y_C3", 
"campaign_y_C3", "campaign_y_B1", "campaign_y_B2", "campaign_y_C3", 
"campaign_y_C3", "campaign_y_B1", "campaign_y_B2", "campaign_y_C3", 
"campaign_y_B1", "campaign_y_C3", "campaign_y_B1", "campaign_y_A1", 
"campaign_y_C3", "campaign_y_B1", "campaign_y_B1", "campaign_y_C3", 
"campaign_y_B1", "campaign_y_A1", "campaign_y_C3", "campaign_y_C3", 
"campaign_y_B1", "campaign_y_B2", "campaign_y_C3", "campaign_y_B1", 
"campaign_y_C3", "campaign_y_C3", "campaign_z_C3", "campaign_z_B1", 
"campaign_z_B2", "campaign_z_C3", "campaign_z_C3", "campaign_z_B1", 
"campaign_z_B2", "campaign_z_C3", "campaign_z_C3", "campaign_z_B1", 
"campaign_z_B2", "campaign_z_C3", "campaign_z_B1", "campaign_z_C3", 
"campaign_z_B1", "campaign_z_A1", "campaign_z_C3", "campaign_z_B1", 
"campaign_z_B1", "campaign_z_C3", "campaign_z_B1", "campaign_z_A1", 
"campaign_z_C3", "campaign_z_C3", "campaign_z_B1", "campaign_z_B2", 
"campaign_z_C3", "campaign_z_B1", "campaign_z_C3", "campaign_z_C3"
), com_elm_id = c(808001L, 811001L, 814001L, 509005L, 729060L, 
817002L, 820002L, 792002L, 793003L, 820003L, 824003L, 792002L, 
811001L, 787001L, 811001L, 468023L, 792002L, 812001L, 812001L, 
808001L, 811001L, 468023L, 468006L, 491014L, 825002L, 828002L, 
741001L, 825002L, 512001L, 733001L, 808001L, 811001L, 814001L, 
509005L, 729060L, 817002L, 820002L, 792002L, 793003L, 820003L, 
824003L, 792002L, 811001L, 787001L, 811001L, 468023L, 792002L, 
812001L, 812001L, 808001L, 811001L, 468023L, 468006L, 491014L, 
825002L, 828002L, 741001L, 825002L, 512001L, 733001L, 808001L, 
811001L, 814001L, 509005L, 729060L, 817002L, 820002L, 792002L, 
793003L, 820003L, 824003L, 792002L, 811001L, 787001L, 811001L, 
468023L, 792002L, 812001L, 812001L, 808001L, 811001L, 468023L, 
468006L, 491014L, 825002L, 828002L, 741001L, 825002L, 512001L, 
733001L), recipient_id = c(5432L, 5432L, 5432L, 197L, 197L, 8388L, 
8388L, 8426L, 8426L, 10903L, 10903L, 14469L, 14469L, 17466L, 
17466L, 17807L, 21666L, 23935L, 24287L, 25412L, 25412L, 31361L, 
31361L, 31361L, 31365L, 31365L, 40849L, 40860L, 41737L, 41737L, 
5432L, 5432L, 5432L, 197L, 197L, 8388L, 8388L, 8426L, 8426L, 
10903L, 10903L, 1446945L, 1446945L, 1746645L, 1746645L, 1780745L, 
2166645L, 2393545L, 24287L, 25412L, 25412L, 3136145L, 3136145L, 
3136145L, 3136545L, 3136545L, 40849L, 40860L, 4173745L, 4173745L, 
5432L, 5432L, 5432L, 19732L, 19732L, 838832L, 838832L, 842632L, 
842632L, 10903L, 10903L, 14469L, 14469L, 1746632L, 1746632L, 
1780732L, 2166645L, 2393545L, 2428745L, 25412L, 25412L, 3136145L, 
3136145L, 3136145L, 3136545L, 3136545L, 40849L, 40860L, 41737L, 
41737L), step = c(3, 1, 2, 3, 3, 1, 2, 3, 3, 1, 2, 3, 1, 3, 1, 
1, 3, 1, 1, 3, 1, 1, 3, 3, 1, 2, 3, 1, 3, 3, 3, 1, 2, 3, 3, 1, 
2, 3, 3, 1, 2, 3, 1, 3, 1, 1, 3, 1, 1, 3, 1, 1, 3, 3, 1, 2, 3, 
1, 3, 3, 3, 1, 2, 3, 3, 1, 2, 3, 3, 1, 2, 3, 1, 3, 1, 1, 3, 1, 
1, 3, 1, 1, 3, 3, 1, 2, 3, 1, 3, 3), date = structure(c(19029, 
19032, 19035, 18778, 18960, 19037, 19040, 19016, 19019, 19040, 
19043, 19015, 19032, 19011, 19032, 18746, 19015, 19033, 19033, 
19029, 19032, 18746, 18746, 18764, 19044, 19047, 18969, 19044, 
18781, 18962, 19029, 19032, 19035, 18778, 18960, 19037, 19040, 
19016, 19019, 19040, 19043, 19015, 19032, 19011, 19032, 18746, 
19015, 19033, 19033, 19029, 19032, 18746, 18746, 18764, 19044, 
19047, 18969, 19044, 18781, 18962, 19029, 19032, 19035, 18778, 
18960, 19037, 19040, 19016, 19019, 19040, 19043, 19015, 19032, 
19011, 19032, 18746, 19015, 19033, 19033, 19029, 19032, 18746, 
18746, 18764, 19044, 19047, 18969, 19044, 18781, 18962), class = "Date")), class = c("tbl_df", 
"tbl", "data.frame"), row.names = c(NA, -90L))

Here is the solution that finally worked for me:

df <- data.frame(twin_campaigns=character(),
                 max_rank=integer(),
                 count=integer()
                 )

x <- c("campaign_x","campaign_y","campaign_z")

segments_list <- list()

datv

for (xval in x){
  y <- x[! x %in% c(xval)]
  for (yval in y){
    segment_name <- paste(str_sort(c(xval,yval)),collapse="::")
    print(segment_name)
    if (!segment_name %in% segments_list) {
      segments_list <- c(segments_list,segment_name)
      datk <- datv %>%
              filter(str_detect(campaign, paste(str_sort(c(xval,yval)),collapse="|"))) %>%
              group_by(recipient_id) %>%
              summarise(rank = dense_rank(campaign), .groups = 'drop') %>%
              group_by(recipient_id,rank) %>%
              summarise(count = n(), .groups = 'drop') %>% #used to remove duplicates with count() to sense check work. Can use distinct()
              group_by(recipient_id) %>%
              summarise(max_rank=max(rank), .groups = 'drop') %>%
              group_by(max_rank) %>%
              summarise(count=n(), .groups = 'drop')
  
      datj <- add_column(datk, campaigns_segment=stri_join(xval, yval, sep="::"), .before = "max_rank")
      print(nrow(datj))
      data <- data.frame(datj)
      df <- rbind(df, datj)
    }
  }
}

df

df %>% 
  pivot_wider(
    names_from = max_rank,
    values_from = c(count),
    names_sep = "_",
    names_prefix = "x.",
    values_fill =list(Abundance = NA)
  ) %>%
  rename(separate_recipients = x.1, overlapped_recipients=x.2)

Which gives me this correct output:

During my journey of figuring that out I experimented with venn tables, but was not able to get to the answer I want. I am posting another question regarding venn in another post.

My Question is:

1- Consider it a challenge! is anyone able to come up with a better, neater and faster solution than the for loop I developed above. It felt like a waste of resource looping across the entire dataframe for every single combination of campaigns. This would take long time if the dataset is large!

An ideal solution, would be one that identifies all possible combinations of campaigns at the start, then loops once through the dataset incrementing the different segment buckets as it goes along!

user_8206434 · Answer

How about this for number 1 and it also deals with question 2.

library(dplyr)
combs <- combn(unique(datv$campaign), 2)
combs <- as.data.frame(t(combs))
combs %>% 
  rowwise() %>% 
  mutate(overlap_resp = length(intersect(unique(na.omit(datv$recipient_id[which(datv$campaign == V1)])), 
                                     unique(na.omit(datv$recipient_id[which(datv$campaign == V2)])))), 
         sep_resp = length(union(unique(na.omit(datv$recipient_id[which(datv$campaign == V1)])), 
                                     na.omit(unique(datv$recipient_id[which(datv$campaign == V2)])))) - 
           overlap_resp)
#> # A tibble: 3 × 4
#> # Rowwise: 
#>   V1         V2         overlap_resp sep_resp
#>                          
#> 1 campaign_x campaign_y            9       16
#> 2 campaign_x campaign_z            7       20
#> 3 campaign_y campaign_z            9       16

Calculate dataframe column items segments overlap (intersection of one column unique values combinations) in R

1 Answers