FotS

This page is read only. You can view the source, but not change it. Ask your administrator if you think this is wrong.
===Alpha Count===

//This module is part of the original MMBasic library. It is reproduced here with kind permission of Hugh Buckle and Geoff Graham. Be aware it may reference functionality which has changed or is deprecated in the latest versions of MMBasic.//



<code>

       ' ALPHA COUNT PROGRAMME
       ' This counts the frequency of each alphabetic character in a text document
       ' and the frequency of double letters.
       ' Counts are output to a CSV file which can be read by Excel and Open Office Calc.
       ' If the input count file is overwritten as output, counts can be accumulated from several text documents.
       ' On completion it draws graphs of the percentage of each letter and double letter.
     Dim LetterCounts(26)
     Dim OLDCounts(26)
     Dim NewCounts(26)
     Dim DblLetterCounts(26)
     Dim OldDblCounts(26)
     Dim NewDblCounts(26)
     Dim a(26)
     Dim pLine$(4)

'Mainline
     GoSub Initialise        ' Initialise
     Timer=0
     GoSub LetterCounts      ' Accumulate letter counts from input text file
     For i = 1 To 26         ' check that text file contains some letters
       atot = atot + LetterCounts(i)
     Next
     If atot = 0 Then
       Print
       Print TxtFileName$ " contains no alphabetic characters."
     Else
       GoSub AddNewToOldCounts ' Add new counts to old
       GoSub PrintGraphs       ' Print accumulated counts graphically
       GoSub WriteCounts       ' Write out csv file with accumulated counts
     EndIf
     Print Timer
     GoTo WindUp             ' Close files and exit

Initialise:
       ' Intialise values in case the routine is rerun
     Cls
     For i = 1 To 26
       LetterCounts(i) = 0
       DblLetterCounts(i) = 0
     Next
     LastChar$ = ""
     Print @(42,0) "ALPHANUM.BAS Counts occurrences of each letter and double letter"
     Print @(24,12) "in an input text file, graphs the counts and writes them to a CSV file."
     Print @(42,24) "Text file counts will be added to those from an input .CSV file."
     Print

GetInputTextFileName:
       ' Ask for input text file name - Reply 'Exit' stops the program
       ' If filename doesn't have an extension, .TXT is assumed

     Input "Input text filename (.txt assumed) - 'Exit  ' to exit: ", TxtFileName$
     If LCase$(TxtFileName$) = "exit" Then GoTo WindUp
       ' IF file name doesn't have an extension, add .txt
     If Instr(1, TxtFileName$, ".") = 0 Then TxtFileName$ = TxtFileName$ + ".txt"
     Option error continue
     Open TxtFileName$ For INPUT As #1
     If MM.Errno <> 0 Then
       Print TxtFileName$ " doesn't exist"
       Print
       GoTo GetInputTextFileName
     EndIf
     Option error abort

GetOldCountFileName:
       ' Get the old count file names - Reply 'None' if there isn't one
       ' If filename doesn't have an extension, .CSV is assumed

     Input "Old count file name (.csv assumed) - 'none  ' if none: ", OldCountFileName$
     If LCase$(OldCountFileName$) = "none" Then GoTo GetNewCountFileName
     If LCase$(OldCountFileName$) = "exit" Then GoTo WindUp
       ' IF file name doesn't have an extension, add .CSV
     If Instr(1, OldCountFileName$, ".") = 0 Then OldCountFileName$ = OldCountFileName$ + ".csv"
     Option error continue
     Open OldCountFileName$ For input As #2
     If MM.Errno <> 0 Then
       Print OldCountFileName$ " doesn't exist. Enter 'none', 'exit  ' or another file"
       Print
       GoTo GetOldCountFileName
     EndIf
     Option error abort
       ' Load counts from Old Count File
     GoSub LoadOldCounts

GetNewCountFileName:
       ' Create a new output count file - Reply 'Exit' stops the program
       ' If a filename extension is not provided, .CSV is appended
       ' If this filename is same as input count filename, check that it is OK to overwrite

     Input "New count file name (.csv assumed) - 'Exit  ' to exit: ", NewCountFileName$
     If LCase$(NewCountFileName$) = "exit" Then GoTo WindUp
     If Instr(1, NewCountFileName$, ".") = 0 Then NewCountFileName$ = NewCountFileName$ + ".csv"
       ' If old file exists, ask if it should be replaced. If not, get another filename
     Option error continue
     Open NewCountFileName$ For input As #3
     If MM.Errno = 0 Then
       Print "OK to overwrite "+OldCountFileName$+" Y/N";:Input ""; Reply$
       If LCase$(Left$(Reply$,1)) <> "y" Then
         Print
         GoTo GetNewCountFileName
       EndIf
       Close #3
     EndIf
     Option error abort
       ' Don't open it until the old counts have been read in case the old count file is to be overwritten
     Return

