Intrest.Bas 1/

 BBS: Inland Empire Archive
Date: 02-23-93 (22:26)             Number: 395
From: QUINN TYLER JACKSON          Refer#: NONE
  To: ALL                           Recvd: NO  
Subj: Intrest.Bas           1/       Conf: (2) Quik_Bas

'
'                   *                                    *
'                 **o************************************o**
'                   ** INTREST.BAS v1.0 (Public Domain) **
'                   *              Written by            *
'                   *          Quinn Tyler Jackson       *
'                   *                  of                *
'                   *  JackMack Consulting & Development *
'                   *                                    *
'                   *              QBS: YES!             *
'                   **      BASIC Code Cache:  YES!     **
'                 **o************************************o**
'                   *                                    *
'
' CAVEAT:   The following program uses PDS/VBDOS extensions of the
'           QuickBASIC language.  It may be modified to work under
'           QB 4.5, but that would take some work on your part.
'           Keywords to be on the lookout for include PRESERVE.

' GOAL:
'           An odd way of looking at text to see if it is worth reading.

'           I wrote it as an intellegent way of scanning through a message
'           base to find those random messages that might be interesting
'           reading.  Why not have some fun with it?

'
' The following TYPE declaration defines the variable type that must
' be passed to funInterest, which is the main interface function of
' this module.

TYPE InterestType
    Total AS INTEGER
    English AS INTEGER
    Keywords AS INTEGER
    Avoid AS INTEGER
    Badwords AS INTEGER
END TYPE

CONST TRUE = -1
CONST FALSE = NOT TRUE

DEFINT A-Z

OPTION BASE 1

'$STATIC is best for the next array, which is always 100 words
DIM SHARED HundredTable$(100)       ' 100 most common words in English

'$DYNAMIC because the next arrays may be redimensioned.
DIM SHARED CustomTable$(100)        ' 100 custom words to start with
DIM SHARED AvoidTable$(100)         ' custom words to avoid
DIM SHARED ObsceneTable$(100)       ' obscene words to avoid

DIM SHARED BlankSpace$

text$ = "Sex and drugs are good for you, old man."

DIM WordArray$(1)
DIM Stats AS InterestType

' Set some weights
Stats.Keywords = 25
Stats.Badwords = 1

SELECT CASE funIntrest(text$, Stats, "d:\cust.txt")
    CASE TRUE
        PRINT "Text worth reading."
    CASE FALSE
        PRINT "Text not worth reading."
END SELECT

END



EnglishWordData:

' Below are listed the hundred most frequently used words in English.
' Taken from fifteen English authors and many newspapers.  Compiled by
' Frank R. Fraprie.  Taken from Helen Gaines Fouche's _Cryptanalysis_,
' which is published by Dover Publications since 1956.  50% of English
' text is made up of these words.  Any disproportion indicates text that
' is either more difficult or more easy to read.

DATA the,of,and,to,a,in,that,is,I,it
DATA for,as,with,was,his,he,be,not,by,but
DATA have,you,which,are,on,or,her,had,at,from
DATA this,my,they,all,their,an,she,has,were,me
DATA been,him,one,so,if,will,there,who,no,we
DATA when,what,your,more,would,them,some,than,may,upon
DATA its,out,into,our,these,man,up,do,like,after
DATA shall,great,now,such,should,other,only,any,then,yet
DATA about,those,can,made,well,old,must,us,said,time,two
DATA time,even,new,could,very,much,own,most,might,first

ObsceneWordData:

' The following list, for reasons of echo decency, is mild.  The SUB that
' initializes the variable ObsceneTable$() scans the following DATA
' until it reaches MOUTH_WITH_SOAP in the list.  This allows everyone out
' there to add his own favotrite obscenities to this list, while allowing
' me to keep our echo clean.

DATA heck,gee,golly,gosh
DATA gads,wilikers,tarnation,MOUTH_WITH_SOAP

REM $STATIC
FUNCTION fqjBiSearch (Array$(), Find$)

' This is Ethan Winer's binary search function, modified a bit.

Target$ = UCASE$(Find$)

fqjBiSearch = 0                 'no matching element yet

Min = LBOUND(Array$)            'start at first element
Max = UBOUND(Array$)            'consider through last

DO
  Try = (Max + Min) \ 2         'start testing in middle

  IF Array$(Try) = Target$ THEN 'found it!
    fqjBiSearch = Try           'return matching element
    EXIT DO                     'all done
  END IF

  IF Array$(Try) > Target$ THEN 'too high, cut in half
    Max = Try - 1
  ELSE
    Min = Try + 1               'too low, cut other way
  END IF
LOOP WHILE Max >= Min


END FUNCTION

FUNCTION fqjDecide (Send AS InterestType)

' This is the FUNCTION that passes back TRUE if the statistics are
' considered interesting, or FALSE if not.  It is up to the individual
' programmer to decide what should be interesting or not.
>>> Continued to next message

 * SLMR 2.1a *

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