r 中列中最近邻值的平均值

Question

我在这里有一个数据框：

df <- data.frame("Time" = 1:10, "Value" = c(1.7,NA,-999,-999,1.5,1.6,NA,4,-999,8))

“NA”表示没有观察，将它们留在那里。 “-999”表示观察被识别为异常值。

现在我试图用最接近的值的平均值替换“-999”。 例如：

The first "-999" should be replaced with (1.7+1.5)/2 = 1.6
The second "-999" should be replaced with (1.7+1.5)/2 = 1.6
The last "-999" should be replaced with (4.0+8.0)/2 = 6

我尝试使用next语句来查找下一次迭代，并使用if语句来决定在哪里停止。 但是我怎样才能上去检查以前的迭代呢？ 或者是否有另一种解决方案？

非常感谢。

Answer 1

使用几个while循环，增加我们落后/领先的程度，我们可以实现这一点。 我不确定此操作在大型数据集上的性能如何。 但它似乎可以为您的示例数据完成工作。

# find where replacements and initialize
where_to_replace <- which(df$Value == -999)
len_replace <- length(where_to_replace)
lag_value <- rep(NA, len_replace)
lead_value <- rep(NA, len_replace)

# more initializing
i <- 1
lag_n <- 1
lead_n <- 1

while(i <= len_replace){
    # find appropriate lagged value
    # can't use NA or lag value == -999
    while(is.na(lag_value[i]) | lag_value[i] == -999){
        lag_value[i] <- dplyr::lag(df$Value, lag_n)[where_to_replace[i]]
        lag_n <- lag_n + 1
    }
    # find appropriate lead value
    # can't use NA or -999 as lead value
    while(is.na(lead_value[i]) | lead_value[i] == -999){
        lead_value[i] <- dplyr::lead(df$Value, lead_n)[where_to_replace[i]]
        lead_n <- lead_n + 1
    }
    # reset iterators   
    i <- i + 1
    lag_n <- 1
    lead_n <- 1
}
# replacement value
df$Value[where_to_replace] <- (lead_value + lag_value) / 2

#    Time Value
# 1     1   1.7
# 2     2    NA
# 3     3   1.6
# 4     4   1.6
# 5     5   1.5
# 6     6   1.6
# 7     7    NA
# 8     8   4.0
# 9     9   6.0
# 10   10   8.0

Answer 2

使用dplyr 、 purrr和tidyr一种方法可能是：

df %>%
 mutate(New_Value = if_else(Value == -999,
                            map_dbl(.x = seq_along(Value), 
                                    ~ mean(c(tail(na.omit(na_if(Value[1:(.x - 1)], -999)), 1),
                                             head(na.omit(na_if(Value[(.x + 1):n()], -999)), 1)))),
                            Value))

   Time  Value New_Value
1     1    1.7       1.7
2     2     NA        NA
3     3 -999.0       1.6
4     4 -999.0       1.6
5     5    1.5       1.5
6     6    1.7       1.7
7     7     NA        NA
8     8    4.0       4.0
9     9 -999.0       6.0
10   10    8.0       8.0

Answer 3

我创建了两个新的辅助列 - 之前和之后。 之前用顶部的下一个值填充每个 NA 和 -999，之后用下面的下一个值填充 NA 和 -999。 在下一步中，我用两个值的平均值覆盖了每个 -999。

df <- data.frame(Time = 1:10, 
                 Value = c(1.7, NA, -999, -999, 1.5,
                           1.6, NA,
                           4, -999, 8))


df <- df %>%
  mutate(before = recode(Value, `-999` = NA_real_),
         after = recode(Value, `-999` = NA_real_)) %>%
  fill(before, .direction = "down") %>%
  fill(after, .direction = "up") %>%
  mutate(Value = case_when(Value == -999 ~ (before + after)/2,
                           TRUE ~ Value)) %>%
  select(Time, Value)

输出

   Time Value
1     1   1.7
2     2    NA
3     3   1.6
4     4   1.6
5     5   1.5
6     6   1.6
7     7    NA
8     8   4.0
9     9   6.0
10   10   8.0

Answer 4

这是使用findInterval的基本 R 选项

x <- which(df$Value == -999)
y <- setdiff(which(!is.na(df$Value)),x)
ind <- findInterval(x,y)
dfout <- within(df,Value <- replace(Value,x,rowMeans(cbind(Value[y[ind]],Value[y[ind+1]]))))

以至于

> dfout
   Time Value
1     1   1.7
2     2    NA
3     3   1.6
4     4   1.6
5     5   1.5
6     6   1.6
7     7    NA
8     8   4.0
9     9   6.0
10   10   8.0

Answer 5

只要坚持使用基本的 R data.frames，我们就可以创建一个函数并在感兴趣的索引上使用sapply 。

outliers <- df$Value == -999 # Keep as logical for now
fillers <- which(!is.na(df$Value) & !outliers)
outliers <- which(outliers) # Now convert to indices; FALSE and NA do not appear
  
filled_outliers <- sapply(outliers, function(x) {
  before_ind = max(fillers[fillers < x]) # maximum INDEX before an outlier
  after_ind = min(fillers[fillers > x]) 
  
  0.5*(df$Value[before_ind] + df$Value[after_ind])
})
  
df[outliers, ] <- filled_outliers
  
df

给出：

   Time Value
1   1.0   1.7
2   2.0    NA
3   1.6   1.6
4   1.6   1.6
5   5.0   1.5
6   6.0   1.6
7   7.0    NA
8   8.0   4.0
9   6.0   6.0
10 10.0   8.0