MetaPhone功能（如SoundEx）功能并在R中使用？

Question

我想使用MetaPhone，Double Metaphone，Caverphone，MetaPhone3，SoundEx，如果还有人在'R'中完成NameX个功能，那么我可以对数据进行分类和汇总，以便在分析之前最大限度地减少数据清理操作。

我完全清楚每种算法都有自己的优点和缺点，非常不喜欢使用SoundEx ，但如果我找不到替代品，它仍可能有用;就像mentioned in this post Harper 会与SoundEx下的任何无关名称列表匹配，但不应该在Metaphone中以获得更好的结果匹配。

虽然我不确定哪个会最好地服务于我的目的，同时仍然保留一些灵活性，所以这就是为什么我想要对它们中的几个进行尝试以及在查看值之前生成如下表格。< / p>

Table Source Link

姓氏不是我初步分析的主题，但认为这是一个很好的例子，因为我想有效地考虑所有像'听起来'的单词被视为相同的值是我真正试图用简单地调用的东西作为评估值。

我已经看过一些事情：

• 我知道可以使用RCpp编写和调用C包，并且SoundEx on SE甚至有C解决方案，但我之前没有写过R包并且希望避免重新发明轮子是否有更简单的方法直接在R中执行它或存在具有该功能的包？
• 我知道RecordLinkage和现在stringdist包有SoundEx功能，但没有任何形式的MetaPhone功能。

  

所以我特意寻找答案是如何在R中运行MetaPhone / Caverphone并知道“值”，以便我可以按它们对数据值进行分组？

另外需要注意的是，我仍然认为自己是R的新手，因为我不是每日用户。

Answer 1

该算法非常简单，但我也找不到现有的R包。如果你真的需要在R中做这项工作，一个短期选择是安装python模块metaphone（pip install metaphone）然后使用rPython桥在R中使用它：< / p>

library(rPython)

python.exec("from metaphone import doublemetaphone")
python.call("doublemetaphone", "architect")
[1] "ARKTKT" ""

这不是最优雅的解决方案，但它可以让你在R中进行metaphone操作。

Apache Commons有一个codec library，它也实现了metaphone算法：

library(rJava)

.jinit() # need to have commons-codec-1.10.jar in your CLASSPATH

mp <- .jnew("org.apache.commons.codec.language.Metaphone")
.jcall(mp,"S","metaphone", "architect")
[1] "ARXT"

您可以将上述.jcall设为R函数，并像使用其他任何R函数一样使用它：

metaphone <- function(x) {
  .jcall(mp,"S","metaphone", x)  
}

sapply(c("abridgement", "stupendous"), metaphone)

## abridgement  stupendous 
##      "ABRJ"      "STPN"

java界面也可以跨平台更兼容。

以下是使用java界面的更完整视图：

library(rJava)

.jinit()

mp <- .jnew("org.apache.commons.codec.language.Metaphone")
dmp <- .jnew("org.apache.commons.codec.language.DoubleMetaphone")

metaphone <- function(x) {
  .jcall(mp,"S","metaphone", x)  
}

double_metaphone <- function(x) {
  .jcall(dmp,"S","doubleMetaphone", x)  
}

words <- c('Catherine', 'Katherine', 'Katarina', 'Johnathan', 
           'Jonathan', 'John', 'Teresa', 'Theresa', 'Smith', 
           'Smyth', 'Jessica', 'Joshua')

data.frame(metaphone=sapply(words, metaphone),
           double=sapply(words, double_metaphone))

##           metaphone double
## Catherine      K0RN   K0RN
## Katherine      K0RN   K0RN
## Katarina       KTRN   KTRN
## Johnathan      JN0N   JN0N
## Jonathan       JN0N   JN0N
## John             JN     JN
## Teresa          TRS    TRS
## Theresa         0RS    0RS
## Smith           SM0    SM0
## Smyth           SM0    SM0
## Jessica         JSK    JSK
## Joshua           JX     JX

Answer 2

现在，R包中的PGRdup内部实现了双重Metaphone。

install.packages(PGRdup)
library(PGRdup)
words <- c('Catherine', 'Katherine', 'Katarina', 'Johnathan', 
           'Jonathan', 'John', 'Teresa', 'Theresa', 'Smith', 
           'Smyth', 'Jessica', 'Joshua')
DoubleMetaphone(words)

$primary
 [1] "K0RN" "K0RN" "KTRN" "JN0N" "JN0N" "JN"   "TRS"  "0RS"  "SM0"  "SM0"  "JSK"  "JX"  

$alternate
 [1] "KTRN" "KTRN" "KTRN" "ANTN" "ANTN" "AN"   "TRS"  "TRS"  "XMT"  "XMT"  "ASK"  "AX"  

