如何在 R 中使文本解析功能高效答案

【问题标题】：how to make a text parsing function efficient in R如何在 R 中使文本解析功能高效
【发布时间】：2015-05-02 20:49:45
【问题描述】：

我有这个函数可以计算一本书的 consonanceScore。首先，我导入语音字典from CMU（它形成了一个大约 134000 行和 33 个列变量的数据框；CMUdictionary 中的任何行基本上都是 CLOUDS K L AW1 D Z 的形式。第一列是单词，其余列有他们的语音等价物）。拿到CMU字典后，我把一本书解析成一个包含所有单词的向量；任何一本书的最大长度（到目前为止）：218711。每个单词的语音都与连续单词中的语音进行比较，并且连续+1个单词。然后将 TRUE 匹配值组合成一个总和。我的功能是这样的：

getConsonanceScore <- function(book, consonanceScore, CMUdict) {

  for (i in 1:((length(book)) - 2)) {

    index1 <- replaceIfEmpty(which (toupper(book[i]) == CMUdict[,1]))
    index2 <- replaceIfEmpty(which (toupper(book[i + 1]) == CMUdict[,1]))
    index3 <- replaceIfEmpty(which (toupper(book[i + 2]) == CMUdict[,1]))

    word1 <- as.character(CMUdict[index1, which(CMUdict[index1,] != "")])
    word2 <- as.character(CMUdict[index2, which(CMUdict[index2,] != "")])
    word3 <- as.character(CMUdict[index3, which(CMUdict[index3,] != "")])

    consonanceScore <- sum(word1 %in% word2)
    consonanceScore <- consonanceScore + sum(word1 %in% word3)
    consonanceScore <- consonanceScore / length(book)
  }

  return(consonanceScore)
}

如果在 CMU 字典中找不到书中任何单词的匹配项，replaceIfEmpty 函数基本上只是返回一个虚拟值的索引（已在数据帧的最后一行中声明）。它是这样的：

replaceIfEmpty <- function(x) {
  if (length(x) > 0)
  {
    return (x)
  }
  else
  {
    x = 133780
  return(x)
  }
}

我面临的问题是 getConsonanceScore 函数需要很多时间。如此之多，以至于在循环中，我不得不将书本长度除以 1000，以检查该功能是否正常工作。我是 R 新手，非常感谢您提供一些帮助来提高此功能的效率并减少时间消耗，有什么方法可以做到这一点吗？（我必须稍后在可能 50-100 本书上调用此函数）非常感谢！

【问题讨论】：

我是否正确，您尝试查找具有相同发音且它们之间的距离 data.frame：拼写和发音，然后您可以将第二列视为向量并非常简单地进行必要的比较。
是的，是的。但基本上我想做的是将一个单词中的每个单独的声音成分与另一个单词中的每个单独的声音成分进行比较。例如，如果有两个单词 sun 和 sky 紧挨着，那么只有它们的 's' 音会匹配。那么，我应该分别对待它们吗？它们是一种可以比较两个字符串的方式，并且我以某种方式获得了它们各个组件的相似性？我的猜测是普通的 '==' 会比较整个字符串。

标签： r text-processing text-parsing

【解决方案1】：

我最近重新阅读了您的问题、cmets 和@wibeasley 的答案，但我没有正确理解所有内容。现在它变得更清楚了，我会尝试提出一些有用的建议。

首先，我们需要一个小例子。我是根据您链接中的字典制作的。

dictdf <- read.table(text =
"A  AH0
CALLED  K AO1 L D
DOG  D AO1 G
DOGMA  D AA1 G M AH0
HAVE  HH AE1 V
I  AY1", 
header = F, col.names = paste0("V", 1:25), fill = T, stringsAsFactors = F )

#       V1  V2  V3 V4 V5  V6 V7 V8 V9 V10 V11 V12 V13 V14 V15 V16 V17 V18 V19 V20 V21 V22 V23 V24 V25
# 1      A AH0               NA NA NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA
# 2 CALLED   K AO1  L  D     NA NA NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA
# 3    DOG   D AO1  G        NA NA NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA
# 4  DOGMA   D AA1  G  M AH0 NA NA NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA
# 5   HAVE  HH AE1  V        NA NA NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA
# 6      I AY1               NA NA NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA

bookdf <- data.frame(words = c("I", "have", "a", "dog", "called", "Dogma"))

#    words
# 1      I
# 2   have
# 3      a
# 4    dog
# 5 called
# 6  Dogma

这里我们使用fill = T 从字典中读取数据，并通过设置col.names 手动定义data.frame 中的列数。您可以制作 50、100 或其他数量的列（但我认为字典中没有这么长的单词）。我们制作了一个bookdf - 一个data.frame 形式的单词向量。

那么让我们将书籍和字典合并在一起。我使用@wibeasley 提到的dplyr 库。

# for big data frames dplyr does merging fast
require("dplyr")

# make all letters uppercase 
bookdf[,1] <- toupper(bookdf[,1])
# merge
bookphon <- left_join(bookdf, dictdf, by = c("words" = "V1"))

#    words  V2  V3 V4 V5  V6 V7 V8 V9 V10 V11 V12 V13 V14 V15 V16 V17 V18 V19 V20 V21 V22 V23 V24 V25
# 1      I AY1               NA NA NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA
# 2   HAVE  HH AE1  V        NA NA NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA
# 3      A AH0               NA NA NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA
# 4    DOG   D AO1  G        NA NA NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA
# 5 CALLED   K AO1  L  D     NA NA NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA
# 6  DOGMA   D AA1  G  M AH0 NA NA NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA

然后我们逐行扫描连续单词中的匹配声音。我是在 sapply 的帮助下安排的。

