r - 根据直接和间接关系对个人进行分组

Question

我想根据地址和包裹的所有权将个人分组到不同的家庭。如果人们住在同一地址，并且如果他们直接或间接地通过至少一个地 block 的所有权联系在一起，那么他们就属于同一家庭。

个人之间的联系可以是直接，即两个人有一个共同的包裹。但是链接也可以是间接的，通过交叉链接形成链 - 两个人有一个共同的包裹，其中一个人与其他人有一个共同的包裹，并且都住在同一个地址。

这里有一些例子:

• 如果一个人 (9) 独自住在他的地址 (C)，即使另一个人 (6) 也拥有他或她的包裹，他也将独自居住。
• 如果两个人(12 岁和 13 岁)住在同一个地址 (F) 并拥有同一个地 block (w)，则他们属于同一家庭。但是，如果三个人住在同一个地址 (B)，但只有两个人(7 和 8)拥有同一个地 block (r)，而第三个人 (6) 住在这个地址 (B) 但拥有另一个地 block (m)只有拥有同一地 block 的两人来自同一家庭。
• 如果在同一地址 (A)，有 4 人居住(1、2、3 和 4)，如果人(1、2 和 3)通过拥有多个地 block (m、n 和 o)而联系在一起，那么他们属于同一家庭，而同样住在该地址但不拥有这 3 个地 block 中的任何一个但拥有另一个 (p) 的人 (4) 不属于同一家庭。

我有三个变量:地址 ID、所有者 ID 和包裹 ID。我想得到一个家庭号码。这是一个示例表:

 id_address id_owner id_parcel id_household
          A        1         m            1
          A        1         n            1
          A        2         n            1
          A        2         o            1
          A        3         o            1
          A        4         p            2
          A        5         q            3
          B        6         s            4
          B        7         r            5
          B        8         r            5
          C        9         s            6
          D       10         t            7
          E       11         u            8
          E       11         v            8
          F       12         w            9
          F       13         w            9

我的第一直觉是循环，但我有 800,000 行，这可能需要很长时间。

示例数据，其中“id_household”是我要创建的变量:

structure(list(id_address = c("A", "A", "A", "A", "A", "A", "A", 
"B", "B", "B", "C", "D", "E", "E", "F", "F"), id_owner = c(1L, 
1L, 2L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 11L, 12L, 13L
), id_parcel = c("m", "n", "n", "o", "o", "p", "q", "s", "r", 
"r", "s", "t", "u", "v", "w", "w"), id_household = c(1L, 1L, 
1L, 1L, 1L, 2L, 3L, 4L, 5L, 5L, 6L, 7L, 8L, 8L, 9L, 9L)), class = "data.frame", row.names = c(NA, 
-16L))

Answer 1

您的问题可能会被视为图形问题。 igraph 包提供了极好的工具。 'id_owner' 和 'id_parcel' 列可以视为边列表。 components 函数提供“每个顶点所属的簇 ID”。我使用 data.table 进行一般数据处理。

library(data.table)
library(igraph)

setDT(d)
d2 = d[ , {
  # create graph. columns id_owner and id_parcel are treated as an edge list.
  g = graph_from_data_frame(.SD)

  # get components of the graph that are directly or indirectly connected
  mem = components(g)$membership

  # grab the memberships and their names (i.e. the vertices) 
  .(id_parcel = names(mem), mem = mem)
 
  # do the above for each id_address
}, by = id_address]

# join the memberships to the original data
# paste with id_address for uniqueness
d[d2, on = .(id_address, id_parcel), id := paste0(id_address, mem)]

# if you want a consecutive integer as 'id', to make it agree with 'id_household'
d[ , id2 := as.integer(as.factor(id))]

输出:

