2

我有以下数据集：

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

对于每个人，我想计算他们每个类别相互比较的相似程度的百分比。例如

name    percentage
joe     88.9%      
jack    60%

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

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

  1. 第 1 行（2013 年 9 月 15 日）与第 2 行（2013 年 9 月 14 日）匹配 100%
  2. 第 1 行（2013 年 9 月 15 日）与第 3 行（2013 年 9 月 13 日）匹配 66%
  3. 第 2 行（2013 年 9 月 14 日）与第 3 行（2013 年 9 月 13 日）匹配 66%
  4. 第 2 行（2013 年 9 月 14 日）与第 1 行（2013 年 9 月 15 日）相比匹配 100%
  5. 第 3 行（2013 年 9 月 13 日）与第 1 行（2013 年 9 月 15 日）相比匹配 100%
  6. 第 3 行（2013 年 9 月 13 日）与第 2 行（2013 年 9 月 14 日）相比匹配 100%

所以平均分是88.9%

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

我研究了 R 中的 ddply 函数，但我不确定是否可以使用它来创建上面的数据框（名称、百分比）。我认为我应该避免的其他选择，因为我确信在 R 中必须有一种更有效的方法来做到这一点，是创建一个带有嵌套 for 循环的 R 脚本..eek！

而我的最后一个选择，这可能是最好的方法（因为这个数据框会很大）是使用 Python，因此如果有人知道如何做到这一点是 Python（猜想我们将使用 Pandas）我会很感激一些帮助。

所以说清楚，两个问题：

  1. 如果可以使用 ddply 有人可以告诉我如何，否则有人对我如何在 r 中解决这个问题有任何其他想法吗？

  2. 使用上面的小数据框，有人可以提供一个他们如何在 Python 中解决这个问题的例子吗？

4

3 回答 3

2

我不明白为什么 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

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

于 2013-11-08T09:14:01.217 回答
1

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

  1. 按名称分组
  2. 对于每个组，使用 . 找到 2 行的组合combn。combn真的很慢也许更好用expand.grid
  3. 对于 2 行的每个组合，删除缺失值并仅保留唯一值。最好在分组之前对所有数据执行此操作。
  4. 由于关系不对称，计算 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
于 2013-11-08T09:26:24.670 回答
1

还有一个选择：

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
  }))
})
于 2013-11-08T09:38:14.010 回答