Teste de igualdade entre todos os elementos de um único vetor

Estou tentando testar se todos os elementos de um vetor são iguais uns aos outros. As soluções que encontrei parecem um tanto indiretas, ambas envolvendo verificação length().

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

Com unique():

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

Com rle():

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

Uma solução que me permitisse incluir um valor de tolerância para avaliar a 'igualdade' entre os elementos seria ideal para evitar os problemas da FAQ 7.31 .

Existe uma função integrada para o tipo de teste que eu ignorei completamente? identical()e all.equal()compare dois objetos R, então eles não funcionarão aqui.

Editar 1

Aqui estão alguns resultados de benchmarking. Usando o código:

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)

Com os resultados:

          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

Portanto, parece que diff(range(x)) < .Machine$double.eps ^ 0.5é o mais rápido.

Eu uso este método, que compara o mínimo e o máximo, depois de dividir pela média:

# 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 você estivesse usando isso mais a sério, provavelmente gostaria de remover os valores ausentes antes de calcular o intervalo e a média.

Por que não simplesmente usar a variação:

var(x) == 0

Se todos os elementos de xforem iguais, você obterá uma variação de 0.

Se forem todos valores numéricos, se tol for sua tolerância, então ...

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

é a solução para o seu problema.

EDITAR:

Depois de olhar para esta e outras respostas, e comparar algumas coisas, o seguinte sai duas vezes mais rápido que a resposta DWin.

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

Isso é um pouco surpreendentemente mais rápido, diff(range(x))já diffque não deve ser muito diferente de -e abscom dois números. Solicitar o intervalo deve otimizar a obtenção do mínimo e máximo. Ambos diffe rangesão funções primitivas. Mas o momento não mente.

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

Outro na mesma linha:

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

Você pode usar identical()e all.equal()comparando o primeiro elemento com todos os outros, varrendo efetivamente a comparação:

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> 

Dessa forma, você pode adicionar qualquer épsilon identical()conforme necessário.

Você pode apenas verificar all(v==v[1])

Como sempre volto a essa pergunta, aqui está uma Rcppsolução que geralmente será muito mais rápida do que qualquer uma das Rsoluções se a resposta for realmente FALSE(porque ela irá parar no momento em que encontra uma incompatibilidade) e terá a mesma velocidade como a solução R mais rápida se a resposta for TRUE. Por exemplo, para o benchmark OP, system.timeclica em exatamente 0 usando esta função.

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

Escrevi uma função especificamente para isso, que pode verificar não apenas os elementos em um vetor, mas também pode verificar se todos os elementos de uma lista são idênticos . É claro que também lida com vetores de caracteres e todos os outros tipos de vetores. Ele também possui tratamento de erros apropriado.

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

Agora tente alguns exemplos.

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

Na verdade, você não precisa usar min, mean ou max. Com base na resposta de John:

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

Aqui está uma alternativa usando o truque mínimo e máximo, mas para um quadro de dados. No exemplo, estou comparando colunas, mas o parâmetro de margem de applypode ser alterado para 1 para linhas.

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

Se valid == 0todos os elementos forem iguais