Tester l'égalité entre tous les éléments d'un même vecteur

J'essaie de tester si tous les éléments d'un vecteur sont égaux les uns aux autres. Les solutions que j'ai proposées semblent quelque peu détournées, toutes deux impliquant des vérifications length().

x <- c(1, 2, 3, 4, 5, 6, 1)  # FALSE
y <- rep(2, times = 7)       # TRUE

Avec unique():

length(unique(x)) == 1
length(unique(y)) == 1

Avec rle():

length(rle(x)$values) == 1
length(rle(y)$values) == 1

Une solution qui me permettrait d'inclure une valeur de tolérance pour évaluer «l'égalité» entre les éléments serait idéale pour éviter les problèmes de la FAQ 7.31 .

Existe-t-il une fonction intégrée pour le type de test que j'ai complètement négligée? identical()et all.equal()comparez deux objets R, afin qu'ils ne fonctionnent pas ici.

Modifier 1

Voici quelques résultats d'analyse comparative. En utilisant le code:

library(rbenchmark)

John <- function() all( abs(x - mean(x)) < .Machine$double.eps ^ 0.5 )
DWin <- function() {diff(range(x)) < .Machine$double.eps ^ 0.5}
zero_range <- function() {
  if (length(x) == 1) return(TRUE)
  x <- range(x) / mean(x)
  isTRUE(all.equal(x[1], x[2], tolerance = .Machine$double.eps ^ 0.5))
}

x <- runif(500000);

benchmark(John(), DWin(), zero_range(),
  columns=c("test", "replications", "elapsed", "relative"),
  order="relative", replications = 10000)

Avec les résultats:

          test replications elapsed relative
2       DWin()        10000 109.415 1.000000
3 zero_range()        10000 126.912 1.159914
1       John()        10000 208.463 1.905251

On dirait donc que diff(range(x)) < .Machine$double.eps ^ 0.5c'est le plus rapide.

J'utilise cette méthode, qui compare le min et le max, après avoir divisé par la moyenne:

# Determine if range of vector is FP 0.
zero_range <- function(x, tol = .Machine$double.eps ^ 0.5) {
  if (length(x) == 1) return(TRUE)
  x <- range(x) / mean(x)
  isTRUE(all.equal(x[1], x[2], tolerance = tol))
}

Si vous l'utilisiez plus sérieusement, vous voudriez probablement supprimer les valeurs manquantes avant de calculer la plage et la moyenne.

Pourquoi ne pas simplement utiliser la variance:

var(x) == 0

Si tous les éléments de xsont égaux, vous obtiendrez une variance de 0.

Si ce sont toutes des valeurs numériques, si tol est votre tolérance, alors ...

all( abs(y - mean(y)) < tol ) 

est la solution à votre problème.

ÉDITER:

Après avoir examiné ceci, et d'autres réponses, et comparé quelques points, ce qui suit ressort deux fois plus vite que la réponse DWin.

abs(max(x) - min(x)) < tol

C'est un peu étonnamment plus rapide que diff(range(x))puisque diffne devrait pas être très différent de -et absavec deux nombres. La demande de la gamme devrait optimiser l'obtention du minimum et du maximum. Les deux diffet rangesont des fonctions primitives. Mais le timing ne ment pas.

> isTRUE(all.equal( max(y) ,min(y)) )
[1] TRUE
> isTRUE(all.equal( max(x) ,min(x)) )
[1] FALSE

Un autre dans le même sens:

> diff(range(x)) < .Machine$double.eps ^ 0.5
[1] FALSE
> diff(range(y)) < .Machine$double.eps ^ 0.5
[1] TRUE

Vous pouvez utiliser identical()et all.equal()en comparant le premier élément à tous les autres, balayant efficacement la comparaison à travers:

R> compare <- function(v) all(sapply( as.list(v[-1]), 
+                         FUN=function(z) {identical(z, v[1])}))
R> compare(x)
[1] FALSE
R> compare(y)
[1] TRUE
R> 

De cette façon, vous pouvez ajouter n'importe quel epsilon au identical()besoin.

Vous pouvez simplement vérifier all(v==v[1])

Puisque je reviens sans cesse sur cette question, voici une Rcppsolution qui sera généralement beaucoup plus rapide que n'importe laquelle des Rsolutions si la réponse est réellement FALSE(car elle s'arrêtera au moment où elle rencontrera une discordance) et aura la même vitesse comme la solution R la plus rapide si la réponse est TRUE. Par exemple, pour le benchmark OP, system.timehorloges à exactement 0 en utilisant cette fonction.

library(inline)
library(Rcpp)

fast_equal = cxxfunction(signature(x = 'numeric', y = 'numeric'), '
  NumericVector var(x);
  double precision = as<double>(y);

  for (int i = 0, size = var.size(); i < size; ++i) {
    if (var[i] - var[0] > precision || var[0] - var[i] > precision)
      return Rcpp::wrap(false);
  }

  return Rcpp::wrap(true);
', plugin = 'Rcpp')

fast_equal(c(1,2,3), 0.1)
#[1] FALSE
fast_equal(c(1,2,3), 2)
#[2] TRUE

J'ai écrit une fonction spécialement pour cela, qui peut vérifier non seulement les éléments d'un vecteur, mais également capable de vérifier si tous les éléments d'une liste sont identiques . Bien sûr, il gère également les vecteurs de caractères et tous les autres types de vecteurs. Il dispose également d'une gestion des erreurs appropriée.

all_identical <- function(x) {
  if (length(x) == 1L) {
    warning("'x' has a length of only 1")
    return(TRUE)
  } else if (length(x) == 0L) {
    warning("'x' has a length of 0")
    return(logical(0))
  } else {
    TF <- vapply(1:(length(x)-1),
                 function(n) identical(x[[n]], x[[n+1]]),
                 logical(1))
    if (all(TF)) TRUE else FALSE
  }
}

Maintenant, essayez quelques exemples.

x <- c(1, 1, 1, NA, 1, 1, 1)
all_identical(x)       ## Return FALSE
all_identical(x[-4])   ## Return TRUE
y <- list(fac1 = factor(c("A", "B")),
          fac2 = factor(c("A", "B"), levels = c("B", "A"))
          )
all_identical(y)     ## Return FALSE as fac1 and fac2 have different level order

Vous n'avez pas réellement besoin d'utiliser min, mean ou max. Basé sur la réponse de John:

all(abs(x - x[[1]]) < tolerance)

Voici une alternative utilisant l'astuce min, max mais pour une trame de données. Dans l'exemple, je compare des colonnes, mais le paramètre de marge de applypeut être changé en 1 pour les lignes.

valid = sum(!apply(your_dataframe, 2, function(x) diff(c(min(x), max(x)))) == 0)

Si valid == 0alors tous les éléments sont les mêmes