home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Mega CD-ROM 1
/
megacd_rom_1.zip
/
megacd_rom_1
/
MAGAZINE
/
DDJMAG
/
DDJ8704.ZIP
/
GRGLST1.LST
< prev
next >
Wrap
File List
|
1987-03-12
|
17KB
|
616 lines
REM Mycin-like expert system for Amiga BASIC
REM by Richard Grigonis
DIM AND.COMPONENT(12),AT.FACTOR.FOR.OR.COMPONENT(12)
DIM OR.COMPONENT(12),TRAIL(30),HUMAN.INPUT$(4)
DIM MESSAGE$(60),WHICH.EQ$(8),BLANK$(19)
DIM HYPOTHESIS(20) ' CHANGE THIS NUMBER IF MORE THAN 20 ANIMALS
no=0:yes=1
DATA 1,is an albatross
albatross=1
DATA 2,is a penguin
penguin=2
DATA 3,is an ostrich
ostrich=3
DATA 4,is a zebra
zebra=4
DATA 5,is a giraffe
giraffe=5
DATA 6,is a tiger
tiger=6
DATA 7,is a cheetah
cheetah=7
DATA 8,flies well
flies.well=8
DATA 9,swims
swims=9
DATA 10,is black and white
black.and.white=10
DATA 11,cannot fly
cannot.fly=11
DATA 12,has a long neck
long.neck=12
DATA 13,has black stripes
black.stripes=13
DATA 14,has long legs
long.legs=14
DATA 15,has dark spots
dark.spots=15
DATA 16,has a tawny color
tawny.color=16
DATA 17,is a bird
bird=17
DATA 18,is an ungulate
ungulate=18
DATA 19,is a carnivore
carnivore=19
DATA 20,is a mammal
mammal=20
DATA 21,has hair
has.hair=21
DATA 22,gives milk
gives.milk=22
DATA 23,eats meat
eats.meat=23
DATA 24,has pointed teeth and claws and forward pointing eyes
teeth.claws.eyes=24
DATA 25,is a mammal and has hoofs
mammal.and.hoofs=25
DATA 26,is a mammal and chews cud
mammal.and.chews.cud=26
DATA 27,has feathers
feathers=27
DATA 28,flies and lays eggs
flies.and.lays.eggs=28
DATA 29,lays eggs
lays.eggs=29
DATA 30,flies
flies=30
DATA 31,chews cud
chews.cud=31
DATA 32,has hoofs
hoofs=32
DATA 33,has forward pointing eyes
front.eyes=33
DATA 34,has claws
claws=34
DATA 35,has pointed teeth
pointed.teeth=35
DATA -1,END OF DATA
REM TOP-LEVEL HYPOTHESES (ROOTS) OF AND/OR TREE:
HYPOTHESIS(1)=albatross
HYPOTHESIS(2)=penguin
HYPOTHESIS(3)=ostrich
HYPOTHESIS(4)=zebra
HYPOTHESIS(5)=giraffe
HYPOTHESIS(6)=tiger
HYPOTHESIS(7)=cheetah
number.of.hypotheses=7
REM DETERMINE TOTAL NUMBER OF FACTS:
number.of.facts=0
WHILE fact <> -1
READ fact,MESSAGE$
number.of.facts=number.of.facts+1
WEND
number.of.facts=number.of.facts-1
DIM BEEN.EXAMINED.BEFORE(number.of.facts),OUTPUT.CF(number.of.facts)
Start:
FOR A=0 TO UBOUND(OUTPUT.CF)
OUTPUT.CF(A)=0:BEEN.EXAMINED.BEFORE(A)=0
NEXT A
PRINT "I'm a backward-chaining expert system."
PRINT "Please think of one of the";number.of.hypotheses
PRINT "animals listed below. I will ask you"
PRINT "questions about the animal and compute"
PRINT "the certainty of it being one"
PRINT "of the following";number.of.hypotheses;"animals:":PRINT
FOR fact=1 TO number.of.hypotheses
which.fact=HYPOTHESIS(fact)
GOSUB Find.message:PRINT "ANIMAL ";MESSAGE$
NEXT fact
PRINT
10030 PRINT "DO YOU WANT: "
PRINT "AN EXHAUSTIVE SEARCH (1) OR,"
PRINT "STOP-ON-SUCCESS (2)? ":PRINT
PRINT "Press the NUMBER of YOUR SELECTION"
PRINT "and then press the RETURN KEY."
halt.on.success=0:INPUT halt.on.success
IF 0>halt.on.success OR halt.on.success>2
THEN PRINT "TRY AGAIN!":GOTO 10030
10050 REM PROVE HYPOTHESES
GOSUB Prove.albatross
IF halt.on.success=2 AND OUTPUT.CF(albatross)=1 THEN 10165
GOSUB Prove.penguin
IF halt.on.success=2 AND OUTPUT.CF(penguin)=1 THEN 10165
GOSUB Prove.ostrich
IF halt.on.success=2 AND OUTPUT.CF(ostrich)=1 THEN 10165
GOSUB Prove.zebra
IF halt.on.success=2 AND OUTPUT.CF(zebra)=1 THEN 10165
GOSUB Prove.giraffe
IF halt.on.success=2 AND OUTPUT.CF(giraffe)=1 THEN 10165
GOSUB Prove.tiger
IF halt.on.success=2 AND OUTPUT.CF(tiger)=1 THEN 10165
GOSUB Prove.cheetah
IF halt.on.success=2 AND OUTPUT.CF(cheetah)=1 THEN 10165
10165 REM DISPLAY RESULTS
CLS
PRINT "HERE ARE THE COMPUTED CERTAINTY FACTORS:"
PRINT "(Correct animal has highest positive CF#)":PRINT
FOR fact=1 TO number.of.hypotheses
which.fact=HYPOTHESIS(fact)
GOSUB Find.message
BLANK$=SPACE$(19)
MESSAGE$=MESSAGE$+MID$(BLANK$,1,LEN(BLANK$)-LEN(MESSAGE$))
PRINT "ANIMAL ";MESSAGE$;" CF=";OUTPUT.CF(which.fact)
NEXT fact
PRINT:PRINT "TO GO AGAIN, press the RETURN button."
INPUT HUMAN.INPUT$:PRINT
GOTO Start
REM SUBROUTINES TO COMPUTE CF'S (IN ALPHABETICAL ORDER)
Compute.and.clause.cf:
GOSUB Find.lowest.cf.branch
GOSUB Multiply.lowest.cf.by.at.factor
GOSUB Trim.to.zero
OUTPUT.CF(TRAIL(depth))=new.cf
RETURN
Compute.or.clause.cf:
GOSUB Multiply.component.cfs.by.at.factors
GOSUB Test.for.a.positive.number
GOSUB Run.or.equation
GOSUB Trim.to.zero
OUTPUT.CF(TRAIL(depth))=new.cf
RETURN
Dec.stack:
depth=depth-1:RETURN
Deduce:
which.fact=TRAIL(depth):GOSUB Find.message
PRINT:PRINT "The fact that the animal "
PRINT MESSAGE$;" (FACT # ";fact.number;")"
PRINT "Now has a Certainty Factor of: ";OUTPUT.CF(TRAIL(depth))
PRINT:GOSUB Dec.stack:GOSUB Delay
RETURN
Delay:
FOR D=1 TO 10000:NEXT D:RETURN
Explain.why:
which.fact=TRAIL(1):GOSUB Find.message:CLS
PRINT "I AM INVESTIGATING THE HYPOTHESIS"
PRINT "THAT THE ANIMAL..."
PRINT MESSAGE$;" (FACT # ";fact.number;")":PRINT
IF depth=1 THEN
PRINT "...BY FIRST ASKING YOU.":PRINT
PRINT "If you are not sure (-8 < CF < 8)"
PRINT "then I will investigate this hypothesis further."
ELSE
FOR A=2 TO depth
which.fact=TRAIL(A)
GOSUB Find.message:PRINT "...BY PROVING THAT THE ANIMAL..."
PRINT MESSAGE$;" (FACT # ";fact.number;")":PRINT
NEXT A
PRINT "...BY ASKING YOU."
END IF
PRINT:INPUT "PRESS RETURN KEY TO CONTINUE",HUMAN.INPUT$
RETURN
Find.lowest.cf.branch:
lowest.number=OUTPUT.CF(AND.COMPONENT(1))
FOR branch=1 TO number.of.and.clause.components
number.to.test=OUTPUT.CF(AND.COMPONENT(branch))
IF lowest.number>number.to.test
THEN lowest.number=number.to.test
NEXT branch
RETURN
Find.message:
RESTORE
FOR C=1 TO which.fact
READ fact.number, MESSAGE$
NEXT C
RETURN
Inc.stack:
depth=depth+1:TRAIL(depth)=current.fact
RETURN
Multiply.component.cfs.by.at.factors:
FOR branch=1 TO number.of.or.clause.components
new.cf=OUTPUT.CF(OR.COMPONENT(branch))
*AT.FACTOR.FOR.OR.COMPONENT(branch)
GOSUB Trim.to.zero
OUTPUT.CF(OR.COMPONENT(branch))=new.cf
NEXT branch
RETURN
Multiply.lowest.cf.by.at.factor:
new.cf=lowest.number*at.factor.for.and.clause
RETURN
Negative.or.equation:
new.cf=1
FOR branch=1 TO number.of.or.clause.components
new.cf=new.cf*(1+OUTPUT.CF(OR.COMPONENT(branch)))
NEXT branch
new.cf=-1+new.cf
RETURN
Positive.or.equation:
new.cf=1
FOR branch=1 TO number.of.or.clause.components
new.cf=new.cf*(1-OUTPUT.CF(OR.COMPONENT(branch)))
NEXT branch
new.cf=1-new.cf
RETURN
Run.or.equation:
IF WHICH.EQ$="POSITIVE" THEN
GOSUB Positive.or.equation
ELSE
GOSUB Negative.or.equation
END IF
RETURN
Test.fact.for.human.input:
leave=no:GOSUB Inc.stack
IF BEEN.EXAMINED.BEFORE(current.fact)=yes THEN leave=yes:GOSUB
Dec.stack:RETURN
BEEN.EXAMINED.BEFORE(current.fact)=yes
4156 which.fact=current.fact
GOSUB Find.message
4160 CLS:PRINT"(FACT # ";fact.number;")":PRINT
PRINT "ON A SCALE OF -10 TO 10 WHERE,"
PRINT " 10=absolutely certain it's true"
PRINT " 8=almost certain"
PRINT " 6=probably"
PRINT " 3=slight evidence"
PRINT " 0=unknown"
PRINT " -6=probably not"
PRINT " -8=almost certainly not"
PRINT "-10=definitely not"
PRINT:PRINT"TO WHAT DEGREE DO YOU BELIEVE THAT"
PRINT "The animal ";MESSAGE$;"?":PRINT
PRINT "TYPE NUMBER AND PRESS RETURN KEY,"
PRINT "OR TYPE `why?' AND PRESS RETURN KEY"
INPUT HUMAN.INPUT$
HUMAN.INPUT$=UCASE$(HUMAN.INPUT$)
IF HUMAN.INPUT$="WHY" OR HUMAN.INPUT$="WHY?"
THEN GOSUB Explain.why:GOTO 4156
I=VAL(HUMAN.INPUT$)
IF -10>I OR I>10 THEN GOTO 4160
I=I/10:OUTPUT.CF(current.fact)=I
IF -.8>I OR I>.8 THEN leave=yes:GOSUB Deduce
RETURN
Test.for.a.positive.number:
WHICH.EQ$="NEGATIVE"
FOR branch=1 TO number.of.or.clause.components
number.to.test=OUTPUT.CF(OR.COMPONENT(branch))
IF number.to.test>0 THEN
WHICH.EQ$="POSITIVE":branch=number.of.or.clause.components
NEXT branch
RETURN
Trim.to.zero:
IF -.2<=new.cf AND new.cf<=.2 THEN
new.cf=0
ELSEIF new.cf>=.8 THEN
new.cf=1
ELSEIF new.cf<=-.8 THEN
new.cf=-1
END IF
RETURN
REM ***DEDUCTIVE ROUTINES FOLLOW***
Prove.albatross:
current.fact=albatross:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Prove.bird:GOSUB Prove.flies.well
number.of.and.clause.components=2
AND.COMPONENT(1)=bird:AND.COMPONENT(2)=flies.well
at.factor.for.and.clause=1
GOSUB Compute.and.clause.cf
GOSUB Deduce
RETURN
Prove.penguin:
current.fact=penguin:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Prove.bird:GOSUB Prove.cannot.fly
GOSUB Prove.black.and.white:GOSUB Prove.swims
number.of.and.clause.components=4
AND.COMPONENT(1)=bird:AND.COMPONENT(2)=cannot.fly
AND.COMPONENT(3)=black.and.white:AND.COMPONENT(4)=swims
at.factor.for.and.clause=.8
GOSUB Compute.and.clause.cf
GOSUB Deduce
RETURN
Prove.ostrich:
current.fact=ostrich:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Prove.bird:GOSUB Prove.cannot.fly
GOSUB Prove.black.and.white:GOSUB Prove.long.neck
number.of.and.clause.components=4
AND.COMPONENT(1)=bird:AND.COMPONENT(2)=cannot.fly
AND.COMPONENT(3)=black.and.white:AND.COMPONENT(4)=long.neck
at.factor.for.and.clause=.85
GOSUB Compute.and.clause.cf
GOSUB Deduce
RETURN
Prove.zebra:
current.fact=zebra:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Prove.ungulate:GOSUB Prove.black.stripes
number.of.and.clause.components=2
AND.COMPONENT(1)=ungulate:AND.COMPONENT(2)=black.stripes
at.factor.for.and.clause=.8
GOSUB Compute.and.clause.cf
GOSUB Deduce
RETURN
Prove.giraffe:
current.fact=giraffe:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Prove.ungulate:GOSUB Prove.long.neck
GOSUB Prove.long.legs:GOSUB Prove.dark.spots
number.of.and.clause.components=4
AND.COMPONENT(1)=ungulate:AND.COMPONENT(2)=long.neck
AND.COMPONENT(3)=long.legs:AND.COMPONENT(4)=dark.spots
at.factor.for.and.clause=.85
GOSUB Compute.and.clause.cf
GOSUB Deduce
RETURN
Prove.tiger:
current.fact=tiger:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Prove.mammal:GOSUB Prove.carnivore
GOSUB Prove.black.stripes:GOSUB Prove.tawny.color
number.of.and.clause.components=4
AND.COMPONENT(1)=mammal:AND.COMPONENT(2)=carnivore
AND.COMPONENT(3)=black.stripes:AND.COMPONENT(4)=tawny.color
at.factor.for.and.clause=.95
GOSUB Compute.and.clause.cf
GOSUB Deduce
RETURN
Prove.cheetah:
current.fact=cheetah:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Prove.mammal:GOSUB Prove.carnivore
GOSUB Prove.tawny.color:GOSUB Prove.dark.spots
number.of.and.clause.components=4
AND.COMPONENT(1)=mammal:AND.COMPONENT(2)=carnivore
AND.COMPONENT(3)=tawny.color:AND.COMPONENT(4)=dark.spots
at.factor.for.and.clause=.95
GOSUB Compute.and.clause.cf
GOSUB Deduce
RETURN
Prove.flies.well:
current.fact=flies.well:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Deduce
RETURN
Prove.swims:
current.fact=swims:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Deduce
RETURN
Prove.black.and.white:
current.fact=black.and.white:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Deduce
RETURN
Prove.cannot.fly:
current.fact=cannot.fly:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Deduce
RETURN
Prove.long.neck:
current.fact=long.neck:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Deduce
RETURN
Prove.black.stripes:
current.fact=black.stripes:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Deduce
RETURN
Prove.long.legs:
current.fact=long.legs:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Deduce
RETURN
Prove.dark.spots:
current.fact=dark.spots:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Deduce
RETURN
Prove.tawny.color:
current.fact=tawny.color:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Deduce
RETURN
Prove.bird:
current.fact=bird:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Prove.feathers:GOSUB Prove.flies.and.lays.eggs
number.of.or.clause.components=2
OR.COMPONENT(1)=feathers
AT.FACTOR.FOR.OR.COMPONENT(1)=1
OR.COMPONENT(2)=flies.and.lays.eggs
AT.FACTOR.FOR.OR.COMPONENT(2)=.8
GOSUB Compute.or.clause.cf
GOSUB Deduce
RETURN
Prove.ungulate:
current.fact=ungulate:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Prove.mammal.and.hoofs
GOSUB Prove.mammal.and.chews.cud
number.of.or.clause.components=2
OR.COMPONENT(1)=mammal.and.hoofs:
AT.FACTOR.FOR.OR.COMPONENT(1)=.85
OR.COMPONENT(2)=mammal.and.chews.cud
AT.FACTOR.FOR.OR.COMPONENT(2)=.8
GOSUB Compute.or.clause.cf
GOSUB Deduce
RETURN
Prove.carnivore:
current.fact=carnivore:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Prove.eats.meat:GOSUB Prove.teeth.claws.eyes
number.of.or.clause.components=2
OR.COMPONENT(1)=eats.meat
AT.FACTOR.FOR.OR.COMPONENT(1)=.85
OR.COMPONENT(2)=teeth.claws.eyes
AT.FACTOR.FOR.OR.COMPONENT(2)=1
GOSUB Compute.or.clause.cf
GOSUB Deduce
RETURN
Prove.mammal:
current.fact=mammal:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Prove.has.hair:GOSUB Prove.gives.milk
number.of.or.clause.components=2
OR.COMPONENT(1)=has.hair:AT.FACTOR.FOR.OR.COMPONENT(1)=.85
OR.COMPONENT(2)=gives.milk:AT.FACTOR.FOR.OR.COMPONENT(2)=.8
GOSUB Compute.or.clause.cf
GOSUB Deduce
RETURN
Prove.has.hair:
current.fact=has.hair:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Deduce
RETURN
Prove.gives.milk:
current.fact=gives.milk:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Deduce
RETURN
Prove.eats.meat:
current.fact=eats.meat:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Deduce
RETURN
Prove.teeth.claws.eyes:
current.fact=teeth.claws.eyes:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Prove.pointed.teeth:GOSUB Prove.claws
GOSUB Prove.front.eyes
number.of.and.clause.components=3
AND.COMPONENT(1)=pointed.teeth:AND.COMPONENT(2)=claws
AND.COMPONENT(3)=front.eyes
at.factor.for.and.clause=.85
GOSUB Compute.and.clause.cf
GOSUB Deduce
RETURN
Prove.mammal.and.hoofs:
current.fact=mammal.and.hoofs:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Prove.mammal:GOSUB Prove.hoofs
number.of.and.clause.components=2
AND.COMPONENT(1)=mammal:AND.COMPONENT(2)=hoofs
at.factor.for.and.clause=.8
GOSUB Compute.and.clause.cf
GOSUB Deduce
RETURN
Prove.mammal.and.chews.cud:
current.fact=mammal.and.chews.cud:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Prove.mammal:GOSUB Prove.chews.cud
number.of.and.clause.components=2
AND.COMPONENT(1)=mammal:AND.COMPONENT(2)=chews.cud
at.factor.for.and.clause=.8
GOSUB Compute.and.clause.cf
GOSUB Deduce
RETURN
Prove.feathers:
current.fact=feathers:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Deduce
RETURN
Prove.flies.and.lays.eggs:
current.fact=flies.and.lays.eggs:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Prove.flies:GOSUB Prove.lays.eggs
number.of.and.clause.components=2
AND.COMPONENT(1)=flies:AND.COMPONENT(2)=lays.eggs
at.factor.for.and.clause=1
GOSUB Compute.and.clause.cf
GOSUB Deduce
RETURN
Prove.lays.eggs:
current.fact=lays.eggs:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Deduce
RETURN
Prove.flies:
current.fact=flies:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Deduce
RETURN
Prove.chews.cud:
current.fact=chews.cud:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Deduce
RETURN
Prove.hoofs:
current.fact=hoofs:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Deduce
RETURN
Prove.front.eyes:
current.fact=front.eyes:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Deduce
RETURN
Prove.claws:
current.fact=claws:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Deduce
RETURN
Prove.pointed.teeth:
current.fact=pointed.teeth:GOSUB Test.fact.for.human.input
IF leave=yes THEN RETURN
GOSUB Deduce
RETURN