Menguji kesetaraan di antara semua elemen vektor tunggal

Saya mencoba untuk menguji apakah semua elemen vektor sama satu sama lain. Solusi yang saya temukan tampaknya agak tidak langsung, keduanya melibatkan pemeriksaan length().

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

Dengan unique():

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

Dengan rle():

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

Solusi yang memungkinkan saya menyertakan nilai toleransi untuk menilai 'kesetaraan' di antara elemen akan ideal untuk menghindari masalah FAQ 7.31 .

Apakah ada fungsi bawaan untuk jenis pengujian yang telah saya abaikan sepenuhnya? identical()dan all.equal()membandingkan dua objek R, sehingga tidak akan berfungsi di sini.

Edit 1

Berikut beberapa hasil benchmarking. Menggunakan kode:

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)

Dengan hasil:

          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

Jadi sepertinya diff(range(x)) < .Machine$double.eps ^ 0.5yang tercepat.

Saya menggunakan metode ini, yang membandingkan min dan max, setelah membagi dengan cara:

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

Jika Anda menggunakan ini lebih serius, Anda mungkin ingin menghapus nilai yang hilang sebelum menghitung kisaran dan mean.

Mengapa tidak hanya menggunakan varians:

var(x) == 0

Jika semua elemen xsama, Anda akan mendapatkan varian sebesar 0.

Jika semuanya nilai numerik maka jika tol adalah toleransi Anda maka ...

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

adalah solusi untuk masalah Anda.

EDIT:

Setelah melihat ini, dan jawaban lainnya, dan membandingkan beberapa hal berikut ini keluar dua kali lebih cepat dari jawaban DWin.

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

Ini sedikit mengejutkan lebih cepat daripada diff(range(x))karena diffseharusnya tidak jauh berbeda dari -dan absdengan dua angka. Meminta kisaran harus mengoptimalkan mendapatkan minimum dan maksimum. Keduanya diffdan rangemerupakan fungsi primitif. Tapi waktunya tidak berbohong.

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

Lainnya di sepanjang garis yang sama:

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

Anda dapat menggunakan identical()dan all.equal()dengan membandingkan elemen pertama dengan elemen lainnya, secara efektif menyapu perbandingan di:

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> 

Dengan cara itu Anda dapat menambahkan epsilon apa pun identical()sesuai kebutuhan.

Anda tinggal memeriksanya all(v==v[1])

Karena saya terus kembali ke pertanyaan ini berulang kali, berikut adalah Rcppsolusi yang umumnya akan jauh lebih cepat daripada Rsolusi mana pun jika jawabannya benar-benar FALSE(karena itu akan berhenti saat menemui ketidakcocokan) dan akan memiliki kecepatan yang sama sebagai solusi R tercepat jika jawabannya adalah TRUE. Misalnya untuk benchmark OP, system.timeclock tepat 0 menggunakan fungsi ini.

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

Saya menulis fungsi khusus untuk ini, yang tidak hanya dapat memeriksa elemen dalam vektor, tetapi juga mampu memeriksa apakah semua elemen dalam daftar identik . Tentu saja itu juga menangani vektor karakter dan semua jenis vektor lainnya dengan baik. Ini juga memiliki penanganan kesalahan yang tepat.

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

Sekarang coba beberapa contoh.

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

Anda sebenarnya tidak perlu menggunakan min, mean, atau max. Berdasarkan jawaban John:

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

Di sini alternatif menggunakan trik min, max tetapi untuk bingkai data. Dalam contoh saya membandingkan kolom tetapi parameter margin dari applydapat diubah menjadi 1 untuk baris.

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

Jika valid == 0kemudian semua elemennya sama