ทดสอบความเท่าเทียมกันระหว่างองค์ประกอบทั้งหมดของเวกเตอร์เดียว

ฉันกำลังพยายามทดสอบว่าองค์ประกอบทั้งหมดของเวกเตอร์มีค่าเท่ากันหรือไม่ 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

วิธีการแก้ปัญหาที่จะให้ฉันมีค่าความอดทนในการประเมิน 'ความเท่าเทียมกันในหมู่องค์ประกอบจะเหมาะที่จะหลีกเลี่ยงคำถามที่พบบ่อย 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จะเร็วที่สุด

ฉันใช้วิธีนี้ซึ่งเปรียบเทียบค่าต่ำสุดและสูงสุดหลังจากหารด้วยค่าเฉลี่ย:

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

หากคุณใช้สิ่งนี้อย่างจริงจังมากขึ้นคุณอาจต้องการลบค่าที่ขาดหายไปก่อนที่จะคำนวณช่วงและค่าเฉลี่ย

ทำไมไม่ใช้ความแปรปรวน:

var(x) == 0

ถ้าองค์ประกอบทั้งหมดของมีค่าเท่ากันคุณจะได้รับความแปรปรวนของx0

ถ้าเป็นค่าตัวเลขทั้งหมดถ้า tol ​​คือความอดทนของคุณแล้วล่ะก็ ...

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

เป็นทางออกสำหรับปัญหาของคุณ

แก้ไข:

หลังจากดูคำตอบนี้และคำตอบอื่น ๆ และการเปรียบเทียบบางสิ่งต่อไปนี้จะพบว่าเร็วกว่าคำตอบ DWin ถึงสองเท่า

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

นี้เป็นบิตที่น่าแปลกใจได้เร็วกว่าdiff(range(x))เนื่องจากdiffไม่ควรจะแตกต่างกันมากกว่า-และabsด้วยตัวเลขสอง การขอช่วงควรเพิ่มประสิทธิภาพการรับค่าต่ำสุดและสูงสุด ทั้งสองdiffและrangeเป็นฟังก์ชันดั้งเดิม แต่เวลาไม่โกหก

> 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

คุณสามารถตรวจสอบ all(v==v[1])

คุณสามารถใช้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> 

ด้วยวิธีนี้คุณสามารถเพิ่ม epsilon ได้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

คุณไม่จำเป็นต้องใช้ค่าต่ำสุดค่าเฉลี่ยหรือสูงสุด จากคำตอบของ John:

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

นี่เป็นอีกทางเลือกหนึ่งโดยใช้เคล็ดลับขั้นต่ำสูงสุด แต่สำหรับกรอบข้อมูล ในตัวอย่างฉันกำลังเปรียบเทียบคอลัมน์ แต่พารามิเตอร์ระยะขอบจากapplyสามารถเปลี่ยนเป็น 1 สำหรับแถวได้

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

ถ้าvalid == 0องค์ประกอบทั้งหมดเหมือนกัน