# Intrest.Bas 2/

``` BBS: Inland Empire Archive
Date: 02-23-93 (22:26)             Number: 396
From: QUINN TYLER JACKSON          Refer#: NONE
To: ALL                           Recvd: NO
Subj: Intrest.Bas           2/       Conf: (2) Quik_Bas```
```>>> Continued from previous message
' Note that the numbers that are passed in represent weighted percentages,
' except for Stats.Badwords, which is a count of obscene words encountered
' to those encountered.  Let each programmer decide himself what is good
' reading and what is bad.  Also remember that the weight can be configured
' by the reader by passing in the appropriate numbers in the first place.
' might want difficult reading, and so different weights
' are allowed.

' For example, if I like simple reading, I might give a greater weight to
' Stats.English.  If I like science, I might create a configuration file
' full of technical terms and give Stats.Keywords more weight.

' This is just my example.  Have fun with this function!

IF Send.Badwords < 100 THEN ' If we haven't passed our threshold for dirt
IF Send.English < 20 AND Send.English > 5 THEN ' It's neither too hard
' nor too easy
IF Send.Keywords > 5 THEN  ' And it talks about what interests us
IF Send.Avoid < 10 THEN ' without using terms we hate
fqjDecide = TRUE
END IF
END IF
END IF
END IF

END FUNCTION

FUNCTION fqjParse (InText\$, WordArray\$())

REDIM WordArray\$(100)
Boundary = UBOUND(WordArray\$)

L = LEN(InText\$)

'Go through the string one character at a time.
FOR i = 1 TO L

Char\$ = MID\$(InText\$, i, 1)

IF INSTR(BlankSpace\$, Char\$) = 0 THEN
'Not a blank space. Test if you're already inside a word.
IF NOT in THEN
'You've found the start of a new word.
NumWords = NumWords + 1
in = TRUE
IF NumWords = Boundary THEN
Boundary = Boundary + 25
REDIM PRESERVE WordArray\$(Boundary)
END IF
END IF
'Add the character to the current word.
WordArray\$(NumWords) = WordArray\$(NumWords) + Char\$
ELSE
'Found a blank space character.
'Set "Not in an argument" flag to FALSE.
in = FALSE
END IF
NEXT i

' Shrink the WordArray\$() down to an appropriate size

REDIM PRESERVE WordArray\$(NumWords)

fqjParse = NumWords

END FUNCTION

FUNCTION funIntrest (InText\$, Stats AS InterestType, ConfigFile\$)

STATIC Been             ' Keep track of this for the next call, since
' subsequent calls do not need to initialize
' the tables.

' This is the main FUNCTION of the whole INTREST.BAS module.  The FUNCTION
' is passed a string of text and interest thresholds in the InterestType
' variable Stats.

IF NOT Been THEN            ' Tables must be set for later calls to be
sqjTableInit ConfigFile\$' processed much faster.
Been = TRUE
END IF

IF Stats.English = 0 THEN   ' Assume a normal weight for English
Stats.English = 10'%
END IF

IF Stats.Keywords = 0 THEN  ' Assume a reasonable weight for keywords
Stats.Keywords = 15'%
END IF

IF Stats.Avoid = 0 THEN     ' Assume a reasonable weight for avoided words
Stats.Avoid = 15'%
END IF

IF Stats.Badwords = 0 THEN  ' Assume that one cuss is too much
END IF

DIM WordArray\$(1)

Stats.Total = fqjParse(InText\$, WordArray\$())
CLS

FOR i = 1 TO Stats.Total
IF fqjBiSearch(HundredTable\$(), WordArray\$(i)) THEN
HundPtr = HundPtr + 1
ELSEIF fqjBiSearch(CustomTable\$(), WordArray\$(i)) THEN
CustPtr = CustPtr + 1
ELSEIF fqjBiSearch(AvoidTable\$(), WordArray\$(i)) THEN
AcPtr = AvPtr + 1
ELSEIF fqjBiSearch(ObsceneTable\$(), WordArray\$(i)) THEN
ObPtr = ObPtr + 1
ELSE
OtherPtr = OtherPtr + 1
END IF
NEXT i

DIM Send AS InterestType

Send.English = 100 * (HundPtr / Stats.Total) * (Stats.English / 100)
Send.Keywords = 100 * (CustPtr / Stats.Total) * (Stats.Keywords / 100)
Send.Avoid = 100 * (AvPtr / Stats.Total) * (Stats.Avoid / 100)

funIntrest = fqjDecide(Send)    ' Pass it to the function that makes
' the decision about what is interesting.

END FUNCTION

SUB sqjShellSort (Array\$())

'   sqjShellSort is a modified version of the SUB that comes with the
'   QuickBASIC 4.5 distribution disks in the program SORTDEMO.BAS.  It
'   has been modified to accept an unsorted array as a parameter, which
'   it then passes back sorted alphabetically.

Start = LBOUND(Array\$)
MaxRow = UBOUND(Array\$)

Offset = MaxRow \ 2
>>> Continued to next message

* SLMR 2.1a *

--- Maximus 2.01wb
* Origin: VKUG/VPCC QuickBasic Echo - Richmond, BC (1:153/151)
``` Echo Basic Postings

Books at Amazon:

Back to BASIC: The History, Corruption, and Future of the Language

Hackers: Heroes of the Computer Revolution (including Tiny BASIC)

Go to: The Story of the Math Majors, Bridge Players, Engineers, Chess Wizards, Scientists and Iconoclasts who were the Hero Programmers of the Software Revolution

The Advent of the Algorithm: The Idea that Rules the World

Moths in the Machine: The Power and Perils of Programming

Mastering Visual Basic .NET