如何将两个数据框与日期进行比较，返回匹配日期并为新数据框中的每一行标记不匹配的日期答案

【问题标题】：How to compare two dataframes with dates, return matching dates and tag non-matching dates for each row in new dataframe如何将两个数据框与日期进行比较，返回匹配日期并为新数据框中的每一行标记不匹配的日期
【发布时间】：2022-04-07 20:55:26
【问题描述】：

我有一个日期框架，其中每一行中的每个科目都有多个测量日期，另一个数据框架有每一行中同一科目的多个访问日期（也包括一些 NA）。

我想要的是提取与某个主题的访问日期匹配的测量日期，并标记不符合访问日期的测量日期（例如，使用“FALSE”或-99），并保留不适用。

set.seed(1)

# Dataframe with measure dates
df1 <- rbind.data.frame(sort(sample(seq(as.Date("2018-01-01"), as.Date("2019-01-01"), by = "day"), 10)),
                        c(sort(sample(seq(as.Date("2018-06-01"), as.Date("2019-06-01"), by = "day"), 8)), NA, NA),
                        c(sort(sample(seq(as.Date("2019-06-01"), as.Date("2020-06-01"), by = "day"), 6)), rep(NA, 4)))
names(df1) <- paste("MEASUREDATE", 1:10, sep = "")

myfun <- function(x) as.Date(x, format = "%Y-%m-%d", origin = "1970-01-01")
df1 <- data.frame(lapply(df1, myfun))
df1

# Dataframe with visit dates
df2 <- rbind.data.frame(as.numeric(df1[1, 2:7]), as.numeric(c(df1[2, 4:6], NA, NA, NA)), as.numeric(c(df1[3, 1:2], rep(NA, 4))))
df2 <- data.frame(lapply(df2, myfun))
names(df2) <- paste("VISIT", 1:6, sep = "")
df2

所以新数据框的第一行应该是这样的：

# New dataframe
df3 <- df1[1, ]
df3[1] <- FALSE
df3[8:10] <- FALSE
df3

你知道如何解决这个问题吗？非常感谢任何帮助。

【问题讨论】：

我刚刚意识到您想区分NA 和FALSE。我已经更新了我的答案，以便这些可以分开，而不是返回所有 NA。
不错的收获@AndrewGillreath-Brown，已经更新了我的。

标签： r date

【解决方案1】：

一种可能性是使用长格式的两个数据帧。在这里，我将df1 转为长，然后将left_join 转为df2（也在将其转换为长格式之后）。对于匹配的日期，将出现来自df2 的名称（而其他名称将是NA），然后如果没有匹配，我们可以使用此信息将日期数据转换为NA。然后，我删除具有访问编号的列name.y，并仅保留唯一值。然后，我们可以转向更广泛的格式。

library(tidyverse)

df1 %>%
  mutate(row = row_number()) %>%
  pivot_longer(-row) %>%
  left_join(.,
            df2 %>% mutate(row = row_number()) %>%
              pivot_longer(-row),
            by = c("row", "value")) %>%
  mutate(value = case_when(is.na(name.y)
                           ~ as.Date(NA),
                           TRUE ~ value)) %>%
  select(-name.y) %>%
  distinct() %>%
  pivot_wider(names_from = "name.x", values_from = "value") %>% 
  select(-row)

输出

  MEASUREDATE1 MEASUREDATE2 MEASUREDATE3 MEASUREDATE4 MEASUREDATE5 MEASUREDATE6 MEASUREDATE7 MEASUREDATE8 MEASUREDATE9 MEASUREDATE10
  <date>       <date>       <date>       <date>       <date>       <date>       <date>       <date>       <date>       <date>       
1 NA           2018-05-09   2018-06-16   2018-07-06   2018-09-27   2018-10-04   2018-10-26   NA           NA           NA           
2 NA           NA           NA           2018-11-12   2018-12-30   2019-01-03   NA           NA           NA           NA           
3 2019-08-28   2020-03-15   NA           NA           NA           NA           NA           NA           NA           NA

更新

如果要区分FALSE 和NA，那么我们需要先将date 转换为character。然后，我们可以在case_when中设置一些附加条件。

