R - 将某些行中某些列的值转移到倾向得分匹配的匹配 ID

Question

我有两个数据框：一个包含使用倾向得分匹配匹配的参与者对的 ID（即，每一行都有两个匹配的 ID；df1），另一个包含 长格式的纵向数据 适用于所有参与者 (df2)。

在每对配对中，一个人来自实验组，另一个人来自对照组。组由变量Group 表示。在 df2 中，来自实验组的参与者在变量 Year 和 Month 上有值，而来自对照组的参与者在这些变量上只有 NA。我现在的目标是将实验组参与者的Year 和Month 上的值复制到对照组的匹配伙伴（基于来自df1 的匹配ID 信息）。

df1 <- read.table(text=
"ID_EG  ID_CG
800057  834341
800119  897177
800125  834011", header = TRUE)

df2 <- read.table(text=
"ID       Group    Year      Month
800057    1        2008      2         
800057    1        2008      2   
800057    1        2008      2   
800057    1        2008      2   
800057    1        2008      2   
800119    1        2014      10  
800119    1        2014      10         
800119    1        2014      10   
834011    0        NA        NA  
834011    0        NA        NA    
834341    0        NA        NA   
834341    0        NA        NA   
834341    0        NA        NA    
834341    0        NA        NA    
834341    0        NA        NA   
800125    1        2010     5
800125    1        2010     5
897177    0        NA       NA
897177    0        NA       NA
897177    0        NA       NA", header=TRUE)

谁能帮助我如何为每对配对完成这项工作？我尝试循环，但由于我对 R 很陌生，所以我被淹没了。

我的预期结果是这样的 (df3)：

df3 <- read.table(text=
"ID       Group    Year      Month
800057    1        2008      2         
800057    1        2008      2   
800057    1        2008      2   
800057    1        2008      2   
800057    1        2008      2   
800119    1        2014      10  
800119    1        2014      10         
800119    1        2014      10   
834011    0        2010      5  
834011    0        2010      5    
834341    0        2008      2   
834341    0        2008      2   
834341    0        2008      2    
834341    0        2008      2    
834341    0        2008      2   
800125    1        2010      5
800125    1        2010      5
897177    0        2014      10
897177    0        2014      10
897177    0        2014      10", header=TRUE) 

非常感谢任何帮助！

Answer 1

这是完成此类任务的一种可能解决方案。基本上，我们首先创建一个lookup 表，其中带有Year 和Month 的每个ID 与其不带Year 和Month 的相对参与者配对。之后，我们使用左连接和coalesce Year 和Month 的NA 值，以获得没有缺失值的新列。

library(dplyr)

lookup <- df1 %>% inner_join(df2, by = c("ID_EG" = "ID")) %>% select(-Group) %>% distinct()
#    ID_EG  ID_CG Year Month
# 1 800057 834341 2008     2
# 2 800119 897177 2014    10
# 3 800125 834011 2010     5

df2 %>%
  left_join(lookup, by = c("ID" = "ID_CG")) %>% 
  mutate(
    Year = coalesce(Year.x, Year.y),
    Month = coalesce(Month.x, Month.y)
    ) %>% 
  select(!ends_with(".x") & !ends_with(".y"), -ID_EG)

最终输出

       ID Group Year Month
1  800057     1 2008     2
2  800057     1 2008     2
3  800057     1 2008     2
4  800057     1 2008     2
5  800057     1 2008     2
6  800119     1 2014    10
7  800119     1 2014    10
8  800119     1 2014    10
9  834011     0 2010     5
10 834011     0 2010     5
11 834341     0 2008     2
12 834341     0 2008     2
13 834341     0 2008     2
14 834341     0 2008     2
15 834341     0 2008     2
16 800125     1 2010     5
17 800125     1 2010     5
18 897177     0 2014    10
19 897177     0 2014    10
20 897177     0 2014    10

Answer 2

df <- df1 %>% 
  left_join(df2 %>% select(-Group), by = c("ID_EG" = "ID")) %>% 
  unique() %>% 
  pivot_longer(contains("ID"), values_to = "ID", names_to = "Group") %>% 
  mutate(Group = ifelse(Group == "ID_EG", 1, 0)) %>% 
  left_join(df2, ., by = "ID") %>%
  select(-contains(".x")) %>%
  data.table::setnames(str_subset(names(.), ".y"), str_subset(names(.), ".y") %>% str_remove(".y"))

给予：

       ID Year Month Group
1  800057 2008     2     1
2  800057 2008     2     1
3  800057 2008     2     1
4  800057 2008     2     1
5  800057 2008     2     1
6  800119 2014    10     1
7  800119 2014    10     1
8  800119 2014    10     1
9  834011 2010     5     0
10 834011 2010     5     0
11 834341 2008     2     0
12 834341 2008     2     0
13 834341 2008     2     0
14 834341 2008     2     0
15 834341 2008     2     0
16 800125 2010     5     1
17 800125 2010     5     1
18 897177 2014    10     0
19 897177 2014    10     0
20 897177 2014    10     0