Тест на равенство всех элементов одного вектора
Я пытаюсь проверить, все ли элементы вектора равны друг другу. Решения, которые я придумал, кажутся несколько окольными, как с проверкой 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
самый быстрый.
9 ответов:
Я использую этот метод, который сравнивает min и max, после деления на среднее:
# 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)) }
Если бы вы использовали это более серьезно, вы, вероятно, захотите удалить отсутствующие значения перед вычислением диапазона и среднего значения.
если все они числовые значения, то если tol-это ваш допуск...
all( abs(y - mean(y)) < tol )
- это решение вашей проблемы.
EDIT:
после просмотра этого и других ответов и сравнения нескольких вещей следующее выходит в два раза быстрее, чем ответ DWin.
abs(max(x) - min(x)) < tol
это немного удивительно быстрее, чем
diff(range(x))
Сdiff
не должно сильно отличаться от-
иabs
С двумя числами. Запрос диапазона должен оптимизировать получение минимума и максимума. Обаdiff
иrange
примитивные функции. Но время не обманывает.
почему бы просто не использовать дисперсию:
var(x) == 0
Если все элементы
x
равны, вы получите дисперсию0
.
> 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
можно использовать
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