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

Question

我有以下的数据表，

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

我想要将电话号码和电子邮件地址合并，如果它们相同的话，期望的输出如下：

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

我已经尝试过先按姓名和电话分组，然后再按姓名和电子邮件分组，但是它没有给我预期的结果。我卡在了寻找算法解决这个问题的方法上，有人能给我一个建议吗？

注意：这里不是关于将列中的值合并的问题，而是关于选择要合并的记录的问题。

- msunij

---

创建一个分组变量，类似于这样：基于多列创建group_indices。然后使用此方法来将一列数据合并为单个逗号分隔的字符串。 - Henrik

grp = components(graph_from_data_frame(contact[ , c(2, 3, 1)]))$membership; aggregate(. ~ grp[contact$email], function(x) toString(unique(x)), data = contact)。 - Henrik

Answer 1

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

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 [e-mail];[e-mail]
# 2 John  789     [e-mail]                   

您可以将原始联系人视为一个图形，即一组顶点，每个顶点对应于contact中的每一行，如果两个联系人具有相同的电话号码或电子邮件，则它们由边连接。在您的情况下，该图形如下所示：plot(g)：

联系人1-3形成一个连通分量，而没有任何联系的联系人4则是另一个分量。每个这样的分量都应合并为最终输出中的一个联系人。

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

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

这告诉我们确切地看到了什么：联系人1-3组成了第一个组件，联系人4是第二个组件。现在我们可以只折叠每个组件内的值。

- Robert Hacken

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 [e-mail], [e-mail]
2 John      789                     [e-mail]

---

一个更加整洁的方式（感谢@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))

- ThomasIsCoding

---

@akrun 哇，太棒了！看来我学习 tidyverse 的路还很长，它看起来非常强大！ - ThomasIsCoding

grp = components(graph_from_data_frame(contact[, c(2, 3, 1)]))$membershipaggregate(. ~ grp[contact$email], function(x) toString(unique(x)), data = contact) - Henrik

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 [e-mail];[e-mail]
# 2: John     789                    [e-mail]

解释

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

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

- Wimpel

Answer 4

使用powerjoin包的不同方法：

contact <- tribble(
  ~name, ~phone, ~email,
  "John", 123, "[e-mail]",
  "John", 456, "[e-mail]",
  "John", 456, "[e-mail]",
  "John", 789, "[e-mail]") |> 
  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 [e-mail];[e-mail]
2 John  789     [e-mail]                   

- Julian