Эффективно заполнять НС по группам

Question

У меня есть набор данных, где я наблюдаю переменную для некоторых людей, а не для других. Для тех людей, где я наблюдаю переменную, я наблюдаю ее ровно один раз. Тем не менее, количество наблюдений на человека, а также положение наблюдаемого значения варьируется.

Я хотел бы заполнить все значения NA для данного индивидуума значением, отличным от NA, в случае, если есть значение, отличное от NA. В противном случае НС должны оставаться НС.

Вот пример набора данных:

#data.frame of 100 individuals with 10 observations each
data <- data.frame(group = rep(1:100,each=10),value = NA)

#first 50 individuals get a value at the fifth observation, others don't have value
data$value[seq(5,500,10)] <- rnorm(50)

Пока все хорошо, не большая проблема. Взятые из другого потока, мы могли бы сделать что-то подобное, используя dplyr и tidyr:

data <- data %>% 
  group_by(group) %>% #by group
  fill(value) %>% #default direction down
  fill(value, .direction = "up") #also fill NAs upwards

Это прекрасно решает проблему. Тем не менее, я должен сделать это около 80 миллионов. наблюдения, которые занимают часы. Есть ли более быстрый метод? Я думаю, что data.table может быть хорошим кандидатом.

Было бы также хорошо, если бы можно было адаптировать подход, чтобы заполнить только те NA, которые появляются перед значением.

Спасибо!

Answer 1

Вы можете использовать довольно простой подход как с data.table, так и с dplyr, который, я считаю, будет довольно быстрым и эффективным:

в data.table:

library(data.table)
setDT(data)
data[, value := value[!is.na(value)][1L], by = group]

или dplyr:

library(dplyr)
data <- data %>% 
  group_by(group) %>% 
  mutate(value = value[!is.na(value)][1L])

Дело в том, что у вас есть значение, отличное от NA, ровно o или 1 раз на группу. Следовательно, вам не нужна логика переноса последнего наблюдения. Просто возьмите первое не-NA значение (если оно существует).

Answer 2

Это код, который я использовал: Ваш код против Акрун против моего. Иногда зоопарк не самый быстрый процесс, но он самый чистый. Во всяком случае, вы можете проверить это.

UPDATE : Он был протестирован с большим количеством данных (100.000), и процесс 03 (подмножество и объединение) выиграл на сегодняшний день.

Последнее обновление Сравнение функций с rbenchmark:

library(dplyr)
library(tidyr)
library(base)
library(data.table)
library(zoo)
library(rbenchmark)

#data.frame of 100 individuals with 10 observations each
data <- data.frame(group = rep(1:10000,each=10),value = NA)
data$value[seq(5,5000,10)] <- rnorm(50) #first 50 individuals get a value at the fifth observation, others don't have value

#Process01
P01 <- function (data){
    data01 <- data %>% 
        group_by(group) %>% #by group
            fill(value) %>% #default direction down
            fill(value, .direction = "up") #also fill NAs upwards
    return(data01)
}

#Process02
P02 <- function (data){
    data02 <- setDT(data)[, value := na.locf(na.locf(value, na.rm = FALSE), 
                                             fromLast = TRUE), group]
    return(data02)
}

#Process03
P03 <- function (data){
    dataU <- subset(unique(data), value!='NA') #keep row number
    dataM <- merge(data, dataU, by = "group", all=T) #merge tables
    data03 <- data.frame(group=dataM$group, value = dataM$value.y) #idem shape of data
    return(data03)
}

benchmark("P01_dplyr" = {data01 <- P01(data)},
          "P02_zoo" = {data02 <- P02(data)},
          "P03_data.table" = {data03 <- P03(data)},
          replications = 10,
          columns = c("test", "replications", "elapsed")
          )

Результаты с данными = 10.000, 10 повторений и I5 7400:

    test replications elapsed
1      P01_dplyr           10  257.78
2        P02_zoo           10   10.35
3 P03_data.table           10    0.09

Answer 3

Мы могли бы использовать data.table для назначения на месте. Здесь na.locf из zoo используется для заполнения элементов NA соседним не-NA элементом

library(data.table)
library(zoo)
setDT(data)[, value := na.locf(na.locf(value, na.rm = FALSE), fromLast = TRUE), group]

Тесты

set.seed(24)
data1 <- data.frame(group = rep(1:1e6,each=10),value = NA)
data1$value[seq(5,1e6,10)] <- rnorm(100000)

data2 <- copy(data1)

system.time({setDT(data2)[, value := na.locf(na.locf(value, 
             na.rm = FALSE), fromLast = TRUE), group]})
#   user  system elapsed 
# 70.681   0.294  70.917 


system.time({

data1 %>% 
  group_by(group) %>% #by group
  fill(value) %>% #default direction down
  fill(value, .direction = "up")

})
# 17% ~33 m remaining 

ПРИМЕЧАНИЕ: это заняло много времени. Поэтому придется прервать сеанс.

ПРИМЕЧАНИЕ 2. Этот подход основан на предположении, что мы хотим заменить элементы NA соседними элементами, не являющимися NA, и иметь более одного элемента, не являющегося NA, на группу