Как расширить поведение `==` к векторам, которые содержат NA?
Я полностью не смог найти другую r-help или Stack Переполнение обсуждения этой конкретной проблемы. Извините, если это где-то очевидно. Я считаю, что я просто ищу самый простой способ получить знак R ==, чтобы никогда не возвращать NA.
# Example #
# Say I have two vectors
a <- c( 1 , 2 , 3 )
b <- c( 1 , 2 , 4 )
# And want to test if each element in the first
# is identical to each element in the second:
a == b
# It does what I want perfectly:
# TRUE TRUE FALSE
# But if either vector contains a missing,
# the `==` operator returns an incorrect result:
a <- c( 1 , NA , 3 )
b <- c( 1 , NA , 4 )
# Here I'd want TRUE TRUE FALSE
a == b
# But I get TRUE NA FALSE
a <- c( 1 , NA , 3 )
b <- c( 1 , 2 , 4 )
# Here I'd want TRUE FALSE FALSE
a == b
# But I get TRUE NA FALSE again.
Я получаю результат, который я хочу:
mapply( `%in%` , a , b )
Но mapply кажется мне тяжелым.
Есть ли более интуитивное решение?
Ответы
Ответ 1
Другой вариант, но лучше, чем mapply('%in%', a, b):
(!is.na(a) & !is.na(b) & a==b) | (is.na(a) & is.na(b))
Следуя предложению @AnthonyDamico, создание оператора "mutt":
"%==%" <- function(a, b) (!is.na(a) & !is.na(b) & a==b) | (is.na(a) & is.na(b))
Изменение: или, немного другую и более короткую версию @Frank (что также более эффективно)
"%==%" <- function(a, b) (is.na(a) & is.na(b)) | (!is.na(eq <- a==b) & eq)
С различными примерами:
a <- c( 1 , 2 , 3 )
b <- c( 1 , 2 , 4 )
a %==% b
# [1] TRUE TRUE FALSE
a <- c( 1 , NA , 3 )
b <- c( 1 , NA , 4 )
a %==% b
# [1] TRUE TRUE FALSE
a <- c( 1 , NA , 3 )
b <- c( 1 , 2 , 4 )
a %==% b
#[1] TRUE FALSE FALSE
a <- c( 1 , NA , 3 )
b <- c( 3 , NA , 1 )
a %==% b
#[1] FALSE TRUE FALSE
Ответ 2
Вы можете попробовать
replace(a, is.na(a), Inf)==replace(b, is.na(b), Inf)
Или более быстрый вариант, предложенный @docendo discimus
replace(a, which(is.na(a)), Inf)==replace(b, which(is.na(b)), Inf)
На основе различных сценариев
1.
a <- c( 1 , 2 , 3 )
b <- c( 1 , 2 , 4 )
akrun1()
#[1] TRUE TRUE FALSE
2.
a <- c( 1 , NA , 3 )
b <- c( 1 , NA , 4 )
akrun1()
#[1] TRUE TRUE FALSE
3.
a <- c( 1 , NA , 3 )
b <- c( 1 , 2 , 4 )
akrun1()
#[1] TRUE FALSE FALSE
Ориентиры
set.seed(24)
a <- sample(c(1:10, NA), 1e6, replace=TRUE)
b <- sample(c(1:20, NA), 1e6, replace=TRUE)
akrun1 <- function() {replace(a, is.na(a), Inf)==replace(b, is.na(b), Inf)}
cathG <- function() {(!is.na(a) & !is.na(b) & a==b) | (is.na(a) & is.na(b))}
anthony <- function() {mapply('%in%', a, b)}
webb <- function() {ifelse(is.na(a),is.na(b),a==b)}
docend <- function() {replace(a, which(is.na(a)), Inf)==replace(b,
which(is.na(b)), Inf)}
library(microbenchmark)
microbenchmark(akrun1(), cathG(), anthony(), webb(),docend(),
unit='relative', times=20L)
#Unit: relative
# expr min lq mean median uq max
# akrun1() 3.050200 3.035625 3.007196 2.963916 2.977490 3.083658
# cathG() 4.829972 4.893266 4.843585 4.790466 4.816472 4.939316
# anthony() 190.499027 224.389971 215.792965 217.647702 215.503308 212.356051
# webb() 14.000363 14.366572 15.412527 14.095947 14.671741 19.735746
# docend() 1.000000 1.000000 1.000000 1.000000 1.000000 1.000000
# neval cld
# 20 a
# 20 a
# 20 c
# 20 b
# 20 a
Ответ 3
Предполагая, что мы не имеем большого относительного числа NA, предлагаемое векторизованное решение отбрасывает некоторые ресурсы, сравнивая значения, которые уже были урегулированы с помощью a==b.
Обычно мы можем предположить, что NAs мало, поэтому сначала стоит вычислять a==b а затем обрабатывать NAs отдельно, несмотря на дополнительные шаги и временные переменные:
'%==%' <- function(a,b){
x <- a==b
na_x <- which(is.na(x))
x[na_x] <- is.na(a[na_x]) & is.na(b[na_x])
x
}
Проверить выход
a <- c( 1 , 2 , 3 )
b <- c( 1 , 2 , 4 )
a %==% b
# [1] TRUE TRUE FALSE
a <- c( 1 , NA , 3 )
b <- c( 1 , NA , 4 )
a %==% b
# [1] TRUE TRUE FALSE
a <- c( 1 , NA , 3 )
b <- c( 1 , 2 , 4 )
a %==% b
# [1] TRUE FALSE FALSE
Ориентиры
Я воспроизвожу ниже тест @akrun с самыми быстрыми решениями и n = 100.
set.seed(24)
a <- sample(c(1:10, NA), 1e6, replace=TRUE)
b <- sample(c(1:20, NA), 1e6, replace=TRUE)
mm <- function(){
x <- a==b
na_x <- which(is.na(x))
x[na_x] <- is.na(a[na_x]) & is.na(b[na_x])
x
}
akrun1 <- function() {replace(a, is.na(a), Inf)==replace(b, is.na(b), Inf)}
cathG <- function() {(!is.na(a) & !is.na(b) & a==b) | (is.na(a) & is.na(b))}
docend <- function() {replace(a, which(is.na(a)), Inf)==replace(b, which(is.na(b)), Inf)}
library(microbenchmark)
microbenchmark(mm(),akrun1(),cathG(),docend(),
unit='relative', times=100L)
# Unit: relative
# expr min lq mean median uq max neval
# mm() 1.000000 1.000000 1.000000 1.000000 1.000000 1.0000000 100
# akrun1() 1.667242 1.884185 1.815392 1.642581 1.765238 0.9973017 100
# cathG() 2.447168 2.449597 2.118306 2.201346 2.358105 1.1421577 100
# docend() 1.683817 1.950970 1.756481 1.745400 2.007889 1.2264461 100
Расширение ==
Поскольку исходный вопрос действительно найти:
самый простой способ получить знак R == чтобы никогда не возвращать NAs
Здесь путь, в котором мы определяем новый класс na_comparable. Только один из векторов должен быть этого класса, поскольку другой будет принужден к нему.
na_comparable <- setClass("na_comparable", contains = "numeric")
'==.na_comparable' <- function(a,b){
x <- unclass(a) == unclass(b) # inefficient but I don't know how to force the default '=='
na_x <- which(is.na(x))
x[na_x] <- is.na(a[na_x]) & is.na(b[na_x])
x
}
'!=.na_comparable' <- Negate('==.na_comparable')
a <- na_comparable(a)
a == b
# [1] TRUE TRUE FALSE
b == a
# [1] TRUE TRUE FALSE
a != b
# [1] FALSE FALSE TRUE
b != a
# [1] FALSE FALSE TRUE
В цепочке dplyr это удобно использовать следующим образом:
data.frame(a=c(1,NA,3),b=c(1,NA,4)) %>%
mutate(a = na_comparable(a),
c = a==b,
d= a!=b)
# a b c d
# 1 1 1 TRUE FALSE
# 2 NA NA TRUE FALSE
# 3 3 4 FALSE TRUE
При таком подходе, если вам нужно обновить код для учетной записи NAs, которые ранее отсутствовали, вы можете установить один единственный вызов na_comparable вместо преобразования исходных данных или замены всего вашего == на %==% вниз по строке.
Ответ 4
Как насчет использования identical(), завернутого в mapply()
a <- c( 1 , 2 , 3 )
b <- c( 1 , 2 , 4 )
mapply(identical,a,b)
#[1] TRUE TRUE FALSE
a <- c( 1 , NA , 3 )
b <- c( 1 , NA , 4 )
mapply(identical,a,b)
#[1] TRUE TRUE FALSE
a <- c( 1 , NA , 3 )
b <- c( 1 , 2 , 4 )
mapply(identical,a,b)
#[1] TRUE FALSE FALSE
Кроме того, если вам нужно сравнить результаты вычислений, вы можете избавиться от identical() и пойти с isTRUE(all.equal()), как это сделать
mapply(FUN=function(x,y){isTRUE(all.equal(x,y))}, a, b)
который дает те же результаты, но может лучше решать проблемы округления.
Например,
a<-.3/3
b<-.1
mapply(FUN=function(x,y){isTRUE(all.equal(x,y))}, a, b)
#[1] TRUE
mapply(identical,a,b)
#[1] FALSE
Я думаю, что этот последний пример испортил бы много предлагаемых решений, но переход на all.equal вместо ==, вероятно, будет работать для всех из них.
