基于模糊标准创建组

编程问答 2023-01-05

问题描述

我有一个如下所示的数据框：

Name   Start_Date   End_Date
A      2015-01-01   2019-12-29
A      2017-03-25   NA
A      2019-10-17   NA
A      2012-04-16   2015-01-09
A      2002-06-01   2006-02-01
A      2005-12-24   NA
B      2018-01-23   NA

我想创建一个列，如果两个观测值具有相同的 Name，并且一个观测值的 Start_Date 在另一个观测值的 End_Date 内为 ±1 年，则它们被归类为同组。

所需的输出：

Name   Start_Date   End_Date    Wanted
A      2015-01-01   2019-12-29  1
A      2017-03-25   NA          NA
A      2019-10-17   NA          1
A      2012-04-16   2015-01-09  1
A      2002-06-01   2006-02-01  2
A      2005-12-24   NA          2
B      2018-01-23   NA          NA

我正在寻找带有数据表的解决方案，但解决我的问题就足够了。

新增： 逐行解释
行：

  1. 第 4 行的开始日期是结束日期前 8 天（
  2. 开始日期是第 1 行结束日期后 2 年以上。与第 1 行不在同一组。与第 4、5 行相同。也不与这两行在同一组。
  3. 第 1 行的开始日期比结束日期早 2 个月（
  4. 见第 1 行。
  5. 见下文。
  6. 第 5 行的开始日期比结束日期早 3 个月（
  7. 没有其他名称 B​​ 可以比较。它属于自己的组。

因此，行 1、3 和 4 在同一组中。行 5 和 6 在同一组中。行 2 和 7 没有组。

EDIT：当观察与另一个观察不匹配时，我已更新我的代码以具有一致的Wanted 类别。

解决方法

方法

这是首选的 data.table 解决方案：

我更喜欢带有 data.table 的解决方案，但非常感谢任何解决方案！

虽然 dplyr 和 fuzzyjoin 可能看起来更优雅，但对于足够大的数据集，它们也可能效率较低。

感谢 ThomasIsCoding 在 this other question 上击败了我，an answer 利用 igraph 在图中索引网络。在这里，网络是由“链接”（Wanted 行）组成的单独“链”（data.frame 组），这些“链接”通过它们的“紧密度”（在它们的 Start_Date 和End_Date 秒）。这种方法似乎有必要对 transitive relationship ℛ 请求的 here

建模

我正在尝试创建“关闭”链接链，以便我可以映射 A 随时间的移动。

还要注意保持ℛ的对称性（请参阅进一步阅读）。

每个same request

因此，我希望标记一个观察的开始日期（2016-01-01）与两个不同的结束日期（2015-01-02 和 2016-12-31）“模糊分组”的情况，反之亦然反之。

和你的further clarification

...我想要另一列表示 [flag]。

我还包含了一个 Flag 列，以标记其 Start_Date 与至少 End_Date 其他行的 flag_at 匹配的每一行；反之亦然。

解决方案

使用您的示例 data.frame，此处复制为 my_data_frame

# Generate dataset as data.frame.
my_data_frame <- structure(list(Name = c("A","A","B"),Start_Date = structure(c(16436,17250,18186,15446,11839,13141,17554),class = "Date"),End_Date = structure(c(18259,NA,16444,13180,NA),class = "Date")),row.names = c(NA,-7L),class = "data.frame")

我们应用 data.table 和 igraph（以及其他软件包）如下：

library(tidyverse)
library(data.table)
library(lubridate)
library(igraph)



# ...
# Code to generate your data.frame 'my_data_frame'.
# ...



# Treat dataset as a data.table.
my_data_table <- my_data_frame %>% data.table::as.data.table()


# Define the tolerance threshold as a (lubridate) "period": 1 year.
tolerance <- lubridate::years(1)

# Set the minimum number of matches for an row to be flagged: 2.
flag_at <- 2



#####################################
# BEGIN: Start Indexing the Groups. #
#####################################

# Begin indexing the "chain" (group) to which each "link" (row) belongs:
output <- my_data_table %>%
  
  ########################################################
  # STEP 1: Link the Rows That Are "Close" to Each Other #
  ########################################################
  
  # Prepare data.table for JOIN,by adding appropriate helper columns.
  .[,`:=`(# Uniquely identify each row (by row number).
           ID = .I,# Boundary columns for tolerance threshold.
           End_Low = End_Date - tolerance,End_High = End_Date + tolerance)] %>%
    
  # JOIN rows to each other,to obtain pairings.
  .[my_data_table,# Clearly describe the relation R: x R y whenever the 'Start_Date' of x is
    # close enough to (within the boundary columns for) the 'End_Date' of y.
    .(x.ID = i.ID,x.Name = i.Name,x.Start_Date = i.Start_Date,x.End_Date = i.End_Date,y.End_Low = x.End_Low,y.End_High = x.End_High,y.ID = x.ID,y.Name = x.Name),# JOIN criteria:
    on = .(# Only pair rows having the same name.
           Name,# Only pair rows whose start and end dates are within the tolerance
           # threshold of each other.
           End_Low <= Start_Date,End_High >= Start_Date),# Make it an OUTER JOIN,to include those rows without a match.
    nomatch = NA] %>%
  
  # Prepare pairings for network analysis.
  .[# Ensure no row is reflexively paired with itself.
    #   NOTE: This keeps the graph clean by trimming extraneous loops,and it
    #   prevents an "orphan" row from contributing to its own tally of matches.
    !(x.ID == y.ID) %in% TRUE,# !(x.ID == y.ID) %in% TRUE,# Simplify the dataset to only the pairings (by ID) of linked rows.
    .(from = x.ID,to = y.ID)]



