我有一个包含这些列的数据集
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:安排巨蟹座。按升序排列的日期列。最上面是最早的日期。本例中日期为1996-11-10的行
步骤2:检查日期是否为NA。如果日期是而不是NA，然后找到3个与"性别"这一行相似、"年龄"这一行最接近的观察值。
例如，在按日期排序(最早的第一个)之后，第三行将是第一行。Gender = M, Age = 84。因此，三个性别相似，年龄最接近的ID是(ID 46, gender =M, Age = 87)， (ID 99, gender =M, Age = 89)， (ID 43, gender =M, Age = 74)。
步骤3:重复步骤2的所有行癌症。日期不是NA(未丢失)。
期望输出
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,92,59
#> 4 12 2000-04-29 20 M No Yes 82,60,4
#> 5 43 2001-02-20 74 M No No 37,46,60
#> 6 67 2002-09-20 67 F No No 53,46,26
#> 7 82 2004-05-08 45 M No No 12,60,4
#> 8 92 2004-10-26 40 F Yes Yes 15,1,59
#> 9 1 2006-04-25 49 F No Yes 15,92,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,1,53
#> 13 60 2016-12-08 70 M Yes No 37,43,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包(v0.3.0)在2021-01-25创建