如何按SurveyId匹配并合并两个R数据框列表中的对应数据框？

我有两个R数据框列表extract2_HW和extract_hw_help，原本是用rdhs包的rbind_labelled将两个列表里的所有数据框合并后，执行以下合并操作：

Results <- merge(comb_extract_hw_help, 
                 comb_extract_HW,  by.x = c("hhid", "hvidx", "SurveyId"),
                 by.y =c("hwhhid", "hwline", "SurveyId"), all.x = TRUE)

但现在我希望保留列表结构，先按数据框中的SurveyId匹配两个列表里的对应数据框，再对每一对匹配的数据框执行左连接：

Results <- merge(extract_hw_help[[对应名称]], 
                 extract2_HW[[对应名称]],  by.x = c("hhid","hvidx"),
                 by.y =c("hwhhid", "hwline"), all.x = TRUE)

最终得到一个以SurveyId为分组的合并后数据框列表，该如何实现？

要实现按SurveyId匹配列表元素并逐一合并，可按以下步骤操作：

步骤1：为列表元素按SurveyId命名 #

首先提取每个数据框的唯一SurveyId，将其设为对应列表元素的名称，确保两个列表的元素能通过SurveyId对应：

# 为extract_hw_help列表命名
names(extract_hw_help) <- sapply(extract_hw_help, function(df) unique(df$SurveyId))
# 为extract2_HW列表命名
names(extract2_HW) <- sapply(extract2_HW, function(df) unique(df$SurveyId))

步骤2：筛选共同的SurveyId #

找出两个列表中都存在的SurveyId，确保只处理匹配的数据对：

common_surveys <- intersect(names(extract_hw_help), names(extract2_HW))

步骤3：逐一合并匹配的数据框 #

方法1：用purrr包实现（简洁高效） #

library(purrr)

merged_list <- map2(extract_hw_help[common_surveys], 
                    extract2_HW[common_surveys],
                    function(df1, df2) {
                      merge(df1, df2, 
                            by.x = c("hhid", "hvidx"),
                            by.y = c("hwhhid", "hwline"),
                            all.x = TRUE)
                    })

方法2：基础R循环实现 #

若不想依赖purrr包，可使用基础R循环：

merged_list <- list()
for(survey in common_surveys) {
  df1 <- extract_hw_help[[survey]]
  df2 <- extract2_HW[[survey]]
  merged_list[[survey]] <- merge(df1, df2,
                                 by.x = c("hhid", "hvidx"),
                                 by.y = c("hwhhid", "hwline"),
                                 all.x = TRUE)
}

扩展：保留所有extract_hw_help中的SurveyId #

如果需要保留extract_hw_help中所有的SurveyId（即使extract2_HW中无对应项），可调整代码如下：

merged_list <- map(names(extract_hw_help), function(survey) {
  df1 <- extract_hw_help[[survey]]
  df2 <- extract2_HW[[survey]]
  if(!is.null(df2)) {
    merge(df1, df2, by.x = c("hhid", "hvidx"), by.y = c("hwhhid", "hwline"), all.x = TRUE)
  } else {
    df1 # 无对应数据框时直接保留原数据
  }
})
names(merged_list) <- names(extract_hw_help)

