Преобразование значений NA на основе первой регистрации и ближайших значений

Question

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

У меня есть такие данные:

Date 1   Date 2    Date 3    Date 4    Date 5   Date 6
A  NA       0.1       0.2       NA        0.3    0.2
B  0.1      NA        NA        0.3       0.2    0.1
C  NA       NA        NA        NA        0.3    NA
D  0.1      0.2       0.3       NA        0.1    NA
E  NA       NA        0.1       0.2       0.1    0.3

Я хотел бы изменить значения NA моих данных, основываясь на первой дате, когда значение зарегистрировано. Так, например, для А первая регистрация - Дата 2. Затем я хочу, чтобы перед этой регистрацией значения NA в А были равны 0, а после первой регистрации значения NA стали средними значениями ближайших значений (среднее значение даты 3). и 5).

Если последним значением является NA, преобразуйте его в последнее зарегистрированное значение (как в C и D). В случае E все значения NA станут 0.

Получите что-то вроде этого:

Date 1   Date 2    Date 3    Date 4    Date 5   Date 6 
A  0       0.1       0.2        0.25      0.3    0.2
B  0.1     0.2       0.2        0.3       0.2    0.1
C  0       0         0          0         0.3    0.3
D  0.1     0.2       0.3        0.2       0.1    0.1
E  0       0         0.1        0.2       0.1    0.3

Вы можете мне помочь? Я не уверен, как это сделать в R.

Answer 1

Вот еще один вариант с базой R + rollmean из zoo (в данном случае явно легко переписать в базу R с размером окна k = 2).

t(apply(df, 1, function(x) {
  means <- c(0, rollmean(na.omit(x), 2), tail(na.omit(x), 1))
  replace(x, is.na(x), means[1 + cumsum(!is.na(x))[is.na(x)]])
}))
#   Date1 Date2 Date3 Date4 Date5 Date6
# A   0.0   0.1   0.2  0.25   0.3   0.2
# B   0.1   0.2   0.2  0.30   0.2   0.1
# C   0.0   0.0   0.0  0.00   0.3   0.3
# D   0.1   0.2   0.3  0.20   0.1   0.1
# E   0.0   0.0   0.1  0.20   0.1   0.3

---

Объяснение . Предположим, что x является первой строкой df:

#   Date1 Date2 Date3 Date4 Date5 Date6
# A    NA   0.1   0.2    NA   0.3   0.2

Тогда

means
# [1] 0.00 0.15 0.25 0.25 0.20

является вектором 0, скользящим средним из двух следующих не-NA элементов и последнего не-NA элемента. Тогда все, что нам нужно сделать, это replace те элементы x, которые is.na(x). Мы заменим их элементами means по индексам 1 + cumsum(!is.na(x))[is.na(x)]. Это самая сложная часть. Здесь

cumsum(!is.na(x))
# [1] 0 1 2 2 3 4

Это означает, что первый элемент x видел 0 не-NA элементов, в то время как, скажем, последний видел 4 не-NA элемента. Тогда

cumsum(!is.na(x))[is.na(x)]
# [1] 0 2

- это те элементы NA в x, которые мы хотим заменить. Обратите внимание, что тогда

1 + cumsum(!is.na(x))[is.na(x)]
# [1] 1 3

соответствует элементам means, которые мы хотим использовать для замены.

Answer 2

Это еще один возможный ответ, используя na.locf из пакета zoo. Редактировать: apply на самом деле не требуется; Это решение заполняет последнее наблюдаемое значение, если это значение отсутствует.

# create the dataframe
Date1 <- c(NA,.1,NA,NA)
Date2 <- c(.1, NA,NA,NA)
Date3 <- c(.2,NA,NA,.1)
Date4 <- c(NA,.3,NA,.2)
Date5 <- c(.3,.2,.3,.1)
Date6 <- c(.1,NA,NA,NA)
df <- as.data.frame(cbind(Date1,Date2,Date3,Date4,Date5,Date6))
rownames(df) <- c('A','B','C','D')

> df
  Date1 Date2 Date3 Date4 Date5 Date6
A    NA   0.1   0.2    NA   0.3   0.1
B   0.1    NA    NA   0.3   0.2    NA
C    NA    NA    NA    NA   0.3    NA
D    NA    NA   0.1   0.2   0.1    NA



# Load library
library(zoo)
df2 <- t(na.locf(t(df),na.rm = F)) # fill last observation carried forward
df3 <- t(na.locf(t(df),na.rm = F, fromLast = T)) # last obs carried backward

df4 <- (df2 + df3)/2 # mean of both dataframes

df4 <- t(na.locf(t(df4),na.rm = F)) # fill last observation carried forward
df4[is.na(df4)] <- 0 # NA values are 0

  Date1 Date2 Date3 Date4 Date5 Date6
