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

Question

Je suis en train de tester si tous les éléments d'un vecteur sont égaux l'un à l'autre. Les solutions que je viens avec le sembler un peu rond-point, impliquant de la vérification de l' 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 leur permettrait de m'inclure une valeur de tolérance pour l'évaluation de "l'égalité" entre les éléments, l'idéal serait d'éviter FAQ 7.31 questions.

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

Edit 1

Voici quelques résultats de l'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

De sorte qu'il ressemble diff(range(x)) < .Machine$double.eps ^ 0.5 est la plus rapide.

Answer 1

Si elles sont toutes les valeurs numériques puis si tol est votre tolérance...

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

est la solution à votre problème.

EDIT:

Après avoir regardé cette, et les autres réponses, et les comparer un peu les choses suivantes sort plus de deux fois plus rapide que la DWin réponse.

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

C'est un peu étonnamment plus rapide que l' diff(range(x)) depuis diff ne devrait pas être très différente de la - et abs , avec deux numéros. Demander la gamme devrait optimiser obtenir le minimum et le maximum. Les deux diff et range sont des fonctions primitives. Mais le timing n'est pas mentir.

Answer 2

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 utilisez cela plus sérieusement, vous voudrez probablement supprimer les valeurs manquantes avant de calculer la plage et la moyenne.

Answer 3

 > 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
 

Answer 4

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

 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 à identical() selon vos besoins.

Answer 5

Depuis j'en reviens toujours à cette question maintes et maintes fois, voici un Rcpp de la solution qui sera généralement beaucoup plus rapide que n'importe quel R solutions si la réponse est réellement FALSE (car il permet d'arrêter le moment il rencontre un décalage) et auront la même vitesse que la R solution la plus rapide si la réponse est - TRUE. Par exemple pour l'OP de référence, system.time horloges à exactement 0 à l'aide de 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