如果日期介于第二个数据帧中的两个日期之间，则 r 标记第一个数据帧中的行

Posted 2023-02-24

【中文标题】如果日期介于第二个数据帧中的两个日期之间，则 r 标记第一个数据帧中的行

【英文标题】：r flag rows in 1st dataframe if the date is between two dates in second dataframe

【发布时间】：2021-11-25 13:02:37

【问题描述】：

我有两个数据集。第一个数据集对于每个 ID 都有两个日期列（开始、停止）。有时它可以为每个 ID 包含多个起止日期。

数据集1

  Id    Code    Start        Stop
  431   279     2017-11-15   2019-08-15
  431   578     2019-09-15   2021-01-15
  832   590     2008-04-15   2020-05-15
  832   519     2020-06-15   2021-04-15

第二个数据集有 Id 和每个 ID 的许多时间戳行，如下所示

  Id   Weight   Date
  431  12.23    2018
  832  15.12    2020
  832   6.78    2020
  832   4.27    2007

我的目标是创建一个列InBetween，如果第二个数据集中的行在第一个数据集中的两个日期之间，则表示“是”；如果第二个数据集中的行不在两个日期之间，则表示“否”在第一个数据集中，与第一个数据集中的其他列类似。

    Id   Weight   Date   Between  Code  Start        Stop
    431  12.23    2018   Yes      279   2017-11-15   2019-08-15  
    832  15.12    2020   Yes      590   2008-04-15   2020-05-15
    832   6.78    2020   Yes      590   2008-04-15   2020-05-15
    832   4.27    2007   No       NA    NA           NA

我可以使用 for 循环来做到这一点，但我更喜欢使用 dplyr、innerjoin 或其他没有 forloops 的选项的任何解决方案。提前致谢。

【参考方案1】：

很乱，但你可以试试，

df2 %>%
  full_join(df1, by = "Id") %>%
  mutate(Date = as.Date(ISOdate(Date,1,1)),
         Start = as.Date(Start),
         Stop = as.Date(Stop)) %>%
  rowwise %>%
  mutate(Between = between(Date, Start, Stop)) %>%
  group_by(Id, Date) %>%
  mutate(check = any(Between)) %>%
  filter(!(Between == FALSE& check == TRUE)) %>%
  mutate(Start = ifelse(check, Start, NA), 
         Stop = ifelse(check, Stop, NA),
         Code = ifelse(check, Code, NA)) %>%
  distinct() %>% select(-check)


     Id Weight Date        Code Start  Stop Between
  <int>  <dbl> <date>     <int> <dbl> <dbl> <lgl>  
1   431  12.2  2018-01-01   279 17485 18123 TRUE   
2   832  15.1  2020-01-01   590 13984 18397 TRUE   
3   832   6.78 2020-01-01   590 13984 18397 TRUE   
4   832   4.27 2007-01-01    NA    NA    NA FALSE

【讨论】：

这样就可以了。出于某种原因，日期以数字形式出现，我不得不重新将它们重新连接成正确的格式，但这可以解决问题。谢谢。

【参考方案2】：

这是一个较短的版本，也可以实现您所追求的。

library(tidyverse)
library(lubridate)
#> 
#> Attaching package: 'lubridate'
#> The following objects are masked from 'package:base':
#> 
#>     date, intersect, setdiff, union
df1 <- tibble::tribble(
         ~Id, ~Code,       ~Start,        ~Stop,
        431L,  279L, "2017-11-15", "2019-08-15",
        431L,  578L, "2019-09-15", "2021-01-15",
        832L,  590L, "2008-04-15", "2020-05-15",
        832L,  519L, "2020-06-15", "2021-04-15"
        )
df2 <- tibble::tribble(
          ~Id, ~Weight, ~Date,
         431L,   12.23, 2018L,
         832L,   15.12, 2020L,
         832L,    6.78, 2020L,
         832L,    4.27, 2007L
         )

df1 <- df1 %>% 
  mutate(Start = ymd(Start),
         Stop = ymd(Stop))

df2 <- df2 %>% 
  mutate(Date = ymd(Date, truncated = 2L))

full_join(df1, df2) %>% 
  mutate(Between = case_when( (Date %within% interval(ymd(Start), ymd(Stop))) == TRUE ~ TRUE,
                              TRUE ~ FALSE))
#> Joining, by = "Id"
#> # A tibble: 8 × 7
#>      Id  Code Start      Stop       Weight Date       Between
#>   <int> <int> <date>     <date>      <dbl> <date>     <lgl>  
#> 1   431   279 2017-11-15 2019-08-15  12.2  2018-01-01 TRUE   
#> 2   431   578 2019-09-15 2021-01-15  12.2  2018-01-01 FALSE  
#> 3   832   590 2008-04-15 2020-05-15  15.1  2020-01-01 TRUE   
#> 4   832   590 2008-04-15 2020-05-15   6.78 2020-01-01 TRUE   
#> 5   832   590 2008-04-15 2020-05-15   4.27 2007-01-01 FALSE  
#> 6   832   519 2020-06-15 2021-04-15  15.1  2020-01-01 FALSE  
#> 7   832   519 2020-06-15 2021-04-15   6.78 2020-01-01 FALSE  
#> 8   832   519 2020-06-15 2021-04-15   4.27 2007-01-01 FALSE

^{由reprex package (v2.0.1) 于 2021 年 10 月 11 日创建}