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 行的组合combncombn真的很慢也许更好用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 回答