基于模糊标准创建组
[英]Create group based on fuzzy criteria
问题描述
我有一个如下所示的数据框：
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
我正在寻找带有数据表的解决方案，但解决我的问题就足够了。
补充：逐行解释
排：
- 开始日期比第 4 行的结束日期早 8 天（< 1 年）。它与第 4 行在同一组中。
- 开始日期是第 1 行结束日期后 2 年以上。 与第 1 行不在同一组。与第 4、5 行相同。它与这两个也不在同一组。
- 开始日期比第 1 行的结束日期早 2 个月（< 1 年）。它与第 1 行在同一组中。
- 见第 1 行。
- 见下文。
- 开始日期比第 5 行的结束日期早 3 个月（< 1 年）。它与第 5 行在同一组中。
- 没有其他名称 B 可以比较。 它在它自己的组中。
因此，第1行、第3行和第4行在同一组中。 第5行和第6行在同一组中。 第2行和第7行没有组。
编辑：当观察与另一个观察不匹配时，我已更新我的代码以具有一致的Wanted类别。
1 个解决方案
解决方案1
8 已采纳 2021-07-13 17:49:12
方法
这是首选的data.table解决方案：
我更喜欢 data.table 的解决方案，但任何解决方案都非常感谢！
虽然dplyr和fuzzyjoin可能看起来更优雅，但对于足够大的数据集，它们也可能效率较低。
感谢 ThomasIsCoding在另一个问题上击败了我，答案是利用igraph来索引图中的网络。 在这里，网络是由“链接”（ data.frame行）组成的单独“链”（ Wanted组），它们通过它们的“紧密度”（在它们的Start_Date和End_Date之间）连接起来。 这种方法似乎有必要对此处要求的传递关系ℛ 进行建模
我正在尝试创建“关闭”链接链，以便我可以随着时间的推移映射 A 的运动。
还要注意保持 ℛ 的对称性（参见进一步阅读）。
每个相同的请求
因此，理想情况下，我想标记一个观察的开始日期（2016-01-01）与两个不同的结束日期（2015-01-02 和 2016-12-31）“模糊分组”的情况，反之亦然。
以及您的进一步说明
...我想要另一列指示 [flag]。
我还包含了一个Flag列，用于标记Start_Date与至少flag_at其他行的Start_Date匹配的End_Date行； 或相反亦然。
解决方案
使用您的示例data.frame ，在此处复制为my_data_frame
# Generate dataset as data.frame.
my_data_frame <- structure(list(Name = c("A", "A", "A", "A", "A", "A", "B"),
Start_Date = structure(c(16436, 17250, 18186, 15446, 11839, 13141, 17554),
class = "Date"),
End_Date = structure(c(18259, NA, NA, 16444, 13180, NA, 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仅仅是因为您的数据缺少与（至少）两个End_Date匹配的任何Start_Date ； 以及与（至少）两个Start_Date匹配的任何End_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
警告
由于某些data.table 操作通过引用（或“就地”）进行修改，因此my_data_table的值在整个工作流中my_data_table发生变化。 在第 1 步之后， 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 （以及其他包）是按值而不是按引用分配的，因此dplyr解决方案将完全回避这个问题。
然而，修改工作流时必须小心，因为在步骤 1 之前可用的my_data_table版本之后无法恢复。
进一步阅读
尽管data.table s 的JOIN是明确的方向——具有“右侧”和“左侧”——该模型设法保留了您在此处描述的关系对称性
如果... [任何一个] 的“Start_Date”在另一个观察的“End_Date”内为 +- 1 年，则它们被归类为同一组。
通过使用无向图。
当JOIN将第一行𝑥（ Start_Date为2015-01-01 ）与第四行𝑦（ End_Date为2015-01-09 ）相关联时，我们认为Start_Date的 Start_Date “足够接近”（在 1 年内） End_Date的 End_Date。 所以我们在数学上说 𝑥 ℛ 𝑦，或者
𝑥“与”𝑦在同一组。
然而，逆𝑦 ℛ 𝑥不一定会出现在JOIN ed 数据中，因为Start_Date的Start_Date可能不会那么方便地End_Date的End_Date附近。 也就是说， JOIN ed 数据不一定表明
𝑦 “与” 𝑥同组。
在后一种情况下，严格有向图（“有向图”）不会捕获 𝑥 和 𝑦 在同一组中的共同成员资格。 您可以通过在步骤 2 的第一行中设置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" ）。 每当JOIN ed 数据中存在 𝑥 ℛ 𝑦 时，这两种方法中的任何一种都将有效地模拟 𝑦 ℛ 𝑥 的存在。
在对您在此处描述的行为进行建模时，此对称属性尤其重要：
...一个观察的开始日期 (2016-01-01) 被“模糊地分组”为两个不同的结束日期（2015-01-02 和 2016-12-31）...
在这种情况下，您希望模型能够识别出任意两行 𝑦 和 𝑧 必须在同一组中（𝑦 ℛ 𝑧），只要它们的End_Date与其他行 𝑥 的相同Start_Date匹配： 𝑦 ℑ 𝑥 和 𝑧 ℛ 𝑧 .
所以假设我们知道 𝑦 ℛ 𝑥 和 𝑧 ℛ 𝑥。 因为我们的模型保留了对称性，所以我们可以从 𝑧 ℛ 𝑥 说 𝑥 ℛ 𝑧 也是。 由于我们现在知道 𝑦 ℛ 𝑥 和 𝑥 ℛ 𝑧，传递性意味着 𝑦 ℛ 𝑧。 因此，我们的模型识别出 𝑦 ℛ 𝑧 每当 𝑦 ℛ 𝑥 和 𝑧 ℛ 𝑥！ 类似的逻辑就足以“反之亦然”。
我们可以通过使用来验证这个结果
my_data_frame <- my_data_frame %>%
rbind(list(Name = "A",
Start_Date = as.Date("2010-01-01"),
End_Date = as.Date("2015-01-05")))
在工作流之前将第 8 行附加到my_data_frame ：
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
第 8 行作为我们的 𝑧，其中 𝑥 是第一行，𝑦 是第 4 行，和以前一样。 实际上， 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现在与两个End_Date匹配：在第 4 行和第 8 行。
干杯!
如何根据某些条件对分组的行进行分组并获得不同的行
[英]How to group by and get distinct rows of of grouped rows based on certain criteria
根据R中的空间邻域和时间标准将行分配给组
[英]Assign rows to a group based on spatial neighborhood and temporal criteria in R
声明:本站的技术帖子网页，遵循CC BY-SA 4.0协议，如果您需要转载，请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.