R 文本挖掘：从数据框中对相似模式进行分组。答案

【问题标题】：R text mining : Grouping of similar patterns from a dataframe.R 文本挖掘：从数据框中对相似模式进行分组。
【发布时间】：2015-03-02 09:07:16
【问题描述】：

我应用了 tm 包中的各种清理功能，例如删除标点符号、数字、特殊字符、常用英文单词等，并得到如下所示的数据框。请记住，我没有可以依赖的主键，例如 cust_id 或 account_number

sno        names
001        SIRIS BLACK
002        JOHN DOE
003        STEPHEN HRYY
004        SIRIUS BLACK
005        SIRUS BLACK
006        JON DOE
007        STEPHEN HARRY
008        STIPHEN HURRY
009        JHN DOE

看上面的数据，我真的能感觉到模式有相似之处，而且那些名字彼此很接近。如何使用 R 的可用文本挖掘功能计算模式相等的百分比，以便最终获得具有所有唯一名称的数据框？

假设和缺点：

直言不讳地假设唯一名称可能是具有最大字符数的名称，因为我拥有的原始数据中有大量的名称拼写错误。（逻辑假设，也许会减少错别字的数量）
agrep() 函数在大字符串中搜索模式的近似匹配，这里的问题是我实际上不知道模式是什么。

像这样对相似的字符串进行分组：

sno        names
001        SIRIS BLACK          
002        SIRIUS BLACK
003        SIRUS BLACK
004        JHN DOE
005        JOHN DOE
006        JON DOE
007        STEPHEN HARRY
008        STIPHEN HURRY
009        STEPHEN HRYY

最后得到这个：

001     JOHN DOE
002     STEPHEN HARRY
003     STIPHEN HURRY
004     SIRIUS BLACK

【问题讨论】：

我会将这类任务交给 Google Refine。
我希望我也能做到这一点。我不确定它是否能满足我正在攻读的 R 课程的学术要求，可能会花费我一些宝贵的分数......； )

标签： r dataframe text-mining tm names

【解决方案1】：

对于agrep 部分，这是一种方法 - 您可以使用参数来调整结果：

sim <- setNames(lapply(1:nrow(df), function(i) agrep(df$names[i], df$names, max.distance = list(all=2, insertions=2, deletions=2, substitutions=0))), df$names)
sim <- lapply(sim, function(x) unique(df$names[x]))
df$names2 <- sapply(sim, "[", 1)
df[!duplicated(df$names2), ]
#   sno         names        names2
# 1   1   SIRIS BLACK   SIRIS BLACK
# 2   2      JOHN DOE      JOHN DOE
# 3   3  STEPHEN HRYY  STEPHEN HRYY
# 8   8 STIPHEN HURRY STIPHEN HURRY

【讨论】：

好吧，我遇到了一个错误。如果我无法解决它，我会回复。我可能错过了某些“东西”.. Error in agrep() 'pattern' must be a non-empty character string 和 try() ，也许
也许您的姓名列属于类型因素，而不是类型字符。
实际上，空行很少，我想这是在玩破坏游戏。
该示例适用于您的示例，以展示agrep 的想法。您可能需要针对整个数据框进行调整。
没错，它就像一个魅力。非常感谢@lukeA 如果没有获得唯一的行或完美的名称，我可以将重复行的数量减少近 53%.. !!!

【解决方案2】：

这是另一种方法。它使用 RecordLinkage 包并找到排序向量的最短形式。您可以调整阈值水平。

structure(list(sno = structure(c(1L, 2L, 3L, 4L, 5L, 6L, 7L, 
7L, 8L), .Label = c("JHN", "JOHN", "JON", "SIRIS", "SIRIUS", 
"SIRUS", "STEPHEN", "STIPHEN"), class = "factor"), names = structure(c(2L, 
2L, 2L, 1L, 1L, 1L, 3L, 4L, 5L), .Label = c("BLACK", "DOE", "HARRY", 
"HRYY", "HURRY"), class = "factor"), both.names = c("JHN DOE", 
"JOHN DOE", "JON DOE", "SIRIS BLACK", "SIRIUS BLACK", "SIRUS BLACK", 
"STEPHEN HARRY", "STEPHEN HRYY", "STIPHEN HURRY")), .Names = c("sno", 
"names", "both.names"), row.names = c("009", "002", "006", "001", 
"004", "005", "007", "003", "008"), class = "data.frame")

library("RecordLinkage")
compareJW <- function(string, vec, cutoff) {
  require(RecordLinkage)
  jarowinkler(string, vec) > cutoff
}

shortenFirms <- function(firms, cutoff) {
  shortnames <- firms[1]
  firms <- firms[-1]

  for (firm in firms) {
    if (is.na(firm)) { # no firm name, so short-circuit and add an NA
      shortnames <- c(shortnames, NA)
      next

    }
    unique.short <- unique(shortnames[!is.na(shortnames)])
    hits <- compareJW(firm, unique.short, cutoff)
    if (sum(hits) > 1) {
      warning(paste("cassifyFirms: more than one match for", firm))
      shortnames <- c(shortnames, NA)
    } else if (sum(hits) == 0) {
      shortnames <- c(shortnames, firm)
    } else {
      shortnames <- c(shortnames, unique.short[hits])
    }
  }
  shortnames
}

shortenFirms(df$both.names, 0.8)

shortenFirms(df$both.names, 0.8)

[1] "JHN DOE"       "JHN DOE"       "JHN DOE"       "SIRIS BLACK"   "SIRIS BLACK"   "SIRIS BLACK"   "STEPHEN HARRY"
[8] "STEPHEN HARRY" "STEPHEN HARRY"

【讨论】：