Algorithmic way to combine different contact number and emails for same contact

Question

I have the following tibble,

contact <- tribble(
  ~name, ~phone, ~email,
  'John', 123, '[email protected]',
  'John', 456, '[email protected]',
  'John', 456, '[email protected]',
  'John', 789, '[email protected]'
)

I'd like to combine the phone numbers and emails if phone or email are the same, the desired output is the following,

contact_combined <- tribble(
  ~name, ~phone, ~email,
  'John', '123;456', '[email protected];[email protected]',
  'John', '789', '[email protected]'
)

I've tried grouping it first by name and phone and then by name and emails but it's not giving me the expected results. I'm stuck on finding an algorithmic way to solve this problem, could someone please give me an advice?

Note: The collapsing of the values in a column is not the question here. It's about selecting the records for the collapsing.

Answer 1

Graphs can help with this.

library(igraph)

# creates a matrix which tells whether pairs of vector elements are equal or not
equal_mat <- function(x) {
  
  outer(x, x, '==')
}

m.adj <- equal_mat(contact$phone) | equal_mat(contact$email)
g <- graph_from_adjacency_matrix(m.adj, mode='undir')

t(sapply(split(contact, components(g)$membership), function(group)
  sapply(group, function(column)
    paste(sort(unique(column)), collapse=';')))) %>%
  as_tibble()

# # A tibble: 2 × 3
#   name  phone   email                                
#   <chr> <chr>   <chr>                                
# 1 John  123;456 [email protected];[email protected]
# 2 John  789     [email protected]                   

You can think of your original contacts as a graph, i.e. a set of vertices, one for each row in contact, which are connected by edges if two contacts have the same phone number or email. In your case the graph looks like this, plot(g):

Contacts 1–3 form one connected component, while the contact number 4 which has no connections is another component. Each such component should be merged into one contact in the final output.

We create the graph from an adjacency matrix m.adj that tells which vertices (nodes) are connected and the graph components are identified using

components(g)$membership
[1] 1 1 1 2

which tells us exactly what we saw above: contacts 1–3 form component one, contact number 4 is component 2. Now we can just collapse the values within each components.

Answer 2

I guess igraph would be a good start (by which you can use decompose to cluster connected subgroups)

contact %>%
  select(c(2, 3, 1)) %>%
  graph_from_data_frame() %>%
  decompose() %>%
  lapply(function(x) {
    aggregate(
      . ~ name, get.data.frame(x),
      function(v) toString(unique(v))
    )
  }) %>%
  bind_rows() %>%
  setNames(names(contact))

which gives

  name    phone                                  email
1 John 123, 456 [email protected], [email protected]
2 John      789                     [email protected]

---

A more tidyverse way (thank @akrun's comment)

contact %>%
  relocate(name, .after = last_col()) %>%
  graph_from_data_frame() %>%
  decompose() %>%
  map(~ .x %>%
    get.data.frame() %>%
    reframe(across(everything(), ~ str_c(unique(.x), collapse = ";")), .by = "name")) %>%
  list_rbind() %>%
  setNames(names(contact))

Answer 3

here is s data.table approach

setDT(contact)
# set keys
setkey(contact, name, phone, email)
# self join on each unique key, filter and summarise on the fly 
ans <- contact[contact, c("phone2", "email2") := {
  temp <- contact[ name == i.name & 
                     (phone %in% contact[name == i.name & email == i.email, ]$phone | 
                        email %in% contact[name == i.name & phone == i.phone, ]$email), ]
  email_temp <- paste0(unique(temp$email), collapse = ";")
  phone_temp <- paste0(unique(temp$phone), collapse = ";")
  list(phone_temp, email_temp)
}, by = .EACHI]
# final step
unique(ans, by = c("name", "phone2", "email2"))[, .(name, phone = phone2, email = email2)]
#    name   phone                                 email
# 1: John 123;456 [email protected];[email protected]
# 2: John     789                    [email protected]

explanation

# so, for the first row, the variable 'temp' is calculated as follows
contact[ name == 'John' &
          (phone %in% contact[name == 'John' & email == '[email protected]', ]$phone | 
           email %in% contact[name == 'John' & phone == 123, ]$email), ]
#    name phone              email
# 1: John   123 [email protected]
# 2: John   456 [email protected]
# 3: John   456 [email protected]

# then, put the unique emails together in a string using
#     email_temp <- paste0(unique(temp$email), collapse = ";")
# and do the same for the phones using 
#     phone_temp <- paste0(unique(temp$phone), collapse = ";")

# and return there two strings to the columns "phone2" ans "email2"

#repeat for each unique key-combination (.EACHI)

Answer 4

A different approach using the powerjoin package:

contact <- tribble(
  ~name, ~phone, ~email,
  "John", 123, "[email protected]",
  "John", 456, "[email protected]",
  "John", 456, "[email protected]",
  "John", 789, "[email protected]") |> 
  mutate(row_id = row_number())


library(powerjoin)
library(dplyr)
# check duplicated entries in phone column
phone_check <- contact |>
  power_right_join(filter(contact, duplicated(phone)),
                   by = c("name", "phone"),
                   conflict = ~ paste(.x, .y, sep = ";")
  ) |>
  group_by(phone) |>
  slice(1) |>
  tidyr::separate_rows(row_id) |> 
  ungroup() |> 
  select(name, email, row_id)


# check duplicated entries in email column
email_check <- contact |>
  power_right_join(filter(contact, duplicated(email)),
                   by = c("name", "email"),
                   conflict = ~ paste(.x, .y, sep = ";") 
  ) |>
  group_by(email) |>
  slice(1) |>
  tidyr::separate_rows(row_id) |> 
  ungroup() |> 
  select(name, phone, row_id)



email_check |> select(name, phone, row_id) |> 
  inner_join(phone_check, by = c("name", "row_id")) |> 
  bind_rows(
    contact |> 
      mutate(phone = as.character(phone), 
             row_id = as.character(row_id)) |> 
      filter(!row_id %in% c(phone_check$row_id, email_check$row_id))
  ) |> 
  select(-row_id)


# A tibble: 2 × 3
  name  phone   email                                
  <chr> <chr>   <chr>                                
1 John  123;456 [email protected];[email protected]
2 John  789     [email protected]