Question

我有以下数据集：

name    date         cat1    cat2    cat3    cat4    cat5
joe     15/09/2013   A       D       C       D       NA
joe     14/09/2013   D       A       C       NA      NA
joe     13/09/2013   A       C       NA      NA      NA
jack    15/09/2013   G       I       K       D       O
jack    14/09/2013   H       G       O       M       K

对于每个人，我想要计算每个类别相互比较的百分比。 e.g。

name    percentage
joe     88.9%      
jack    60%

请注意，NA被忽略，类别出现的次数是无关紧要的。

引导你完成我的逻辑（这可能是错误的，或者可能有更好的方法来做到这一点，如果是这样，请说）：让我们以乔为例，

row1（15/09/2013）与row2（2013年9月14日）相比，100％

row1（15/09/2013）与row3（13/09/2013）匹配66％

row2（14/09/2013）与row3（13/09/2013）相比，匹配66％

row2（14/09/2013）与row1（2013年9月15日）比较100％

row3（13/09/2013）与row1（2013年9月15日）相比，100％

row3（13/09/2013）与row2（2013年9月14日）相比，100％

因此平均得分为88.9％

对于杰克，只有类别'G'，'K'，'O'出现在两行中，因此平均得分为60％

我已经查看了R中的ddply函数，但我不确定是否可以使用它来创建上面的数据帧（名称，百分比）。我认为我应该避免使用其他选项，因为我确信在R中必须有一种更有效的方法，就是创建一个带有嵌套for循环的R脚本！

我最后的选择，可能是最好的方式（因为这个数据框会非常大）是使用Python，因此如果有人知道如何做到这一点是Python（猜测我们将使用Pandas）我会很高兴得到一些帮助。

所以要明确两个问题：

如果有可能使用ddply，有人可以告诉我怎么样，否则有没有人对如何解决这个问题有任何其他想法？
使用上面的小数据框有人可以举例说明他们如何在Python中解决这个问题吗？

Answer 1

我不明白为什么row2 vs row3给出66％，而row1 vs row3为100％。我没有看到那里的逻辑。

这是我理解的逻辑实现：

fun <- function(df) {
  M <- as.matrix(df)
  res1 <- combn(seq_len(nrow(M)), 2, function(ind) {
    i <- na.omit(intersect(M[ind[1],], M[ind[2],]))
    l <- length(unique(na.omit(M[ind[2],])))
    length(i)/l
  })
  res2 <- combn(rev(seq_len(nrow(M))), 2, function(ind) {
    i <- na.omit(intersect(M[ind[1],], M[ind[2],]))
    l <- length(unique(na.omit(M[ind[2],])))
    length(i)/l
  })
  c(res1,res2)
}

fun(DF[1:3,3:7])
#[1] 1.0000000 1.0000000 1.0000000 0.6666667 0.6666667 1.0000000

然后我尝试将ddply与此函数一起使用，但是存在延迟评估或范围确定的问题。所以，我转向data.table：

library(data.table)
DT <- data.table(DF)
DT[, mean(fun(.SD)), .SDcols=3:7, by=name]
#   name        V1
#1:  joe 0.8888889
#2: jack 0.6000000

我不知道这对您的数据是否足够有效。

Answer 2

使用ddply，我发现它与@Roland的想法类似：

按名称分组
对于每个组使用combn找到2行的组合。使用combn

expand.grid

对于2行的每个组合，删除缺失值并仅保留唯一值。最好在分组之前对所有数据执行此操作。
计算2分，因为关系不对称。

这是我的代码：

library(plyr)
id <- grep("cat*",names(dat))


compare.row <- function(x,y){
  xx <- x[id]
  xx <- unique(xx[!is.na(xx)])
  yy <- y[id]
  yy <- unique(yy[!is.na(yy)])
  v = c(length(intersect(xx,yy))/length(yy),
        length(intersect(xx,yy))/length(xx))
}


ddply(dat,.(name),function(x){
  ll <-  combn(seq(nrow(x)),2,FUN=function(i)
                 compare.row(x[i[1],],x[i[2],]))
  mean(unlist(ll))
})

 name        V1
1 jack 0.6000000
2  joe 0.8888889

编辑添加一些标记：

利用这些小数据，data.table解决方案是赢家;

library(microbenchmark)
microbenchmark(ag(),ro(),jb(),times=5)
Unit: milliseconds
 expr       min        lq    median        uq       max neval
 ag()  8.410804  8.790441  9.389289  9.684352 13.981724     5
 ro()  4.351227  4.765756  4.787374  5.414287  7.320817     5
 jb() 11.077366 11.413388 11.888599 11.923870 12.119946     5

Answer 3

又一个选择：

d <- read.table(
  text='name    date         cat1    cat2    cat3    cat4    cat5
joe     15/09/2013   A       D       C       D       NA
joe     14/09/2013   D       A       C       NA      NA
joe     13/09/2013   A       C       NA      NA      NA
jack    15/09/2013   G       I       K       D       O
jack    14/09/2013   H       G       O       M       K', 
  header=T, stringsAsFactors=FALSE)

library(plyr)
ddply(d, 'name', function(x) {
  combns <- expand.grid(seq_len(nrow(x)), seq_len(nrow(x)))
  combns <- combns[!combns[, 1] == combns[, 2], ]
  mean(sapply(seq_len(nrow(combns)), function(i) {
    n <- sum(!is.na(unique(unlist(x[combns[i, 1], -(1:2)]))))
    sum(!is.na(match(unique(unlist(x[combns[i, 1], -(1:2)])), 
                     unique(unlist(x[combns[i, 2], -(1:2)])), 
                     incomparables=NA))) / n
  }))
})

如何使用r计算数据帧中一组行的相似程度

3 个答案: