此问题基于@Arun here给出的回答。在响应中,@ Arun提出了一种聪明的方法,通过简单地只查看出现的对来避免创建稀疏矩阵,从而避免保存多个零和对A-B和B-A对的加倍。
以下内容是从他的回答中复制粘贴的:
第1步:构建尺寸的样本数据:
require(data.table) ## 1.9.4+
set.seed(1L) ## For reproducibility
N = 2724098L
motif = sample(paste("motif", 1:1716, sep="_"), N, TRUE)
id = sample(83509, N, TRUE)
DT = data.table(id, motif)
第2步:预处理:
DT = unique(DT) ## IMPORTANT: not to have duplicate motifs within same id
setorder(DT) ## IMPORTANT: motifs are ordered within id as well
setkey(DT, id) ## reset key to 'id'. Motifs ordered within id from previous step
DT[, runlen := .I]
第3步:解决方案:
ans = DT[DT, {
tmp = runlen < i.runlen;
list(motif[tmp], i.motif[any(tmp)])
},
by=.EACHI][, .N, by="V1,V2"]
如果计算机上有足够的内存,运行此工作正常。我也谦虚地承认,我并不认为代码正在创建想要的结果,所以我只关注输入和输出,不知道该过程。 将完全相同的代码应用于我的数据时,似乎发生的情况是出现的对不在原始数据中。
我正在运行以下代码,这是@Arun提供的稍微改编的版本。适应是因为我需要运行17个不同块的代码。即我正在寻找特定区块内出现的对。
cooc <- data.frame()
for(j in 1:17){
DT <- dt[block == j,c("pid", "cid"), with =F]
DT$pid <- as.factor(DT$pid)
setorder(DT)
setkey(DT,pid)
DT[, runlen := .I]
ans <- DT[DT, {
tmp = runlen < i.runlen;
list(cid[tmp],i.cid[any(tmp)])
},
by= .EACHI][, .N, by="V1,V2"]
ans$block <- j
cooc <- data.table(rbind(cooc,ans))
rm(ans)
}
就我理解的代码而言,它们都是相同的,只需与for
循环即可为17个块执行相同的操作。 pid
和cid
都只是识别感兴趣变量的整数。
对于j = 1
,以下内容如下:
DT[cid == 39] # cid is my equivalent of motif above and pid is my equivalent of id above
pid cid runlen
20319 39 3614
这表明只有一个pid
cid
等于39
现在,当我查看生成的ans
数据表时,我得到以下内容:
ans[V1 == 39]
V1 V2 N block
1: 39 41 1 1
2: 39 42 1 1
3: 39 44 1 1
4: 39 47 1 1
5: 39 7027 1 1
6: 39 7043 1 1
7: 39 7174 1 1
8: 39 9434 1 1
9: 39 11493 1 1
10: 39 18815 1 1
11: 39 18875 1 1
12: 39 18896 1 1
13: 39 18909 1 1
14: 39 18924 1 1
15: 39 18928 1 1
16: 39 18929 1 1
17: 39 18931 1 1
18: 39 18932 1 1
19: 39 19265 1 1
20: 39 19410 1 1
突然间,有{20}次出现V1
(如果我正确理解了代码,这相当于cid
)。然而,在DT
中,只有pid
分配给cid
。
我不知道如何重现这个发现,所以我试图展示看似不一致的东西。我不认为原始代码存在此问题所以我希望有人可以根据我在此处提供的信息解释cid == 39
的其他出现位置。
答案 0 :(得分:1)
两件事:
首先,我不明白你得到的结果有什么问题。从
开始require(data.table)
set.seed(1L)
N = 2724098L
motif = sample(paste("motif", 1:1716, sep="_"), N, TRUE)
id = sample(83509, N, TRUE)
DT = data.table(id, motif)
让我重新创建有助于回答问题的数据。
# keep only one of 'motif_456'
DT2 = rbind(DT[1L], DT[motif != "motif_456"])
DT2[1L]
# id motif
# 1: 49338 motif_456
DT2[ , .N, by=motif]
# motif N
# 1: motif_456 1
# 2: motif_639 1637
# 3: motif_984 1649
# 4: motif_1559 1531
# 5: motif_347 1603
# ---
# 1712: motif_46 1623
# 1713: motif_521 1613
# 1714: motif_803 1568
# 1715: motif_603 1573
# 1716: motif_461 1591
让我们检查与id = 49338
对应的所有主题:
DT2[id == 49338, motif]
# [1] "motif_456" "motif_553" "motif_1048" "motif_1680" "motif_171" "motif_1706"
# [7] "motif_707" "motif_163" "motif_489" "motif_107" "motif_1419" "motif_595"
# [13] "motif_1223" "motif_1274" "motif_1164" "motif_427" "motif_505" "motif_1041"
# [19] "motif_1321" "motif_1231" "motif_1498" "motif_837" "motif_298" "motif_649"
# [25] "motif_631"
对于所有这些图案来说显而易见&#39;与motif_456
组合后,结果应为1.这就是data.table解决方案提供的内容。这是运行data.table
解决方案后的相关结果:
# data.table solution takes 11.2 secs
ans[V1 == "motif_456", .N] + ans[V2 == "motif_456", .N]
# [1] 24
其次,虽然data.table答案很好,但我们可以使用@nograpes所示的解决方案更有效地完成这项工作。我们试试DT2
:
require(Matrix)
DT2[, names(DT2) := lapply(.SD, as.factor)]
s <- sparseMatrix(
as.integer(DT2$id),
as.integer(DT2$motif),
dimnames = list(levels(DT2$id),levels(DT2$motif)),
x = TRUE)
co.oc <- t(s) %*% s # Find co-occurrences.
tab <- summary(co.oc) # Create triplet representation.
tab <- tab[tab$i < tab$j,] # Extract upper triangle of matrix
ans = setDT(list(motif1 = levels(DT2$motif)[tab$i],
motif2 = levels(DT2$motif)[tab$j],
number = tab$x))
# Matrix solution takes 2.4 secs
ans[motif1 == "motif_456", .N] + ans[motif2 == "motif_456", .N]
# [1] 24