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?
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)
}
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With