问题描述
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 日创建