A   0.0   0.1   0.2  0.25   0.3   0.1
B   0.1   0.2   0.2  0.30   0.2   0.2
C   0.0   0.0   0.0  0.00   0.3   0.3
D   0.0   0.0   0.1  0.20   0.1   0.1

Answer 3

Я считаю, что приведенная ниже функция слишком сложна, но она работает, и вот она.

fun <- function(x){
  if(anyNA(x)){
    inx <- which(!is.na(x))
    if(inx[1] > 1) x[seq_len(inx[1] - 1)] <- 0
    prev <- inx[1]
    for(i in inx[-1]){
      if(i - prev > 1){
        m <- mean(c(x[i], x[prev]))
        while(prev < i){
          x[prev] <- m
          prev <- prev + 1
        }
      }
      prev <- i
    }
  }
  x
}

res <- t(apply(df1, 1, fun))
res <- as.data.frame(res)
res
#  Date.1 Date.2 Date.3 Date.4 Date.5
#A    0.0    0.1   0.25   0.25    0.3
#B    0.2    0.2   0.20   0.30    0.2
#C    0.0    0.0   0.00   0.00    0.3
#E    0.0    0.0   0.10   0.20    0.1

Данные.

df1 <- read.table(text = "
Date.1   Date.2    Date.3    Date.4    Date.5
A  NA       0.1       0.2       NA        0.3
B  0.1      NA        NA        0.3       0.2
C  NA       NA        NA        NA        0.3
E  NA       NA        0.1       0.2       0.1                  
", header = TRUE)

Answer 4

Вот способ использования na.approx из пакета zoo и apply с MARGIN = 1 (так что это, вероятно, не очень эффективно, но сделайте свою работу).

library(zoo)
df1 <- as.data.frame(t(apply(dat, 1, na.approx, method = "constant", f = .5, na.rm = FALSE)))

В результате

df1
#   V1  V2  V3   V4  V5
#A  NA 0.1 0.2 0.25 0.3
#B 0.1 0.2 0.2 0.30 0.2
#C  NA  NA  NA   NA 0.3
#E  NA  NA 0.1 0.20 0.1

Заменить NA s и переименовать столбцы.

df1[is.na(df1)] <- 0
names(df1) <- names(dat)
df1
#  Date_1 Date_2 Date_3 Date_4 Date_5
#A    0.0    0.1    0.2   0.25    0.3
#B    0.1    0.2    0.2   0.30    0.2
#C    0.0    0.0    0.0   0.00    0.3
#E    0.0    0.0    0.1   0.20    0.1

---

Объяснение

Учитывая вектор

x <- c(0.1, NA, NA, 0.3, 0.2)
na.approx(x)

возвращает x с линейными интерполированными значениями

#[1] 0.1000000 0.1666667 0.2333333 0.3000000 0.2000000

Но OP запросил постоянные значения, поэтому нам нужен аргумент method = "constant" из функции approx.

na.approx(x, method = "constant") 
# [1] 0.1 0.1 0.1 0.3 0.2

Но это все-таки не то, что запрашивал OP, потому что он переносит последнее наблюдение вперед, в то время как вы хотите получить среднее значение для ближайших не NA значений. Поэтому нам нужен аргумент f (также из approx)

na.approx(x, method = "constant", f = .5)
# [1] 0.1 0.2 0.2 0.3 0.2 # looks good

С ?approx

f: для method = "constant" число от 0 до 1 включительно, указывающее на компромисс между пошаговыми функциями слева и справа. Если y0 и y1 являются значениями слева и справа от точки, то значение равно y0, если f == 0, y1, если f == 1, и y0 * (1-f) + y1 * f для промежуточных значений. Таким образом, результат является непрерывным справа для f == 0 и непрерывным слева для f == 1, даже для не конечных значений y.

Наконец, если мы не хотим заменять NA s в начале и конце каждой строки, нам нужно na.rm = FALSE.

С ?na.approx

na.rm: логично. Если результат (сплайновой) интерполяции все еще приводит к NA, должны ли они быть удалены?

Данные

dat <- structure(list(Date_1 = c(NA, 0.1, NA, NA), Date_2 = c(0.1, NA, 
NA, NA), Date_3 = c(0.2, NA, NA, 0.1), Date_4 = c(NA, 0.3, NA, 
0.2), Date_5 = c(0.3, 0.2, 0.3, 0.1)), .Names = c("Date_1", "Date_2", 
"Date_3", "Date_4", "Date_5"), class = "data.frame", row.names = c("A", 
"B", "C", "E"))

EDIT

Если в последнем столбце есть NA s, мы можем заменить их на последние не-1066 * s перед тем, как применить na.approx, как показано выше.

dat$Date_6[is.na(dat$Date_6)] <- dat[cbind(1:nrow(dat),
                                           max.col(!is.na(dat), ties.method = "last"))][is.na(dat$Date_6)]