R语言 使用多个条件将控件与案例匹配

mpbci0fu  于 2023-01-22  发布在  其他
关注(0)|答案(3)|浏览(220)

我想用两个条件为每个case匹配2个controls

  1. age差值应在± 2之间;
  2. income差值应在± 2之间。
    如果一个案例超过2个controls,我只需要随机选择2个controls即可,举个例子:

示例

数据

dat = structure(list(id = c(1, 2, 3, 4, 111, 222, 333, 444, 555, 666, 
                     777, 888, 999, 1000), 
              age = c(10, 20, 44, 11, 12, 11, 8, 12,  11, 22, 21, 18, 21, 18), 
              income = c(35, 72, 11, 35, 37, 36, 33,  70, 34, 74, 70, 44, 76, 70), 
              group = c("case", "case", "case", "case", "control", "control", 
                        "control", "control", "control", "control", "control", 
                        "control", "control", "control")), 
         row.names = c(NA, -14L), class = c("tbl_df", "tbl", "data.frame"))
> dat
# A tibble: 14 x 4
      id   age income group  
   <dbl> <dbl>  <dbl> <chr>  
 1     1    10     35 case   
 2     2    20     72 case   
 3     3    44     11 case   
 4     4    11     35 case   
 5   111    12     37 control
 6   222    11     36 control
 7   333     8     33 control
 8   444    12     70 control
 9   555    11     34 control
10   666    22     74 control
11   777    21     70 control
12   888    18     44 control
13   999    21     76 control
14  1000    18     70 control

预期结局

对于id = 1,匹配的控件如下所示,我只需要在下表中随机选择2个controls
| 身份证|年龄|收入|群|
| - ------|- ------|- ------|- ------|
| 一百一十一|十二|三十七|控制|
| 二百二十二|十一|三十六|控制|
| 三百三十三|八个|三十三|控制|
| 五百五十五|十一|三十四|控制|
对于id = 2,匹配的控件如下所示,我只需要在下表中随机选择2个controls
| 身份证|年龄|收入|群|
| - ------|- ------|- ------|- ------|
| 六六六|二十二|七十四|控制|
| 七七七|二十一|七十|控制|
| 一千|十八|七十|控制|
对于id = 3,在dat中没有匹配的controls
对于id = 4,匹配的控件如下所示,我只需要在下表中随机选择2个controls
这里需要注意的是,我们可以发现id = 1id = 4的控件有重叠的部分,我不希望两个cases共享一个control,我需要的是如果id = 1选择id = 111id = 222作为control,那么id = 4只能选择id = 555作为control,并且如果id = 1选择id = 111id = 333作为对照,那么id = 4只能选择id = 222id = 555作为对照。
| 身份证|年龄|收入|群|
| - ------|- ------|- ------|- ------|
| 一百一十一|十二|三十七|控制|
| 二百二十二|十一|三十六|控制|
| 五百五十五|十一|三十四|控制|
最终的输出可能是这样的(control组中的id是从满足条件的id中随机选择的):
| 身份证|年龄|收入|群|
| - ------|- ------|- ------|- ------|
| 1个|十个|三十五|箱|
| 第二章|二十个|七十二|箱|
| 三个|四十四|十一|箱|
| 四个|十一|三十五|箱|
| 一百一十一|十二|三十七|控制|
| 二百二十二|十一|三十六|控制|
| 三百三十三|八个|三十三|控制|
| 五百五十五|十一|三十四|控制|
| 七七七|二十一|七十|控制|
| 一千|十八|七十|控制|

注解

我查过一些网站,但是它们不符合我的需求。我不知道如何用R代码实现我的需求。
任何帮助将不胜感激!

参考:

1.https://stackoverflow.com/questions/56026700/is-there-any-package-for-case-control-matching-individual-1n-matching-in-r-n
2. Case control matching in R (or spss), based on age, sex and ethnicity?
3. Matching case-controls in R using the ccoptimalmatch package
4. Exact Matching in R

gz5pxeao

gz5pxeao1#

根据修改后的要求,我建议使用以下for loop

