如何将距离估算为一个值

Posted 2023-03-12

【中文标题】如何将距离估算为一个值

【英文标题】：how to impute the distance to a value

【发布时间】：2019-05-22 04:21:55

【问题描述】：

我想用“行距离”填充缺失值到最近的非 NA 值。换句话说，我如何将此示例数据框中的 x 列转换为 y 列？

#    x y
#1   0 0
#2  NA 1
#3   0 0
#4  NA 1
#5  NA 2
#6  NA 1
#7   0 0
#8  NA 1
#9  NA 2
#10 NA 3
#11 NA 2
#12 NA 1
#13  0 0

我似乎找不到 dplyr group_by 和 mutate row_number() 语句的正确组合来解决问题。我研究过的各种插补包专为使用统计数据和其他变量执行插补的更复杂场景而设计。

d<-data.frame(x=c(0,NA,0,rep(NA,3),0,rep(NA,5),0),y=c(0,1,0,1,2,1,0,1,2,3,2,1,0))

【参考方案1】：

这是使用data.table的一种方式

library(data.table)
setDT(d)
d[, out := pmin(cumsum(is.na(x)), rev(cumsum(is.na(x)))), by = rleid(is.na(x))]
d
#     x y out
# 1:  0 0   0
# 2: NA 1   1
# 3:  0 0   0
# 4: NA 1   1
# 5: NA 2   2
# 6: NA 1   1
# 7:  0 0   0
# 8: NA 1   1
# 9: NA 2   2
#10: NA 3   3
#11: NA 2   2
#12: NA 1   1
#13:  0 0   0

对于每组NAs，我们计算cumsum(is.na(x)) 的并行最小值及其相反。这是因为所有非NAs 组中的值都是0。如果您想继续使用data.frame，请致电setDF(d)。

除了计算cumsum(is.na(x)) 两次，我们还可以这样做

d[, out := 
  tmp <- cumsum(is.na(x))
  pmin(tmp, rev(tmp))
  , by = rleid(is.na(x))]

这可能会提高性能，但我没有测试。

---

使用dplyr 语法会这样读

library(dplyr)
d %>% 
  group_by(grp = data.table::rleid(is.na(x))) %>% 
  mutate(out = pmin(cumsum(is.na(x)), rev(cumsum(is.na(x))))) %>% 
  ungroup()
# A tibble: 13 x 4
#       x     y   grp   out
#   <dbl> <dbl> <int> <int>
# 1     0     0     1     0
# 2    NA     1     2     1
# 3     0     0     3     0
# 4    NA     1     4     1
# 5    NA     2     4     2
# 6    NA     1     4     1
# 7     0     0     5     0
# 8    NA     1     6     1
# 9    NA     2     6     2
#10    NA     3     6     3
#11    NA     2     6     2
#12    NA     1     6     1
#13     0     0     7     0

---

base R中的相同想法

rle_x <- rle(is.na(d$x))
grp <- rep(seq_along(rle_x$lengths), times = rle_x$lengths)

transform(d, out = ave(is.na(x), grp, FUN = function(i) pmin(cumsum(i), rev(cumsum(i)))))

【讨论】：

这是一个很好的解决方案

【参考方案2】：

我们可以使用

d$z = sapply(seq_along(d$x), function(z) min(abs(z - which(!is.na(d$x)))))
#     x y z
# 1   0 0 0
# 2  NA 1 1
# 3   0 0 0
# 4  NA 1 1
# 5  NA 2 2
# 6  NA 1 1
# 7   0 0 0
# 8  NA 1 1
# 9  NA 2 2
# 10 NA 3 3
# 11 NA 2 2
# 12 NA 1 1
# 13  0 0 0

如果您想在 dplyr 中执行此操作，只需将 sapply 部分包装在 mutate 中即可。

d %>%
   mutate(z = sapply(seq_along(x), function(z) min(abs(z - which(!is.na(x))))))

或者，也使用library(purrr)（感谢@Onyambu）：

d %>% mutate(m=map_dbl(1:n(),~min(abs(.x-which(!is.na(x))))))

【讨论】：

非常有用。然而，为了让我的问题简短而简单，我忘了提到我是 tidyverse 的忠实粉丝，理想情况下我会喜欢我可以在我的 dplyr 链中使用的东西。我怀疑我可以在我的链中使用这个解决方案，但我肯定不介意知道是否有“更整洁”的方法。

d%>%mutate(m = map_dbl(1:n(), ~min(abs(.x - which(!is.na(x))))))

【参考方案3】：

这里是使用vapply的解决方案

d$y <- 0
d$y[is.na(d$x)] <- vapply(which(diff(cumsum(is.na(d$x))) != 0), 
                          function (k) min(abs(which(diff(cumsum(is.na(d$x))) == 0) - k)), 
                          numeric(1))
d
    x y
1   0 0
2  NA 1
3   0 0
4  NA 1
5  NA 2
6  NA 1
7   0 0
8  NA 1
9  NA 2
10 NA 3
11 NA 2
12 NA 1
13  0 0

与

d <- structure(list(x = c(0, NA, 0, NA, NA, NA, 0, NA, NA, NA, NA, NA, 0)), 
               class = "data.frame", row.names = c(NA, -13L))