#############################
# PAUSE: Count the Matches. #
#############################

# Count how many times each row has its 'End_Date' matched by a 'Start_Date'.
my_data_table$End_Matched <- output %>%
  
  # Include again the missing IDs for y that were never matched by the JOIN.
  .[my_data_table[,.(ID)],on = .(to = ID)] %>%
  
  # For each row y,count every other row x where x R y.
  .[,.(Matches = sum(!is.na(from))),by = to] %>%
  
  # Extract the count column.
  .$Matches


# Count how many times each row has its 'Start_Date' matched by an 'End_Date'.
my_data_table$Start_Matched <- output %>%
  
  # For each row x,count every other row y where x R y.
  .[,.(Matches = sum(!is.na(to))),by = from] %>%
  
  # Extract the count column.
  .$Matches



#########################################
# RESUME: Continue Indexing the Groups. #
#########################################

# Resume indexing:
output <- output %>%
  
  # Ignore nonmatches (NAs) which are annoying to process into a graph.
  .[from != to,] %>%
  
  ###############################################################
  # STEP 2: Index the Separate "Chains" Formed By Those "Links" #
  ###############################################################
  
  # Convert pairings (by ID) of linked rows into an undirected graph.
  igraph::graph_from_data_frame(directed = FALSE) %>%
  
  # Find all groups (subgraphs) of transitively linked IDs.
  igraph::components() %>%
  
  # Pair each ID with its group index.
  igraph::membership() %>%
  
  # Tabulate those pairings...
  utils::stack() %>% utils::type.convert(as.is = TRUE) %>%
  
  # ...in a properly named data.table.
  data.table::as.data.table() %>% .[,.(ID = ind,Group_Index = values)] %>%
  
  
  
  #####################################################
  # STEP 3: Match the Original Rows to their "Chains" #
  #####################################################
  
  # LEFT JOIN (on ID) to match each original row to its group index (if any).
  .[my_data_table,on = .(ID)] %>%
  
  # Transform output into final form.
  .[# Sort into original order.
    order(ID),.(# Select existing columns.
      Name,Start_Date,End_Date,# Rename column having the group indices.
      Wanted = Group_Index,# Calculate column(s) to flag rows with sufficient matches.
      Flag = (Start_Matched >= flag_at) | (End_Matched >= flag_at))]



# View results.
output

结果

结果 output 是以下 data.table：

   Name Start_Date   End_Date Wanted  Flag
1:    A 2015-01-01 2019-12-29      1 FALSE
2:    A 2017-03-25       <NA>     NA FALSE
3:    A 2019-10-17       <NA>      1 FALSE
4:    A 2012-04-16 2015-01-09      1 FALSE
5:    A 2002-06-01 2006-02-01      2 FALSE
6:    A 2005-12-24       <NA>      2 FALSE
7:    B 2018-01-23       <NA>     NA FALSE

请记住，Flag 都是 FALSE，因为您的数据缺少任何 Start_Date 匹配（至少）两个 {{1} }s;以及由（至少）两个 End_Date 匹配的任何 End_Date。

假设，如果我们将 Start_Date 降低到 flag_at，那么 1 会output 每一行，即使是单个匹配（在任一方向）：

Flag

警告

由于某些 Name Start_Date End_Date Wanted Flag 1: A 2015-01-01 2019-12-29 1 TRUE 2: A 2017-03-25 <NA> NA FALSE 3: A 2019-10-17 <NA> 1 TRUE 4: A 2012-04-16 2015-01-09 1 TRUE 5: A 2002-06-01 2006-02-01 2 TRUE 6: A 2005-12-24 <NA> 2 TRUE 7: B 2018-01-23 <NA> NA FALSE operations 修改了 by reference（或“就地”），data.table 的值会在整个工作流程中发生变化。在第 1 步之后，my_data_table 变为

my_data_table

与最初复制的 Name Start_Date End_Date ID End_Low End_High 1: A 2015-01-01 2019-12-29 1 2018-12-29 2020-12-29 2: A 2017-03-25 <NA> 2 <NA> <NA> 3: A 2019-10-17 <NA> 3 <NA> <NA> 4: A 2012-04-16 2015-01-09 4 2014-01-09 2016-01-09 5: A 2002-06-01 2006-02-01 5 2005-02-01 2007-02-01 6: A 2005-12-24 <NA> 6 <NA> <NA> 7: B 2018-01-23 <NA> 7 <NA> <NA> 的结构背离。

