web-dev-qa-db-ja.com

単一ベクトルのすべての要素間の等価性をテストします

ベクトルのすべての要素が互いに等しいかどうかをテストしようとしています。私が思いついた解決策は、どちらも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()は2つの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が最速のように見えます。

83
kmm

このメソッドを使用します。平均で除算した後、最小値と最大値を比較します。

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

これをもっと真剣に使用している場合は、おそらく範囲と平均を計算する前に欠損値を削除する必要があります。

32
hadley

それらがすべて数値の場合、tolが許容範囲である場合...

_all( abs(y - mean(y)) < tol ) 
_

あなたの問題の解決策です。

編集:

これと他の答えを見て、いくつかのことをベンチマークした後、DWinの答えの2倍の速さで次のことが明らかになりました。

_abs(max(x) - min(x)) < tol
_

diffは、2つの数値を持つ_-_およびabsとそれほど違わないはずなので、これはdiff(range(x))よりも少し驚くほど高速です。範囲を要求すると、最小値と最大値の取得が最適化されます。 diffrangeは両方ともプリミティブ関数です。しかし、タイミングは嘘ではありません。

36
John

単に分散を使用しないのはなぜですか:

var(x) == 0

xのすべての要素が等しい場合、0の分散が得られます。

30
Yohan Obadia
> 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
20
42-

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()に任意のイプシロンを追加できます。

13

私は何度もこの質問に戻ってくるので、答えが実際にRcppである場合、一般にRソリューションよりもはるかに高速になるFALSEソリューションがあります。 (不一致に遭遇した瞬間に停止するため)、答えがTRUEの場合、最速のRソリューションと同じ速度になります。たとえば、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
10
eddi

これ専用の関数を作成しました。ベクトル内の要素だけでなく、リスト内のすべての要素がidenticalであるかどうかもチェックできます。もちろん、文字ベクトルと他のすべてのタイプのベクトルもうまく処理します。また、適切なエラー処理も備えています。

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
7
Lawrence Lee

実際には、min、mean、またはmaxを使用する必要はありません。ジョンの答えに基づいて:

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

ここでは、データフレームの場合に、最小、最大トリックを使用する代替方法を示します。この例では、列を比較していますが、applyのmarginパラメーターを行の1に変更できます。

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

valid == 0その後、すべての要素は同じです

2
pedrosaurio