Вот моя попытка. Поскольку вы не можете делиться своими данными, то, что я могу для вас сделать, ограничено. Но я надеюсь, что следующее поможет вам в какой-то мере. Я думаю, что проблема здесь состоит в том, чтобы преобразовать числа в письменные числа. Это то, что мы можем решить с помощью пакета engli sh. Я создал два вектора (т.е. WWname и PXname). Я также создал свою собственную функцию под названием myfun
. Это обрабатывает некоторые операции со строками, такие как преобразование% в проценты и преобразование чисел в записанные числа. Я использовал эту функцию и создал два фрейма данных (т. Е. Ww и px).
library(tidyverse)
library(english)
library(stringi)
library(stringdist)
WWname <- c("Excellence Dark 85% Cocoa 100g", "Excellence Dark 78% COCOA 100G",
"ZDEL Excellence Dark 85% Cocoa 100g", "Excellence Dark 50% Cocoa 100g")
PXname <- c("Excellence Dark 85% Cocoa 100g", "Excellence Dark 80% Cocoa 200g",
"ZDEL Excellence Dark 80% Cocoa 100g", "ZDEL Excellence Dark 85% Cocoa 100g",
"ZDEL Excellence Dark 78% Cocoa 100g", "Excellence Dark 78% Cocoa 100g",
"Excellence Dark 50% Cocoa 100g")
myfun <- function(myvec) {
sub(x = myvec, pattern = "%", replacement = " percent") %>%
sub(pattern = "(?<=[0-9])g|G", replacement = " grams", perl = T) %>%
tolower %>%
stri_split_regex(pattern = "\\s") %>%
enframe %>%
unnest(value) %>%
mutate(word = if_else(grepl(x = value, pattern = "[0-9]+"),
as.character(english(as.numeric(value))),
value)) %>%
group_by(name) %>%
summarize(string = paste0(word, collapse = " ")) -> out
return(out)
}
# Convert numbers to alphabets abd create new strings.
ww <- myfun(myvec = WWname)
px <- myfun(myvec = PXname)
# Calculate distance.
mymat <- stringdistmatrix(a = ww$string, b = px$string, method = "lcs")
rownames(mymat) <- WWname
colnames(mymat) <- PXname
# Check if there is any non-match.
mymat %>%
as.data.frame(stringsAsFactors = F) %>%
rownames_to_column(var = "WWname") %>%
pivot_longer(cols = -WWname, names_to = "PXname", values_to = "ranking") %>%
group_by(WWname) %>%
mutate(check = if_else(any(ranking == 0),
TRUE,
FALSE)) -> out
Теперь мы проверяем соответствующие шаблоны.
filter(out, check == TRUE) %>%
slice(which.min(ranking))
WWname PXname ranking check
<chr> <chr> <dbl> <lgl>
1 Excellence Dark 50% Cocoa 100g Excellence Dark 50% Cocoa 100g 0 TRUE
2 Excellence Dark 78% COCOA 100G Excellence Dark 78% Cocoa 100g 0 TRUE
3 Excellence Dark 85% Cocoa 100g Excellence Dark 85% Cocoa 100g 0 TRUE
4 ZDEL Excellence Dark 85% Cocoa 100g ZDEL Excellence Dark 85% Cocoa 100g 0 TRUE
Если мы хотим проверить несоответствие, мы можем сделать следующее. Это вернет кратчайшее несоответствие. В этом случае совпадения нет.
filter(out, check == FALSE) %>%
slice(which.min(ranking))