Функция R для восстановления после отказа в left_join?

Question

У меня есть более 20 различных таблиц данных с данными, проиндексированными одной и той же системой кодирования (Североамериканская система отраслевой классификации, NAICS), которую я хочу объединить в одну таблицу.

Проблема в том, что в каждой таблице доступны разные уровни детализации, и когда я присоединяюсь, я хочу найти лучшее совпадение, отказывая в иерархии системы кодирования до тех пор, пока совпадение не будет найдено.

Обычный left_join не будет работать, потому что не всегда будет точное совпадение. Я посмотрел на пакет fuzzyjoin, но это немного над моей головой.

Хочу начать с таблицы кодов:

t_master
# A tibble: 360 x 1
   NAICS17
   <chr>  
 1 311111 
 2 311119 
 3 311211 
 4 311212 
 5 311213 
 6 311221 
 7 311224 
 8 311225 
 9 311230 
10 311313 
# ... with 350 more rows

t_master <- structure(list(NAICS17 = c(311111L, 311119L, 311211L, 311212L, 
311213L, 311221L, 311224L, 311225L, 311230L, 311313L)), row.names = c(NA, 
-10L), class = "data.frame")

, а затем переберите все остальные таблицы, чтобы найти наилучшее из доступных совпадений в каждой из них, а затем объедините все переменные. Иногда это просто, потому что есть точное совпадение (311111 и 311119 из t_asm будут соединены с 311111 и 311119 в t_master):

t_asm
# A tibble: 8,167 x 3
   NAICS17 CEXBLD   CEXMCH  
   <chr>   <chr>    <chr>   
 1 31-33   16806796 96986337
 2 311     2099542  9063451 
 3 3111    92429    517196  
 4 31111   92429    517196  
 5 311111  49756    225494  
 6 311119  42673    291702  
 7 3112    192911   1016770 
 8 31121   75310    267693  
 9 31121M  75310    267693  
10 31122   94339    546407  
# ... with 8,157 more rows

t_asm <- structure(list(NAICS17 = c("31-33", "311", "3111", "31111", "311111", 
"311119", "3112", "31121", "31121M", "31122"), CEXBLD = c("16806796", 
"2099542", "92429", "92429", "49756", "42673", "192911", "75310", 
"75310", "94339"), CEXMCH = c("96986337", "9063451", "517196", 
"517196", "225494", "291702", "1016770", "267693", "267693", 
"546407")), row.names = c(NA, -10L), class = c("tbl_df", "tbl", 
"data.frame"))

Но иногда я хочу, чтобы он искал лучшее совпадение, даже если это менее детально (311 из t_brdis_2015 будет присоединен к 311111 и 311119 в t_master)

t_brdis_2015
# A tibble: 90 x 3
   NAICS17 rdcost_total rdcost_wage
   <chr>   <chr>        <chr>      
 1 0       355821       204170     
 2 31      236132       129375     
 3 32      236132       129375     
 4 33      236132       129375     
 5 311     4838         2945       
 6 312     1002         532        
 7 313     748          481        
 8 314     748          481        
 9 315     748          481        
10 316     748          481        
# ... with 80 more rows

t_brdis_2015 <- structure(list(NAICS17 = c("0", "31", "32", "33", "311", "312", 
"313", "314", "315", "316"), rdcost_total = c("355821", "236132", 
"236132", "236132", "4838", "1002", "748", "748", "748", "748"
), rdcost_wage = c("204170", "129375", "129375", "129375", "2945", 
"532", "481", "481", "481", "481")), class = c("tbl_df", "tbl", 
"data.frame"), row.names = c(NA, -10L))

Это было бы левое соединение, я хочу, чтобы все наблюдения t_master были объединены только одним наблюдением из других таблиц данных.

Метод возврата был бы (на примере 311111):

• Попробуйте 311111
• Попробуйте 31111
• Попробуйте 3111
• Попробуйте 311
• Попробуйте 31
• Попробуйте 3
• Возврат NA

Спасибо и дайте мне знать, если что-то из этого не ясно.

Answer 1

Я бы сделал последовательность обновлений:

library(data.table)

ncs  = seq_len(max(nchar(t_master$NAICS17)))
nms  = copy(names(t_asm))
xnms = sprintf("x.%s", nms)
tnms = replace(nms, nms == "NAICS17", "m")

t_asm2 <- data.table(t_asm)
out = data.table(t_master)
out[, NAICS17 := as.character(NAICS17)]
out[, m := NA_character_]
for (nc in rev(ncs)){
  out[is.na(m), target := substr(NAICS17, 1, nc)]
  out[is.na(m), 
    (tnms) := t_asm2[.SD, on=.(NAICS17 = target), mget(xnms)][]
  ]
  if (!anyNA(out$m)) break
}
out[, target := NULL][]

    NAICS17      m  CEXBLD  CEXMCH
 1:  311111 311111   49756  225494
 2:  311119 311119   42673  291702
 3:  311211  31121   75310  267693
 4:  311212  31121   75310  267693
 5:  311213  31121   75310  267693
 6:  311221  31122   94339  546407
 7:  311224  31122   94339  546407
 8:  311225  31122   94339  546407
 9:  311230   3112  192911 1016770
10:  311313    311 2099542 9063451

m - значение, которое было сопоставлено; target - это значение, которое мы пытаемся найти в текущей итерации цикла. Итерации работают в обратном направлении, начиная с самого длинного кода. (Посмотрите на rev(ncs), который повторяется.)

При фильтрации до is.na(m) мы пропускаем строки, которые были сопоставлены на предыдущих итерациях. Тест anyNA(out$m) позволяет нам выйти рано, если каждая строка соответствует.

copy - это всего лишь мера, позволяющая избежать проблем, отмеченных в Почему data.table обновляет имена (DT) по ссылке, даже если я назначаю другую переменную?