Levenshtein 계산 QWERTY 오류 허용 거리 R

Question

사용자 입력 회사 이름 간의 R에서 Levenshtein 거리를 Fortune 1000 목록과 비교하여 계산하지만 QWERTY 인쇄 오류는 허용됩니다. 예를 들어, Mcdimldes은 McDonalds에서 2의 거리를 가져야합니다. i은 o 옆에 있고 m은 n 옆에 있기 때문입니다.

구현시 다른 시도가 있었지만 파이썬 (click here). 어떤 도움을 주셔서 감사합니다.

문제를 명확히하기 위해 추가 세부 정보를 추가해야하는지 알려 주시기 바랍니다.

Answer 1

어쩌면 당신이 뭔가를 구축 할 수 있습니다 :

## from the link in the linked python answer: 
# txt <- "'q': {'x':0, 'y':0}, 'w': {'x':1, 'y':0}, 'e': {'x':2, 'y':0}, 'r': {'x':3, 'y':0}, 't': {'x':4, 'y':0}, 'y': {'x':5, 'y':0}, 'u': {'x':6, 'y':0}, 'i': {'x':7, 'y':0}, 'o': {'x':8, 'y':0}, 'p': {'x':9, 'y':0}, 'a': {'x':0, 'y':1},'z': {'x':0, 'y':2},'s': {'x':1, 'y':1},'x': {'x':1, 'y':2},'d': {'x':2, 'y':1},'c': {'x':2, 'y':2}, 'f': {'x':3, 'y':1}, 'b': {'x':4, 'y':2}, 'm': {'x':5, 'y':2}, 'j': {'x':6, 'y':1}, 'g': {'x':4, 'y':1}, 'h': {'x':5, 'y':1}, 'j': {'x':6, 'y':1}, 'k': {'x':7, 'y':1}, 'l': {'x':8, 'y':1}, 'v': {'x':3, 'y':2}, 'n': {'x':5, 'y':2}" 
# txt <- strsplit(txt, "\\},\\s?")[[1]] 
# m <- t(sapply(regmatches(txt, regexec("'(.)':\\s*\\{'x':(\\d+),\\s*'y':(\\d+).*", txt)), "[", -1)) 
# m <- matrix(as.numeric(m[,-1]), ncol=2, dimnames = list(m[,1],c("x","y"))) 
# dput(m) 
m <- structure(c(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 0, 1, 1, 2, 2, 3, 
    4, 5, 6, 4, 5, 6, 7, 8, 3, 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 
    2, 1, 2, 1, 2, 1, 2, 2, 1, 1, 1, 1, 1, 1, 2, 2), .Dim = c(27L, 
    2L), .Dimnames = list(c("q", "w", "e", "r", "t", "y", "u", "i", 
    "o", "p", "a", "z", "s", "x", "d", "c", "f", "b", "m", "j", "g", 
    "h", "j", "k", "l", "v", "n"), c("x", "y"))) 
m["m", ] <- c(6,2) # 5,2 seems wrong... 

f <- function(a, b) { 
    posis <- lapply(strsplit(c(a, b), "", T), function(x) m[x,,drop=F]) 
    d <- abs(posis[[1]]-posis[[2]]) 
    idx <- which(rowSums(d>1)==0) 
    if (length(idx)>0) rownames(posis[[1]])[idx] <- rownames(posis[[2]])[idx] 
    paste(rownames(posis[[1]]), collapse="") 
} 
a <- tolower("Mcdimldes") # make it case-insensitive 
b <- tolower("McDonalds") 
adist(a,b) # regular distance 
# [1,] 4 
newa <- f(a, b) # replace possible typo chars 
adist(newa,b) # new dist is 2 - as requested 
#  [,1] 
# [1,] 2 

매트릭스의 키보드 레이아웃 :

keyb <- sweep(m, 2, c(1, -1), "*") 
plot(keyb, type = "n") 
text(keyb, rownames(keyb)) 
grid()