how to make a text parsing function efficient in R - r

Question

I have this function which calculates the consonanceScore of a book. First I import the phonetics dictionary from CMU (which forms a dataframe of about 134000 rows and 33 column variables; any row in the CMUdictionary is basically of the form CLOUDS K L AW1 D Z. The first column has the words, and the remaining columns have their phonetic equivalents). After getting the CMU dictionary, I parse a book into a vector containing all the words; max-length of any one book (so far): 218711 . Each word's phonetics are compared with the phonetics in the consecutive word, and the consecutive+1 word. The TRUE match values are then combined into a sum. The function I have is this:
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)
}
A replaceIfEmpty function basically just returns the index for a dummy value (that has been declared in the last row of the dataframe) if there is no match found in the CMU dictionary for any word in the book. It goes like this:
replaceIfEmpty <- function(x) {
if (length(x) > 0)
{
return (x)
}
else
{
x = 133780
return(x)
}
}
The issue that I am facing is that getConsonanceScore function takes a lot of time. So much so that in the loop, I had to divide the book length by 1000 just to check if the function was working alright. I am new to R, and would really be grateful for some help on making this function more efficient and consume less time, are there any ways of doing this? (I have to later call this function on possibly 50-100 books) Thanks a lot!

Answer 1

I've re-read recently your question, comments and #wibeasley's answer and got that didn't understand everything correctly. Now it have become more clear, and I'll try to suggest something useful.
First of all, we need a small example to work with. I've made it from the dictionary in your 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
Here we read data from dictionary with fill = T and manually define number of columns in data.frame by setting col.names. You may make 50, 100 or some other number of columns (but I don't think there are so long words in the dictionary). And we make a bookdf - a vector of words in the form of data.frame.
Then let's merge book and dictionary together. I use dplyr library mentioned by #wibeasley.
# 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
And after that we scan rowwise for matching sounds in consecutive words. I arranged it with the help of 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
There are no same phonemes in first three rows but the 4-th word 'dog' has 2 matching sounds with 'called' (D and O/A) and 2 matches with 'dogma' (D and G). The result is a numeric vector, you can sum() it, divide by nrow(bookdf) or whatever you need.

Answer 2

Are you sure it's working correctly? Isn't that function returning consonanceScore just for the last three words of the book? If the loop's 3rd-to-last-line is
consonanceScore <- sum(word1 %in% word2)
, how is its value being recorded, or influencing later iterations of the loop?
There are several vectorization approaches that will increase your speed, but for something tricky like this, I like making sure the slow loopy way is working correctly first. While you're in that stage of development, here are some suggestions how to make the code quicker and/or neater (which hopefully helps you debug with more clarity).
Short-term suggestions
Inside replaceIfEmpty(), use ifelse(). Maybe even use ifelse() directly inside the main function.
Why is as.character() necessary? That casting can be expensive. Are those columns factors? If so, use , stringsAsFactors=F when you use something like read.csv().
Don't use toupper() three times for each iteration. Just convert the whole thing once before the loop starts.
Similarly, don't execute / length(book) for each iteration. Since it's the same denominator for the whole book, divide the final vector of numerators only once (after the loop's done).
Long-term suggestions
Eventually I think you'll want to lookup each word only once, instead of three times. Those lookups are expensive. Similar to #inscaven 's suggestion, I think an intermediate table make sense (where each row is a book's word).
To produce the intermediate table, you should get much better performance from a join function written and optimized by someone else in C/C++. Consider something like dplyr::left_join(). Maybe book has to be converted to a single-variable data.frame first. Then left join it to the first column of the dictionary. The row's subsequent columns will essentially be appended to the right side of book (which I think is what's happening now).
Once each iteration is quicker and correct, consider using one of the xapply functions, or something in dplyr. The advantage of these functions is that memory for the entire vector isn't destroyed and reallocated for every single word in each book.