kmm*_*kmm 88 equality r vector
我正在尝试测试向量的所有元素是否彼此相等.我提出的解决方案似乎有点迂回,都涉及检查length().
x <- c(1, 2, 3, 4, 5, 6, 1) # FALSE
y <- rep(2, times = 7) # TRUE
Run Code Online (Sandbox Code Playgroud)
用unique():
length(unique(x)) == 1
length(unique(y)) == 1
Run Code Online (Sandbox Code Playgroud)
用rle():
length(rle(x)$values) == 1
length(rle(y)$values) == 1
Run Code Online (Sandbox Code Playgroud)
一个允许我包含容差值的解决方案,用于评估元素之间的"平等",这是避免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)
Run Code Online (Sandbox Code Playgroud)
结果如下:
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
Run Code Online (Sandbox Code Playgroud)
所以看起来diff(range(x)) < .Machine$double.eps ^ 0.5最快.
Joh*_*ohn 39
如果它们都是数值,那么如果tol是你的容差那么......
all( abs(y - mean(y)) < tol )
Run Code Online (Sandbox Code Playgroud)
是你的问题的解决方案.
编辑:
在查看了这个和其他答案,并对一些事情进行基准测试之后,以下内容的速度是DWin答案的两倍.
abs(max(x) - min(x)) < tol
Run Code Online (Sandbox Code Playgroud)
这是一个令人惊讶的一点速度比diff(range(x)),因为diff不应该是远远不同-,并abs用两个数字.请求范围应优化获得最小值和最大值.这两个diff和range是原始的功能.但时间不是谎言.
Yoh*_*dia 35
为什么不简单地使用方差:
var(x) == 0
Run Code Online (Sandbox Code Playgroud)
如果所有元素x相等,则会得到方差0.
had*_*ley 34
我使用这个方法,在除以平均值后比较最小值和最大值:
# 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))
}
Run Code Online (Sandbox Code Playgroud)
如果你更认真地使用它,你可能想要在计算范围和平均值之前删除缺失的值.
May*_*evy 24
你可以检查 all(v==v[1])
42-*_*42- 21
> isTRUE(all.equal( max(y) ,min(y)) )
[1] TRUE
> isTRUE(all.equal( max(x) ,min(x)) )
[1] FALSE
Run Code Online (Sandbox Code Playgroud)
另一条沿着同样的路线:
> diff(range(x)) < .Machine$double.eps ^ 0.5
[1] FALSE
> diff(range(y)) < .Machine$double.eps ^ 0.5
[1] TRUE
Run Code Online (Sandbox Code Playgroud)
Dir*_*tel 14
您可以使用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>
Run Code Online (Sandbox Code Playgroud)
这样你可以identical()根据需要添加任何epsilon .
edd*_*ddi 10
由于我一遍又一遍地回到这个问题,这里的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
Run Code Online (Sandbox Code Playgroud)
我专门为此编写了一个函数,它不仅可以检查向量中的元素,还可以检查列表中的所有元素是否相同.当然它也可以很好地处理字符向量和所有其他类型的向量.它也有适当的错误处理.
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
}
}
Run Code Online (Sandbox Code Playgroud)
现在尝试一些例子.
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
Run Code Online (Sandbox Code Playgroud)
小智 5
您实际上并不需要使用 min、mean 或 max。基于约翰的回答:
all(abs(x - x[[1]]) < tolerance)
Run Code Online (Sandbox Code Playgroud)