R：如何识别未知数量的组合？

Question

我有以下格式的数据：

Data <- data.frame(
  Names = c("Person A", "Person B","Person F", "Person G", "Person F", "Person G", "Person Q", "Person R"),
  Time_Stamp = c("2013-08-01 07:06:00", "2013-08-01 07:06:00", "2013-08-01 07:53:00", "2013-08-01 07:53:00", "2013-08-01 11:01:00", "2013-08-01 11:01:00", "2013-08-01 11:08:00", "2013-08-19 06:57:00")
)

#> Data
#      Names          Time_Stamp
# 1 Person A 2013-08-01 07:06:00
# 2 Person B 2013-08-01 07:06:00
# 3 Person F 2013-08-01 07:53:00
# 4 Person G 2013-08-01 07:53:00
# 5 Person F 2013-08-01 11:01:00
# 6 Person G 2013-08-01 11:01:00
# 7 Person Q 2013-08-01 11:08:00
# 8 Person R 2013-08-19 06:57:00

我想创建一个代码，用于识别何时出现人员组合（顺序无关紧要）并带有相同的时间戳。因此，例如，人物 F 和人物 G 同时出现在 2013 年 8 月 1 日的 8 点 14 分，所以他们是一个组，并获得一个唯一的组名。如果他们再次一起出现，他们仍然会得到相同的名字。我一直遇到的问题是，真实数据接近 100,000 行，我不知道其中有多少人组合出现了相同的时间戳，并且组合可能不止 2 个人。

我希望新数据看起来像这样：

Desired <- data.frame(
  Names = c("Person A", "Person B","Person F", "Person G", "Person F", "Person G", "Person Q", "Person R"),
  Time_Stamp = c("2013-08-01 07:06:00", "2013-08-01 07:06:00", "2013-08-01 07:53:00", "2013-08-01 07:53:00", "2013-08-01 11:01:00", "2013-08-01 11:01:00", "2013-08-01 11:08:00", "2013-08-19 06:57:00"),
  Group = c("Group 1", "Group 1", "Group 2", "Group 2", "Group 2", "Group 2", "No Group", "No Group")
)
#      Names          Time_Stamp    Group
# 1 Person A 2013-08-01 07:06:00  Group 1
# 2 Person B 2013-08-01 07:06:00  Group 1
# 3 Person F 2013-08-01 07:53:00  Group 2
# 4 Person G 2013-08-01 07:53:00  Group 2
# 5 Person F 2013-08-01 11:01:00  Group 2
# 6 Person G 2013-08-01 11:01:00  Group 2
# 7 Person Q 2013-08-01 11:08:00 No Group
# 8 Person R 2013-08-19 06:57:00 No Group

Answer 1

我相信以下功能可以满足问题的要求。

代码工作如下：

1. 因子在内部被编码为连续的整数，因此强制转换为因子，然后转换为整数，以便将每个唯一的 "Time_Stamp" 视为字符串，以获得唯一的整数。
2. 使用ave 将整数向量除以"Names"，如果f 跨越多个名称，则只保留第一个。
3. 最后，如果f的每一层只有一个元素，则返回"No Group"，否则在该层之前粘贴"Group"。

此函数仅使用基数 R，但可以在 dplyr::mutate 指令中使用。

group_names <- function(x, col.name, col.date){
  f <- as.integer(as.factor(x[[col.date]]))
  f <- ave(f, x[[col.name]], FUN = function(x){
    if(length(x) > 1) x[1] else x
  })
  f <- ave(f, f, FUN = function(x){
    if(length(x) == 1) "No Group" else paste("Group", x)
  })
  f
}

Data$Group <- group_names(Data, "Names", "Time_Stamp")

或者，dplyr。列号或列名都有效。

Data %>% mutate(Group = group_names(., 1, 2))
Data %>% mutate(Group = group_names(., "Names", "Time_Stamp"))
#     Names          Time_Stamp    Group
#1 Person A 2013-08-01 07:06:00  Group 1
#2 Person B 2013-08-01 07:06:00  Group 1
#3 Person F 2013-08-01 07:53:00  Group 2
#4 Person G 2013-08-01 07:53:00  Group 2
#5 Person F 2013-08-01 11:01:00  Group 2
#6 Person G 2013-08-01 11:01:00  Group 2
#7 Person Q 2013-08-01 11:08:00 No Group
#8 Person R 2013-08-19 06:57:00 No Group

Answer 2

这是使用igraph的解决方案

library(igraph)
u <- graph_from_data_frame(Data)
grp <- clusters(u)$membership[match(Data$Names,names(clusters(u)$membership))]
Desired <- within(Data, Group <- ave(grp,grp,FUN = function(x) {if (length(x)>1) paste("Group",x) else "No Group"}))

这样

> Desired
     Names          Time_Stamp    Group
1 Person A 2013-08-01 07:06:00  Group 1
2 Person B 2013-08-01 07:06:00  Group 1
3 Person F 2013-08-01 07:53:00  Group 2
4 Person G 2013-08-01 07:53:00  Group 2
5 Person F 2013-08-01 11:01:00  Group 2
6 Person G 2013-08-01 11:01:00  Group 2
7 Person Q 2013-08-01 11:08:00 No Group
8 Person R 2013-08-19 06:57:00 No Group

Answer 3

使用data.table的选项：

library(data.table)
setDT(Data, key=c("Time_Stamp","Names"))
Data[, g := if (.N > 1L) paste(Names, collapse=""), Time_Stamp]
Data[order(g), g := fifelse(is.na(g), NA_integer_, rleid(g))]

输出：

      Names          Time_Stamp    g
1: Person A 2013-08-01 07:06:00    1
2: Person B 2013-08-01 07:06:00    1
3: Person F 2013-08-01 07:53:00    2
4: Person G 2013-08-01 07:53:00    2
5: Person F 2013-08-01 11:01:00    2
6: Person G 2013-08-01 11:01:00    2
7: Person Q 2013-08-01 11:08:00 <NA>
8: Person R 2013-08-19 06:57:00 <NA>