Создание уникального столбца идентификатора для большого набора данных с помощью пакета RecordLinkage

Question

Я пытаюсь создать уникальный столбец идентификатора с помощью пакета RecordLinkage. Я успешно сделал это при работе с меньшими наборами данных (<= 1 000 000), но не смог воспроизвести этот результат для больших наборов данных (> 1 000 000), которые используют разные (но похожие) функции в пакете. Мне дают несколько переменных-идентификаторов, для которых я хочу создать уникальный идентификатор, несмотря на то, что в записях могут быть некоторые ошибки (близкие совпадения) или дубликаты.

Учитывая некоторые данные кадра идентификаторов:

data(RLdata500)
df_identifiers <- RLdata500

Это код для меньших наборов дат (которые работают):

df_identifiers <- df_identifiers %>% mutate(ID = 1:nrow(df_identifiers))
rpairs <- compare.dedup(df_identifiers)
p=epiWeights(rpairs)
classify <- epiClassify(p,0.3)
matches <- getPairs(object = classify, show = "links", single.rows = TRUE)

# this code writes an "ID" column that is the same for similar identifiers
classify <- matches %>% arrange(ID.1) %>% filter(!duplicated(ID.2))
df_identifiers$ID_prior <- df_identifiers$ID

# merge matching information with the original data
df_identifiers <- left_join(df_identifiers, matches %>% select(ID.1,ID.2), by=c("ID"="ID.2"))

# replace matches in ID with the thing they match with from ID.1
df_identifiers$ID <- ifelse(is.na(df_identifiers$ID.1), df_identifiers$ID, df_identifiers$ID.1)

Этот подход обсуждается здесь. Но этот код не кажется расширяемым при применении к большим наборам данных при использовании других функций. Например, большой эквивалент данных compare.dedup является RLBigDataDedup, чья RLBigData Поддержка классов аналогичных функций, таких как epiWeights, epiClassify, getPairsи т. д. Замена compare.dedup с RLBigDataDedup не работает в этой ситуации.

Рассмотрим следующую попытку для больших наборов данных:

df_identifiers <- df_identifiers %>% mutate(ID = 1:nrow(df_identifiers))
rpairs <- RLBigDataDedup(df_identifiers)
p=epiWeights(rpairs)
( . . . )

Здесь оставшийся код практически идентичен первому. Хотя epiWeights а также epiClassify работать на RLBigData класс, как и ожидалось, getPairs не. Функция getPairs не использует show = "links" аргумент. Из-за этого весь последующий код не работает.

Существует ли другой подход, который необходимо использовать для создания столбца уникальных идентификаторов при работе с большими наборами данных в RLBigData класс или это просто ограничение?

Answer 1

Сначала импортируйте следующие библиотеки:

library(RecordLinkage)
library(dplyr)
library(magrittr)

Рассмотрим эти примеры наборов данных из пакета RecordLinkage:

data(RLdata500)
data(RLdata10000)

Предположим, что мы заботимся об этих совпадающих переменных и пороге:

matching_variables <- c("fname_c1", "lname_c1", "by", "bm", "bd")
threshold <- 0.5

Связывание записей для малых наборов данных выглядит следующим образом:

RLdata <- RLdata500
df_names <- data.frame(RLdata[, matching_variables])
df_names %>%
  compare.dedup() %>%
  epiWeights() %>%
  epiClassify(threshold) %>%
  getPairs(show = "links", single.rows = TRUE) -> matching_data

Здесь можно применить следующие МАЛЕНЬКИЕ манипуляции с данными, чтобы добавить соответствующие идентификаторы к данному набору данных (тот же код здесь):

RLdata_ID <- left_join(mutate(df_names, ID = 1:nrow(df_names)),
                       select(matching_data, id1, id2) %>%
                         arrange(id1) %>% filter(!duplicated(id2)),
                       by = c("ID" = "id2")) %>%
  mutate(ID = ifelse(is.na(id1), ID, id1)) %>%
  select(-id1)
RLdata$ID <- RLdata_ID$ID

Эквивалентный код для больших наборов данных выглядит следующим образом:

RLdata <- RLdata10000
df_names <- data.frame(RLdata[, matching_variables])
df_names %>%
  RLBigDataDedup() %>%
  epiWeights() %>%
  epiClassify(threshold) %>%
  getPairs(filter.link = "link", single.rows = TRUE) -> matching_data

Здесь можно применить следующие БОЛЬШИЕ манипуляции с данными, чтобы добавить соответствующие идентификаторы к данному набору данных (аналогично коду отсюда):

RLdata_ID <- left_join(mutate(df_names, ID = 1:nrow(df_names)),
                       select(matching_data, id.1, id.2) %>%
                         arrange(id.1) %>% filter(!duplicated(id.2)),
                       by = c("ID" = "id.2")) %>%
  mutate(ID = ifelse(is.na(id.1), ID, id.1)) %>%
  select(-id.1)
RLdata$ID <- RLdata_ID$ID