Verifica l'uguaglianza tra tutti gli elementi di un singolo vettore

Sto cercando di verificare se tutti gli elementi di un vettore sono uguali tra loro. Le soluzioni che ho escogitato sembrano alquanto indirette, entrambe implicanti il ​​controllo length().

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

Con unique():

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

Con rle():

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

Una soluzione che mi permettesse di includere un valore di tolleranza per valutare l '"uguaglianza" tra gli elementi sarebbe l'ideale per evitare problemi con la FAQ 7.31 .

Esiste una funzione integrata per il tipo di test che ho completamente trascurato? identical()e all.equal()confronta due oggetti R, così non funzioneranno qui.

Modifica 1

Ecco alcuni risultati di benchmarking. Utilizzando il codice:

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)

Con i risultati:

          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

Quindi sembra che diff(range(x)) < .Machine$double.eps ^ 0.5sia il più veloce.

Uso questo metodo, che confronta il minimo e il massimo, dopo aver diviso per la media:

# 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))
}

Se lo stessi usando più seriamente, probabilmente vorresti rimuovere i valori mancanti prima di calcolare l'intervallo e la media.

Perché non usare semplicemente la varianza:

var(x) == 0

Se tutti gli elementi di xsono uguali, otterrai una varianza di 0.

Se sono tutti valori numerici, se tol è la tua tolleranza, allora ...

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

è la soluzione al tuo problema.

MODIFICARE:

Dopo aver esaminato questa e altre risposte e aver analizzato alcune cose, quanto segue risulta due volte più veloce della risposta DWin.

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

Questo è un po 'sorprendentemente più veloce di diff(range(x))quanto diffnon dovrebbe essere molto diverso da -e abscon due numeri. La richiesta dell'intervallo dovrebbe ottimizzare ottenendo il minimo e il massimo. Entrambi diffe rangesono funzioni primitive. Ma il tempismo non mente.

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

Un altro sulla stessa linea:

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

Puoi usare identical()e all.equal()confrontando il primo elemento con tutti gli altri, estendendo efficacemente il confronto tra:

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> 

In questo modo puoi aggiungere qualsiasi epsilon a identical()seconda delle necessità.

Puoi solo controllare all(v==v[1])

Dato che continuo a tornare su questa domanda più e più volte, ecco una Rcppsoluzione che sarà generalmente molto più veloce di qualsiasi Rsoluzione se la risposta è effettivamente FALSE(perché si fermerà nel momento in cui incontra una mancata corrispondenza) e avrà la stessa velocità come la soluzione R più veloce se la risposta è TRUE. Ad esempio per il benchmark OP, system.timeclock esattamente a 0 utilizzando questa funzione.

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

Ho scritto una funzione appositamente per questo, che può controllare non solo gli elementi in un vettore, ma anche in grado di verificare se tutti gli elementi in un elenco sono identici . Ovviamente gestisce bene anche i vettori di caratteri e tutti gli altri tipi di vettore. Ha anche una gestione degli errori appropriata.

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
  }
}

Ora prova alcuni esempi.

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

In realtà non è necessario utilizzare min, mean o max. Basato sulla risposta di John:

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

Ecco un'alternativa che usa il trucco min, max ma per un data frame. Nell'esempio sto confrontando le colonne ma il parametro del margine da applypuò essere modificato in 1 per le righe.

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

Se valid == 0poi tutti gli elementi sono gli stessi