检查列表的所有元素在R中是否相等

Question

我有几个向量的列表。我想检查列表中的所有向量是否相等。 identical 仅适用于成对比较。所以我写了以下对我来说看起来很丑的函数。我仍然没有找到更好的解决方案。这是我的回复：

test_true <- list(a=c(1,2,3),b=c(1,2,3),d=c(1,2,3))
test_false <- list(a=c(1,2,3),b=c(1,2,3),d=c(1,32,13))

compareList <- function(li){
  stopifnot(length(li) > 1)
  l <- length(li)
  res <- lapply(li[-1],function(X,x) identical(X,x),x=li[[1]])
  res <- all(unlist(res))
  res
}

compareList(test_true)
compareList(test_false)

有什么建议吗？除了成对比较之外，是否有任何本机检查是否相同？

Answer 1

怎么样

allSame <- function(x) length(unique(x)) == 1

allSame(test_true)
# [1] TRUE
allSame(test_false)
# [1] FALSE

正如@JoshuaUlrich 在下面指出的那样，unique 在列表中可能会很慢。此外，identical 和 unique 可能使用不同的标准。 Reduce 是我最近了解到的用于扩展成对操作的函数：

identicalValue <- function(x,y) if (identical(x,y)) x else FALSE
Reduce(identicalValue,test_true)
# [1] 1 2 3
Reduce(identicalValue,test_false)
# [1] FALSE

在找到一个不匹配项后继续进行比较效率低下。我对此的粗略解决方案是写else break 而不是else FALSE，这会引发错误。

Answer 2

这也有效

m <- combn(length(test_true),2)

for(i in 1:ncol(m)){
    print(all(test_true[[m[,i][1]]] == test_true[[m[,i][2]]]))
    }

Answer 3

加入我对cgwtools::approxeq 的自我推销建议，它基本上做了all.equal 所做的事情，但返回一个逻辑值向量，表示是否相等。

所以：取决于您想要完全相等还是浮点表示相等。

Answer 4

我会这样做：

all.identical <- function(l) all(mapply(identical, head(l, 1), tail(l, -1)))

all.identical(test_true)
# [1] TRUE
all.identical(test_false)
# [1] FALSE

Answer 5

总结解决方案。测试数据：

x1 <- as.list(as.data.frame(replicate(1000, 1:100)))
x2 <- as.list(as.data.frame(replicate(1000, sample(1:100, 100))))

解决方案：

comp_list1 <- function(x) length(unique.default(x)) == 1L
comp_list2 <- function(x) all(vapply(x[-1], identical, logical(1L), x = x[[1]]))
comp_list3 <- function(x) all(vapply(x[-1], function(x2) all(x[[1]] == x2), logical(1L)))
comp_list4 <- function(x) sum(duplicated.default(x)) == length(x) - 1L

数据测试：

for (i in 1:4) cat(match.fun(paste0("comp_list", i))(x1), " ")
#> TRUE  TRUE  TRUE  TRUE   
for (i in 1:4) cat(match.fun(paste0("comp_list", i))(x2), " ")
#> FALSE  FALSE  FALSE  FALSE  

基准测试：

library(microbenchmark)
microbenchmark(comp_list1(x1), comp_list2(x1), comp_list3(x1), comp_list4(x1))
#> Unit: microseconds
#>            expr      min        lq      mean   median        uq      max neval cld
#>  comp_list1(x1)  138.327  148.5955  171.9481  162.013  188.9315  269.342   100 a  
#>  comp_list2(x1) 1023.932 1125.2210 1387.6268 1255.985 1403.1885 3458.597   100  b 
#>  comp_list3(x1) 1130.275 1275.9940 1511.7916 1378.789 1550.8240 3254.292   100   c
#>  comp_list4(x1)  138.075  144.8635  169.7833  159.954  185.1515  298.282   100 a  
microbenchmark(comp_list1(x2), comp_list2(x2), comp_list3(x2), comp_list4(x2))
#> Unit: microseconds
#>            expr     min        lq      mean   median        uq      max neval cld
#>  comp_list1(x2) 139.492  140.3540  147.7695  145.380  149.6495  218.800   100  a 
#>  comp_list2(x2) 995.373 1030.4325 1179.2274 1054.711 1136.5050 3763.506   100   b
#>  comp_list3(x2) 977.805 1029.7310 1134.3650 1049.684 1086.0730 2846.592   100   b
#>  comp_list4(x2) 135.516  136.4685  150.7185  139.030  146.7170  345.985   100  a

