Проверка на равенство всех элементов одного числового вектора

Я использую этот метод, который сравнивает минимальное и максимальное значение после деления на среднее значение:

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

Если бы вы использовали это более серьезно, вы, вероятно, захотели бы удалить отсутствующие значения перед вычислением диапазона и среднего.

Почему бы просто не использовать дисперсию:

var(x) == 0

Если все элементы x равны, вы получите отклонение 0.

Если они все числовые значения, тогда если tol - ваша терпимость, тогда ...

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

это решение вашей проблемы.

РЕДАКТИРОВАТЬ:

Посмотрев на этот и другие ответы, а также протестировав несколько вещей, следующее получается более чем в два раза быстрее, чем ответ DWin.

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

Это немного на удивление быстрее, чем diff(range(x)), поскольку diff не должно сильно отличаться от - и abs с двумя числами. Запрос диапазона должен оптимизировать получение минимума и максимума. И diff, и range - примитивные функции. Но время не врет.

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

Другой в том же духе:

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

Вы можете просто проверить all(v==v[1])

Вы можете использовать identical() и all.equal(), сравнивая первый элемент со всеми остальными, эффективно охватывая сравнение:

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> 

Таким образом, вы можете добавить любой эпсилон к identical() по мере необходимости.

Поскольку я возвращаюсь к этому вопросу снова и снова, вот решение Rcpp, которое, как правило, будет намного быстрее, чем любое из решений R, если на самом деле ответ будет FALSE (потому что оно остановится в момент обнаружения несоответствия) и будет иметь та же скорость, что и самое быстрое решение R, если ответ TRUE. Например, для теста OP при использовании этой функции частота system.time составляет ровно 0.

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

Я написал специально для этого функцию, которая может проверять не только элементы в векторе, но также может проверять, все ли элементы в списке идентичны. Конечно, он также хорошо обрабатывает символьные векторы и все другие типы векторов. Он также имеет соответствующую обработку ошибок.

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

А теперь попробуйте несколько примеров.

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

На самом деле вам не нужно использовать минимальное, среднее или максимальное значение. На основании ответа Джона:

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

Здесь альтернатива с использованием трюка min, max, но для фрейма данных. В этом примере я сравниваю столбцы, но параметр поля с apply можно изменить на 1 для строк.

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

Если valid == 0, то все элементы одинаковые

Другое решение, использующее пакет data.table, совместимое со строками и NA, - это uniqueN(x) == 1