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


101

Я пытаюсь проверить, все ли элементы вектора равны друг другу. Решения, которые я придумал, кажутся несколько окольными, оба предполагают проверку length().

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

С unique():

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

С rle():

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

Решение, которое позволило бы мне включить значение допуска для оценки «равенства» между элементами, было бы идеальным, чтобы избежать проблем с FAQ 7.31 .

Есть ли встроенная функция для типа теста, который я полностью упустил из виду? identical()и all.equal()сравните два объекта R, поэтому они не будут работать здесь.

Редактировать 1

Вот некоторые результаты тестов. Используя код:

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)

С результатами:

          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

Похоже, diff(range(x)) < .Machine$double.eps ^ 0.5это самый быстрый.

Ответы:


37

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

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

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


Я выбрал этот, потому что он быстрее, чем у Дирка. У меня нет миллионов элементов, но это должно работать для меня немного быстрее.
kmm

@ Кевин: как насчет решения Джона? Он примерно в 10 раз быстрее, чем у Хэдли, и позволяет устанавливать допуск. Есть ли какой-то другой недостаток?
Джошуа Ульрих

Пожалуйста, проведите сравнительный анализ - я только что проверил, что у меня примерно то же самое для вектора из миллиона униформ.
hadley

@hadley: Я бежал system.time(for(i in 1:1e4) zero_range(x)), откуда xбыл из ОП. Решение Джона примерно в 10 раз для x, в ~ 3 раза быстрее yи немного медленнее для runif(1e6).
Джошуа Ульрих

10-кратная разница не имеет большого значения, когда вы смотрите на разницу между 0,00023 и 0,000023 секунд - и DWin, вероятно, заявит, что они одинаковы с указанной степенью допуска;)
Хэдли

46

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

var(x) == 0

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


17
length(unique(x))=1оказывается примерно в два раза быстрее, но varлаконичен, что приятно.
AdamO

YohanBadia, у меня есть массив c (-5.532456e-09, 1.695298e-09), и я понимаю, John test: TRUE ; DWin test: TRUE ; zero-range test: TRUE ; variance test: FALSEчто все остальные тесты распознают, что значения идентичны в R. Как можно использовать тест дисперсии в этом контексте?
mjs

2 значения в вашем массиве не идентичны. Почему вы хотите, чтобы тест вернулся TRUE? В случае ответа Джона вы проверяете, превышает ли разница определенный порог. В вашем случае разница между двумя значениями очень мала, что может привести к тому, что она окажется ниже установленного вами порога.
Йохан Обадиа

41

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

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

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

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

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

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

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


Можете ли вы прокомментировать относительные преимущества вычитания среднего по сравнению с делением на него?
hadley

Это проще в вычислительном отношении. В зависимости от системы и того, как R компилируется и векторизуется, это будет выполняться быстрее с меньшим энергопотреблением. Кроме того, когда вы делите на среднее значение, ваш тестируемый результат относительно 1, а при вычитании - 0, что мне кажется приятнее. Кроме того, допуск имеет более прямую интерпретацию.
Джон

1
Но дело даже не в том, что деление является сложным, поскольку поиск и сортировка, необходимые для извлечения диапазона, намного более затратны в вычислительном отношении, чем простое вычитание. Я тестировал его, и приведенный выше код примерно в 10 раз быстрее, чем функция zero_range Хэдли (и ваш ответ - это самый быстрый правильный ответ здесь). Функция сравнения у Дирка очень медленная. Это самый быстрый ответ.
Джон

Только что видел комментарии Джоша по времени в вашем ответе Хэдли ... У меня нет ситуаций, когда zero_range быстрее. Несоответствие между немного более быстрым (возможно, 20%) и 10-кратным всегда в пользу этого ответа. Было испробовано несколько способов.
Джон

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

Я не думаю, что это так хорошо работает для очень маленьких чисел:x <- seq(1, 10) / 1e10
hadley

2
@Hadley: ОП попросил решение, которое позволило бы указать допуск, по-видимому, потому, что его не волновали очень маленькие различия. all.equal можно использовать с другими допусками, и ОП, похоже, это понимает.
IRTFM

2
Я не очень четко выразился - в моем примере есть десятикратная относительная разница между наибольшим и наименьшим числами. Вероятно, вы хотите это заметить! Я думаю, что числовую погрешность необходимо вычислять относительно диапазона данных - я не делал этого в прошлом, и это вызывало проблемы.
hadley

2
Не думаю, что я вас неправильно понял. Я просто подумал, что спрашивающий просит решение, которое игнорировало бы десятикратную относительную разницу для чисел, которые фактически равны нулю. Я слышал, что он просил решения, которое игнорировало бы разницу между 1e-11 и 1e-13.
IRTFM

5
Я стараюсь дать людям то, что им нужно, а не то, что они хотят;) Но точка зрения принята.
hadley

17

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


Этот отличный, потому что он работает и со строками! Спасибо
arvi1000

1
Это работает, если NAв вашем векторе нет: x <- c(1,1,NA); all(x == x[1])return NA, not FALSE. В таких случаях length(unique(x)) == 1работает.
HBat

16

Вы можете использовать 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()мере необходимости.


2
Ужасно неэффективно ... (на моем компьютере миллион номеров занимает около 10 секунд)
Хэдли

2
Без сомнений. О.П. был , однако сомневается , что это может быть сделано на всех . Сделать это хорошо - второй шаг. И вы знаете, где я стою с петлями ... ;-)
Дирк Эддельбюттель

10
Какие петли классные? ;)
hadley

4
Что мне нравится в этом подходе, так это то, что его можно использовать с нечисловыми объектами.
Лучано Зельцер

compare <- function (v) all (sapply (as.list (v [-1]), FUN = function (z) {isTRUE (all.equal (z, v [1]))})
N. McA .

11

Поскольку я продолжаю возвращаться к этому вопросу снова и снова, вот 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

1
Это хорошо и +1 для скорости, но я не уверен, что сравнение всех элементов с 1-м элементом правильно. Вектор может пройти этот тест, но разница между max (x) и min (x) больше, чем точность. Напримерfast_equal(c(2,1,3), 1.5)
dww 06

@dww Что вы указывая, что сравнение не является транзитивным , если у вас есть вопросы точности - то есть a == b, b == cне обязательно означает , что a == cесли вы делаете сравнения с плавающей точкой. Вы можете либо разделить точность по количеству элементов , чтобы избежать этой проблемы, или изменить алгоритм для вычисления minи maxи использовать это как условие остановки.
eddi 06

10

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

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

4

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

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

3

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

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

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

Используя наш сайт, вы подтверждаете, что прочитали и поняли нашу Политику в отношении файлов cookie и Политику конфиденциальности.
Licensed under cc by-sa 3.0 with attribution required.