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.
' One reader might want simple reading, another
' 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
    Stats.Badwords = 1
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)
Send.Badwords = 100 * (CussPtr / Stats.Badwords)

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)