d
#     id_address id_owner id_parcel id_household id id2
#  1:          A        1         m            1 A1   1
#  2:          A        1         n            1 A1   1
#  3:          A        2         n            1 A1   1
#  4:          A        2         o            1 A1   1
#  5:          A        3         o            1 A1   1
#  6:          A        4         p            2 A2   2
#  7:          A        5         q            3 A3   3
#  8:          B        6         s            4 B1   4
#  9:          B        7         r            5 B2   5
# 10:          B        8         r            5 B2   5
# 11:          C        9         s            6 C1   6
# 12:          D       10         t            7 D1   7
# 13:          E       11         u            8 E1   8
# 14:          E       11         v            8 E1   8
# 15:          F       12         w            9 F1   9
# 16:          F       13         w            9 F1   9

---

避免 by 操作的替代方案。另一方面增加了一些其他的步骤，所以是否更高效取决于数据的结构。

首先，创建“复合变量”，其中地址分别与包裹和所有者连接。创建成员资格。通过拆分名称检索原始列 (tstrsplit(names(mem), "_", fixed = TRUE))。加入成员(member)资格到原始数据

d[ , `:=`(
  address_parcel = paste(id_address, id_parcel, sep = "_"),
  address_owner = paste(id_address, id_owner, sep = "_"))]

d2 = d[ , {
  g = graph_from_data_frame(.SD[ , .(address_owner, address_parcel)])
  mem = components(g)$membership
  c(tstrsplit(names(mem), "_", fixed = TRUE), .(mem = mem))
}]

d[d2, on = c(id_address = "V1", id_parcel = "V2"), id_hh := mem]

输出:

d
#     id_address id_owner id_parcel id_household id_hh
#  1:          A        1         m            1     1
#  2:          A        1         n            1     1
#  3:          A        2         n            1     1
#  4:          A        2         o            1     1
#  5:          A        3         o            1     1
#  6:          A        4         p            2     2
#  7:          A        5         q            3     3
#  8:          B        6         s            4     4
#  9:          B        7         r            5     5
# 10:          B        8         r            5     5
# 11:          C        9         s            6     6
# 12:          D       10         t            7     7
# 13:          E       11         u            8     8
# 14:          E       11         v            8     8
# 15:          F       12         w            9     9
# 16:          F       13         w            9     9

---

对较大数据(原始数据重复 1e4 次并在每个 block 中创建新 ID)计时两个备选方案。对于此特定数据，避免 by 的第二种选择的速度大约快 100 倍。

# prepare toy data
d1 = as.data.table(d)
n = 1e4
dL = d1[rep(1:.N, n)]

# make unique id within the repeated data frames
dL[ , `:=`(
  id_address = paste(rep(1:n, each = nrow(d1)), sep = ".", id_address),
  id_owner = paste(rep(1:n, each = nrow(d1)), sep = ".", id_owner),
  id_parcel = paste(rep(1:n, each = nrow(d1)), sep = ".", id_parcel)
)]

备选方案 1:通过 地址

dL1 = copy(dL) 

system.time({
d2 = dL1[ , {
  g = graph_from_data_frame(.SD)
  mem = components(g)$membership
  .(id_parcel = names(mem), mem = mem)
}, by = id_address]

dL1[d2, on = .(id_address, id_parcel), id_hh := paste(id_address, mem, sep = "_")]
})

#  user  system elapsed 
# 59.46    7.68   67.11

备选方案 2. 复合变量和拆分:

dL2 = copy(dL)

system.time({
dL2[ , `:=`(
  address_parcel = paste(id_address, id_parcel, sep = "_"),
  address_owner = paste(id_address, id_owner, sep = "_"))]

d3 = dL2[ , {
  g = graph_from_data_frame(.SD[ , .(address_owner, address_parcel)])
  mem = components(g)$membership
  c(tstrsplit(names(mem), "_", fixed = TRUE), .(mem = mem))
}]

dL2[d3, on = c(id_address = "V1", id_parcel = "V2"), id_hh := mem]
})

# user  system elapsed 
# 0.47    0.24    0.57

相等性测试:

all.equal(as.integer(as.factor(stringi::stri_pad_left(dL1$id_hh, 9, "0"))),
          dL2$id_hh) 
# TRUE