consonanceScore <- 
  sapply(1:(nrow(bookphon)-2), 
         conScore <- function(i_row)
         {
           word1 <- bookphon[i_row,][,-1]
           word2 <- bookphon[i_row+1,][,-1]
           word3 <- bookphon[i_row+2,][,-1]

           word1 <- unlist( word1[which(!is.na(word1) & word1 != "")] )
           word2 <- unlist( word2[which(!is.na(word2) & word2 != "")] )
           word3 <- unlist( word3[which(!is.na(word3) & word3 != "")] )

           sum(word1 %in% word2) + sum(word1 %in% word3)
         })

[1] 0 0 0 4

前三行中没有相同的音素，但第 4 个单词“dog”有 2 个与“call”匹配的声音（D 和 O/A）和 2 个与“dogma”匹配的声音（D 和 G）。结果是一个数字向量，你可以sum() 它，除以nrow(bookdf) 或任何你需要的。

【讨论】：

哇，非常感谢。我一直在尝试实现@wibeasley 提出的建议，但被困在 sapply 的使用中，你让它看起来很容易。我创建了另一种稍有不同的函数，当它在 for 循环而不是 sapply 中实现时，一本书花了大约 15 分钟，尽管比以前有了很大的改进，但并没有我希望达到的那么快。我将尝试与您合作，然后发布最终代码以获取你们的任何进一步建议。谢谢，非常感谢您编写了整个代码。
我喜欢它，@inscaven。 3个想法可能不会成功。 (1a) 在bookphon 中，用NA 替换零长度词以消除像word1 != "" 这样的内循环比较。（也许是dplyr::mutate_each()。（1b）有没有办法也消除!is.na(word1)？（例如，如果在以后的比较中忽略NAs。）（2）我不知道它是否会更快（甚至正确），但考虑是否有办法对三个单词进行矢量化，可能类似于word <- bookphon[i_row+0:2,][,-1] 和第二个块。（3）删除sapply 之前的第一列，这样你就可以删除@ 987654340@.

【解决方案2】：

您确定它工作正常吗？那个函数返回consonanceScore 不只是为了书的最后三个字吗？如果循环的倒数第三行是

consonanceScore <- sum(word1 %in% word2)

，它的值如何被记录，或影响循环的后续迭代？

有几种矢量化方法可以提高您的速度，但对于像这样棘手的事情，我喜欢首先确保慢速循环方式正常工作。当您处于开发的那个阶段时，这里有一些建议如何使代码更快和/或更整洁（希望可以帮助您更清晰地进行调试）。

短期建议

在replaceIfEmpty() 内，使用ifelse()。甚至可以直接在主函数中使用ifelse()。
为什么需要as.character()？这种铸造可能很昂贵。这些列是factors 吗？如果是这样，请在使用 read.csv() 之类的内容时使用 , stringsAsFactors=F。
不要在每次迭代中使用toupper() 三次。只需在循环开始之前将整个内容转换一次即可。
同样，不要为每次迭代执行/ length(book)。由于整本书的分母相同，因此仅将最终的分子向量除一次（在循环完成后）。

长期建议

最终，我认为您只想查找每个单词一次，而不是三次。那些查找是昂贵的。与@inscaven 的建议类似，我认为中间表是有意义的（每一行都是一本书的单词）。
要生成中间表，您应该从其他人用 C/C++ 编写和优化的连接函数获得更好的性能。考虑像@987654332@ 这样的东西。也许book 必须首先转换为单变量data.frame。然后 left 将它加入到字典的第一列。该行的后续列基本上将附加到book 的右侧（我认为这是现在正在发生的事情）。
一旦每次迭代更快且正确，请考虑使用 xapply 函数之一，或 dplyr 中的某个函数。这些函数的优势在于，整个向量的内存不会被销毁，也不会为每本书中的每个单词重新分配。

【讨论】：

非常感谢，我一直在尝试理解 left_join 方法，它的功能给我留下了深刻的印象，还包含了您提到的所有其他要点。我将使用 inscaven 发布的内容，比较效率，并将发布代码以获得进一步的建议。再次非常感谢！由于 left_join 方法，我解析的书花了大约 15 分钟的时间来获得 consonanceScore。对此印象深刻，尽管必须尝试使其更有效率。将发布代码以获取更多指示！
没问题。这是一个有趣的问题。如果您最后不介意，请告诉我们粗略估计一本书（算法的）每个草稿需要多长时间。 ...只是在未来编码期间更新我的先验概率。
当然！我之前说的 15m 只是为了比较连续的单词，而不是每个其他单词。我尝试了wibeasly方法，大约需要30-40分钟，而我的仍在测试中。我现在正在使用这样的东西：' consonanceScore 0, na.rm = TRUE) + sum(match(bookP[i_row,], bookP[i_row + 2,], incomparables = NA, nomatch = 0) > 0, na.rm = TRUE) })' 你觉得呢？
抱歉迟到了。我刚刚测试了时间，一本 3281 字的书需要 37.63815 秒。我也测试了我的方法，它在 21.53423 秒内完成。但是，价值观不同。 inscaven 的方法给出 0.6690034，而我的方法给出 0.6799756。我不明白为什么他们似乎在做同样的事情。
假设两者都没有真正的错误，我对 1.5% 差异的第一个猜测是，这是由于有限精度算术的差异/不准确造成的。暂时去掉除法，看看两个版本的总和是否相同。选择一本足够小的书，总和小于大约 10^10。如果他们在这种情况下不匹配，我会开始怀疑其中一个错误。如果 do 匹配，则支持使用较少除法的那个（假设每本书的总和不会溢出浮点数的整数部分）。考虑在 github gist 中分享这些内容。