Task

Open a text file and count the occurrences of each letter.

Some of these programs count all characters (including punctuation),
but some only count letters A to Z.




Other tasks related to string operations:

Metrics
 Array length
 String length
 Copy a string
 Empty string  (assignment)
Counting
 Word frequency
 Letter frequency
 Jewels and stones
 I before E except after C
 Bioinformatics/base count
 Count occurrences of a substring
 Count how many vowels and consonants occur in a string
Remove/replace
 XXXX redacted
 Conjugate a Latin verb
 Remove vowels from a string
 String interpolation (included)
 Strip block comments
 Strip comments from a string
 Strip a set of characters from a string
 Strip whitespace from a string -- top and tail
 Strip control codes and extended characters from a string
Anagrams/Derangements/shuffling
 Word wheel
 ABC problem
 Sattolo cycle
 Knuth shuffle
 Ordered words
 Superpermutation minimisation
 Textonyms (using a phone text pad)
 Anagrams
 Anagrams/Deranged anagrams
 Permutations/Derangements
Find/Search/Determine
 ABC words
 Odd words
 Word ladder
 Semordnilap
 Word search
 Wordiff  (game)
 String matching
 Tea cup rim text
 Alternade words
 Changeable words
 State name puzzle
 String comparison
 Unique characters
 Unique characters in each string
 Extract file extension
 Levenshtein distance
 Palindrome detection
 Common list elements
 Longest common suffix
 Longest common prefix
 Compare a list of strings 
 Longest common substring
 Find common directory path
 Words from neighbour ones
 Change e letters to i in words
 Non-continuous subsequences
 Longest common subsequence
 Longest palindromic substrings
 Longest increasing subsequence
 Words containing "the" substring
 Sum of the digits of n is substring of n
 Determine if a string is numeric
 Determine if a string is collapsible
 Determine if a string is squeezable
 Determine if a string has all unique characters
 Determine if a string has all the same characters
 Longest substrings without repeating characters
 Find words which contains all the vowels
 Find words which contains most consonants
 Find words which contains more than 3 vowels
 Find words which first and last three letters are equals
 Find words which odd letters are consonants and even letters are vowels or vice_versa
Formatting
 Substring
 Rep-string
 Word wrap
 String case
 Align columns
 Literals/String
 Repeat a string
 Brace expansion
 Brace expansion using ranges
 Reverse a string
 Phrase reversals
 Comma quibbling
 Special characters
 String concatenation
 Substring/Top and tail
 Commatizing numbers
 Reverse words in a string
 Suffixation of decimal numbers
 Long literals, with continuations 
 Numerical and alphabetical suffixes
 Abbreviations, easy
 Abbreviations, simple
 Abbreviations, automatic
Song lyrics/poems/Mad Libs/phrases
 Mad Libs
 Magic 8-ball
 99 Bottles of Beer
 The Name Game (a song)
 The Old lady swallowed a fly
 The Twelve Days of Christmas
Tokenize
 Text between
 Tokenize a string
 Word break problem
 Tokenize a string with escaping
 Split a character string based on change of character
Sequences
 Show ASCII table
 De Bruijn sequences
 Self-referential sequences
 Generate lower case ASCII alphabet




 
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
'  Program CountCar                                   '
'                                                     '
'  This program counts how many distinct characters   '
'  have a text file specified by the user.            '
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
' OPTION EXPLICIT  ' Remove comment in VB-DOS

' Register
TYPE regChar
  Character AS STRING * 3
  Count AS LONG
END TYPE
 
' Var
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
 
'------Main program cycle

' Initialize variables
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
 
          ' Validates if iChar is a letter
          IF iChar >= 0 AND iChar <= 25 THEN
            rChar(iChar).Count = rChar(iChar).Count + 1
          ELSEIF iChar = 100 THEN ' CHR$(165)
            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
 
    ' Show the characters found
    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
      ' Most Used Character
      IF lMUC < rChar(i).Count THEN
        lMUC = rChar(i).Count
        iMUI = i
      END IF
 
      ' Print character
      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
 
        ' Least Used Character
        IF lLUC > rChar(i).Count THEN
          lLUC = rChar(i).Count
          iLUI = i
        END IF
      END IF
    NEXT i
 
    PRINT "."
 
    ' Shows the summary
    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
    ' File does not exist
    CLOSE #iFile
    KILL strFile
    PRINT
    PRINT "File does not exist."
  END IF
 
  ' Again?
  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
' ---End of main program cycle

 