@ RonakShah опубликовал версию этого ранее сегодня, но затем удалил ее, так как его решение не вполне соответствовало требованиям.
Идея состоит в том, чтобы использовать пакет fuzzyjoin
, который имеет множество функций для нечеткого сопоставления двух наборов данных. Ни один из них точно не соответствует требованиям этого вопроса, но вот более длинный ответ, который должен это сделать.
Функция stringdist_inner_join
выполняет регулярное нечеткое совпадение. Он работает путем построения сложной функции для использования в fuzzy_join
. Это не экспортирует эту функцию; но вы можете создать свою собственную функцию (я называю это stringdist_match
), которая просто создает функцию и экспортирует ее. Затем объедините его с тем, который сравнивает первые буквы, и используйте объединенную функцию (custom_match
) в fuzzy_join
. Вот код Большая часть функции stringdist_match
скопирована из пакета fuzzyjoin
.
library(fuzzyjoin)
stringdist_match <- function(max_dist = 2,
method = c("osa", "lv", "dl", "hamming", "lcs", "qgram",
"cosine", "jaccard", "jw", "soundex"),
mode = "inner",
ignore_case = FALSE,
distance_col = NULL, ...) {
# It's a good idea to force evaluation of all the arguments
# in case they get changed between when we call this function and
# when we use the function it returns.
force(max_dist)
force(mode)
force(ignore_case)
force(distance_col)
forceotherargs <- list(...)
method <- match.arg(method)
if (method == "soundex") {
# soundex always returns 0 or 1, so any other max_dist would
# lead either to always matching or never matching
max_dist <- .5
}
function(v1, v2) {
if (ignore_case) {
v1 <- stringr::str_to_lower(v1)
v2 <- stringr::str_to_lower(v2)
}
# shortcut for Levenshtein-like methods: if the difference in
# string length is greater than the maximum string distance, the
# edit distance must be at least that large
# length is much faster to compute than string distance
if (method %in% c("osa", "lv", "dl")) {
length_diff <- abs(stringr::str_length(v1) - stringr::str_length(v2))
include <- length_diff <= max_dist
dists <- rep(NA, length(v1))
dists[include] <- stringdist::stringdist(v1[include], v2[include], method = method, ...)
} else {
# have to compute them all
dists <- stringdist::stringdist(v1, v2, method = method, ...)
}
ret <- tibble::tibble(include = (dists <= max_dist))
if (!is.null(distance_col)) {
ret[[distance_col]] <- dists
}
ret
}
}
# Now the example. First, create a matching function that
# just does the fuzzy part.
fuzzy_match <- stringdist_match()
# Next create a matching function that just compares first letters.
first_letter_match <- function(col1, col2)
sub("(^.).*", "\\1", col1) == sub("(^.).*", "\\1", col2)
# Now create one that requires both to match.
custom_match <- function(col1, col2)
first_letter_match(col1, col2) & fuzzy_match(col1, col2)
# Now run the example
df1 <- data.frame(name = c("Peter P", "Jim Gordon", "Bruce Wayne", "Tony Stark","Mony Blake" ))
df2<- data.frame(name = c( "Jeter P", "Bruce Wayne", "Mony Blake" ))
fuzzy_inner_join(df1, df2, by = "name", match_fun = custom_match)
#> name.x name.y
#> 1 Bruce Wayne Bruce Wayne
#> 2 Mony Blake Mony Blake
Создана в 2020-02-21 пакетом представлением (v0.3.0)
Для документации по всем аргументам stringdist_match
см. ?fuzzyjoin::stringdist_join
.