Test auf Gleichheit zwischen allen Elementen eines einzelnen Vektors

Ich versuche zu testen, ob alle Elemente eines Vektors gleich sind. Die Lösungen, die ich gefunden habe, scheinen etwas umständlich zu sein, beide beinhalten Überprüfungen length().

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

Mit unique():

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

Mit rle():

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

Eine Lösung, mit der ich einen Toleranzwert für die Bewertung der „Gleichheit“ zwischen Elementen angeben könnte, wäre ideal, um Probleme mit FAQ 7.31 zu vermeiden .

Gibt es eine eingebaute Funktion für die Art des Tests, die ich völlig übersehen habe? identical()und all.equal()vergleichen Sie zwei R-Objekte, damit sie hier nicht funktionieren.

Bearbeiten 1

Hier sind einige Benchmarking-Ergebnisse. Verwenden des Codes:

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)

Mit den Ergebnissen:

          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

Es sieht also so aus, als wäre diff(range(x)) < .Machine$double.eps ^ 0.5es am schnellsten.

Ich benutze diese Methode, die das Minimum und das Maximum vergleicht, nachdem ich durch den Mittelwert dividiert habe:

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

Wenn Sie dies ernsthafter verwenden, möchten Sie wahrscheinlich fehlende Werte entfernen, bevor Sie den Bereich und den Mittelwert berechnen.

Warum nicht einfach die Varianz verwenden:

var(x) == 0

Wenn alle Elemente von xgleich sind, erhalten Sie eine Varianz von 0.

Wenn sie alle numerische Werte sind, wenn tol Ihre Toleranz ist, dann ...

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

ist die Lösung für Ihr Problem.

BEARBEITEN:

Nachdem Sie sich diese und andere Antworten angesehen und einige Dinge verglichen haben, ist das Folgende doppelt so schnell wie die DWin-Antwort.

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

Dies ist ein bisschen überraschend schneller als diff(range(x))da diffsollte nicht viel anders sein als -und absmit zwei Zahlen. Das Anfordern des Bereichs sollte das Erhalten des Minimums und Maximums optimieren. Beide diffund rangesind primitive Funktionen. Aber das Timing lügt nicht.

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

Ein anderer in der gleichen Richtung:

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

Sie können das erste Element verwenden identical()und all.equal()mit allen anderen vergleichen, um den Vergleich effektiv zu vertiefen:

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> 

Auf diese Weise können Sie nach Bedarf jedes Epsilon hinzufügen identical().

Sie können nur überprüfen all(v==v[1])

Da ich immer wieder auf diese Frage zurückkomme, ist hier eine RcppLösung, die im Allgemeinen viel schneller ist als jede der RLösungen, wenn die Antwort tatsächlich lautet FALSE(weil sie in dem Moment stoppt, in dem sie auf eine Nichtübereinstimmung stößt) und dieselbe Geschwindigkeit aufweist als schnellste R-Lösung, wenn die Antwort lautet TRUE. Beispiel: Für den OP-Benchmark wird system.timemit dieser Funktion genau 0 eingegeben.

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

Ich habe speziell dafür eine Funktion geschrieben, mit der nicht nur Elemente in einem Vektor überprüft werden können, sondern auch überprüft werden kann, ob alle Elemente in einer Liste identisch sind . Natürlich kann es auch Zeichenvektoren und alle anderen Arten von Vektoren gut verarbeiten. Es hat auch eine angemessene Fehlerbehandlung.

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

Versuchen Sie nun einige Beispiele.

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

Sie müssen nicht unbedingt min, mean oder max verwenden. Basierend auf Johns Antwort:

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

Hier eine Alternative mit dem Min, Max-Trick aber für einen Datenrahmen. Im Beispiel vergleiche ich Spalten, aber der Randparameter von applykann für Zeilen in 1 geändert werden.

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

Wenn valid == 0dann alle Elemente gleich sind