Answer 3

我一直在研究这个名为 phonics ，for a few months的软件包。我已经实现了几个常见的和不常见的，包括Caverphone，Caverphone2，Metaphone和soundex。其他一些实施。在调用1.0之前，我还有一些计划实现，但我刚刚向CRAN提交了一个软件包版本。

Answer 4

这是一个caverphone解释，虽然它捕获了级联规则的方法，但请记住，caverphone总是打算作为自定义到区域重音上下文的一个例子（尽管人们确实以一般的方式使用它）根据他们自己的区域对大多数其他人做出不同的权衡取舍），所以我建议a）获取数据源中的唯一字符以确保你正在处理所有这些，b）考虑改变最终长度限制与你正在使用的名字的关系，以及c）考虑对区域口音组合进行建模 - 这是为了对19世纪末/ 20世纪初新西兰的各种口音团体进行建模，以及他们可能错误地转录每个口音的方式其他人说。

caverphonise <- function(x) {
# Convert to lowercase
x <- tolower(x)

# Remove anything not A-Z
x <- gsub("[^a-z]", "", x)

# If the name starts with
## cough make it cou2f
x <- gsub("^cough", "cou2f", x)
## rough make it rou2f
x <- gsub("^rough", "rou2f", x)
## tough make it tou2f
x <- gsub("^tough", "tou2f", x)
## enough make it enou2f
x <- gsub("^enough", "enou2f", x)
## gn make it 2n
x <- gsub("^gn", "2n", x)

# If the name ends with
## mb make it m2
x <- gsub("mb$", "m2", x)

# Replace
## cq with 2q
x <- gsub("cq", "2q", x)
## ci with si
x <- gsub("ci", "si", x)
## ce with se
x <- gsub("ce", "se", x)
## cy with sy
x <- gsub("cy", "sy", x)
## tch with 2ch
x <- gsub("tch", "2ch", x)
## c with k
x <- gsub("c", "k", x)
## q with k
x <- gsub("q", "k", x)
## x with k
x <- gsub("x", "k", x)
## v with f
x <- gsub("v", "f", x)
## dg with 2g
x <- gsub("dg", "2g", x)
## tio with sio
x <- gsub("tio", "sio", x)
## tia with sia
x <- gsub("tia", "sia", x)
## d with t
x <- gsub("d", "t", x)
## ph with fh
x <- gsub("ph", "fh", x)
## b with p
x <- gsub("b", "p", x)
## sh with s2
x <- gsub("sh", "s2", x)
## z with s
x <- gsub("z", "s", x)
## any initial vowel with an A
x <- gsub("^[aeiou]", "A", x)
## all other vowels with a 3
x <- gsub("[aeiou]", "3", x)
## 3gh3 with 3kh3
x <- gsub("3gh3", "3kh3", x)
## gh with 22
x <- gsub("gh", "22", x)
## g with k
x <- gsub("g", "k", x)
## groups of the letter s with a S
x <- gsub("s+", "S", x)
## groups of the letter t with a T
x <- gsub("t+", "T", x)
## groups of the letter p with a P
x <- gsub("p+", "P", x)
## groups of the letter k with a K
x <- gsub("k+", "K", x)
## groups of the letter f with a F
x <- gsub("f+", "F", x)
## groups of the letter m with a M
x <- gsub("m+", "M", x)
## groups of the letter n with a N
x <- gsub("n+", "N", x)
## w3 with W3
x <- gsub("w3", "W3", x)
## wy with Wy
x <- gsub("wy", "Wy", x)
## wh3 with Wh3
x <- gsub("wh3", "Wh3", x)
## why with Why
x <- gsub("why", "Why", x)
## w with 2
x <- gsub("w", "2", x)
## any initial h with an A
x <- gsub("^h", "A", x)
## all other occurrences of h with a 2
x <- gsub("h", "2", x)
## r3 with R3
x <- gsub("r3", "R3", x)
## ry with Ry
x <- gsub("ry", "Ry", x)
## r with 2
x <- gsub("r", "2", x)
## l3 with L3
x <- gsub("l3", "L3", x)
## ly with Ly
x <- gsub("ly", "Ly", x)
## l with 2
x <- gsub("l", "2", x)
## j with y
x <- gsub("j", "y", x)
## y3 with Y3
x <- gsub("y3", "Y3", x)
## y with 2
x <- gsub("y", "2", x)

# remove all
## 2s
x <- gsub("2", "", x)
## 3s
x <- gsub("3", "", x)
# put six 1s on the end
x <- paste(x,"111111", sep="")
# take the first six characters as the code
unlist(lapply(x, FUN= function(x){paste((strsplit(x, "")[[1]])[1:6], collapse="")}))
}