优化解决方案以在大型数据集上找到共同的第三个
Posted
技术标签:
【中文标题】优化解决方案以在大型数据集上找到共同的第三个【英文标题】：optimizing solution to find common third on large data set 【发布时间】：2017-12-06 22:19:33 【问题描述】：这是我的previous question 的后续问题。我遇到了一个问题，要找到一种内存高效的解决方案，以便为我的大型数据集（350 万组和 620 万人）找到共同的三分之一
使用igraph 包的建议解决方案对于正常大小的数据集运行速度很快，不幸的是，由于为更大的数据集创建了一个大矩阵，因此遇到了内存问题。类似的问题出现在我自己的使用串联内连接的解决方案中，其中第三个内连接使数据帧膨胀，因此我的电脑内存不足 (16gb)。
df.output <- inner_join(df,df, by='group' ) %>%
inner_join(.,df, by=c('person.y'='person')) %>%
inner_join(.,df, by=c('group.y'='group')) %>%
rename(person_in_common='person.y', pers1='person.x',pers2='person') %>%
select(pers1,pers2,person_in_common) %>%
filter(pers1!=pers2) %>%
distinct() %>%
filter(person_in_common!=pers1 & person_in_common!=pers2)
df.output[-3] <- t(apply(df.output[-3], 1,
FUN=function(x) sort(x, decreasing=FALSE)))
df.output <- unique(df.output)
小数据集示例和预期输出
df <- data.frame(group= c("a","a","b","b","b","c"),
person = c("Tom","Jerry","Tom","Anna","Sam","Nic"), stringsAsFactors = FALSE)
df
group person
1 a Tom
2 a Jerry
3 b Tom
4 b Anna
5 b Sam
6 c Nic
预期结果
df.output
pers1 pers2 person_in_common
1 Anna Jerry Tom
2 Jerry Sam Tom
3 Sam Tom Anna
4 Anna Tom Sam
6 Anna Sam Tom
不幸的是，我无法使用具有更多内存的机器，也没有真正的云计算经验，所以我希望让它在我的本地电脑上运行。我将不胜感激输入如何优化任何解决方案或建议如何以其他方式解决问题。
编辑 1
反映我实际数据大小的数据框。
set.seed(33)
Data <- data.frame(group = sample(1:3700000, 14000000, replace=TRUE),
person = sample(1:6800000, 14000000,replace = TRUE))
编辑 2
作为示例数据，就更大的组和每组更多的人而言，我的真实数据要复杂一些。因此，它变得更加记忆密集。我不知道如何模拟这种结构，所以请按照真实数据下载：
Full person-group data
【问题讨论】：
我不明白你是如何选择共同的人的。 你能给出创建你想要处理的大小的示例数据的代码吗？ 第一次加入（inner_join(df,df, by='group')）你能做到吗？
@minem，抱歉回复晚了。我可以运行第一个和第二个连接，它与第三个连接崩溃。我会尽快用我的真实数据的实际尺寸设置一个测试数据框
@F.Privé 我不确定如何比输出示例更清楚地解释它。基本上，当你有至少三个人时，你可以在一个组内有一个共同的第三个，当你们两个人共享一个第三个时，你可以跨组。
【参考方案1】：
所以，我设法在您的测试数据上运行它（我有 16 GB 的 RAM），但是如果您在小示例上运行它，那么您会发现它不会给出相同的结果。我不明白为什么，但也许你可以帮助我。所以我会尽量解释每一步：
myFun <- function(dt)
require(data.table)
# change the data do data.table:
setDT(dt)
# set key/order the data by group and person:
setkey(dt, group, person)
# I copy the initial data and change the name of soon to be merged column name to "p2"
# which represents person2
dta <- copy(dt)
setnames(dta, "person", "p2")
# the first merge using data.table:
dt1 <- dt[dta, on = "group", allow.cartesian = TRUE, nomatch = 0]
# now we remove rows where persons are the same:
dt1 <- dt1[person != p2] # remove equal persons
# and also we need to remove rows where person1 and person2 are the same,
# just in different order , example:
# 2: a Tom Jerry
# 3: a Jerry Tom
# is the same, if I get it right then you did this using apply in the end of code,
# but it would be much better if we could reduce data now
# also my approach will be much faster (we take pairwise min word to 2 column
# and max to the last):
l1 <- pmin(dt1[[2]], dt1[[3]])
l2 <- pmax(dt1[[2]], dt1[[3]])
set(dt1, j = 2L, value = l1)
set(dt1, j = 3L, value = l2)
# now lets clear memory and take unique rows of dt1:
rm(l1, l2, dt)
dt1 <- unique(dt1)
gc()
# change name for group column:
setnames(dta, "group", "g2")
# second merge:
dt2 <- dt1[dta, on = "p2", allow.cartesian = TRUE, nomatch = 0]
rm(dt1)
gc()
setnames(dta, "p2", "p3")
dt3 <- dt2[dta, on = "g2", allow.cartesian = TRUE, nomatch = 0] # third merge
rm(dt2)
gc()
dt3 <- dt3[p3 != p2 & p3 != person] # removing equal persons
gc()
dt3 <- dt3[, .(person, p2, p3)]
gc()
return(dt3[])
小数据集示例：
df <- data.frame(group = c("a","a","b","b","b","c"),
person = c("Tom","Jerry","Tom","Anna","Sam","Nic"),
stringsAsFactors = FALSE)
df
myFun(df)
# person p2 p3
# 1: Anna Tom Jerry
# 2: Sam Tom Jerry
# 3: Jerry Tom Anna
# 4: Sam Tom Anna
# 5: Jerry Tom Sam
# 6: Anna Tom Sam
# 7: Anna Sam Tom
与您的结果相似但不完全相同
现在有了更大的数据：
set.seed(33)
N <- 10e6
dt <- data.frame(group = sample(3.7e6, N, replace = TRUE),
person = sample(6.8e6, N, replace = TRUE))
system.time(results <- myFun(dt)) # 13.22 sek
rm(results)
gc()
还有：
set.seed(33)
N <- 14e6
dt <- data.frame(group = sample(3.7e6, N, replace = TRUE),
person = sample(6.8e6, N, replace = TRUE))
system.time(results <- myFun(dt)) # around 40 sek, but RAM does get used to max
更新：
也许你可以试试这个拆分方法，比如nparts 6-10？：
myFunNew3 <- function(dt, nparts = 2)
require(data.table)
setDT(dt)
setkey(dt, group, person)
dta <- copy(dt)
# split into N parts
splits <- rep(1:nparts, each = ceiling(dt[, .N]/nparts))
set(dt, j = "splits", value = splits)
dtl <- split(dt, by = "splits", keep.by = F)
set(dt, j = "splits", value = NULL)
rm(splits)
gc()
i = 1
for (i in seq_along(dtl))
X <- copy(dtl[[i]])
setnames(dta, c("group", "person"))
X <- X[dta, on = "group", allow.cartesian = TRUE, nomatch = 0]
X <- X[person != i.person]
gc()
X <- X[dta, on = "person", allow.cartesian = TRUE, nomatch = 0]
gc()
setnames(dta, "group", "i.group")
X <- X[dta, on = "i.group", allow.cartesian = TRUE, nomatch = 0]
gc()
setnames(X, "i.person.1", "pers2")
setnames(X, "i.person", "pers1" )
setnames(X, "person", "person_in_common" )
X <- X[, .(pers1, pers2, person_in_common)]
gc()
X <- X[pers1 != pers2 & person_in_common != pers1 & person_in_common != pers2]
gc()
name1 <- "pers1"
name2 <- "pers2"
l1 <- pmin(X[[name1]], X[[name2]])
l2 <- pmax(X[[name1]], X[[name2]])
set(X, j = name1, value = l1)
set(X, j = name2, value = l2)
rm(l1, l2)
gc()
X <- unique(X)
gc()
if (i > 1)
X1 <- rbindlist(list(X1, X), use.names = T, fill = T)
X1 <- unique(X1)
rm(X)
gc()
else
X1 <- copy(X)
dtl[[i]] <- 0L
gc()
rm(dta, dtl)
gc()
setkey(X1, pers1, pers2, person_in_common)
X1[]
【讨论】：
非常感谢！我会调查的，但可能需要一天时间 我建议对您的代码进行一些小的编辑@minem 以获得所需的输出。然而，我的大数据示例似乎不能完全代表我的真实数据。我进行了一些挖掘，发现在我的数据中，与示例数据相比，我有更大的组（每组更多的人）+ 多个组中的更多人。因此最终的dt 变得更大。由于我不知道如何产生这种特殊特性，我将上传完整的数据。
@user6617454 更新了答案，也许这个函数可以解决问题
感谢@minem，抱歉花了我一段时间来检查它。它与建议的拆分版本一起运行。非常感谢您的工作！以上是关于优化解决方案以在大型数据集上找到共同的第三个的主要内容，如果未能解决你的问题，请参考以下文章