left_join фрейм данных несколько раз на разных ключах

Question

У меня есть фрейм данных, назначающий код (2-й столбец) географическим областям в первом столбце (может быть страна, континент или более крупная область), а затем еще 3 столбца, указывающие код географической области, в которой находится географическая область. первый столбец принадлежит, например:

library(dplyr)

area <- c('Earth','Europe','Eurasia','Spain','Germany','North America','Latin America','Americas','US','Canada','Brazil','Argentina','Asia','Japan')
code <- c(0,1000,100,1100,1200,2000,2500,200,2100,2200,2600,2700,3000,3100)
level_1 <- as.numeric(c(NA,1000,NA,1000,1000,2000,2500,NA,2000,2000,2500,2500,3000,3000))
level_2 <- as.numeric(c(NA,100,100,100,100,200,200,200,200,200,200,200,100,100))
level_3 <- as.numeric(c(0,0,0,0,0,0,0,0,0,0,0,0,0,0))

data <- data.frame(area,code,level_1, level_2, level_3, stringsAsFactors = F)

Теперь я хочу добавить названия географических областей из столбца level_1 в level_3. Это мое решение:

data2 <- data %>% select(area,code)

final <- data %>%
  left_join(data2, by = c('level_1' = 'code')) %>%
  left_join(data2, by = c('level_2' = 'code')) %>%
  left_join(data2, by = c('level_3' = 'code'))

Я получаю следующее, что выглядит неплохо:

       country.x code level_1 level_2 level_3     country.y country.x.x country.y.y
1          Earth    0      NA      NA       0          <NA>        <NA>       Earth
2         Europe 1000    1000     100       0        Europe     Eurasia       Earth
3        Eurasia  100      NA     100       0          <NA>     Eurasia       Earth
4          Spain 1100    1000     100       0        Europe     Eurasia       Earth
5        Germany 1200    1000     100       0        Europe     Eurasia       Earth
6  North America 2000    2000     200       0 North America    Americas       Earth
7  Latin America 2500    2500     200       0 Latin America    Americas       Earth
8       Americas  200      NA     200       0          <NA>    Americas       Earth
9             US 2100    2000     200       0 North America    Americas       Earth
10        Canada 2200    2000     200       0 North America    Americas       Earth
11        Brazil 2600    2500     200       0 Latin America    Americas       Earth
12     Argentina 2700    2500     200       0 Latin America    Americas       Earth
13          Asia 3000    3000     100       0          Asia     Eurasia       Earth
14         Japan 3100    3000     100       0          Asia     Eurasia       Earth

Но мне интересно, нет ли более разумного способа сделать это, особенно как в моя настоящая задача, мне нужно сделать более 3 left_joins, какие-либо мысли?

У меня было go ниже, но это не работает, поскольку аргумент 'by' ожидает простую строку, я думаю ...

df <- data
for (i in 1:3) {
  df <- left_join(df, data2, by = c(paste0('level_',i) = 'code'), na_matches = 'never')
}

Answer 1

Это можно было бы сделать более простым способом, перебрав в цикле level столбцы в mutate с помощью across, получив индекс, где он match с столбцом 'code', используйте это для подмножества соответствующего ' площадь ',

library(dplyr)# 1.0.0
data1 <- data %>%
         mutate(across(starts_with('level'),  ~area[match(., code)],
           .names = 'country{col}'))
data1
#            area code level_1 level_2 level_3 countrylevel_1 countrylevel_2 countrylevel_3
#1          Earth    0      NA      NA       0           <NA>           <NA>          Earth
#2         Europe 1000    1000     100       0         Europe        Eurasia          Earth
#3        Eurasia  100      NA     100       0           <NA>        Eurasia          Earth
#4          Spain 1100    1000     100       0         Europe        Eurasia          Earth
#5        Germany 1200    1000     100       0         Europe        Eurasia          Earth
#6  North America 2000    2000     200       0  North America       Americas          Earth
#7  Latin America 2500    2500     200       0  Latin America       Americas          Earth
#8       Americas  200      NA     200       0           <NA>       Americas          Earth
#9             US 2100    2000     200       0  North America       Americas          Earth
#10        Canada 2200    2000     200       0  North America       Americas          Earth
#11        Brazil 2600    2500     200       0  Latin America       Americas          Earth
#12     Argentina 2700    2500     200       0  Latin America       Americas          Earth
#13          Asia 3000    3000     100       0           Asia        Eurasia          Earth
#14         Japan 3100    3000     100       0           Asia        Eurasia          Earth

Или в base R, мы делаем то же самое logi c, перебирая столбцы 'level' в lapply, затем получаем индекс с помощью match и получаем соответствующую 'область'

nm1 <- grep('^level_\\d+$', names(data), value = TRUE)
data[paste0('country', 1:3)] <- lapply(data[nm1], function(x) 
                 data$area[match(x, data$code)])

Или без зацикливания путем преобразования в matrix

data[paste0('country', seq_along(nm1))] <- matrix(data$area[match(as.matrix(data[nm1]), 
          data$code)], ncol = length(nm1))