我们看到了基于duplicated 和unique 函数的最有效解决方案。

Answer 6

暂时实施弗兰克的解决方案：

all.identical <- function(l) class(try(Reduce(function(x, y) if(identical(x, y)) x else break, l), silent = TRUE)) != "try-error"

继续使用 Artem 的基准测试并添加 Jake 评论中的解决方案，速度很大程度上取决于被比较的对象：

library(microbenchmark)

all.identical <- function(l) !is.null(Reduce(function(x, y) if(identical(x, y)) x else NULL, l))
all.identical.beak <- function(l) class(try(Reduce(function(x, y) if(identical(x, y)) x else break, l), silent = TRUE)) != "try-error"
comp_list4 <- function(l) sum(duplicated.default(l)) == length(l) - 1L
comp_list5 <- function(l) all(duplicated.default(l)[-1])

x1 <- as.list(as.data.frame(replicate(1000, 1:100)))
x2 <- as.list(as.data.frame(replicate(1000, sample(100))))
microbenchmark(all.identical(x1), all.identical.beak(x1), comp_list4(x1), comp_list5(x1))
#> Unit: microseconds
#>                    expr    min      lq     mean  median      uq    max neval
#>       all.identical(x1) 1060.2 1145.30 1396.207 1208.40 1433.25 4628.9   100
#>  all.identical.beak(x1) 1081.1 1150.55 1345.244 1202.90 1334.50 5051.9   100
#>          comp_list4(x1)  190.4  201.05  269.145  205.65  228.65 4225.8   100
#>          comp_list5(x1)  195.8  207.60  267.277  218.35  250.30 3214.7   100
microbenchmark(all.identical(x2), all.identical.beak(x2), comp_list4(x2), comp_list5(x2))
#> Unit: microseconds
#>                    expr   min      lq     mean  median      uq    max neval
#>       all.identical(x2) 997.2 1058.30 1199.814 1113.50 1195.75 3309.2   100
#>  all.identical.beak(x2) 101.6  110.60  136.213  118.10  136.00  361.9   100
#>          comp_list4(x2) 152.5  161.05  188.098  168.95  196.15  418.4   100
#>          comp_list5(x2) 156.0  165.30  191.243  172.85  194.65  638.2   100

x1 <- as.list(as.data.frame(replicate(10, 1:1e5)))
x2 <- as.list(as.data.frame(replicate(10, sample(1e5))))
microbenchmark(all.identical(x1), all.identical.beak(x1), comp_list4(x1), comp_list5(x1))
#> Unit: microseconds
#>                    expr    min      lq     mean  median      uq    max neval
#>       all.identical(x1)  391.1  435.75  491.762  459.95  500.80 1038.0   100
#>  all.identical.beak(x1)  420.5  444.60  525.837  470.60  541.40 1542.8   100
#>          comp_list4(x1) 1506.8 1596.65 1707.656 1645.80 1784.00 2241.0   100
#>          comp_list5(x1) 1502.2 1583.55 1696.311 1647.65 1759.25 2275.6   100
microbenchmark(all.identical(x2), all.identical.beak(x2), comp_list4(x2), comp_list5(x2))
#> Unit: microseconds
#>                    expr    min      lq     mean  median      uq    max neval
#>       all.identical(x2)   11.0   13.35   16.623   14.60   16.40   81.9   100
#>  all.identical.beak(x2)   87.1   99.00  132.218  114.40  144.95  472.5   100
#>          comp_list4(x2) 1127.6 1184.90 1286.094 1219.80 1298.90 2463.2   100
#>          comp_list5(x2) 1124.9 1189.85 1291.297 1221.65 1301.60 2569.1   100

Created on 2021-12-02 by the reprex package (v2.0.1)