LetterCounts:
       ' Read characters one by one from the text input file and convert to lower case
       ' Set start position of the progress line (which will show that something is happening)

     x = 20: y = 120
     Do While Not Eof(1)
         ' Save previous character to compare with next to accumulate double character count
       LastChar$ = NextChar$
         ' Get next character
       NextChar$ = Input$(1, #1)
         ' If upper case character, convert to lower case
       NextChar$ = LCase$(NextChar$)
         ' If a letter, accumulate totals for that letter, else ignore it
       If NextChar$ >= "a" And NextChar$ <= "z" Then
         GoSub AccumulateCounts
       EndIf
         ' periodically show progress
       If CharCount > 500 Then
         GoSub PrintProgressLine
         CharCount = 0
       Else
         charCount = CharCount + 1
       EndIf
     Loop
     Close #1
     Return

PrintProgressLine:
       ' Print a progress line to show that something is happening every 500th character read
       ' prints another dot and also toggles the MM Power LED

     If ProgressDots < 70 Then
       ProgressDots = ProgressDots + 1
       ProgressLine$ = ProgressLine$ + "."
       Print @(x,y) ProgressLine$
         ' Toggle the power LED on and off
       Pin(0) = ProgressDots Mod 2
     Else
       Print @(x,y) Space$(70)
       ProgressDots = 0
       ProgressLine$ = ""
     EndIf
     Return

AccumulateCounts:
       ' Accumulate counts of each letter and double letters.

     i = Asc(NextChar$) - 96   ' Note: ASC("a") = 97
     LetterCounts(i) = LetterCounts(i) + 1
       ' If same as last letter, accumulate double letter count
     If NextChar$ = LastChar$ Then DblLetterCounts(i) = DblLetterCounts(i) + 1
     Return

AddNewToOldCounts:
       ' Add new counts to old

     For i = 1 To 26
       NewCounts(i) = OldCounts(i) + LetterCounts(i)
       NewDblCounts(i) = OldDblCounts(i) + DblLetterCounts(i)
     Next
     Return

PrintGraphs:
       ' Print the 2 graphs - Proportion of single letters and double letters
       ' Do this twice;
       '   1st for current text file and then
       '   if there was an input .CSV file, for the accumulated counts

       'Common graph parameters
     bars = 26    ' number of bars in the graph
     xscale = 1   'Use full screen width of 480 pixels
     yScale = 0.5 'Use half screen height of 432/2 = 216 pixels
       ' set ends of x axis, allowing space to the left of the graph for scale
     xorig = 5*6         ' Indent y axis 5 characters
     xmax  = 480*xScale  ' end of x axis
       ' set ends of y axis, allowing space above and below graph
       ' for title & x scale
     yTopSpace = 2*12    ' 2 lines
     yBotSpace = 2*12    ' 2 lines

       ' Get y values for single letters in the input text file
     atot = 0
     For i = 1 To bars
       a(i) = LetterCounts(i)
       atot = atot +a(i)
     Next
       ' Print the graph in top half of screen
     Cls
     Title$ = "Percent of single letters in " + TxtFileName$
     GoSub SetupSingleLetterGraphParms
     GoSub PrintAGraph

       ' Get y values for double letters in the input text file
     atot = 0
     For i = 1 To bars
       a(i) = DblLetterCounts(i)
       atot = atot +a(i)
     Next

     If atot > 0 Then
         ' Print the graph in bottom half of screen (yoffset sets bottom half)
       Title$ = "Percent of double letters in " + TxtFileName$
       GoSub SetupDoubleLetterGraphParms
       GoSub PrintAGraph
     Else
       Print
       Print "There are no double letters in the text file."
       Print
     EndIf

       ' If the input .CSV file was overwritten, then repeat the graphs for accumulated totals
       ' otherwise we are finished
     If NewCountFileName$ = OldCountFileName$ Then
       Print "Press A to see accumulated percentages; Any other to exit";
       Do
         Reply$ = Inkey$
       Loop Until Reply$ <> ""
       If LCase$(Reply$) <> "a" Then
         Return
       EndIf
     Else
       End
     EndIf

       ' Get y values for single letters in the accumulated counts file
     atot = 0
     For i = 1 To bars
       a(i) = NewCounts(i)
       atot = atot +a(i)
     Next
       ' Print the graph in top half of screen
     Cls
     Title$ = "Percent of single letters in " + NewCountFileName$
     GoSub SetupSingleLetterGraphParms
     GoSub PrintAGraph

       ' Get y values for double letters in the accumulated counts file
     atot = 0
     For i = 1 To bars
       a(i) = NewDblCounts(i)
       atot = atot +a(i)
     Next

     If atot > 0 Then
         ' Print the graph in bottom half of screen (yoffset sets bottom half)
       Title$ = "Percent of double letters in " + NewCountFileName$
       GoSub SetupDoubleLetterGraphParms
       GoSub PrintAGraph
     Else
       Print
       Print "There are no double letter in the acumulated counts file."
       Print
     EndIf

     Print "Press A to see the first graph again; any other to exit";
     Do
       Reply$ = Inkey$
     Loop Until Reply$ <> ""
     If LCase$(Reply$) = "a" Then
       GoTo PrintGraphs
     EndIf

     Return

SetupSingleLetterGraphParms:
     yorig = 432*yScale - yTopSpace - yBotSpace
     ymax  = yTopSpace   ' top of y axis

     Return

SetupDoubleLetterGraphParms:
     yOffset = 432/2
     yorig = 432*yscale - yTopSpace - yBotSpace + yOffset
     ymax  = yTopSpace + yOffset  ' top of y axis

     Return

PrintAGraph:
      ' Prints a graph at preset points
      ' Normalise all the values to percent of total letters read
     HiY = 0
     For i = 1 To bars
       a(i) = a(i) / atot * 100
       If a(i) > HiY Then HiY = a(i)
     Next

       ' Set top of y axis to highest value of y + 10% and round up
     HiY = HiY*1.1
     HiY = Cint(HiY/5)*5

       ' Set origin for the graph and the scale
       ' Normal font chars occupy 6x12 pixels giving 36 lines of 80 chars each
       ' Calc No of pixel per data unit
     xUnit = (xmax-xorig)/bars
     yUnit = (ymax-yorig)/HiY

       ' Draw Axes
     Line (Xorig,ymax)-(Xorig,yorig)
     Line (Xorig,yorig)-(xmax,yorig)

       ' Draw tick marks on y axis and print tick values
     tickmks = 5   ' Int(HiY/10+.5)
     ytickspace = (yOrig-ymax)/tickmks
     For i = 0 To tickmks-1
       Line (xOrig,ymax+i*ytickspace) - (xOrig+5,ymax+i*ytickspace)
       Print @(0,ymax+i*ytickspace-6) Hiy-i*Hiy/tickmks
     Next

       ' Print title, centred
       ' Title chars are 6 px wide
     Print @((xmax-xOrig)/2-Len(Title$)*6/2,ymax-12) Title$

       ' Print alphabet below x axis and percentages below that
     Print @(12,yOrig+24) "%"
     barspace = Fix((xmax-xOrigin)/(bars+1))
     For i = 0 To bars-1
       Print @(xOrig+barspace*i+8, yOrig+12) Chr$(i+1+64)
       Print @(xOrig+barSpace*i+2, yOrig+24) Int(a(i+1)+0.5)
     Next

       ' Print graph bars
     For i = 1 To bars
       x1 = xOrig+barspace*(i-1)+6
       y1 = yOrig
       x2 = x1+barspace/2
       y2 = yOrig-a(i)*(yorig-ymax)/Hiy
       Line (x1,y1)-(x2,y2),1,BF
     Next

     Return

LoadOldCounts:
        ' Subroutine: Load counts from old counts file
        ' Being a .CSV file, concatenate numeric characters
        ' until a comma is found then
        ' load the resulting number into the array.

      Do While Not Eof(2)
          ' First line contains single letter counts
        Line Input #2, Counts$
        StartPos = 1
        LetterNo = 1
        Do
          CommaPos = Instr(StartPos,Counts$,",")
          OldCounts(LetterNo) = Val(Mid$(Counts$,StartPos,CommaPos-StartPos))
          LetterNo = LetterNo + 1
          StartPos = CommaPos + 1
        Loop Until StartPos >= Len(Counts$)

          ' Second line contains double letter counts
        Line Input #2, Counts$
        StartPos = 1
        LetterNo = 1
        Do
          CommaPos = Instr(StartPos,Counts$,",")
          OldDblCounts(LetterNo) = Val(Mid$(Counts$,StartPos,CommaPos-StartPos))
          LetterNo = LetterNo + 1
          StartPos = CommaPos + 1
        Loop Until StartPos >= Len(Counts$)
      Loop
      Close #2
      Return

WriteCounts:
        ' Subroutine: Write new counts to output as .CSV file
        ' If the file exists, delete it
        ' Writes 2 lines of comma-separated numbers
        '   1st line contains the counts of each alphabetic character
        '   2nd line, counts of each double alphabetic character

      Open NewCountFileName$ For OUTPUT As #3
      For i = 1 To 26
        Print #3, Format$(NewCounts(i),"%0g") ",";
      Next
      Print #3
      For i = 1 To 26
        Print #3, Format$(NewDblCounts(i),"%0g") ",";
      Next
      Close #3
      Return

WindUp:
       ' Exit the program after restoring normal error handling
      Option error continue
      Print Timer
      End

</code>