如何解决r 根据年龄和性别寻找匹配
ID Cancer.Date Age Gender Col1 Col2
15 1998-03-26 35 F Yes No
53 NA 65 F No Yes
37 1996-11-10 84 M Yes No
58 NA 90 F Yes No
60 2016-12-08 70 M Yes No
12 2000-04-29 20 M No Yes
46 NA 72 F Yes No
59 2008-05-26 34 F Yes No
99 NA 89 M Yes No
46 2009-06-22 87 M No Yes
35 2000-02-20 24 F Yes Yes
26 NA 80 F Yes No
43 2001-02-20 74 M No No
77 NA 81 F No Yes
16 2015-11-03 52 F No Yes
04 NA 27 M Yes No
82 2004-05-08 45 M No No
01 2006-04-25 49 F No Yes
92 2004-10-26 40 F Yes Yes
67 2002-09-20 67 F No No
我的目标是执行以下任务。
步骤 1: 按升序排列 Cancer.Date 列。最早的日期在上面。日期为 1996-11-10
步骤 2: 检查日期是否为 NA。如果日期不是 NA,则在 Gender 中找到与该行相似且在 Age 上最接近的 3 个观察值。
例如,按日期排序后(最早在前),第三行将是第一行。 Gender = M,Age = 84
。所以性别相近,年龄最接近的三个ID是,(ID 46,Gender =M,Age = 87),(ID 99,Age = 89),(ID 43,Age = 74).
步骤 3: 对 Cancer.Date 不是 NA(未缺失)的所有行重复步骤 2。
预期输出
ID Cancer.Date Age Gender Col1 Col2 Match.ID
37 1996-11-10 84 M Yes No 46,99,43
15 1998-03-26 35 F Yes No 59,35,12
. . . . . . .
也许我可以使用 for 循环、性别子集和年龄距离来做到这一点,但我怀疑这会非常缓慢。如果您有任何关于更有效地完成这项工作的建议,我将不胜感激。
解决方法
您可以使用 purr::map
来完成这项工作。
library(tidyverse)
read.table(textConnection("ID Cancer.Date Age Gender Col1 Col2
15 1998-03-26 35 F Yes No
53 NA 65 F No Yes
37 1996-11-10 84 M Yes No
58 NA 90 F Yes No
60 2016-12-08 70 M Yes No
12 2000-04-29 20 M No Yes
46 NA 72 F Yes No
59 2008-05-26 34 F Yes No
99 NA 89 M Yes No
46 2009-06-22 87 M No Yes
35 2000-02-20 24 F Yes Yes
26 NA 80 F Yes No
43 2001-02-20 74 M No No
77 NA 81 F No Yes
16 2015-11-03 52 F No Yes
04 NA 27 M Yes No
82 2004-05-08 45 M No No
01 2006-04-25 49 F No Yes
92 2004-10-26 40 F Yes Yes
67 2002-09-20 67 F No No"),header = T) %>%
as_tibble() -> df
df
#> # A tibble: 20 x 6
#> ID Cancer.Date Age Gender Col1 Col2
#> <int> <chr> <int> <chr> <chr> <chr>
#> 1 15 1998-03-26 35 F Yes No
#> 2 53 <NA> 65 F No Yes
#> 3 37 1996-11-10 84 M Yes No
#> 4 58 <NA> 90 F Yes No
#> 5 60 2016-12-08 70 M Yes No
#> 6 12 2000-04-29 20 M No Yes
#> 7 46 <NA> 72 F Yes No
#> 8 59 2008-05-26 34 F Yes No
#> 9 99 <NA> 89 M Yes No
#> 10 46 2009-06-22 87 M No Yes
#> 11 35 2000-02-20 24 F Yes Yes
#> 12 26 <NA> 80 F Yes No
#> 13 43 2001-02-20 74 M No No
#> 14 77 <NA> 81 F No Yes
#> 15 16 2015-11-03 52 F No Yes
#> 16 4 <NA> 27 M Yes No
#> 17 82 2004-05-08 45 M No No
#> 18 1 2006-04-25 49 F No Yes
#> 19 92 2004-10-26 40 F Yes Yes
#> 20 67 2002-09-20 67 F No No
df %>%
mutate(Cancer.Date = Cancer.Date %>% lubridate::as_date()) %>%
arrange(Cancer.Date) -> df1
df1
#> # A tibble: 20 x 6
#> ID Cancer.Date Age Gender Col1 Col2
#> <int> <date> <int> <chr> <chr> <chr>
#> 1 37 1996-11-10 84 M Yes No
#> 2 15 1998-03-26 35 F Yes No
#> 3 35 2000-02-20 24 F Yes Yes
#> 4 12 2000-04-29 20 M No Yes
#> 5 43 2001-02-20 74 M No No
#> 6 67 2002-09-20 67 F No No
#> 7 82 2004-05-08 45 M No No
#> 8 92 2004-10-26 40 F Yes Yes
#> 9 1 2006-04-25 49 F No Yes
#> 10 59 2008-05-26 34 F Yes No
#> 11 46 2009-06-22 87 M No Yes
#> 12 16 2015-11-03 52 F No Yes
#> 13 60 2016-12-08 70 M Yes No
#> 14 53 NA 65 F No Yes
#> 15 58 NA 90 F Yes No
#> 16 46 NA 72 F Yes No
#> 17 99 NA 89 M Yes No
#> 18 26 NA 80 F Yes No
#> 19 77 NA 81 F No Yes
#> 20 4 NA 27 M Yes No
closest <- function(x,df = df1){
if(is.na(x)){
NA
} else{
df1 %>%
filter(Cancer.Date == x) -> s_row
df1 %>%
filter((Gender == s_row$Gender & !Cancer.Date == x) %>% replace_na(T)) %>%
pull(Age) %>%
enframe(name = NULL) %>%
mutate(num = s_row$Age,diff = abs(num-value)) %>%
arrange(diff) %>%
slice(1:3) %>%
pull(value) -> near_ages
df1 %>%
filter(Age %in% near_ages & Gender == s_row$Gender) %>%
pull(ID) %>%
paste(collapse = ",")
}
}
df1 %>%
mutate(Match.ID = Cancer.Date %>% map_chr(closest))
#> # A tibble: 20 x 7
#> ID Cancer.Date Age Gender Col1 Col2 Match.ID
#> <int> <date> <int> <chr> <chr> <chr> <chr>
#> 1 37 1996-11-10 84 M Yes No 43,46,99
#> 2 15 1998-03-26 35 F Yes No 35,92,59
#> 3 35 2000-02-20 24 F Yes Yes 15,59
#> 4 12 2000-04-29 20 M No Yes 82,60,4
#> 5 43 2001-02-20 74 M No No 37,60
#> 6 67 2002-09-20 67 F No No 53,26
#> 7 82 2004-05-08 45 M No No 12,4
#> 8 92 2004-10-26 40 F Yes Yes 15,1,59
#> 9 1 2006-04-25 49 F No Yes 15,16
#> 10 59 2008-05-26 34 F Yes No 15,35,92
#> 11 46 2009-06-22 87 M No Yes 37,43,99
#> 12 16 2015-11-03 52 F No Yes 92,53
#> 13 60 2016-12-08 70 M Yes No 37,46
#> 14 53 NA 65 F No Yes <NA>
#> 15 58 NA 90 F Yes No <NA>
#> 16 46 NA 72 F Yes No <NA>
#> 17 99 NA 89 M Yes No <NA>
#> 18 26 NA 80 F Yes No <NA>
#> 19 77 NA 81 F No Yes <NA>
#> 20 4 NA 27 M Yes No <NA>
如果你想提高效率,你可以查看 furrr
包,这将使代码并行运行。
由 reprex package (v0.3.0) 于 2021 年 1 月 25 日创建
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。