как заполнить пропущенные значения в векторе средним значением до и после пропущенного - PullRequest
Новая
       94

как заполнить пропущенные значения в векторе средним значением до и после пропущенного

3 голосов
/ 14 февраля 2020

В настоящее время я пытаюсь вменять значения в вектор в R. Условия вменения:

  • Найти все значения NA
  • Затем проверьте, есть ли у них существующее значение до и после них
  • Также проверьте, больше ли значение, следующее за NA, чем значение до NA
  • Если условия соблюдены, рассчитайте среднее значение, принимая значения до и после.
  • Заменить значение NA на вмененное значение 
# example one
input_one = c(1,NA,3,4,NA,6,NA,NA)

# example two
input_two = c(NA,NA,3,4,5,6,NA,NA)

# example three
input_three = c(NA,NA,3,4,NA,6,NA,NA)

Я начал писать код для определения значений, которые можно вменять. Но я застрял со следующим. 

# incomplete function to detect the values
sapply(split(!is.na(input[c(rbind(which(is.na(c(input)))-1, which(is.na(c(input)))+1))]), 
             rep(1:(length(!is.na(input[c(which(is.na(c(input)))-1, which(is.na(c(input)))+1)]))/2), each = 2)), all)

Это, однако, обнаруживает только NA, которые могут быть вменяемыми, и работает только с примером один. Он неполный и, к сожалению, очень трудный для чтения и понимания.

Любая помощь с этим будет высоко оценена.

Ответы [ 4 ]

1 голос
/ 14 февраля 2020

Вот пример использования библиотеки imputeTS. Он учитывает более одного NA в последовательности, обеспечивает вычисление среднего значения, если следующее действительное наблюдение больше, чем последнее действительное наблюдение, а также игнорирует NA в начале и конце. 

library(imputeTS)
myimpute <- function(series) {
    # Find where each NA is
    nalocations <- is.na(series)
    # Find the last and the previous observation for each row
    last1 <- lag(series)
    next1 <- lead(series)
    # Carry forward the last and next observations over sequences of NA
    # Each row will then get a last and next that can be averaged
    cflast <- na_locf(last1, na_remaining = 'keep')
    cfnext <- na_locf(next1, option = 'nocb', na_remaining = 'keep')
    # Make a data frame 
    df <- data.frame(series, nalocations, last1, cflast, next1, cfnext)
    # Calculate the mean where there is currently a NA
    # making sure that the next is greater than the last
    df$mean <- ifelse(df$nalocations, ifelse(df$cflast < df$cfnext, (df$cflast+df$cfnext)/2, NA), NA)
    imputedseries <- ifelse(df$nalocations, ifelse(!is.na(df$mean), df$mean, NA), series)
    #list(df,  imputedseries) # comment this in and return it to see the intermediate data frame for debugging
    imputedseries
}
myimpute(c(NA,NA,3,4,NA,NA,6,NA,NA,8,NA,7,NA,NA,9,NA,11,NA,NA))

# [1] NA NA  3  4  5  5  6  7  7  8 NA  7  8  8  9 10 11 NA NA
1 голос
/ 14 февраля 2020

Для этого мы можем использовать функции dplyr s lag и lead: 

input_three = c(NA,NA,3,4,NA,6,NA,NA)

library(dplyr)
ifelse(is.na(input_three) & lead(input_three) > lag(input_three),
       (lag(input_three)  + lead(input_three))/ 2,
       input_three)

Возвраты: 

[1] NA NA  3  4  5  6 NA NA

Редактировать

Объяснение:

Мы используем ifelse, который является векторизованной версией if. Т.е. все в пределах ifelse будет применено к каждому элементу векторов. Сначала мы проверяем, являются ли элементы NA и является ли следующий элемент> предыдущим. Чтобы получить предыдущий и следующий элемент, мы можем использовать функции dplyr lead и lag:

lag смещает вектор вправо (по умолчанию 1 шаг): 

lag(1:5)

Возвращает: 

[1] NA  1  2  3  4

lead смещает вектор влево: 

lead(1:5)

Возвращает: 

[1]  2  3  4  5 NA

Теперь к «тесту» предложение ifelse: 

is.na(input_three) & lead(input_three) > lag(input_three)

, которое возвращает: 

[1]    NA    NA FALSE FALSE  TRUE FALSE    NA    NA

Тогда, если предложение ifelse оценивается как TRUE, мы хотим вернуть сумму предыдущего и следующего элемент, деленный на 2, в противном случае возвращает исходный элемент

0 голосов
/ 15 февраля 2020

В пакете imputeTS также имеется функция na_ma для вычисления скользящих средних.

В вашем случае это будет со следующими настройками:

na_ma(x, k = 1, weighting = "simple")

  • k = 1 (имеется в виду 1 значение до и 1 после принятия NA во внимание)
  • weighting = "simple" (среднее из этих двух значений вычислено)

Это может быть применено довольно просто, в основном с 1 строкой кода: 

library(imputeTS)
na_ma(yourData, k = 1, weighting = "simple")

Вы также можете принять больше значений до и после NA, например, k = 3. Интересной особенностью, если принять во внимание более 1 значения для каждой стороны, является возможность выбора различных весовых коэффициентов, например, с помощью weighting = "linear" при уменьшении весовых коэффициентов в арифметической прогрессии (линейное взвешенное скользящее среднее) - это означает, что чем дальше их значения будут удалены АН тем меньше влияния они оказывают.

0 голосов
/ 14 февраля 2020

Вот альтернатива, которая использует zoo::rollapply(): 

library(zoo)

fill_sandwiched_na <- function(f) rollapply(f, 3, FUN = function(x) {
  y <- mean(x[-2]); if(is.na(y)) x[2] else y
}, fill = NA, partial = TRUE)

fill_sandwiched_na(input_one)
[1]  1  2  3  4  5  6 NA NA

fill_sandwiched_na(input_two)
[1] NA NA  3  4  5  6 NA NA

fill_sandwiched_na(input_three)
[1] NA NA  3  4  5  6 NA NA
...