Task: Letter frequency








VB: 








TYPE regChar
  Character AS STRING * 3
  Count AS LONG
END TYPE


DIM iChar AS INTEGER
DIM iCL AS INTEGER
DIM iCountChars AS INTEGER
DIM iFile AS INTEGER
DIM i AS INTEGER
DIM lMUC AS LONG
DIM iMUI AS INTEGER
DIM lLUC AS LONG
DIM iLUI AS INTEGER
DIM iMaxIdx AS INTEGER
DIM iP AS INTEGER
DIM iPause AS INTEGER
DIM iPMI AS INTEGER
DIM iPrint AS INTEGER
DIM lHowMany AS LONG
DIM lTotChars AS LONG
DIM sTime AS SINGLE
DIM strFile AS STRING
DIM strTxt AS STRING
DIM strDate AS STRING
DIM strTime AS STRING
DIM strKey AS STRING
CONST LngReg = 256
CONST Letters = 1
CONST FALSE = 0
CONST TRUE = NOT FALSE




strDate = DATE$
strTime = TIME$
iFile = FREEFILE


DO
  CLS
  PRINT "This program counts letters or characters in a text file."
  PRINT
  INPUT "File to open: ", strFile
  OPEN strFile FOR BINARY AS #iFile
  IF LOF(iFile) > 0 THEN
    PRINT "Count: 1) Letters 2) Characters (1 or 2)";
    DO
      strKey = INKEY$
    LOOP UNTIL strKey = "1" OR strKey = "2"
    PRINT ". Option selected: "; strKey
    iCL = VAL(strKey)
    sTime = TIMER
    iP = POS(0)
    lHowMany = LOF(iFile)
    strTxt = SPACE$(LngReg)

    IF iCL = Letters THEN
      iMaxIdx = 26
    ELSE
      iMaxIdx = 255
    END IF

    IF iMaxIdx <> iPMI THEN
      iPMI = iMaxIdx
      REDIM rChar(0 TO iMaxIdx) AS regChar

      FOR i = 0 TO iMaxIdx
        IF iCL = Letters THEN
          strTxt = CHR$(i + 65)
          IF i = 26 THEN strTxt = CHR$(165)
        ELSE
          SELECT CASE i
            CASE 0: strTxt = "nul"
            CASE 7: strTxt = "bel"
            CASE 9: strTxt = "tab"
            CASE 10: strTxt = "lf"
            CASE 11: strTxt = "vt"
            CASE 12: strTxt = "ff"
            CASE 13: strTxt = "cr"
            CASE 28: strTxt = "fs"
            CASE 29: strTxt = "gs"
            CASE 30: strTxt = "rs"
            CASE 31: strTxt = "us"
            CASE 32: strTxt = "sp"
            CASE ELSE: strTxt = CHR$(i)
          END SELECT
        END IF
        rChar(i).Character = strTxt
      NEXT i
    ELSE
      FOR i = 0 TO iMaxIdx
        rChar(i).Count = 0
      NEXT i
    END IF

    PRINT "Looking for ";
    IF iCL = Letters THEN PRINT "letters.";  ELSE PRINT "characters.";
    PRINT " File is"; STR$(lHowMany); " in size. Working"; : COLOR 23: PRINT "..."; : COLOR (7)
    DO WHILE LOC(iFile) < LOF(iFile)
      IF LOC(iFile) + LngReg > LOF(iFile) THEN
        strTxt = SPACE$(LOF(iFile) - LOC(iFile))
      END IF
      GET #iFile, , strTxt
      FOR i = 1 TO LEN(strTxt)
        IF iCL = Letters THEN
          iChar = ASC(UCASE$(MID$(strTxt, i, 1)))
          SELECT CASE iChar
            CASE 164: iChar = 165
            CASE 160: iChar = 65
            CASE 130, 144: iChar = 69
            CASE 161: iChar = 73
            CASE 162: iChar = 79
            CASE 163, 129: iChar = 85
          END SELECT
          iChar = iChar - 65
          
          
          IF iChar >= 0 AND iChar <= 25 THEN
            rChar(iChar).Count = rChar(iChar).Count + 1
          ELSEIF iChar = 100 THEN 
            rChar(iMaxIdx).Count = rChar(iMaxIdx).Count + 1
          END IF
        ELSE
          iChar = ASC(MID$(strTxt, i, 1))
          rChar(iChar).Count = rChar(iChar).Count + 1
        END IF
      NEXT i
    LOOP
    CLOSE #iFile

    
    lMUC = 0
    iMUI = 0
    lLUC = 2147483647
    iLUI = 0
    iPrint = FALSE
    lTotChars = 0
    iCountChars = 0
    iPause = FALSE
    CLS
    IF iCL = Letters THEN PRINT "Letters found: ";  ELSE PRINT "Characters found: ";
    FOR i = 0 TO iMaxIdx
      
      IF lMUC < rChar(i).Count THEN
        lMUC = rChar(i).Count
        iMUI = i
      END IF

      
      IF rChar(i).Count > 0 THEN
        strTxt = ""
        IF iPrint THEN strTxt = ", " ELSE iPrint = TRUE
        strTxt = strTxt + LTRIM$(RTRIM$(rChar(i).Character))
        strTxt = strTxt + "=" + LTRIM$(STR$(rChar(i).Count))
        iP = POS(0)
        IF iP + LEN(strTxt) + 1 >= 80 AND iPrint THEN
          PRINT ","
          IF CSRLIN >= 23 AND NOT iPause THEN
            iPause = TRUE
            PRINT "Press a key to continue..."
            DO
              strKey = INKEY$
            LOOP UNTIL strKey <> ""
          END IF
          strTxt = MID$(strTxt, 3)
        END IF
        PRINT strTxt;
        lTotChars = lTotChars + rChar(i).Count
        iCountChars = iCountChars + 1

        
        IF lLUC > rChar(i).Count THEN
          lLUC = rChar(i).Count
          iLUI = i
        END IF
      END IF
    NEXT i

    PRINT "."

    
    PRINT
    PRINT "File analyzed....................: "; strFile
    PRINT "Looked for.......................: "; : IF iCL = Letters THEN PRINT "Letters" ELSE PRINT "Characters"
    PRINT "Total characters in file.........:"; lHowMany
    PRINT "Total characters counted.........:"; lTotChars
    IF iCL = Letters THEN PRINT "Characters discarded on count....:"; lHowMany - lTotChars
    PRINT "Distinct characters found in file:"; iCountChars; "of"; iMaxIdx + 1
    PRINT "Most used character was..........: ";
      iPrint = FALSE
      FOR i = 0 TO iMaxIdx
        IF rChar(i).Count = lMUC THEN
          IF iPrint THEN PRINT ", ";  ELSE iPrint = TRUE
          PRINT RTRIM$(LTRIM$(rChar(i).Character));
        END IF
      NEXT i
    PRINT " ("; LTRIM$(STR$(rChar(iMUI).Count)); " times)"
    PRINT "Least used character was.........: ";
      iPrint = FALSE
      FOR i = 0 TO iMaxIdx
        IF rChar(i).Count = lLUC THEN
          IF iPrint THEN PRINT ", ";  ELSE iPrint = TRUE
          PRINT RTRIM$(LTRIM$(rChar(i).Character));
        END IF
      NEXT i
      PRINT " ("; LTRIM$(STR$(rChar(iLUI).Count)); " times)"
    PRINT "Time spent in the process........:"; TIMER - sTime; "seconds"
  ELSE
    
    CLOSE #iFile
    KILL strFile
    PRINT
    PRINT "File does not exist."
  END IF

  
  PRINT
  PRINT "Again? (Y/n)"
  DO
    strTxt = UCASE$(INKEY$)
  LOOP UNTIL strTxt = "N" OR strTxt = "Y" OR strTxt = CHR$(13) OR strTxt = CHR$(27)
LOOP UNTIL strTxt = "N" OR strTxt = CHR$(27)

CLS
PRINT "End of execution."
PRINT "Start time: "; strDate; " "; strTime; ", end time: "; DATE$; " "; TIME$; "."
END





Ada: with Ada.Text_IO;

procedure Letter_Frequency is
   Counters: array (Character) of Natural := (others => 0); 
   C:        Character;
   File:     Ada.Text_IO.File_Type;

begin
   Ada.Text_IO.Open(File, Mode => Ada.Text_IO.In_File, Name => "letter_frequency.adb");
   while not Ada.Text_IO.End_Of_File(File) loop
      Ada.Text_IO.Get(File, C);
      Counters(C) := Counters(C) + 1;
   end loop;

   for I in Counters'Range loop
      if Counters(I) > 0 then
            Ada.Text_IO.Put_Line("'" & I & "':" & Integer'Image(Counters(I)));
      end if;
   end loop;
end Letter_Frequency;