df1 %>%
  mutate(row = row_number()) %>%
  pivot_longer(-row) %>%
  left_join(.,
            df2 %>% mutate(row = row_number()) %>%
              pivot_longer(-row),
            by = c("row", "value")) %>%
  mutate(across(everything(), ~as.character(.))) %>% 
  mutate(value = case_when(is.na(name.y) & !is.na(value) ~ "FALSE",
                           !is.na(name.y) & !is.na(value) ~ value,
                           TRUE ~ "NA")) %>%
  select(-name.y) %>%
  distinct() %>%
  pivot_wider(names_from = "name.x", values_from = "value") %>% 
  select(-row)

输出

  MEASUREDATE1 MEASUREDATE2 MEASUREDATE3 MEASUREDATE4 MEASUREDATE5 MEASUREDATE6 MEASUREDATE7 MEASUREDATE8 MEASUREDATE9 MEASUREDATE10
  <chr>        <chr>        <chr>        <chr>        <chr>        <chr>        <chr>        <chr>        <chr>        <chr>        
1 FALSE        2018-05-09   2018-06-16   2018-07-06   2018-09-27   2018-10-04   2018-10-26   FALSE        FALSE        FALSE        
2 FALSE        FALSE        FALSE        2018-11-12   2018-12-30   2019-01-03   FALSE        FALSE        NA           NA           
3 2019-08-28   2020-03-15   FALSE        FALSE        FALSE        FALSE        NA           NA           NA           NA

数据

df1 <- structure(
  list(
    MEASUREDATE1 = structure(c(17616, 17719, 18136), class = "Date"),
    MEASUREDATE2 = structure(c(17660, 17761, 18336), class = "Date"),
    MEASUREDATE3 = structure(c(17698, 17787, 18337), class = "Date"),
    MEASUREDATE4 = structure(c(17718, 17847, 18373), class = "Date"),
    MEASUREDATE5 = structure(c(17801, 17895, 18387), class = "Date"),
    MEASUREDATE6 = structure(c(17808, 17899, 18409), class = "Date"),
    MEASUREDATE7 = structure(c(17830, 17945, NA), class = "Date"),
    MEASUREDATE8 = structure(c(17838, 18011, NA), class = "Date"),
    MEASUREDATE9 = structure(c(17855, NA, NA), class = "Date"),
    MEASUREDATE10 = structure(c(17861, NA, NA), class = "Date")
  ),
  class = "data.frame",
  row.names = c(NA,-3L)
)

df2 <-
  structure(
    list(
      VISIT1 = structure(c(17660, 17847, 18136), class = "Date"),
      VISIT2 = structure(c(17698, 17895, 18336), class = "Date"),
      VISIT3 = structure(c(17718, 17899, NA), class = "Date"),
      VISIT4 = structure(c(17801, NA, NA), class = "Date"),
      VISIT5 = structure(c(17808, NA, NA), class = "Date"),
      VISIT6 = structure(c(17830, NA, NA), class = "Date")
    ),
    class = "data.frame",
    row.names = c(NA,-3L)
  )

【讨论】：

感谢您最有帮助的回复。他们非常感激。 @Andrew Gillreath-Brown，您的回答非常有效。如果我想跳过将生成的数据帧转换回宽格式，可以从您的答案中删除哪些 tidyverse 代码（因为我不熟悉这个包）？
@Orangemarmalade 没问题！如果你想保持长格式，那么你可以删除代码底部的pivot_wider 行。另外，仅供参考，tidyverse 一次加载多个包。在这里，我真的只是使用dplyr 和tidyr 包。

【解决方案2】：

我认为最干净的方法是采取@Andrew Gillreath-Brown 的回答提供的不错的长途路线。但是，如果您愿意，我们也可以简单地跨数据框的行应用（如果 nrow(df1) == nrow(df2)）。

dfl <- lapply(
  1:nrow(df1),
  \(i) {
    measures <- as.Date(unlist(df1[i,]), origin = "1970-01-01")
    visits <- as.Date(unlist(df2[i,]), origin = "1970-01-01")
    measures[!(measures %in% visits)] <- NA
    measures
  } 
)