由于 my_data_frame（以及其他包）是按值而不是按引用分配的，因此 dplyr 解决方案将完全回避这个问题。

然而，您必须在修改工作流程时小心，因为在步骤 1 之前可用的 dplyr 版本之后无法恢复。

进一步阅读

虽然 my_data_table 的 JOINing 是明确的方向性 - 具有“右侧”和“左侧” - 该模型设法保留了您在此处描述的 relational symmetry

如果...[either] 一个的“Start_Date”在 other 观察的“End_Date”内为 +- 1 年，则它们被归类为同一组。

通过使用 undirected graph。

当 data.table 将第一行?（JOIN 为 Start_Date）与第四行?（2015-01-01 为 End_Date）相关联时，我们得出结论，? 的 2015-01-09 与（在 1 年内）? 的 Start_Date “足够接近”。所以我们在数学上说 ? ℛ ?，或

?“与”?在同一组。

然而，converse ? ℛ ?不一定出现在End_Dateed数据中，因为?的JOIN > 可能不会在 ? 的 Start_Date 附近如此方便地降落。也就是说，End_Dateed 数据不一定表明

?“与”?在同一组。

在后一种情况下，严格的directed graph（“有向图”）不会捕获同一组中?和?的共同成员资格。您可以通过在步骤 2 的第一行中设置 JOIN 来观察这种刺耳的差异

directed = TRUE

并在下一行设置 igraph::graph_from_data_frame(directed = TRUE) %>% 

mode = "strong"

产生这些分离的结果：

  igraph::components(mode = "strong") %>%

相比之下，可以通过使用无向图 ( Name Start_Date End_Date Wanted Flag 1: A 2015-01-01 2019-12-29 4 FALSE 2: A 2017-03-25 <NA> NA FALSE 3: A 2019-10-17 <NA> 3 FALSE 4: A 2012-04-16 2015-01-09 5 FALSE 5: A 2002-06-01 2006-02-01 2 FALSE 6: A 2005-12-24 <NA> 1 FALSE 7: B 2018-01-23 <NA> NA FALSE ) 对行进行正确分组；或通过更宽松的标准 (directed = FALSE)。每当 ? ℛ ? 出现在 mode = "weak" ed 数据中时，这两种方法中的任何一种都将有效地模拟 ? ℛ ? 的存在。

这种对称属性在对您描述的行为进行建模时特别很重要here：

...一个观察的开始日期 (2016-01-01) 被“模糊地分组”为两个不同的结束日期（2015-01-02 和 2016-12-31）...

在这种情况下，您希望模型识别任意两行 ? 和 ? 必须在同一组中（? ℛ ?），只要它们的 JOIN 匹配某些相同的 End_Date另一行?：? ℛ ? 和 ? ℛ ?。

所以假设我们知道? ℛ ? 和 ? ℛ ?。因为我们的模型保留了对称性，所以我们可以从 ? ℛ ? 说 ? ℛ ? 也是。由于我们现在知道 ? ℛ ? 和 ? ℛ ?，transitivity 意味着 ? ℛ ?。因此，我们的模型识别出 ? ℛ ? 每当 ? ℛ ? 和 ? ℛ ?！类似的逻辑就足以“反之亦然”。

我们可以通过使用

来验证这个结果 
Start_Date

在工作流之前将第 8 行附加到 my_data_frame <- my_data_frame %>% rbind(list(Name = "A",Start_Date = as.Date("2010-01-01"),End_Date = as.Date("2015-01-05"))) ：

my_data_frame

第 8 行作为我们的 ?，其中 ? 是第 1 行，而 ? 是第 4 行，和以前一样。实际上， Name Start_Date End_Date 1 A 2015-01-01 2019-12-29 # ⋮ ⋮ ⋮ ⋮ 4 A 2012-04-16 2015-01-09 # ⋮ ⋮ ⋮ ⋮ 8 A 2010-01-01 2015-01-05 正确地将 ? 和 ? 归为同一组 output：? ℛ ?。

1

同样， Name Start_Date End_Date Wanted Flag 1: A 2015-01-01 2019-12-29 1 TRUE 2: A 2017-03-25 <NA> NA FALSE 3: A 2019-10-17 <NA> 1 FALSE 4: A 2012-04-16 2015-01-09 1 FALSE 5: A 2002-06-01 2006-02-01 2 FALSE 6: A 2005-12-24 <NA> 2 FALSE 7: B 2018-01-23 <NA> NA FALSE 8: A 2010-01-01 2015-01-05 1 FALSE 正确地 output 是第一行，其 Flag 现在与两个 Start_Date 匹配：在第 4 行和第 8 行。

干杯！

data.tabledata.tableigraphrr