проверить, все ли элементы списка равны в R

Question

У меня есть список из нескольких векторов. Я хотел бы проверить, равны ли все векторы в списке. Есть identical, который работает только для парного сравнения. Поэтому я написал следующую функцию, которая выглядит уродливо для меня. Тем не менее я не нашел лучшего решения. Вот мой 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) 

Любые предложения? Существуют ли какие-либо собственные проверки для идентичности для более чем простого сравнения?

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

Я woud сделать:

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.