library(dplyr, warn.conflicts = F)

dat %>%
  split(.$group) %>%
  list2env(envir = .GlobalEnv)
#> <environment: R_GlobalEnv>

control$FILTER <- FALSE
control
#> # A tibble: 10 x 5
#>       id   age income group   FILTER
#>    <dbl> <dbl>  <dbl> <chr>   <lgl> 
#>  1   111    12     37 control FALSE 
#>  2   222    11     36 control FALSE 
#>  3   333     8     33 control FALSE 
#>  4   444    12     70 control FALSE 
#>  5   555    11     34 control FALSE 
#>  6   666    22     74 control FALSE 
#>  7   777    21     70 control FALSE 
#>  8   888    18     44 control FALSE 
#>  9   999    21     76 control FALSE 
#> 10  1000    18     70 control FALSE

set.seed(123)

for(i in seq_len(nrow(case))){
  x <- which(between(control$age, case$age[i] -2, case$age[i] +2) & 
               between(control$income, case$income[i] -2, case$income[i] + 2) & 
               !control$FILTER)
  control$FILTER[sample(x, min(2, length(x)))] <- TRUE
}

control
#> # A tibble: 10 x 5
#>       id   age income group   FILTER
#>    <dbl> <dbl>  <dbl> <chr>   <lgl> 
#>  1   111    12     37 control TRUE  
#>  2   222    11     36 control TRUE  
#>  3   333     8     33 control TRUE  
#>  4   444    12     70 control FALSE 
#>  5   555    11     34 control TRUE  
#>  6   666    22     74 control FALSE 
#>  7   777    21     70 control TRUE  
#>  8   888    18     44 control FALSE 
#>  9   999    21     76 control FALSE 
#> 10  1000    18     70 control TRUE

bind_rows(case, control) %>% filter(FILTER | is.na(FILTER)) %>% select(-FILTER)
#> # A tibble: 10 x 4
#>       id   age income group  
#>    <dbl> <dbl>  <dbl> <chr>  
#>  1     1    10     35 case   
#>  2     2    20     72 case   
#>  3     3    44     11 case   
#>  4     4    11     35 case   
#>  5   111    12     37 control
#>  6   222    11     36 control
#>  7   333     8     33 control
#>  8   555    11     34 control
#>  9   777    21     70 control
#> 10  1000    18     70 control

检查不同种子的结果

set.seed(234)
for(i in seq_len(nrow(case))){
  x <- which(between(control$age, case$age[i] -2, case$age[i] +2) & 
               between(control$income, case$income[i] -2, case$income[i] + 2) & 
               !control$FILTER)
  control$FILTER[sample(x, min(2, length(x)))] <- TRUE
}
control

bind_rows(case, control) %>% filter(FILTER | is.na(FILTER)) %>% select(-FILTER)

# A tibble: 10 x 4
      id   age income group  
   <dbl> <dbl>  <dbl> <chr>  
 1     1    10     35 case   
 2     2    20     72 case   
 3     3    44     11 case   
 4     4    11     35 case   
 5   111    12     37 control
 6   222    11     36 control
 7   333     8     33 control
 8   555    11     34 control
 9   777    21     70 control
10  1000    18     70 control

dat已修改,然后才能继续处理id 3

  • 使用baseR's 'split将数据拆分为两组casecontrol
  • 使用list2env将两个保存为单独的dfs
  • 使用purrr::map_df,您可以为每种情况取两行样本
  • 一次用于age
  • 并且一次用于income
  • 最后,从这些结果中的每一个再次采样2行
  • bind_rows同样,这些与case
library(tidyverse)

dat = structure(list(id = c(1, 2, 3, 111, 222, 333, 444, 555, 666, 777, 888, 999, 1000), 
                     age = c(10, 20, 44, 12, 11, 8, 12, 11, 22, 21, 18, 21, 18), 
                     income = c(35, 72, 11, 37, 36, 33, 70, 34, 74, 70, 44, 76, 70), 
                     group = c("case", "case", "case", "control", "control", "control", 
                               "control", "control", "control", "control", "control", 
                               "control", "control")),
                row.names = c(NA, -13L), class = c("tbl_df", "tbl", "data.frame"))

