编写通过最高相似性匹配列名称的代码/函数

如何解决编写通过最高相似性匹配列名称的代码/函数

我有五个数据集，随着时间的推移，它们涵盖了相同的主题。

library(data.table)
DT <- data.table(A= round(rnorm(10,10,10),2),B= round(rnorm(10,C= round(rnorm(10,2))
DT_2 <- data.table(A= round(rnorm(10,D= round(rnorm(10,2))
DT_3 <- DT
DT_4 <- DT_2
DT_5 <- DT_2
names(DT)   <- c("something","nothing","anything")
names(DT_2) <- c("some thing","no thing","any thing","number4")
names(DT_3) <- c("some thing wrong","anything_")
names(DT_4) <- c("something","nothingg","anything","number_4")
names(DT_5) <- c("something","anything happening","number4")

但是，每年都有一些不同。列的名称略有更改，添加了一些列，并删除了一些列。我想“捆绑”这些数据集。但是，每个数据集都有大约100列，而手动使所有列名称保持一致将很困难。

编辑：请注意，这些列不一定具有相同的索引，例如下面的已编辑列名称中的情况，其中DT_2具有列XXX。

# EDIT
names(DT)<- c("something","number4")
names(DT_2)<- c("some thing","XXX","number4")
names(DT_3)<- c("some thing wrong","anything_")
names(DT_4)<- c("something","number_4")
names(DT_5)<- c("something","number4")

我认为编写一个函数为我做一个更好的主意。

我曾经问过某功能类似here的函数的帮助。以下函数将变量名的大写和非大写版本的列合并在一起，而未指定变量名。

非常整洁，它另外指定了合并了哪些var名称。

library(data.table)
library(magrittr) # piping is used to improve readability
names(DT_panel) %>% 
  data.table(orig = .,lc = tolower(.)) %>% 
  .[,{
    if (.N > 1L) {
      new <- toupper(.BY)
      old <- setdiff(orig,new)
      DT_panel[,(new) := fcoalesce(.SD),.SDcols = orig]
      DT_panel[,(old) := NULL]
      sprintf("Coalesced %s onto %s",toString(old),new)
    }
  },by = lc]

此外，我发现了这个问题here，该问题基于列条目进行模糊连接。

library(fuzzyjoin); library(dplyr);

stringdist_join(a,b,by = "name",mode = "left",ignore_case = FALSE,method = "jw",max_dist = 99,distance_col = "dist") %>%
  group_by(name.x) %>%
  top_n(1,-dist)

问题是我对这两种解决方案都不足够了解，无法将它们组合成一个提供所需解决方案的功能。

有人可以帮助我开始吗？我想要的输出如下：

DT <- data.table(A= round(rnorm(10,2))
D <- c(NA,NA,NA)
DT_3 <- DT
DT_4 <- DT_2
DT_5 <- DT_2
DT <- cbind(DT,D)
DT_3 <- cbind(DT_3,D)
DT <- rbind (DT,DT_2,DT_3,DT_4,DT_5)
names(DT) <- c("something","number4")

解决方法

此方法基于fuzzyjoin::stringdist_join。它可以处理新列和已删除列。

从一些虚拟数据开始。

library(tidyverse)

df1 <- tibble("something" = 1,"nothing" = 2,"anything" = 3,"number4" = 4)
df2 <- tibble("some thing" = 1,"no thing" = 2,"XXX" = 99,"number4" = 4)
df3 <- tibble("some thing wrong" = 1,"anything_" = 4)
df4 <- tibble("something" = 1,"nothingg" = 2,"anything" = 2,"number_4" = 4,"YYY" = 100)
df5 <- tibble("something" = 1,"anything happening" = 2,"number4" = 4)

fuzzy_rowbind模糊合并两个数据帧。它使用fuzzyjoin::stringdist_join来标识最相似的列。第二个数据框的列被重命名并合并。

fuzzy_rowbind <- function(a,b,method = "cosine",max_dist = 0.9999) {
  a_name_df <- tibble(name = names(a))
  b_name_df <- tibble(name = names(b))
  
  fj <- 
    fuzzyjoin::stringdist_join(
      a_name_df,b_name_df,by = "name",mode = "left",ignore_case = FALSE,method = method,max_dist = max_dist,distance_col = "dist"
    ) %>%
    arrange(dist)
  
  name_mapping <- NULL
  while (nrow(fj) > 0 && !all(b_name_df$name %in% name_mapping$name.y)) {
    name_mapping <- bind_rows(name_mapping,fj %>% slice(1))
    
    fj <- fj %>% filter(!name.x %in% name_mapping$name.x,!name.y %in% name_mapping$name.y)
  }
  
  new_names <- setNames(name_mapping$name.y,name_mapping$name.x)
  
  b_renamed <- rename(b,new_names[!is.na(new_names)])
  
  enframe(new_names,name = "new_name",value = "original_name") %>%
    filter(new_name != original_name,!is.na(new_name)) %>%
    as.data.frame() %>%
    print()
  cat("\n")
  
  bind_rows(a,b_renamed)
}

例如，当我们将df1和df2结合在一起时，会发生以下情况。

fuzzy_rowbind(df1,df2)
#>    new_name original_name
#> 1 something    some thing
#> 2   nothing      no thing
#> 
#> # A tibble: 2 x 5
#>   something nothing anything number4   XXX
#>       <dbl>   <dbl>    <dbl>   <dbl> <dbl>
#> 1         1       2        3       4    NA
#> 2         1       2       NA       4    99

接下来，定义fuzzy_rowbind_all，它可以获取数据帧列表并将它们组合在一起。

fuzzy_rowbind_all <- function(l) {
  last(accumulate(l,fuzzy_rowbind))
}

此处fuzzy_rowbind_all用于我们的数据帧。

fuzzy_rowbind_all(
  lst(df1,df2,df3,df4,df5)
)
#>    new_name original_name
#> 1 something    some thing
#> 2   nothing      no thing
#> 
#>    new_name    original_name
#> 1  anything        anything_
#> 2 something some thing wrong
#> 
#>   new_name original_name
#> 1  nothing      nothingg
#> 2  number4      number_4
#> 
#>   new_name      original_name
#> 1 anything anything happening
#> 
#> # A tibble: 5 x 6
#>   something nothing anything number4   XXX   YYY
#>       <dbl>   <dbl>    <dbl>   <dbl> <dbl> <dbl>
#> 1         1       2        3       4    NA    NA
#> 2         1       2       NA       4    99    NA
#> 3         1       2        4      NA    NA    NA
#> 4         1       2        2       4    NA   100
#> 5         1       2        2       4    NA    NA