567 lines
16 KiB
Text
567 lines
16 KiB
Text
OPTION _EXPLICIT
|
|
|
|
' SUBs and FUNCTIONs
|
|
DECLARE SUB CountWords (FromString AS STRING)
|
|
DECLARE SUB QuickSort (lLeftN AS LONG, lRightN AS LONG, iMode AS INTEGER)
|
|
DECLARE SUB ShowResults ()
|
|
DECLARE SUB ShowCompletion ()
|
|
DECLARE SUB TopCounted ()
|
|
DECLARE FUNCTION InsertWord& (WhichWord AS STRING)
|
|
DECLARE FUNCTION BinarySearch& (LookFor AS STRING, RetPos AS INTEGER)
|
|
DECLARE FUNCTION CleanWord$ (WhichWord AS STRING)
|
|
|
|
' Var
|
|
DIM iFile AS INTEGER
|
|
DIM iCol AS INTEGER
|
|
DIM iFil AS INTEGER
|
|
DIM iStep AS INTEGER
|
|
DIM iBar AS INTEGER
|
|
DIM iBlock AS INTEGER
|
|
DIM lIni AS LONG
|
|
DIM lEnd AS LONG
|
|
DIM lLines AS LONG
|
|
DIM lLine AS LONG
|
|
DIM lLenF AS LONG
|
|
DIM iRuns AS INTEGER
|
|
DIM lMaxWords AS LONG
|
|
DIM sTimer AS SINGLE
|
|
DIM strFile AS STRING
|
|
DIM strKey AS STRING
|
|
DIM strText AS STRING
|
|
DIM strDate AS STRING
|
|
DIM strTime AS STRING
|
|
DIM strBar AS STRING
|
|
DIM lWords AS LONG
|
|
DIM strWords AS STRING
|
|
CONST AddWords = 100
|
|
CONST TopCount = 10
|
|
CONST FALSE = 0, TRUE = NOT FALSE
|
|
|
|
' Initialize
|
|
iFile = FREEFILE
|
|
lIni = 1
|
|
strDate = DATE$
|
|
strTime = TIME$
|
|
lEnd = 0
|
|
lMaxWords = 1000
|
|
REDIM strWords(lIni TO lMaxWords) AS STRING
|
|
REDIM lWords(lIni TO lMaxWords) AS LONG
|
|
REDIM lTopWords(1) AS LONG
|
|
REDIM strTopWords(1) AS STRING
|
|
|
|
' ---Main program loop
|
|
$RESIZE:SMOOTH
|
|
DO
|
|
DO
|
|
CLS
|
|
PRINT "This program will count how many words are in a text file and shows the 10"
|
|
PRINT "most used of them."
|
|
PRINT
|
|
INPUT "Document to open (TXT file) (f=see files): ", strFile
|
|
IF UCASE$(strFile) = "F" THEN
|
|
strFile = ""
|
|
FILES
|
|
DO: LOOP UNTIL INKEY$ <> ""
|
|
END IF
|
|
LOOP UNTIL strFile <> ""
|
|
OPEN strFile FOR BINARY AS #iFile
|
|
IF LOF(iFile) > 0 THEN
|
|
iRuns = iRuns + 1
|
|
CLOSE #iFile
|
|
|
|
' Opens the document file to analyze it
|
|
sTimer = TIMER
|
|
ON TIMER(1) GOSUB ShowAdvance
|
|
OPEN strFile FOR INPUT AS #iFile
|
|
lLenF = LOF(iFile)
|
|
PRINT "Looking for words in "; strFile; ". File size:"; STR$(lLenF); ". ";: iCol = POS(0): PRINT "Initializing";
|
|
COLOR 23: PRINT "...";: COLOR 7
|
|
|
|
' Count how many lines has the file
|
|
lLines = 0
|
|
DO WHILE NOT EOF(iFile)
|
|
LINE INPUT #iFile, strText
|
|
lLines = lLines + 1
|
|
LOOP
|
|
CLOSE #iFile
|
|
|
|
' Shows the bar
|
|
LOCATE , iCol: PRINT "Initialization complete."
|
|
PRINT
|
|
PRINT "Processing"; lLines; "lines";: COLOR 23: PRINT "...": COLOR 7
|
|
iFil = CSRLIN
|
|
iCol = POS(0)
|
|
iBar = 80
|
|
iBlock = 80 / lLines
|
|
IF iBlock = 0 THEN iBlock = 1
|
|
PRINT STRING$(iBar, 176)
|
|
lLine = 0
|
|
iStep = lLines * iBlock / iBar
|
|
IF iStep = 0 THEN iStep = 1
|
|
IF iStep > 20 THEN
|
|
TIMER ON
|
|
END IF
|
|
OPEN strFile FOR INPUT AS #iFile
|
|
DO WHILE NOT EOF(iFile)
|
|
lLine = lLine + 1
|
|
IF (lLine MOD iStep) = 0 THEN
|
|
strBar = STRING$(iBlock * (lLine / iStep), 219)
|
|
LOCATE iFil, 1
|
|
PRINT strBar
|
|
ShowCompletion
|
|
END IF
|
|
LINE INPUT #iFile, strText
|
|
CountWords strText
|
|
strKey = INKEY$
|
|
LOOP
|
|
ShowCompletion
|
|
CLOSE #iFile
|
|
TIMER OFF
|
|
LOCATE iFil - 1, 1
|
|
PRINT "Done!" + SPACE$(70)
|
|
strBar = STRING$(iBar, 219)
|
|
LOCATE iFil, 1
|
|
PRINT strBar
|
|
LOCATE iFil + 5, 1
|
|
PRINT "Finishing";: COLOR 23: PRINT "...";: COLOR 7
|
|
ShowResults
|
|
|
|
' Frees the RAM
|
|
lMaxWords = 1000
|
|
lEnd = 0
|
|
REDIM strWords(lIni TO lMaxWords) AS STRING
|
|
REDIM lWords(lIni TO lMaxWords) AS LONG
|
|
|
|
ELSE
|
|
CLOSE #iFile
|
|
KILL strFile
|
|
PRINT
|
|
PRINT "Document does not exist."
|
|
END IF
|
|
PRINT
|
|
PRINT "Try again? (Y/n)"
|
|
DO
|
|
strKey = UCASE$(INKEY$)
|
|
LOOP UNTIL strKey = "Y" OR strKey = "N" OR strKey = CHR$(13) OR strKey = CHR$(27)
|
|
LOOP UNTIL strKey = "N" OR strKey = CHR$(27) OR iRuns >= 99
|
|
|
|
CLS
|
|
IF iRuns >= 99 THEN
|
|
PRINT "Maximum runs reached for this session."
|
|
END IF
|
|
|
|
PRINT "End of program"
|
|
PRINT "Start date/time: "; strDate; " "; strTime
|
|
PRINT "End date/time..: "; DATE$; " "; TIME$
|
|
END
|
|
' ---End main program
|
|
|
|
ShowAdvance:
|
|
ShowCompletion
|
|
RETURN
|
|
|
|
FUNCTION BinarySearch& (LookFor AS STRING, RetPos AS INTEGER)
|
|
' Var
|
|
DIM lFound AS LONG
|
|
DIM lLow AS LONG
|
|
DIM lHigh AS LONG
|
|
DIM lMid AS LONG
|
|
DIM strLookFor AS STRING
|
|
SHARED lIni AS LONG
|
|
SHARED lEnd AS LONG
|
|
SHARED lMaxWords AS LONG
|
|
SHARED strWords() AS STRING
|
|
SHARED lWords() AS LONG
|
|
|
|
' Binary search for stated word in the list
|
|
lLow = lIni
|
|
lHigh = lEnd
|
|
lFound = 0
|
|
strLookFor = UCASE$(LookFor)
|
|
DO WHILE (lFound < 1) AND (lLow <= lHigh)
|
|
lMid = (lHigh + lLow) / 2
|
|
IF strWords(lMid) = strLookFor THEN
|
|
lFound = lMid
|
|
ELSEIF strWords(lMid) > strLookFor THEN
|
|
lHigh = lMid - 1
|
|
ELSE
|
|
lLow = lMid + 1
|
|
END IF
|
|
LOOP
|
|
|
|
' Should I return the position if not found?
|
|
IF lFound = 0 AND RetPos THEN
|
|
IF lEnd < 1 THEN
|
|
lFound = 1
|
|
ELSEIF strWords(lMid) > strLookFor THEN
|
|
lFound = lMid
|
|
ELSE
|
|
lFound = lMid + 1
|
|
END IF
|
|
END IF
|
|
|
|
' Return the value
|
|
BinarySearch = lFound
|
|
|
|
END FUNCTION
|
|
|
|
FUNCTION CleanWord$ (WhichWord AS STRING)
|
|
' Var
|
|
DIM iSeek AS INTEGER
|
|
DIM iStep AS INTEGER
|
|
DIM bOK AS INTEGER
|
|
DIM strWord AS STRING
|
|
DIM strChar AS STRING
|
|
|
|
strWord = WhichWord
|
|
|
|
' Look for trailing wrong characters
|
|
strWord = LTRIM$(RTRIM$(strWord))
|
|
IF LEN(strWord) > 0 THEN
|
|
iStep = 0
|
|
DO
|
|
' Determines if step will be forward or backwards
|
|
IF iStep = 0 THEN
|
|
iStep = -1
|
|
ELSE
|
|
iStep = 1
|
|
END IF
|
|
|
|
' Sets the initial value of iSeek
|
|
IF iStep = -1 THEN
|
|
iSeek = LEN(strWord)
|
|
ELSE
|
|
iSeek = 1
|
|
END IF
|
|
|
|
bOK = FALSE
|
|
DO
|
|
strChar = MID$(strWord, iSeek, 1)
|
|
SELECT CASE strChar
|
|
CASE "A" TO "Z"
|
|
bOK = TRUE
|
|
CASE CHR$(129) TO CHR$(154)
|
|
bOK = TRUE
|
|
CASE CHR$(160) TO CHR$(165)
|
|
bOK = TRUE
|
|
END SELECT
|
|
|
|
' If it is not a character valid as a letter, please move one space
|
|
IF NOT bOK THEN
|
|
iSeek = iSeek + iStep
|
|
END IF
|
|
|
|
' If no letter was recognized, then exit the loop
|
|
IF iSeek < 1 OR iSeek > LEN(strWord) THEN
|
|
bOK = TRUE
|
|
END IF
|
|
LOOP UNTIL bOK
|
|
|
|
IF iStep = -1 THEN
|
|
' Reviews if a word was encountered
|
|
IF iSeek > 0 THEN
|
|
strWord = LEFT$(strWord, iSeek)
|
|
ELSE
|
|
strWord = ""
|
|
END IF
|
|
ELSEIF iStep = 1 THEN
|
|
IF iSeek <= LEN(strWord) THEN
|
|
strWord = MID$(strWord, iSeek)
|
|
ELSE
|
|
strWord = ""
|
|
END IF
|
|
END IF
|
|
LOOP UNTIL iStep = 1 OR strWord = ""
|
|
END IF
|
|
|
|
' Return the result
|
|
CleanWord = strWord
|
|
|
|
END FUNCTION
|
|
|
|
SUB CountWords (FromString AS STRING)
|
|
' Var
|
|
DIM iStart AS INTEGER
|
|
DIM iLenW AS INTEGER
|
|
DIM iLenS AS INTEGER
|
|
DIM iLenD AS INTEGER
|
|
DIM strString AS STRING
|
|
DIM strWord AS STRING
|
|
DIM lWhichWord AS LONG
|
|
SHARED lEnd AS LONG
|
|
SHARED lMaxWords AS LONG
|
|
SHARED strWords() AS STRING
|
|
SHARED lWords() AS LONG
|
|
|
|
' Converts to Upper Case and cleans leading and trailing spaces
|
|
strString = UCASE$(FromString)
|
|
strString = LTRIM$(RTRIM$(strString))
|
|
|
|
' Get words from string
|
|
iStart = 1
|
|
iLenW = 0
|
|
iLenS = LEN(strString)
|
|
DO WHILE iStart <= iLenS
|
|
iLenW = INSTR(iStart, strString, " ")
|
|
IF iLenW = 0 AND iStart <= iLenS THEN
|
|
iLenW = iLenS + 1
|
|
END IF
|
|
strWord = MID$(strString, iStart, iLenW - iStart)
|
|
|
|
' Will remove mid dashes or apostrophe or "â€"
|
|
iLenD = INSTR(strWord, "-")
|
|
IF iLenD < 1 THEN
|
|
iLenD = INSTR(strWord, "'")
|
|
IF iLenD < 1 THEN
|
|
iLenD = INSTR(strWord, "â€")
|
|
END IF
|
|
END IF
|
|
IF iLenD >= 2 THEN
|
|
strWord = LEFT$(strWord, iLenD - 1)
|
|
iLenW = iStart + (iLenD - 1)
|
|
END IF
|
|
strWord = CleanWord(strWord)
|
|
|
|
IF strWord <> "" THEN
|
|
' Look for the word to be counted
|
|
lWhichWord = BinarySearch(strWord, FALSE)
|
|
|
|
' If the word doesn't exist in the list, add it
|
|
IF lWhichWord = 0 THEN
|
|
lWhichWord = InsertWord(strWord)
|
|
END IF
|
|
|
|
' Count the word
|
|
IF lWhichWord > 0 THEN
|
|
lWords(lWhichWord) = lWords(lWhichWord) + 1
|
|
END IF
|
|
END IF
|
|
iStart = iLenW + 1
|
|
LOOP
|
|
|
|
END SUB
|
|
|
|
' Here a word will be inserted in the list
|
|
FUNCTION InsertWord& (WhichWord AS STRING)
|
|
' Var
|
|
DIM lFound AS LONG
|
|
DIM lWord AS LONG
|
|
DIM strWord AS STRING
|
|
SHARED lIni AS LONG
|
|
SHARED lEnd AS LONG
|
|
SHARED lMaxWords AS LONG
|
|
SHARED strWords() AS STRING
|
|
SHARED lWords() AS LONG
|
|
|
|
' Look for the word in the list
|
|
strWord = UCASE$(WhichWord)
|
|
lFound = BinarySearch(WhichWord, TRUE)
|
|
IF lFound > 0 THEN
|
|
' Add one word
|
|
lEnd = lEnd + 1
|
|
|
|
' Verifies if there is still room for a new word
|
|
IF lEnd > lMaxWords THEN
|
|
lMaxWords = lMaxWords + AddWords ' Other words
|
|
IF lMaxWords > 32767 THEN
|
|
IF lEnd <= 32767 THEN
|
|
lMaxWords = 32767
|
|
ELSE
|
|
lFound = -1
|
|
END IF
|
|
END IF
|
|
|
|
IF lFound > 0 THEN
|
|
REDIM _PRESERVE strWords(lIni TO lMaxWords) AS STRING
|
|
REDIM _PRESERVE lWords(lIni TO lMaxWords) AS LONG
|
|
END IF
|
|
END IF
|
|
|
|
IF lFound > 0 THEN
|
|
' Move the words below this
|
|
IF lEnd > 1 THEN
|
|
FOR lWord = lEnd TO lFound + 1 STEP -1
|
|
strWords(lWord) = strWords(lWord - 1)
|
|
lWords(lWord) = lWords(lWord - 1)
|
|
NEXT lWord
|
|
END IF
|
|
|
|
' Insert the word in the position
|
|
strWords(lFound) = strWord
|
|
lWords(lFound) = 0
|
|
END IF
|
|
END IF
|
|
|
|
InsertWord = lFound
|
|
END FUNCTION
|
|
|
|
SUB QuickSort (lLeftN AS LONG, lRightN AS LONG, iMode AS INTEGER)
|
|
' Var
|
|
DIM lPivot AS LONG
|
|
DIM lLeftNIdx AS LONG
|
|
DIM lRightNIdx AS LONG
|
|
SHARED lWords() AS LONG
|
|
SHARED strWords() AS STRING
|
|
|
|
' Clasifies from highest to lowest
|
|
lLeftNIdx = lLeftN
|
|
lRightNIdx = lRightN
|
|
IF (lRightN - lLeftN) > 0 THEN
|
|
lPivot = (lLeftN + lRightN) / 2
|
|
DO WHILE (lLeftNIdx <= lPivot) AND (lRightNIdx >= lPivot)
|
|
IF iMode = 0 THEN ' Ascending
|
|
DO WHILE (lWords(lLeftNIdx) < lWords(lPivot)) AND (lLeftNIdx <= lPivot)
|
|
lLeftNIdx = lLeftNIdx + 1
|
|
LOOP
|
|
DO WHILE (lWords(lRightNIdx) > lWords(lPivot)) AND (lRightNIdx >= lPivot)
|
|
lRightNIdx = lRightNIdx - 1
|
|
LOOP
|
|
ELSE ' Descending
|
|
DO WHILE (lWords(lLeftNIdx) > lWords(lPivot)) AND (lLeftNIdx <= lPivot)
|
|
lLeftNIdx = lLeftNIdx + 1
|
|
LOOP
|
|
DO WHILE (lWords(lRightNIdx) < lWords(lPivot)) AND (lRightNIdx >= lPivot)
|
|
lRightNIdx = lRightNIdx - 1
|
|
LOOP
|
|
END IF
|
|
SWAP lWords(lLeftNIdx), lWords(lRightNIdx)
|
|
SWAP strWords(lLeftNIdx), strWords(lRightNIdx)
|
|
lLeftNIdx = lLeftNIdx + 1
|
|
lRightNIdx = lRightNIdx - 1
|
|
IF (lLeftNIdx - 1) = lPivot THEN
|
|
lRightNIdx = lRightNIdx + 1
|
|
lPivot = lRightNIdx
|
|
ELSEIF (lRightNIdx + 1) = lPivot THEN
|
|
lLeftNIdx = lLeftNIdx - 1
|
|
lPivot = lLeftNIdx
|
|
END IF
|
|
LOOP
|
|
QuickSort lLeftN, lPivot - 1, iMode
|
|
QuickSort lPivot + 1, lRightN, iMode
|
|
END IF
|
|
END SUB
|
|
|
|
SUB ShowCompletion ()
|
|
' Var
|
|
SHARED iFil AS INTEGER
|
|
SHARED lLine AS LONG
|
|
SHARED lLines AS LONG
|
|
SHARED lEnd AS LONG
|
|
|
|
LOCATE iFil + 1, 1
|
|
PRINT "Lines analyzed :"; lLine
|
|
PRINT USING "% of completion: ###%"; (lLine / lLines) * 100
|
|
PRINT "Words found....:"; lEnd
|
|
END SUB
|
|
|
|
SUB ShowResults ()
|
|
' Var
|
|
DIM iMaxL AS INTEGER
|
|
DIM iMaxW AS INTEGER
|
|
DIM lWord AS LONG
|
|
DIM lHowManyWords AS LONG
|
|
DIM strString AS STRING
|
|
DIM strFileR AS STRING
|
|
SHARED lIni AS LONG
|
|
SHARED lEnd AS LONG
|
|
SHARED lLenF AS LONG
|
|
SHARED lMaxWords AS LONG
|
|
SHARED sTimer AS SINGLE
|
|
SHARED strFile AS STRING
|
|
SHARED strWords() AS STRING
|
|
SHARED lWords() AS LONG
|
|
SHARED strTopWords() AS STRING
|
|
SHARED lTopWords() AS LONG
|
|
SHARED iRuns AS INTEGER
|
|
|
|
' Show results
|
|
|
|
' Creates file name
|
|
lWord = INSTR(strFile, ".")
|
|
IF lWord = 0 THEN lWord = LEN(strFile)
|
|
strFileR = LEFT$(strFile, lWord)
|
|
IF RIGHT$(strFileR, 1) <> "." THEN strFileR = strFileR + "."
|
|
|
|
' Retrieves the longest word found and the highest count
|
|
FOR lWord = lIni TO lEnd
|
|
' Gets the longest word found
|
|
IF LEN(strWords(lWord)) > iMaxL THEN
|
|
iMaxL = LEN(strWords(lWord))
|
|
END IF
|
|
|
|
lHowManyWords = lHowManyWords + lWords(lWord)
|
|
NEXT lWord
|
|
IF iMaxL > 60 THEN iMaxW = 60 ELSE iMaxW = iMaxL
|
|
|
|
' Gets top counted
|
|
TopCounted
|
|
|
|
' Shows the results
|
|
CLS
|
|
PRINT "File analyzed : "; strFile
|
|
PRINT "Length of file:"; lLenF
|
|
PRINT "Time lapse....:"; TIMER - sTimer;"seconds"
|
|
PRINT "Words found...:"; lHowManyWords; "(Unique:"; STR$(lEnd); ")"
|
|
PRINT "Longest word..:"; iMaxL
|
|
PRINT
|
|
PRINT "The"; TopCount; "most used are:"
|
|
PRINT STRING$(iMaxW, "-"); "+"; STRING$(80 - (iMaxW + 1), "-")
|
|
PRINT " Word"; SPACE$(iMaxW - 5); "| Count"
|
|
PRINT STRING$(iMaxW, "-"); "+"; STRING$(80 - (iMaxW + 1), "-")
|
|
strString = "\" + SPACE$(iMaxW - 2) + "\| #########,"
|
|
FOR lWord = lIni TO TopCount
|
|
PRINT USING strString; strTopWords(lWord); lTopWords(lWord)
|
|
NEXT lWord
|
|
PRINT STRING$(iMaxW, "-"); "+"; STRING$(80 - (iMaxW + 1), "-")
|
|
PRINT "See files "; strFileR + "S" + LTRIM$(STR$(iRuns)); " and "; strFileR + "C" + LTRIM$(STR$(iRuns)); " to see the full list."
|
|
END SUB
|
|
|
|
SUB TopCounted ()
|
|
' Var
|
|
DIM lWord AS LONG
|
|
DIM strFileR AS STRING
|
|
DIM iFile AS INTEGER
|
|
CONST Descending = 1
|
|
SHARED lIni AS LONG
|
|
SHARED lEnd AS LONG
|
|
SHARED lMaxWords AS LONG
|
|
SHARED strWords() AS STRING
|
|
SHARED lWords() AS LONG
|
|
SHARED strTopWords() AS STRING
|
|
SHARED lTopWords() AS LONG
|
|
SHARED iRuns AS INTEGER
|
|
SHARED strFile AS STRING
|
|
|
|
' Assigns new dimmentions
|
|
REDIM strTopWords(lIni TO TopCount) AS STRING
|
|
REDIM lTopWords(lIni TO TopCount) AS LONG
|
|
|
|
' Saves the current values
|
|
lWord = INSTR(strFile, ".")
|
|
IF lWord = 0 THEN lWord = LEN(strFile)
|
|
strFileR = LEFT$(strFile, lWord)
|
|
IF RIGHT$(strFileR, 1) <> "." THEN strFileR = strFileR + "."
|
|
iFile = FREEFILE
|
|
OPEN strFileR + "S" + LTRIM$(STR$(iRuns)) FOR OUTPUT AS #iFile
|
|
FOR lWord = lIni TO lEnd
|
|
WRITE #iFile, strWords(lWord), lWords(lWord)
|
|
NEXT lWord
|
|
CLOSE #iFile
|
|
|
|
' Classifies the counted in descending order
|
|
QuickSort lIni, lEnd, Descending
|
|
|
|
' Now, saves the required values in the arrays
|
|
FOR lWord = lIni TO TopCount
|
|
strTopWords(lWord) = strWords(lWord)
|
|
lTopWords(lWord) = lWords(lWord)
|
|
NEXT lWord
|
|
|
|
' Now, saves the order from the file
|
|
OPEN strFileR + "C" + LTRIM$(STR$(iRuns)) FOR OUTPUT AS #iFile
|
|
FOR lWord = lIni TO lEnd
|
|
WRITE #iFile, strWords(lWord), lWords(lWord)
|
|
NEXT lWord
|
|
CLOSE #iFile
|
|
|
|
END SUB
|