# extract_hw_help[[1]]的部分数据
structure(list(hhid = c("        1 17", "        1 17"), hvidx = c(1, 
2), hv001 = c(1, 1), hv002 = c(17, 17), hv005 = c(1894033, 1894033
), hv006 = c(11, 11), hv007 = c(1997, 1997), hv021 = c(1, 1), 
    hv023 = structure(c(5, 5), label = "Sample domain", format.spss = "F2.0", display_width = 5L, labels = c(`Tigray - rural` = 1, 
    `Tigray - urban` = 2, `Afar - rural` = 3, `Afar - urban` = 4, 
    `Amhara - rural` = 5, `Amhara - urban` = 6, `Oromiya - rural` = 7, 
    `Oromiya - urban` = 8, `Somali - rural` = 9, `Somali - urban` = 10, 
    `Ben-Gumz - rural` = 11, `Ben-Gumz - urban` = 12, `SNNP - rural` = 13, 
    `SNNP - urban` = 14, `Gambela - rural` = 15, `Gambela - urban` = 16, 
    `Harari - rural` = 17, `Harari - urban` = 18, `Addis Ababa - rural` = 19, 
    `Addis Ababa - urban` = 20, `Dire Dawa - rural` = 21, `Dire Dawa - urban` = 22
    ), class = c("haven_labelled", "vctrs_vctr", "double")), 
    hv024 = structure(c(3, 3), label = "Region", format.spss = "F2.0", display_width = 5L, labels = c(Tigray = 1, 
    Afar = 2, Amhara = 3, Oromiya = 4, Somali = 5, `Ben-Gumz` = 6, 
    SNNP = 7, Gambela = 12, Harari = 13, `Addis Abeba` = 14, 
    `Dire Dawa` = 15), class = c("haven_labelled", "vctrs_vctr", 
    "double")), hv025 = structure(c(2, 2), label = "Type of place of residence", format.spss = "F1.0", display_width = 5L, labels = c(Urban = 1, 
    Rural = 2), class = c("haven_labelled", "vctrs_vctr", "double"
    )), hv103 = structure(c(1, 1), label = "Slept last night", na_values = 9, format.spss = "F1.0", display_width = 5L, labels = c(No = 0, 
    Yes = 1), class = c("haven_labelled_spss", "haven_labelled", 
    "vctrs_vctr", "double")), hc1 = c(NA_real_, NA_real_), CLUSTER = c(1, 
    1), ALT_DEM = c(2314L, 2314L), LATNUM = c(10.889096, 10.889096
    ), LONGNUM = c(37.269565, 37.269565), ADM1NAME = c("amhara", 
    "amhara"), DHSREGNA = c("amhara", "amhara"), SurveyId = c("ET2005DHS", 
    "ET2005DHS")), row.names = 1:2, class = "data.frame")

# extract2_HW[[1]]的部分数据
structure(list(hwhhid = structure(c("        1 17", "        1 32"
), label = "case identification", format.stata = "%12s"), hwline = structure(c(4, 
7), label = "line", format.stata = "%8.0g"), hwlevel = structure(c(1, 
1), label = "data from hh or individual", format.stata = "%8.0g", labels = c(`from household` = 1, 
`from individual questionnaire` = 2), class = c("haven_labelled", 
"vctrs_vctr", "double")), hc70 = structure(c(-121, -212), label = "ht/a standard deviations (according to who)", format.stata = "%8.0g", labels = c(`height out of plausible limits` = 9996, 
`age in days out of plausible limits` = 9997, `flagged cases` = 9998
), class = c("haven_labelled", "vctrs_vctr", "double")), hc71 = structure(c(-54, 
-331), label = "wt/a standard deviations (according to who)", format.stata = "%8.0g", labels = c(`height out of plausible limits` = 9996, 
`age in days out of plausible limits` = 9997, `flagged cases` = 9998
), class = c("haven_labelled", "vctrs_vctr", "double")), hc72 = structure(c(0, 
-319), label = "wt/ht standard deviations (according to who)", format.stata = "%8.0g", labels = c(`height out of plausible limits` = 9996, 
`age in days out of plausible limits` = 9997, `flagged cases` = 9998
), class = c("haven_labelled", "vctrs_vctr", "double")), hc73 = structure(c(26, 
-312), label = "bmi standard deviations (according to who)", format.stata = "%8.0g", labels = c(`height out of plausible limits` = 9996, 
`age in days out of plausible limits` = 9997, `flagged cases` = 9998
), class = c("haven_labelled", "vctrs_vctr", "double"))), row.names = c(NA, 
-2L), class = c("tbl_df", "tbl", "data.frame"))

内容的提问来源于stack exchange，提问作者Sulz