Подсчет конечных и ведущих NA для каждого вектора

У меня есть несколько векторов в следующем формате

    v1 <- c(NA,NA,NA,10,10,10,10)
    v2 <- c(NA,NA, 3, 3, 3,NA,NA)
    v3 <- c( 5, 5, NA,NA,NA,NA,NA)

Для каждого вектора я хочу рассчитать, сколько ведущих NA и конечных NA.

    For v1, LeadNA = 3, TrailNA = 0
    For v2, LeadNA = 2, TrailNA = 2
    For v3, LeadNA = 0, TrailNA = 5

r vector na
person Afiq Johari    schedule 15.09.2019    source источник

Ответы (5)


arrow_upward
6
arrow_downward

1) Cumsum. Можно создать логический вектор с cumsum при наличии элементов, отличных от NA, и получить sum (base R — пакеты не используются)

f1 <- function(vec, trail = FALSE) {
  if(trail) {
     vec <- rev(vec)
    }
    sum(!cumsum(!is.na(vec)))
 }

f1(v1)
#[1] 3
f1(v1, TRUE)
#[1] 0

sapply(mget(paste0("v", 1:3)), f1)
#  v1 v2 v3 
# 3  2  0 
sapply(mget(paste0("v", 1:3)), f1, TRUE)  
#  v1 v2 v3 
#  0  2  5

2 rle — еще один вариант base R — rle (пакеты не используются).

with(rle(is.na(v2)), lengths[values & seq_along(values) %in% c(1, length(values))])
person akrun    schedule 15.09.2019

arrow_upward
2
arrow_downward

Это похоже на решение @Bulat.

count_nas <- function(x) {
  nas <- is.na(x)

  if (sum(nas) == length(x)) {
    warning('all elements were NA')
    return(c(start_na = NA_integer_, end_na = NA_integer_))
  }

  c(start_na = which.min(nas) - 1,
    end_na = which.min(rev(nas)) - 1)
}

count_nas(v1)
#start_na   end_na 
#       3        0 

sapply(list(v1,v2,v3), count_nas)
#         [,1] [,2] [,3]
#start_na    3    2    0
#end_na      0    2    5

Что касается производительности, это самый быстрый метод, а методы @akrun находятся на приблизительном уровне.

v_test3 <- sample(10000)
v_test3[c(1:3, 9998:10000)] <- NA_integer_

Unit: microseconds
             expr     min       lq      mean   median       uq     max neval
     akrun_cumsum   175.7   182.15   193.580   186.55   200.80   354.7   100
        akrun_rle   168.6   199.25   210.635   209.25   221.00   289.3   100
    g_grothen_zoo  1848.5  1904.45  2008.994  1941.40  2001.35  4799.6   100
 g_grothen_reduce 12467.3 12888.10 14174.157 13445.15 15054.35 28241.6   100
        www_rleid  5357.2  5439.40  5741.471  5517.15  5947.15  8470.4   100
   bulat_and_cole    63.5    66.45    73.681    71.25    75.75    96.9   100

Код для воспроизводимости:

library(microbenchmark)
library(zoo)
library(data.table)

v_test3 <- sample(10000)
v_test3[c(1:3, 9998:10000)] <- NA_integer_

count_nas <- function(x) {
  nas <- is.na(x)

  if (sum(nas) == length(x)) {
    warning('all elements were NA')
    return(c(start_na = NA_integer_, end_na = NA_integer_))
  }

  c(start_na = which.min(nas) - 1,
    end_na = which.min(rev(nas)) - 1)
}

countNA <- function(x) {
  len <- function(fromLast = FALSE) length(na.locf(x, fromLast = fromLast))
  if (all(is.na(x))) c(left = NA, right = NA)
  else length(x) - c(left = len(), right = len(TRUE))
}

f1 <- function(vec, trail = FALSE) {
  if(trail) {
    vec <- rev(vec)
  }
  sum(!cumsum(!is.na(vec)))
}

count_fun <- function(x){
  y <- rleid(x)
  z <- split(x, y)[c(1, length(unique(y)))]
  ans <- sapply(z, function(x) sum(is.na(x)))
  return(unname(ans))
}

countNA2 <- function(x) {
  f <- function(x) sum(Reduce(all, is.na(x), acc = TRUE))
  if (all(is.na(x))) c(left = NA, right = NA)
  else c(left = f(x), right = f(rev(x)))
}

microbenchmark(
  akrun_cumsum = {
    f1(v_test3, TRUE)
    f1(v_test3, FALSE)
  }
  , 
  akrun_rle = {
    with(rle(is.na(v_test3)), lengths[values & seq_along(values) %in% c(1, length(values))])
  }
  ,
  g_grothen_zoo = {
    countNA(v_test3)
  }
  ,
  g_grothen_reduce = {
    countNA2(v_test3)
  }
  ,
  www_rleid = {
    count_fun(v_test3)
  }
  ,
  bulat_and_cole = {
    count_nas(v_test3)
  }
)
person Cole    schedule 16.09.2019

arrow_upward
2
arrow_downward

Обертка над which.max:

leading.nas <- function(x) {
  if (length(x) == 0) {
   0L 
  }
  else {
    which.min(!is.na(x)) - 1
  }
}
person Bulat    schedule 15.09.2019
comment
Можно также использовать which.min - person G. Grothendieck; 15.09.2019

arrow_upward
1
arrow_downward

Функция возвращает два числа. Первый - это количество ведущих NA. Второй — это количество завершающих NA. Для этого требуется функция rleid из пакета data.table.

library(data.table)

count_fun <- function(x){
  y <- rleid(x)
  z <- split(x, y)[c(1, length(unique(y)))]
  ans <- sapply(z, function(x) sum(is.na(x)))
  return(unname(ans))
}

count_fun(v1)
# [1] 3 0

count_fun(v2)
# [1] 2 2

count_fun(v3)
# [1] 0 5
person www    schedule 15.09.2019

arrow_upward
1
arrow_downward

1) na.locf Удалите ведущие NA, используя na.locf, и определите разницу в длине между исходным и сокращенным вектором. Сделайте то же самое для замыкающих NA. Непонятно, что должно быть возвращено, если входной вектор пуст или все NA, поэтому мы возвращаем NA как для левого, так и для правого.

library(zoo)

countNA <- function(x) {
  len <- function(fromLast = FALSE) length(na.locf(x, fromLast = fromLast))
  if (all(is.na(x))) c(left = NA, right = NA)
  else length(x) - c(left = len(), right = len(TRUE))
}

countNA(v1)
##  left right 
##     3     0 

countNA(v2)
##  left right 
##     2     2 

countNA(v3)
##  left right 
##     0     5

Также можно было бы использовать na.fill для выполнения этого вычисления.

2) Уменьшить Второй подход заключается в использовании Reduce. Он дает тот же ответ. Пакеты не используются.

countNA2 <- function(x) {
  f <- function(x) sum(Reduce(all, is.na(x), acc = TRUE))
  if (all(is.na(x))) c(left = NA, right = NA)
  else c(left = f(x), right = f(rev(x)))
}
person G. Grothendieck    schedule 15.09.2019