确定列值在data.table中是否唯一

Question

我使用数据表来存储数据。我试图弄清楚每行中的某些列是否是唯一的。我想在data.table中添加一列，如果有重复值，该列将保存值“重复值”,如果没有重复值，该列将为NA。我要检查重复的列名存储在一个字符向量中。例如，我创建了我的数据表:

tmpdt<-data.table(a=c(1,2,3,4,5), b=c(2,2,3,4,5), c=c(4,2,2,4,4), d=c(3,3,1,4,5))
> tmpdt
   a b c d
1: 1 2 4 3
2: 2 2 2 3
3: 3 3 2 1
4: 4 4 4 4
5: 5 5 4 5

我还有另一个变量，指示需要检查哪些列是否重复。重要的是，我能够将列名存储在字符向量中，而不需要“知道”它们（因为它们将作为参数传递给函数）。

dupcheckcols<-c("a", "c", "d")

我希望输出是：

> tmpdt
   a b c d     Dups
1: 1 2 4 3     <NA>
2: 2 2 2 3 Has Dups
3: 3 3 2 1     <NA>
4: 4 4 4 4 Has Dups
5: 5 5 4 5 Has Dups

如果我使用的是数据帧，这很容易。我可以简单地使用：

tmpdt<-data.frame(a=c(1,2,3,4,5), b=c(2,2,3,4,5), c=c(4,2,2,4,4), d=c(3,3,1,4,5))
tmpdt$Dups<-NA
tmpdt$Dups[apply(tmpdt[,dupcheckcols], 1, function(x) {return(sum(duplicated(x))>0)})]<-"Has Dups"
> tmpdt
  a b c d     Dups
1 1 2 4 3     <NA>
2 2 2 2 3 Has Dups
3 3 3 2 1     <NA>
4 4 4 4 4 Has Dups
5 5 5 4 5 Has Dups

但是我不知道如何用data.table.完成同样的任务。非常感谢任何帮助。

Answer 1

按照hadley的例子(在“集合”下面)，我找到了一种用Rcpp实现这一点的方法:

// [[Rcpp::plugins(cpp11)]]
#include <Rcpp.h>
#include <unordered_set>
using namespace Rcpp;

// [[Rcpp::export]]
LogicalVector anyDupCols(IntegerMatrix x) {
    int nr = x.nrow();
    int nc = x.ncol();
    LogicalVector out(nr, false);

    std::unordered_set<int> seen;
    for (int i = 0; i < nr; i++) {
        seen.clear();
        for (int j = 0; j < nc; j++){
            int xij = x(i,j);
            if (seen.count(xij)){ out[i] = true; break; }
            else seen.insert(xij);
        }
    }

    return out;
}

要使用它，把它放在一个cpp文件中并运行

library(Rcpp)
sourceCpp("anyDupCols.cpp")
anyDupCols(as.matrix(DT))

它在基准测试中做得很好：

nc = 30
nv = nc^2
n  = 1e4

set.seed(1)
DT = setDT( replicate(nc, sample(nv, n, replace = TRUE), simplify=FALSE) )

library(microbenchmark)
microbenchmark(
    ananda = DT[, any(duplicated(unlist(.SD, use.names = FALSE))), by = 1:nrow(DT)]$V1,
    tospig = {
        expr = parse(text=paste(apply(t(combn(names(DT),2)),1,FUN = 
          function(x){ paste0(x, collapse="==") }), collapse = "|"))
        DT[, eval(expr)]
    },
    cpp = anyDupCols(as.matrix(DT)),
    alex = ff(DT),
    tscharf = apply(DT,1,function(row) any(duplicated(row))),
    unit = "relative", times = 10
)

Unit: relative
    expr      min       lq     mean   median       uq      max neval  cld
  ananda 2.462739 2.596990 2.774660 2.659898 2.869048 3.352547    10   c 
  tospig 3.118158 3.253102 3.606263 3.424598 3.885561 4.583268    10    d
     cpp 1.000000 1.000000 1.000000 1.000000 1.000000 1.000000    10 a   
    alex 1.295415 1.927802 1.914883 1.982580 2.029868 2.538143    10  b  
 tscharf 2.112286 2.204654 2.385318 2.234963 2.322206 2.978047    10  bc 

如果我转到nc=50，@thossh的exr变得太长，R无法处理，我得到节点堆栈溢出，这很有趣。

Answer 2

你应该可以这样做：

tmpdt[, dups := any(duplicated(unlist(.SD, use.names = FALSE))), 
      by = 1:nrow(tmpdt), .SDcols = dupcheckcols]
tmpdt
#    a b c d  dups
# 1: 1 2 4 3 FALSE
# 2: 2 2 2 3  TRUE
# 3: 3 3 2 1 FALSE
# 4: 4 4 4 4  TRUE
# 5: 5 5 4 5  TRUE

如果你真的想用“Has Dups”这样的词，请做相应的调整，但是请注意，使用逻辑值可能更容易，就像我在这里的回答一样。

Answer 3

我相信还有其他方法

tmpdt[, dups := tmpdt[, dupcheckcols, with=FALSE][, apply(.SD, 1, function(x){sum(duplicated(x))>0})] ]
#   a b c d  dups
#1: 1 2 4 3 FALSE
#2: 2 2 2 3  TRUE
#3: 3 3 2 1 FALSE
#4: 4 4 4 4  TRUE
#5: 5 5 4 5  TRUE

一种更复杂但稍快（在计算方面）的方法是在i中构造过滤条件，然后通过引用在j中更新

expr <- paste(apply(t(combn(dupcheckcols,2)), 1, FUN=function(x){ paste0(x, collapse="==") }), collapse = "|")
# [1] "a==c|a==d|c==d"

expr <- parse(text=expr)
tmpdt[ eval(expr), dups := TRUE ]
#   a b c d dups
#1: 1 2 4 3   NA
#2: 2 2 2 3 TRUE
#3: 3 3 2 1   NA
#4: 4 4 4 4 TRUE
#5: 5 5 4 5 TRUE

我对速度优势很感兴趣，所以我已经对这两个加上阿南达的解决方案进行了基准测试：

library(microbenchmark)

tmpdt<-data.table(a=c(1,2,3,4,5), b=c(2,2,3,4,5), c=c(4,2,2,4,4), d=c(3,3,1,4,5))
t1 <- tmpdt
t2 <- tmpdt
t3 <- tmpdt

expr <- paste(apply(t(combn(dupcheckcols,2)), 1, FUN=function(x){ paste0(x, collapse="==") }), collapse = "|")
expr <- parse(text=expr)

microbenchmark(
#Ananda's solution
t1[, dups := any(duplicated(unlist(.SD))), by = 1:nrow(tmpdt), .SDcols = dupcheckcols],

t2[, dups := t2[, dupcheckcols, with=FALSE][, apply(.SD, 1, function(x){sum(duplicated(x))>0})] ],

t3[ eval(expr), dups := TRUE ]
)
 #     min        lq      mean   median        uq      max neval cld
 # 531.416  552.5760  577.0345  565.182  573.2015 1761.863   100  b 
 #1277.569 1333.2615 1389.5857 1358.021 1387.9860 2694.951   100   c
 # 265.872  283.3525  293.9362  292.487  301.1640  520.436   100 a