按 R 中的最小欧氏距离匹配

Question

我有以下数据集：

X <- data.frame(PERMNO = c(10001,10002,10003,10001,10002,10003),
                Date = c("Nov 2021","Nov 2021","Nov 2021","Dec 2021","Dec 2021","Dec 2021"),
                     ME = c(100,95,110,110,115,108),
                     IVOL = c(1,1.1,0.8,0.7,1,2.1),
                     C = c(NA, 2, 3,NA, 4, 1.5))

对于公司 10001，缺少 C。我想每个月通过使用具有非缺失 C 的公司匹配来自其他公司的 C 来填充 C，从而最小化排名 ME 和排名 IVOL 与缺失公司的欧氏距离：

我申请中的X有更多的PERMNOs和更长的时间范围，并且可能有多个公司缺少C。我的问题是如何在 R 中有效地编码。

使用 rank() 可以直接获得排名，如果我是正确的，可以使用 outer() 计算欧氏距离。然而，我努力制作公司 i 和 j 的对，然后选择最小距离，然后将公司 j 的 C 匹配到公司 i 的缺失 C。

Answer 1

也许这有帮助：

library(tidyverse)

X <- data.frame(
  PERMNO = c(10001, 10002, 10003, 10001, 10002, 10003),
  Date = c("Nov 2021", "Nov 2021", "Nov 2021", "Dec 2021", "Dec 2021", "Dec 2021"),
  ME = c(100, 95, 110, 110, 115, 108),
  IVOL = c(1, 1.1, 0.8, 0.7, 1, 2.1),
  C = c(NA, 2, 3, NA, 4, 1.5)
) %>% as_tibble()
X
#> # A tibble: 6 x 5
#>   PERMNO Date        ME  IVOL     C
#>    <dbl> <chr>    <dbl> <dbl> <dbl>
#> 1  10001 Nov 2021   100   1    NA  
#> 2  10002 Nov 2021    95   1.1   2  
#> 3  10003 Nov 2021   110   0.8   3  
#> 4  10001 Dec 2021   110   0.7  NA  
#> 5  10002 Dec 2021   115   1     4  
#> 6  10003 Dec 2021   108   2.1   1.5

imputations <-
  X %>%
  rename_all(~ paste0(.x, ".1")) %>%
  expand_grid(X %>% rename_all(~ paste0(., ".2"))) %>%
  mutate(
    dist = sqrt((rank(ME.1) - rank(ME.2))**2 + (rank(IVOL.1) - rank(IVOL.2))**2)
  ) %>%
  group_by(PERMNO.1) %>%
  filter(PERMNO.1 != PERMNO.2) %>%
  arrange(dist) %>%
  slice(1) %>%
  ungroup() %>%
  transmute(
    PERMNO = PERMNO.1,
    imputed.C = case_when(
      !is.na(C.1) ~ C.1,
      !is.na(C.2) ~ C.2
    )
  )
imputations
#> # A tibble: 3 x 2
#>   PERMNO imputed.C
#>    <dbl>     <dbl>
#> 1  10001         3
#> 2  10002         2
#> 3  10003         3

X %>%
  left_join(imputations) %>%
  mutate(C = ifelse(is.na(C), imputed.C, C)) %>%
  select(-imputed.C)
#> Joining, by = "PERMNO"
#> # A tibble: 6 x 5
#>   PERMNO Date        ME  IVOL     C
#>    <dbl> <chr>    <dbl> <dbl> <dbl>
#> 1  10001 Nov 2021   100   1     3  
#> 2  10002 Nov 2021    95   1.1   2  
#> 3  10003 Nov 2021   110   0.8   3  
#> 4  10001 Dec 2021   110   0.7   3  
#> 5  10002 Dec 2021   115   1     4  
#> 6  10003 Dec 2021   108   2.1   1.5

^{由 reprex package (v2.0.0)}

于 2022-02-18 创建

Answer 2

使用 Rfast 包中的 colMins 的 data.table 解决方案。

library(data.table)

X <- data.frame(PERMNO = c(10001,10002,10003,10001,10002,10003),
                Date = c("Nov 2021","Nov 2021","Nov 2021","Dec 2021","Dec 2021","Dec 2021"),
                ME = c(100,95,110,110,115,108),
                IVOL = c(1,1.1,0.8,0.7,1,2.1),
                C = c(NA, 2, 3, NA, 4, 1.5))

fFillNA <- function(C, ME, IVOL) {
  idxNA <- which(is.na(C))
  C[idxNA] <- C[-idxNA][Rfast::colMins(outer(ME[-idxNA], ME[idxNA], "-")^2 + outer(IVOL[-idxNA], IVOL[idxNA], "-")^2)]
  C
}

setDT(X)[, C := if(anyNA(C)) fFillNA(C, ME, IVOL), by = "Date"]
X
#>    PERMNO     Date  ME IVOL   C
#> 1:  10001 Nov 2021 100  1.0 2.0
#> 2:  10002 Nov 2021  95  1.1 2.0
#> 3:  10003 Nov 2021 110  0.8 3.0
#> 4:  10001 Dec 2021 110  0.7 1.5
#> 5:  10002 Dec 2021 115  1.0 4.0
#> 6:  10003 Dec 2021 108  2.1 1.5

最小距离指标无需开平方。另外，请注意，由于相对大小，ME 对距离计算的影响远大于 IVOL，至少对于示例数据集而言。也许考虑在距离计算中归一化 ME 和 IVOL。

按 R 中的最小欧氏距离匹配

Match by minimum Euclidean distance in R

r

euclidean-distance