Counting Words

Assignment for Programming in Mathematica, Oct 20 2004, Jim Mahoney

This runs too slowly to be very practical, and I don't think its just the list of words that's the problem - 
something about my string processing is just too ineffecient.

Getting the text

I'm using the text from the novel Moby Dick, which was obtatined online from the Guttenberg project.  I've removed the Guttenberg information for this exercise, 
and saved the resulting 1.1MByte file as "moby.txt".

text  =  Import["moby.txt"];

StringLength[text]

That's a lot of characters.  Here are the first 20.

StringTake[text, {1, 20}]

Definitions

Now I'll define the various functions.

\(\(\( (*\ 
      init[]\ defines\ and\ give\ initial\ values\ to\ the\ various\ globals . \ \ Invoke\ this\ to\ read\ in\ the\ text, \ 
      initialize\ the\ counters\ and\ start\ at\ the\ beginning\ of\ the\ \(\(text\)\(.\)\)
*) \)\(
\)\(\(init[] := 
        Module[{}, 
text\  = \ 
            Import["moby.txt"]; 
i\  = \ 
            1; \ \ \ \  (*\ 
            the\ index\ of\ the\ next\ character\ in\ the\ file\ *) 
iMax = 
            StringLength[text]; 
endOfFile = 
            False; 
dictionary = {}; \ \ \  (*\ 
            empty\ dictionary . \ \ It\ will\ be\ of\ the\ form\ {word, word, 
                word,  ... }\ *) 
counts\  = \ {}; \  (*\ 
            how\ many\ times\ each\ word\ appears, \ 
            e . g . \ {3, 5, 2,  ... }\ *) 
lastTime\  = \ 
            SessionTime[]; 
iInc\  = \ 
            500; 
iNext\  = \ 
            iInc;
];\)

 (*\ \(letterQ[
              char]\ returns\ True\ if\ char\ is\ a .. \) \(\(z\)\(.\)\)\ *) 

    \(lowerLetterQ[char_] := 
        Module[{n}, 
 (*\ 
            ToCharacterCode["azAZ"]\ is\ {\ 97, \ 122, \ 65, \ 
                90\ }\ \ *) 
n\  = \ \(ToCharacterCode[
                char]\)[\([1]\)]; \ \ \ \ \ \ \ \ \ \ \ \  (*\ 
            numeric\ value\ of\ the\ character\ *) 
Return[\ 97\  ≤ \ n\  && \ 
              n ≤ 
                122\ ];
];\)

 (*\ 
      lowerCase[
          char]\ converts\ "A"\ to\ "a", \ \(for\ any\ letter\ A .. \) Z\ *) 

    \(lowerCase[char_] := 
        Module[{n}, 
n\  = \ \(ToCharacterCode[
                char]\)[\([1]\)]; 
If[\ 
            65\  ≤ \ n\  && \ n ≤ 90, \ 
            n = n + 32]; 
Return[
            FromCharacterCode[
              n]];
];\)

 (*\ 
      nextChar[]\ returns\ the\ next\ character\ from\ the\ text\ string\ 
converted\ to\ lower\ case, \ 
      or\ ""\ if\ we' 
        re\ at\ the\ end\ of\ the\ \(\(text\)\(.\)\)\ *) 

    \(nextChar[] := 
        Module[{char}, 
If[i ≥ iMax, \ 
            endOfFile = True; Return[""]]; 
char = 
            StringTake[
              text, {i, 
                i}]; 
\(i++\); 
Return[
            lowerCase[
              char]];
];\)

 (*\ 
      nextWord[]\ returns\ the\ next\ word\ from\ the\ text, \ 
      in\ lowercase . \ \ Anything\ that' s\ not\ a - z\ or\ A - 
        Z\ is\ \(\(ignored\)\(.\)\)
*) 

    \(nextWord[] := 
        Module[{char, word}, 
char\  = \ 
            nextChar[]; 
While[\ \(! endOfFile\)\  && \(! \ 
                letterQ[char]\), \ 
            char = nextChar[]]; 
word = ""; 
While[\ \(! endOfFile\)\  && \ letterQ[char], \ 
            word = word <> char; 
            char = nextChar[]]; 
Return[
            word];
];\)

 (*\ 
      Process\ a\ word . \ \ 
If\ it' 
        s\ in\ the\ dictionary, \ increment\ its\ count . \ \ If\ not, \ 
      append\ it . 
Nothing\ fancy\ is\ being\ done\ here\ to\ order\ the\ list\ of\ words\ or\ speed\ this\ up, 
though\ I\ am\ using\ Mathematica' 
        s\ Position[]\ function\ to\ do\ the\ word\ index\ \(\(search\)\(.\)\)
*) 

    \(processWord[word_] := 
        Module[{p, n}, 
p = 
            Position[\ dictionary, word]; 
If[
            p == {}, \ 
 (*then*) \ 
            AppendTo[dictionary, word]; 
            AppendTo[counts, 1], 
 (*else*) \ 
            n = p[\([1, 
                  1]\)]; \ \(counts[\([n]\)]++\)
];
];\)

 (*\ 
      output\ timing\ information\ if\ we' 
        ve\ processed\ enough\ characters\ *) 

    \(checkTime[] := 
        Module[{percent, 
            elapsed}, 
\(If[
              i > iNext, 
percent\  = \ 
                N[100\ \ i/iMax]; 
elapsed\  = \ 
                SessionTime[] - lastTime; 
Print[
                ToString[i] <> " chars done (" <> 
                  ToString[percent] <> " percent) in " <> 
                  ToString[
                    elapsed] <> " seconds."]; 
iNext = 
                iNext + iInc; 
lastTime = 
                SessionTime[];
];\)
];\)

 (*\ 
      Talk\ about\ the\ counting\ we' 
        re\ going\ to\ do\ *) 

    \(printBlurb[] := 
        Module[{}, 
Print[" counting words in "\  <> \ 
              ToString[
                iMax] <> " character string : "]; 
Print[
            StringTake[
              text, {1, 
                40}]]; 
Print["..."];
];\)

 (*\ 
      Go\ ahead\ and\ \(\(count\)\(.\)\)\ *) 

    \(doIt[] := 
        Module[{word, 
            time}, 
init[]; 
printBlurb[]; 
While[\ \(! \ 
              endOfFile\), 
word = 
              nextWord[]; 
processWord[
              word]; 
checkTime[];
]; 
Print[" ** done ** "];
];\)

 (*\ 
      create\ sorted\ results\ and\ print\ ' \(\(em\)\(.\)\)\ \ *) 

    \(results[] := 
        Module[{}, 
sortOrder = 
            Ordering[counts]; 
orderedCounts = 
            Reverse[\ 
              counts[\([sortOrder]\)]]; 
orderedDict\  = \ 
            Reverse[\ 
              dictionary[\([sortOrder]\)]]; 
Print[\ 
            TableForm[\ 
              Transpose[\ {\ orderedDict, \ 
                  orderedCounts}]]];
];\)\)\)\)

Testing

init[];

iMax

lowerLetterQ["a"]

lowerLetterQ["."]

lowerCase["B"]

lowerCase["a"]

lowerCase["."]

nextChar[]

nextChar[]

nextChar[]

nextWord[]

nextWord[]

i

endOfFile

init[]

nextWord[]

i

endOfFile

char  =  nextChar[];

char

! endOfFile  &&  letterQ[char]

init[]

nextWord[]

nextWord[]

nextWord[]

StringTake[text, {1, 30}]

init[]

processWord["hello"]

dictionary

counts

processWord["there"]

processWord["sam"]

processWord["hello"]

dictionary

counts

doIt[]

i

words

Length[dictionary]

counts

?Time

?*Time*

?TimeUsed

TimeUsed[]

TimeUsed[]

AbsoluteTime[]

?SessionTime

SessionTime[]

Scratch

?ToCharacterCode

?Order

Order["a", "a"]

ToCharacterCode["azAZ"]

"a" == "a"

char = "";

char == ""

char == "a"

?Position

?*Insert*

Running it - slow version

doIt[]

Length[dictionary]

results[]

<< Graphics`Graphics`

?BarChart

BarChart[orderedCounts[[Range[1, 20]]]]