I have a list of several vectors. I would like to check whether all vectors in the list are equal. There's identical
which only works for pairwise comparison. So I wrote the following function which looks ugly to me. Still I did not find a better solution. Here's my RE:
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)
Any suggestions? Are there any native checks for identical for more than just pairwise comparison?
How about
allSame <- function(x) length(unique(x)) == 1
allSame(test_true)
# [1] TRUE
allSame(test_false)
# [1] FALSE
As @JoshuaUlrich pointed out below, unique
may be slow on lists. Also, identical
and unique
may use different criteria. Reduce
is a function I recently learned about for extending pairwise operations:
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
This inefficiently continues making comparisons after finding one non-match. My crude solution to that would be to write else break
instead of else FALSE
, throwing an error.
I woud do:
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
To summarize the solutions. Data for the tests:
x1 <- as.list(as.data.frame(replicate(1000, 1:100)))
x2 <- as.list(as.data.frame(replicate(1000, sample(1:100, 100))))
Solutions:
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
Test on the data:
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
Benchmarks:
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
As we see the most efficient solutions based on the duplicated
and unique
functions.
PUtting in my self-promoting suggestion for cgwtools::approxeq
which essentially does what all.equal
does but returns a vector of logical values indicating equality or not.
So: depends whether you want exact equality or floating-point-representational equality.
Implementing Frank's solution with a break:
all.identical <- function(l) class(try(Reduce(function(x, y) if(identical(x, y)) x else break, l), silent = TRUE)) != "try-error"
Continuing with Artem's benchmarking and adding the solution from Jake's comment, speeds are pretty dependent on the objects being compared:
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)
this also works
m <- combn(length(test_true),2)
for(i in 1:ncol(m)){
print(all(test_true[[m[,i][1]]] == test_true[[m[,i][2]]]))
}
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.