如何使 R 中的文本解析函数高效

Question

我有这个函数可以计算一本书的 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)
}

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

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

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

Answer 1

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

consonanceScore <- sum(word1 %in% word2)

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

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

短期建议

在 replaceIfEmpty() 内，使用 ifelse()。甚至可以直接在主函数中使用 ifelse()。
为什么需要as.character()？铸造可能很昂贵。这些列是 factor 吗？如果是这样，请在使用 read.csv().

, stringsAsFactors=F

不要在每次迭代中使用三次 toupper()。只需在循环开始前将整个内容转换一次。
同样，不要在每次迭代时都执行/ length(book)。由于整本书的分母相同，因此仅将分子的最终向量除一次（在循环完成后）。

长期建议

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

Answer 2

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

首先，我们需要一个小例子来使用。我是从你的 link.

中的字典中提取的

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 个与 'called' 匹配的声音（D 和 O/A）和 2 个与 [= 匹配35=]（D 和 G）。结果是一个数字向量，你可以 sum() 它，除以 nrow(bookdf) 或者你需要的任何东西。

如何使 R 中的文本解析函数高效

how to make a text parsing function efficient in R

text-processing

r

text-parsing