【问题标题】:Efficient way to compute scores within data.table by group按组计算data.table中分数的有效方法
【发布时间】:2019-07-24 08:06:23
【问题描述】:

我有以下data.table,我希望按组 (id) 计算该组所有其他成员的最小 (min) jarowinkler 分数。我有一个简单的嵌套循环可以计算这个,虽然正在寻找更有效的方法。

library(data.table)
# install.packages("stringdist")
library(stringdist)

# Create `data.table`
dt <- data.table(id = c(1,1,2,2,2,3,3,3,3,4,4,4), 
                var = c("a","a","kyle","kyle","kile","rage","page","cage","","asd","fdd","xzx"))

# Add a numeric empty score variable         
dt[, "score" := as.numeric()]       
# Create a unique id within each group         
dt[, uid := sequence(.N), by = id]

dt
#     id  var score uid
#  1:  1    a    NA   1
#  2:  1    a    NA   2
#  3:  2 kyle    NA   1
#  4:  2 kyle    NA   2
#  5:  2 kile    NA   3
#  6:  3 rage    NA   1
#  7:  3 page    NA   2
#  8:  3 cage    NA   3
#  9:  3         NA   4
# 10:  4  asd    NA   1
# 11:  4  fdd    NA   2
# 12:  4  xzx    NA   3

当前但缓慢的方法:

# Loop over all unique id's
for(i in unique(dt$id)){
   # Loop over each member and compute lowest stringdist 
   for(j in 1:nrow(dt[id == i])){
        dt[id == i & uid == j, "score" := min(stringdist(dt[id == i & uid == j, var], 
                                              dt[id == i & uid != j, var],
                                              method = "jw"))]
    }
}

dt[]
#     id  var     score uid
#  1:  1    a 0.0000000   1
#  2:  1    a 0.0000000   2
#  3:  2 kyle 0.0000000   1
#  4:  2 kyle 0.0000000   2
#  5:  2 kile 0.1666667   3
#  6:  3 rage 0.1666667   1
#  7:  3 page 0.1666667   2
#  8:  3 cage 0.1666667   3
#  9:  3      1.0000000   4
# 10:  4  asd 0.4444444   1
# 11:  4  fdd 0.4444444   2
# 12:  4  xzx 1.0000000   3

【问题讨论】:

  • 首先,(不看函数本身)for(i in unique(dt$id)) 是多余的,这就是为什么你在 data.table 中有 , by = 部分
  • 其次,如果你在一个组中有重复的单词,你应该只计算唯一的组合。此外,stringdist 接受向量,因此您不需要按行运行(至少并非总是如此)。

标签: r data.table


【解决方案1】:

(再想一想,这实际上非常接近大卫的 cmets)一种可能的方法:

#create combinations of unique var by group then call stringdist once
jw <- dt[, if (uniqueN(var)>1) transpose(combn(unique(var), 2, simplify=FALSE)), .(id)][,
    dis := stringdist(V1, V2, "jw")]

#find the min distance for each word
lu <- rbindlist(list(jw[, .(mdis=min(dis)), .(id, var=V1)], 
    jw[, .(mdis=min(dis)), .(id, var=V2)]))

#update join on the min distance for each word
dt[lu, on=.(var, id), score := mdis]

#for duplicated words, dist is 0
dt[dt[, .I[duplicated(var) | duplicated(var, fromLast=TRUE)], by=.(id)]$V1,
    score := 0]

动机:由于stringdist 已经为速度而构建,并通过使用“openMP”(手动)并行运行,如果您运行stringdist 一次而不是按组多次运行,它会更快。

【讨论】:

  • 您不应该仅仅因为很少的 cmets 就将其设为社区 wiki。编写代码比仅仅推测要困难得多。关于你的最后一行,我想你可以用dt[, score := 0] 开始,然后更新所有不是骗子的东西?
  • @DavidArenburg,它不适用于kyle,因为它事先会有一些价值。我只是认为不抄袭别人的想法是礼仪
猜你喜欢
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2012-12-25
  • 1970-01-01
  • 1970-01-01
  • 2014-04-29
  • 1970-01-01
  • 1970-01-01
相关资源
最近更新 更多