dat
#> # A tibble: 13 x 4
#>       id   age income group  
#>    <dbl> <dbl>  <dbl> <chr>  
#>  1     1    10     35 case   
#>  2     2    20     72 case   
#>  3     3    44     11 case   
#>  4   111    12     37 control
#>  5   222    11     36 control
#>  6   333     8     33 control
#>  7   444    12     70 control
#>  8   555    11     34 control
#>  9   666    22     74 control
#> 10   777    21     70 control
#> 11   888    18     44 control
#> 12   999    21     76 control
#> 13  1000    18     70 control

dat %>%
  split(.$group) %>%
  list2env(envir = .GlobalEnv)
#> <environment: R_GlobalEnv>

set.seed(123)
bind_rows(case, map_dfr(case$age, ~ control %>% filter(between(age, .x -2, .x +2) ) %>%
       sample_n(min(n(),2))) %>% sample_n(min(n(),2)),
       map_dfr(case$income, ~ control %>% filter(between(income, .x -2, .x +2)) %>%
                 sample_n(min(n(),2))) %>% sample_n(min(n(),2)))
#> # A tibble: 7 x 4
#>      id   age income group  
#>   <dbl> <dbl>  <dbl> <chr>  
#> 1     1    10     35 case   
#> 2     2    20     72 case   
#> 3     3    44     11 case   
#> 4   222    11     36 control
#> 5   777    21     70 control
#> 6   111    12     37 control
#> 7   333     8     33 control

下面的代码也可以做同样的事情而不保存单独的dfs

dat %>%
  split(.$group) %>%
  {bind_rows(.$case, 
             map_dfr(.$case$age, \(.x) .$control %>% filter(between(age, .x -2, .x +2) ) %>%
                       sample_n(min(n(),2))) %>% sample_n(min(n(),2)),
             map_dfr(.$case$income, \(.x) .$control %>% filter(between(income, .x -2, .x +2)) %>%
                       sample_n(min(n(),2))) %>% sample_n(min(n(),2)))}
xqkwcwgp

xqkwcwgp2#

在不同的 Dataframe 中分离case和control。对于case_data中的每一行,在control_data中找到匹配的行,并从中随机选择2行。
使用map_df,我们可以将所有内容合并到一个 Dataframe 中。

library(dplyr)
library(purrr)

case_data <- dat %>% filter(group == 'case')
control_data <- dat %>% filter(group == 'control')

case_data %>%
  group_split(row_number(), .keep = FALSE) %>%
  map_df(~bind_rows(.x, control_data %>% 
                    filter(between(age, .x$age - 2, .x$age + 2), 
                           between(income, .x$income - 2, .x$income + 2)) %>%
        slice_sample(n = 2)))

#     id   age income group  
#  <dbl> <dbl>  <dbl> <chr>  
#1     1    10     35 case   
#2   333     8     33 control
#3   111    12     37 control
#4     2    20     72 case   
#5   666    22     74 control
#6   777    21     70 control
ogsagwnx

ogsagwnx3#

我把map2函数放在大括号里,这样我就可以选择我想用什么变量来表示.x.y,否则%>%会把整个数据集替换为第一个参数:

library(dplyr)
library(purrr)

dat %>%
  filter(group == "case") %>%
  group_by(id) %>%
  {map2(.$age, .$income, ~ dat %>% 
          filter(group == "control" & age >= .x - 2 & age <= .x + 2 & 
                   income >= .y - 2 & income <= .y + 2))} %>%
  map_dfr(~ .x %>% 
            slice_sample(n = 2)) %>%
  bind_rows(dat %>% 
              filter(group == "case")) %>%
  arrange(id)

# A tibble: 7 x 4
     id   age income group  
  <dbl> <dbl>  <dbl> <chr>  
1     1    10     35 case   
2     2    20     72 case   
3     3    44     11 case   
4   222    11     36 control
5   333     8     33 control
6   777    21     70 control
7  1000    18     70 control

相关问题