Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Iterating in R to spell check a vector of words

I have a data set that is full of inappropriately spaced sentences. I'm trying to come up with a way to remove some of the spaces.

I start with a sentence that I convert to a data frame of words:

> word5 <- "hotter the doghou se would be bec ause the co lor was diffe rent"
> abc1 <- data.frame(filler1 = 1,words1=factor(unlist(strsplit(word5, split=" "))))
> abc1
   filler1 words1
1        1 hotter
2        1    the
3        1 doghou
4        1     se
5        1  would
6        1     be
7        1    bec
8        1   ause
9        1    the
10       1     co
11       1    lor
12       1    was
13       1  diffe
14       1   rent

Next I use the following code to try and spell check and combine words that are the combination of the word before or after them:

abc2 <- abc1
i <- 1
while(i < nrow(abc1)){
  print(abc2)
  if(nrow(aspell(abc1$words1[i])) == 0){
    print(paste(i,"Words OK",sep=" | "));flush.console() 
    i <- i + 1
  }
 else{
  if(nrow(aspell(abc1$words1[i])) > 0 & i != 1){
    preWord1 <- abc1$words1[i-1]
    postWord1 <- abc1$words1[i+1]
    badWord1 <- abc1$words1[i]
    newWord1 <- factor(paste(preWord1,badWord1,sep=""))
    newWord2 <- factor(paste(badWord1,postWord1,sep=""))

    if(nrow(aspell(newWord1)) == 0 & nrow(aspell(newWord2)) != 0){
      abc2[i,"words1"] <-as.character(newWord1)
      abc2 <- abc2[-c(i+1),]
      print(paste(i,"word1",sep=" | "));flush.console()
      i <- i + 1
    }

    if(nrow(aspell(newWord1)) != 0 & nrow(aspell(newWord2)) == 0){
      abc2[i ,"words1"] <-as.character(newWord2)
      abc2 <- abc2[-c(i-1),]
      print(paste(i,"word2",sep=" | "));flush.console()
      i <- i + 1
    }

  }
}
}

After playing with this for sometime I'm coming to the conclusion that I need some type of iterator but am uncertain of how to implement it in R. Any suggestions?

like image 867
screechOwl Avatar asked Aug 13 '12 06:08

screechOwl


1 Answers

Note: I came up with a quite different, and much better solution as it circumvents all the downsides of the previous solution. But I would still like to keep the old solution. Therefore, I added it as a new answer, please correct me if I am wrong to do this.

In this approach I reformat the dataset a bit. The base is what I call a wordpair object. For example:

> word5
[1] "hotter the doghou se would be bec ause the col or was diffe rent"

would look like:

> abc1_pairs
    word1  word2
1  hotter    the
2     the doghou
3  doghou     se
4      se  would
5   would     be
6      be    bec
7     bec   ause
8    ause    the
9     the    col
10    col     or
11     or    was
12    was  diffe
13  diffe   rent

Next we iterate over the wordpairs and see if they are valid words themselves, recursively doing this until no valid new words are found (note that a few additional functions are listed at the bottom of this post):

# Recursively delete wordpairs which lead to a correct word
merge_wordpairs = function(wordpairs) {
  require(plyr)
  merged_pairs = as.character(mlply(wordpairs, merge_word))
  correct_words_idxs = which(sapply(merged_pairs, word_correct))
  if(length(correct_words_idxs) == 0) {
    return(wordpairs)
  } else {
    message(sprintf("Number of words about to be merged in this pass: %s", length(correct_words_idxs)))
    for(idx in correct_words_idxs) {
      wordpairs = merge_specific_pair(wordpairs, idx, delete_pair = FALSE)
    }
    return(merge_wordpairs(wordpairs[-correct_words_idxs,])) # recursive call
  }
}

Applied to the example dataset this would result in:

> word5 <- "hotter the doghou se would be bec ause the col or was diffe rent"
> abc1 = strsplit(word5, split = " ")[[1]]
> abc1_pairs = wordlist2wordpairs(abc1)
> abc1_pairs
    word1  word2
1  hotter    the
2     the doghou
3  doghou     se
4      se  would
5   would     be
6      be    bec
7     bec   ause
8    ause    the
9     the    col
10    col     or
11     or    was
12    was  diffe
13  diffe   rent
> abc1_merged_pairs = merge_wordpairs(abc1_pairs)
Number of words about to be merged in this pass: 4
> merged_sentence = paste(wordpairs2wordlist(abc1_merged_pairs), collapse = " ")
> c(word5, merged_sentence)
[1] "hotter the doghou se would be bec ause the col or was diffe rent"
[2] "hotter the doghouse would be because the color was different"    

Additional functions needed:

# A bunch of functions
# Data transformation
wordlist2wordpairs = function(word_list) {
  require(plyr)
  wordpairs = ldply(seq_len(length(word_list) - 1), 
                    function(idx) 
                      return(c(word_list[idx], 
                               word_list[idx+1])))
  names(wordpairs) = c("word1", "word2")
  return(wordpairs)
}
wordpairs2wordlist = function(wordpairs) {
  return(c(wordpairs[[1]], wordpairs[[2]][nrow(wordpairs)]))
}

# Some checking functions
# Is the word correct?
word_correct = function(word) return(nrow(aspell(factor(word))) == 0)
# Merge two words
merge_word = function(word1, word2) return(paste(word1, word2, sep = ""))

# Merge a specific pair, option to postpone deletion of pair
merge_specific_pair = function(wordpairs, idx, delete_pair = TRUE) {
  # merge pair into word
  merged_word = do.call("merge_word", wordpairs[idx,])
  # assign the pair to the idx above
  if(!(idx == 1)) wordpairs[idx - 1, "word2"] = merged_word
  if(!(idx == nrow(wordpairs))) wordpairs[idx + 1, "word1"] = merged_word
  # assign the pair to the index below (if not last one)
  if(delete_pair) wordpairs = wordpairs[-idx,]
  return(wordpairs)
}
like image 167
Paul Hiemstra Avatar answered Nov 10 '22 19:11

Paul Hiemstra