如何从更改的数据框中创建查找表？

Question

我想根据更改的数据框创建一个查找表。原始数据框的每一行都表示给定地区编码的变化。该数据集涵盖了 2009 年至 2019 年的某个时间段。虽然一个地区在该时间段内可能会经历多次变化，但我想要 2009 年和 2019 年每个区的编码。也就是第一个和最新的编码。

数据框覆盖数百个地区。一些地区可能只进行一次更改，而另一些地区可能会进行多次更改。一个地区可以合并或拆分为多个其他地区。

理想的查找表如下所示：

coding_2009	coding_2019
00QR	S12000047
00QR	S12000048
00RB	S12000047
00RB	S12000048

coding_2009 是该区截至 2009 年的编码，coding_2019 是其截至 2019 年的最新编码。

每行显示变化的原始数据框（子集）如下所示：

past	new	date
00QR	S12000015	2009-01-01
S12000015	S12000047	2018-02-02
S12000015	S12000048	2018-02-02
00RB	S12000015	2009-01-01
S12000024	S12000047	2018-02-02
S12000024	S12000048	2018-02-02

对于每一行，past 是从date 重新编码为new 的代码。

比如区00QR变成S12000015，后来又拆分成S12000047和S12000048。

我已经处理这个问题好几个星期了，尝试了不同的临时版本，但似乎没有一个能始终如一地解决。请注意，代码需要考虑一些地区只经历一次变化，而其他地区可能经历两次或更多变化。如示例所示，区域也可以拆分或合并。

理想的答案是使用tidyverse。

对于 reprex，我在下面选择了一些地区的子集。

感谢您的帮助！将不胜感激。

重复数据： （您也可以超越并使用原始数据集，Changes.csv。请参见下面的链接）

# Library tibble (a part of tidyverse) is needed to copy paste reprex data
#install.packages("tibble") # if you need to install it
library(tibble)

data <- tibble::tribble(
        ~past,        ~new,        ~date,
       "00RJ", "S12000013", "2009-01-01",
       "00QR", "S12000015", "2009-01-01",
       "00RB", "S12000024", "2009-01-01",
       "13UD", "E07000015", "2009-01-01",
       "15UH", "E07000025", "2009-01-01",
       "00HC", "E06000024", "2009-01-01",
       "00KG", "E06000034", "2009-01-01",
       "19UD", "E07000049", "2009-01-01",
       "19UE", "E07000050", "2009-01-01",
       "19UG", "E07000051", "2009-01-01",
       "19UH", "E07000052", "2009-01-01",
       "19UJ", "E07000053", "2009-01-01",
  "E07000017", "E06000049", "2009-04-01",
  "E07000025", "E06000053", "2009-04-01",
  "E07000014", "E06000049", "2009-04-01",
  "E07000015", "E06000049", "2009-04-01",
  "S12000013", "S12000013", "2015-06-16",
  "S12000013", "S12000013", "2015-11-01",
  "S12000015", "S12000047", "2018-02-02",
  "S12000024", "S12000047", "2018-02-02",
  "S12000015", "S12000048", "2018-02-02",
  "S12000024", "S12000048", "2018-02-02",
  "E07000049", "E06000059", "2019-04-01",
  "E07000050", "E06000059", "2019-04-01",
  "E07000053", "E06000059", "2019-04-01",
  "E07000051", "E06000059", "2019-04-01",
  "E07000052", "E06000059", "2019-04-01"
  )

# Convert date to Date (after being copy pasted as tibble)
data$date <- as.Date(data$date)

对于任何感兴趣的人，此数据来自英国的Code History Database。您可以从下面的链接下载 zip。这是名为Changes.csv:https://geoportal.statistics.gov.uk/datasets/code-history-database-december-2019-for-the-united-kingdom 的文件。请注意，在Changes.csv 中，past 被命名为geogcd_p，new 被命名为geogcd 和date 被命名为oper_date。

Answer 1

您实际上是在看一个扁平的树结构。使用 igraph 包可以轻松绘制图表：

library(igraph)
g <- dat %>% select( past,new ) %>% t %>% c %>% graph
plot( g )

从现在开始，有很多方法可以解决这个问题，但归结为深度优先或宽度优先方法来解决问题。

假设我们有几个小图是合理的。一堆不同的代码经历了一些变化，而不是选择的几个代码经历了很多变化。

这提出了一种宽度优先的方法，并且可以通过将数据连接到自身来解决，希望不要太多次：

## work with data.table for that extra speed.
setDT(dat)

## remove duplicate entries of same code
dat <- dat[, .(date=max(date)), by=.(past,new) ]

## these are the roots, all `past` values never present in `new`
roots <- dat[ !past %in% new ]

## likewise, the leaves are those that never appear as `past` , unless they are self referencing.
leaves <- unique( dat[ !new %in% past | new == past, !"past" ], by="new" )


dd <- copy(roots)

## sucessively add next step from the source data till we have arrived at leaves only.
while( !all( dd$new %in% leaves$new ) ) {
    dd <- unique(
        merge( dd, dat, by.x="new", by.y="past", all.x=TRUE )[ , .(date.x, past, new=coalesce(new.y,new), date.y=coalesce(date.y,date.x) ) ]
    )
}

## final cleanup
dd[ order(past), .(coding_2009=past,coding_2019=new) ]

输出：

> dd[ order(past), .(coding_2009=past,coding_2019=new) ]
    coding_2009 coding_2019
 1:        00HC   E06000024
 2:        00KG   E06000034
 3:        00QR   S12000047
 4:        00QR   S12000048
 5:        00RB   S12000047
 6:        00RB   S12000048
 7:        00RJ   S12000013
 8:        13UD   E06000049
 9:        15UH   E06000053
10:        19UD   E06000059
11:        19UE   E06000059
12:        19UG   E06000059
13:        19UH   E06000059
14:        19UJ   E06000059
15:   E07000014   E06000049
16:   E07000017   E06000049

现在我只查看了迷你数据集，所以我不知道代码在野外会如何运行，但你可以试一试。

看上面的图片，我们看到每个图从根到叶最多有 3 个步骤，这意味着上面的 while 循环只需要运行一次。

Answer 2

Sirius 使用 data.table 提供了一个惊人的答案。在这里，我将这个答案翻译成tidyverse：

# Remove duplicate entries of same code
data_sub <- data %>%
  group_by(past, new) %>%
  filter(date == max(date)) %>%
  ungroup()

# Create roots: All past values never present in new
roots <- data_sub %>%
  filter(!past %in% new)

# Create leaves: Those that never appear as past, unless they self reference
leaves <- data_sub %>%
  filter(!new %in% past | new == past) %>%
  select(-past) %>%
  distinct(new, .keep_all = TRUE)

# Copy before loop
dd <- roots

# Successively add next step from source data until we have arrived at leaves only
while(!all(dd$new %in% leaves$new)) {
  
  # Join
  dd_merge <- left_join(dd, data_sub, by = c("new" = "past"))
  
  # Coalesce
  dd_sub <- dd_merge %>%
    transmute(date.x,
              past,
              new = coalesce(new.y, new),
              date.y = coalesce(date.y, date.x))
  
  # Take unique
  dd <- unique(dd_sub)
  
}