dfl
#> [[1]]
#>  MEASUREDATE1  MEASUREDATE2  MEASUREDATE3  MEASUREDATE4  MEASUREDATE5 
#>            NA  "2018-05-09"  "2018-06-16"  "2018-07-06"  "2018-09-27" 
#>  MEASUREDATE6  MEASUREDATE7  MEASUREDATE8  MEASUREDATE9 MEASUREDATE10 
#>  "2018-10-04"  "2018-10-26"            NA            NA            NA 
#> 
#> [[2]]
#>  MEASUREDATE1  MEASUREDATE2  MEASUREDATE3  MEASUREDATE4  MEASUREDATE5 
#>            NA            NA            NA  "2018-11-12"  "2018-12-30" 
#>  MEASUREDATE6  MEASUREDATE7  MEASUREDATE8  MEASUREDATE9 MEASUREDATE10 
#>  "2019-01-03"            NA            NA            NA            NA 
#> 
#> [[3]]
#>  MEASUREDATE1  MEASUREDATE2  MEASUREDATE3  MEASUREDATE4  MEASUREDATE5 
#>  "2019-08-28"  "2020-03-15"            NA            NA            NA 
#>  MEASUREDATE6  MEASUREDATE7  MEASUREDATE8  MEASUREDATE9 MEASUREDATE10 
#>            NA            NA            NA            NA            NA

那么为了方便可以直接绑定在一起得到你的df3（或者只用上面的purrr::map_dfr）。

dplyr::bind_rows(dfl)
#> # A tibble: 3 × 10
#>   MEASUREDATE1 MEASUREDATE2 MEASUREDATE3 MEASUREDATE4 MEASUREDATE5 MEASUREDATE6
#>   <date>       <date>       <date>       <date>       <date>       <date>      
#> 1 NA           2018-05-09   2018-06-16   2018-07-06   2018-09-27   2018-10-04  
#> 2 NA           NA           NA           2018-11-12   2018-12-30   2019-01-03  
#> 3 2019-08-28   2020-03-15   NA           NA           NA           NA          
#> # … with 4 more variables: MEASUREDATE7 <date>, MEASUREDATE8 <date>,
#> #   MEASUREDATE9 <date>, MEASUREDATE10 <date>

更新

@Andrew Gillreath-Brown 指出您希望将 FALSE 和 NA 分开。如果您想将FALSE 和NA 值分开，则只需先使用此方法将字符串转换为字符即可。

dfl2 <- lapply(
  1:nrow(df1),
  \(i) {
    measures <- as.character(as.Date(unlist(df1[i,]), origin = "1970-01-01"))
    visits <- as.character(as.Date(unlist(df2[i,]), origin = "1970-01-01"))
    measures[!(measures %in% visits)] <- "FALSE"
    measures
  } 
)

dplyr::bind_rows(dfl2)
#> # A tibble: 3 × 10
#>   MEASUREDATE1 MEASUREDATE2 MEASUREDATE3 MEASUREDATE4 MEASUREDATE5 MEASUREDATE6
#>   <chr>        <chr>        <chr>        <chr>        <chr>        <chr>       
#> 1 FALSE        2018-05-09   2018-06-16   2018-07-06   2018-09-27   2018-10-04  
#> 2 FALSE        FALSE        FALSE        2018-11-12   2018-12-30   2019-01-03  
#> 3 2019-08-28   2020-03-15   FALSE        FALSE        FALSE        FALSE       
#> # … with 4 more variables: MEASUREDATE7 <chr>, MEASUREDATE8 <chr>,
#> #   MEASUREDATE9 <chr>, MEASUREDATE10 <chr>

【讨论】：

感谢您最有帮助的回复。他们非常感激。 @caldwellst，我非常喜欢你的答案是用 base R 编码的。但是，当我运行你的代码时，我偶然发现了一个错误。 \ 似乎是一个意外的输入。我做错了吗？
啊，那是从 R >= 4.1，\(x) 是 function(x) 的简写。
啊，感谢您的支持。非常感谢。