将不同联系电话号码和电子邮件组合为同一联系人的算法方式

Question

我有以下小题，

contact <- tribble(
  ~name, ~phone, ~email,
  'John', 123, 'john_abc@gmail.com',
  'John', 456, 'john_abc@gmail.com',
  'John', 456, 'john_xyz@gmail.com',
  'John', 789, 'john_pqr@gmail.com'
)

如果电话或电子邮件相同，我想合并电话号码和电子邮件，所需的输出如下，

contact_combined <- tribble(
  ~name, ~phone, ~email,
  'John', '123;456', 'john_abc@gmail.com;john_xyz@gmail.com',
  'John', '789', 'john_pqr@gmail.com'
)

我尝试先按姓名和电话进行分组，然后按姓名和电子邮件进行分组，但它没有给我预期的结果。我一直在寻找一种算法方法来解决这个问题，有人能给我建议吗？

注意：列中值的折叠不是这里的问题。这是关于选择要折叠的记录。

Answer 1

图表可以帮助解决这个问题。

\n

library(igraph)\n\n# creates a matrix which tells whether pairs of vector elements are equal or not\nequal_mat <- function(x) {\n  \n  outer(x, x, \'==\')\n}\n\nm.adj <- equal_mat(contact$phone) | equal_mat(contact$email)\ng <- graph_from_adjacency_matrix(m.adj, mode=\'undir\')\n\nt(sapply(split(contact, components(g)$membership), function(group)\n  sapply(group, function(column)\n    paste(sort(unique(column)), collapse=\';\')))) %>%\n  as_tibble()\n\n# # A tibble: 2 \xc3\x97 3\n#   name  phone   email                                \n#   <chr> <chr>   <chr>                                \n# 1 John  123;456 john_abc@gmail.com;john_xyz@gmail.com\n# 2 John  789     john_pqr@gmail.com                   \n

\n

您可以将原始联系人视为一个图，即一组顶点，每行一个顶点contact，如果两个联系人具有相同的电话号码或电子邮件，则这些顶点通过边连接。在您的情况下，图表如下所示plot(g)：\n

\n

触点 1\xe2\x80\x933 形成一个连通分量，而没有连接的触点 4 是另一个分量。每个这样的组件都应该合并到最终输出中的一个联系人中。

\n

我们从邻接矩阵创建图m.adj，该矩阵告诉哪些顶点（节点）是连接的，并且使用以下方法来识别图组件

\n

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

\n

这准确地告诉了我们上面看到的内容：触点 1\xe2\x80\x933 构成组件 1，触点 4 是组件 2。现在我们可以折叠每个组件内的值。

\n

Answer 2

我想igraph这将是一个好的开始（您可以使用它decompose来对连接的子组进行聚类）

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

这使

  name    phone                                  email
1 John 123, 456 john_abc@gmail.com, john_xyz@gmail.com
2 John      789                     john_pqr@gmail.com

更多的tidyverse方法（感谢@akrun的评论）

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

这是data.table方法

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 john_abc@gmail.com;john_xyz@gmail.com
# 2: John     789                    john_pqr@gmail.com

解释

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

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