Shareware Overload/ShartewareOverload.cdr/database/steel44.zip/EXPERT.BAS

BASIC Source File | 1980-01-01 | 29KB | 995 lines

3 PRINT FRE(0)
4 DEFINT B-D,G-Z
5 DIM ANS(3000)
13 DIM SB(1000)
16 DIM PRI(1000)
35 DIM K$(80)
40 DIM PFOR(1000)
45 DIM PA(1000)
50 DIM EVAL(1000)
60 DIM PBM(200)
65 DIM ACT(25)
70 CH = 29
75 PRINT FRE(0)
80 GOSUB 52000
100 GOSUB 50000
150 IF DT# = 2 THEN GOSUB 36000
200 GOSUB 53000
300 IF DT# = 1 THEN GOSUB 10000
310 GOSUB 12000
320 GOTO 20000
500 REM  CLEAR SCREEN
510 CLS
520 RETURN
8000 REM ***** FILE NAME ACCEPLABLE TEST ************
8010 TEST = 1
8100 FOR Q = 1 TO LEN(A$)
8110 K$(Q) = MID$(A$,Q,1)
8120 C = ASC(K$(Q))
8130 IF C < 48 OR C > 122 THEN TEST = 4
8140 IF Q = 1 AND ( C < 65 OR C > 122 ) THEN TEST = 4
8150 NEXT Q
8190 RETURN
10000 REM INITAL ASK ALL QUESTIONS
10010 GOSUB 500
10020 NEFLG = 5
10030 PRINT "                       START A NEW ANALYSIS "
10035 PRINT ""
10040 PRINT "        The computer will ask you the introductory questions "
10045 PRINT ""
10050 PRINT "  Answer the questions by entering the answer then press return "
10055 PRINT ""
10060 PRINT "                 You may enter  N  for no answer"
10065 PRINT ""
10070 PRINT "                    PRESS ANY KEY TO CONTINUE "
10080 IF INKEY$ = "" THEN 10080
10100 FOR R = 1 TO MRN1
10103 ANS(R) = -999
10104 RN = R
10105 GOSUB 54100
10110 IF Q2 = 2 THEN GOSUB 10200
10120 NEXT R
10125 NEFLG = 0
10130 RETURN
10200 REM ASK QUESTION
10210 GOSUB 500
10240 PRINT Q$
10250 IF ABS(Q3) > 1 THEN 10400
10260 GOSUB 60120
10265 IF DT# = -999 AND NFLG = 0 THEN 10500
10270 ANS(R) = DT#
10290 RETURN
10400 REM PRINT CONTINUED QUESTIONS
10410 RN = ABS(Q3)
10420 GOSUB 54100
10430 PRINT Q$
10440 GOTO 10250
10500 REM DONT ACCEPT -999
10510 PRINT "  THE COMPUTER WILL NOT ACCEPT -999 FOR AN ANSWER BECAUSE IT IS THE "
10520 PRINT " CODE FOR NO ANSWER "
10530 PRINT " PLEASE GIVE ANOTHER ANSWER FOR THE QUESTION "
10540 GOTO 10260
10600 REM DONT ACCEPT -999
10610 PRINT "  THE COMPUTER WILL NOT ACCEPT -999 FOR AN ANSWER BECAUSE IT IS THE "
10620 PRINT " CODE FOR NO ANSWER "
10630 PRINT " PLEASE GIVE ANOTHER ANSWER FOR THE QUESTION "
10640 GOTO 31130
11000 REM READ OLD DATA
12000 REM READ SUBPROBLEMS AND PRIORITY
12100 FOR T = 1 TO MRN2
12110 GET #2,T
12120 SB(T) = CVI(P2$)
12130 PRI(T) = CVI(P3$)
12140 NEXT T
12150 RETURN
17000 REM CHECK FOR CONTINUED QUESTIONS
17100 IF ABS(Q3) <= 1 THEN RETURN
17110 RN = ABS(Q3)
17120 GOSUB 54000
17122 KTQ = KTQ - 1
17130 PRINT TAB(8) Q$
17135 IF PRTFLG = 2 THEN LPRINT TAB(8)Q$
17140 GOTO 17100
17200 RN = T
17208 IF ABS(Q3) <= 1 THEN RETURN
17210 RN = ABS(Q3)
17220 GOSUB 54000
17230 LPRINT TAB(8) Q$
17240 GOTO 17200
18000 REM PRINT SINGLE PROBLEM AND SUPPORTING EVIDENCE
18010 PRINT "******  MAKE SURE YOUR PRINTER IS ON  ******"
18100 PRINT "WHICH PROBLEM DO YOU WANT PRINTED ON PAPER ?"
18105 PRINT "          ENTER  0  TO RETURN "
18110 GOSUB 60060
18115 IF DT# = 0 THEN 20000
18120 RN = DT#
18130 GOSUB 54200
18140 LPRINT RN;P1$;TAB(60) PFOR(RN);TAB(65) PA(RN)
18145 T = RN
18150 GOSUB 34000
18160 GOTO 20000
19000 REM **** OPTIONS MENU
19100 PRINT "** OPTIONS ** 0 - NONE  1 - SAVE  2 - PRINT OPTIONS DISPLAYED ON PAPER "
19110 PRINT "3 - REVIEW ALL PROBLEMS  4 - ALL QUESTIONS & ANSWERS 5 - PRINT PROBLEM  6-EXIT"
19150 GOSUB 60000
19160 IF DT# < 0 OR DT# > 6 THEN 19150
19170 IF DT# = 0 THEN 20000
19180 ON DT# GOTO 35000,24000,37000,41000,18000,51000
20000 REM START SEARCH
20005 LPRTFLG = 0
20007 KTQ = 0
20008 PRTFLG = 0
20010 H = 0
20020 GOSUB 500
20030 KT = 0
20035 IF SB(ND) > 3000 THEN ND = 0
20040 GOSUB 21000
20050 PRINT " #    PROBLEM  ";TAB(60) " +    -    P CK CONT"
20055 IF LPRTFLG = 1 THEN LPRINT " #    PROBLEM  ";TAB(60) " +    -    P CK CONT"
20100 FOR T = 1 TO MRN2
20110 IF SB(T) = ND OR SB(T) = -ND THEN GOSUB 20500
20120 NEXT T
20140 IF ND = 0 AND H = 0 THEN PRINT "END OF COMPUTER RECOMMENDATIONS, EXIT OR CONDUCT MANUAL SEARCH"
20150 IF ND <> 0 AND H = 0 THEN PRINT "COMPUTER RECOMMENDS BACKTRACK TO SUBPROBLEM";SB(ND)
20200 PRINT "BRANCH ? * NEGATIVE NBR TO OVERRIDE * 9999 TO OPTIONS *";
20205 IF H > 0 THEN PRINT " COMPUTER RECOMMENDS";H ELSE PRINT " "
20210 RN = P12
20250 GOSUB 60060
20252 IF DT# > 9998 THEN 19000
20253 IF ABS(DT#) > MRN2 THEN 20250
20255 IF DT# > 0 THEN 30000
20260 ND = -DT#
20265 IF SB(ND) < 0 THEN 20250
20270 GOTO 20000
20500 REM PRINT STARTING NODE ON SCREEN
20504 PB = T
20505 GOSUB 22000
20510 RN = T
20520 GOSUB 54200
20530 PRINT RN;TAB(6) P1$;TAB(60) PFOR(T);TAB(65) PA(T);TAB(70) P3;
20532 IF EVAL(T) = 1 THEN PRINT TAB(73) "PC ";
20533 IF EVAL(T) = 0 THEN PRINT TAB(73) "NC ";
20534 IF EVAL(T) = 2 THEN PRINT TAB(73) "C  ";
20535 IF SB(T) >-1 THEN PRINT "CONT" ELSE PRINT "END"
20537 IF PFOR(T) > 89 AND PA(T) > 89 THEN PRINT " PROBABLE CONTRADICTORY EVIDENCE "
20540 KT = KT + 1
20545 IF PRI(T) > PRI(H) AND EVAL(T) = 0 THEN H = T
20547 IF LPRTFLG = 1 THEN GOSUB 20600
20550 RETURN
20600 REM PRINT ON PAPER
20630 LPRINT RN;TAB(6) P1$;TAB(60) PFOR(T);TAB(65) PA(T);TAB(70) P3;
20632 IF EVAL(T) = 1 THEN LPRINT TAB(73) "PC ";
20633 IF EVAL(T) = 0 THEN LPRINT TAB(73) "NC ";
20634 IF EVAL(T) = 2 THEN LPRINT TAB(73) "C  ";
20635 IF SB(T) >-1 THEN LPRINT "CONT" ELSE LPRINT "END"
20637 IF PFOR(T) > 89 AND PA(T) > 89 THEN LPRINT " PROBABLE CONTRADICTORY EVIDENCE "
20650 RETURN
21000 REM PRINT SUBRECORDS UP TO 0
21005 IF ND = 0 THEN PRINT "AT STARTING NODE 0"
21006 IF ND = 0 THEN RETURN
21010 PRINT "SUBPROBLEMS OF :"
21015 IF LPRTFLG = 1 THEN LPRINT "SUBPROBLEMS OF :"
21100 T = ND
21105 T = ABS(T)
21110 RN = T
21115 IF RN = 0 THEN RETURN
21120 GOSUB 54200
21130 PRINT RN;TAB(6) P1$,TAB(60) PFOR(T);TAB(65) PA(T)
21135 IF LPRTFLG = 1 THEN  LPRINT RN;TAB(6) P1$,TAB(60) PFOR(T);TAB(65) PA(T)
21140 T = SB(T)
21145 T = ABS(T)
21150 GOTO 21110
22000 REM compute probability
22010 PA(PB) = 0
22020 PFOR(PB) = 0
22030 DCHKFLG = 0
22100 RN = PB
22105 RNH = RN
22110 T4= RN
22120 S = SB(T4)
22125 S = ABS(S)
22128 IF S > 2000 THEN RETURN
22130 IF S = 0 THEN 22300
22140 IF PA(S) > PA(RN) THEN PA(RN) = PA(S)
22150 S = SB(S)
22155 S = ABS(S)
22160 GOTO 22130
22300 GOSUB 54200
22310 IF ANS(P8) = -999 THEN 22410
22315 ANS = ANS(P8)
22320 RT = P7
22330 QN = P8
22340 FV = P9!
22350 PB = P10
22360 GOSUB 23000
22410 IF ANS(P12) = -999 THEN 22510
22415 ANS = ANS(P12)
22420 RT = P11
22430 QN = P12
22440 FV = P13!
22450 PB = P14
22460 GOSUB 23000
22510 IF ANS(P16) = -999 THEN 22610
22515 ANS = ANS(P16)
22520 RT = P15
22530 QN = P16
22540 FV = P17!
22550 PB = P18
22560 GOSUB 23000
22610 IF ANS(P20) = -999 THEN 22710
22615 ANS = ANS(P20)
22620 RT = P19
22630 QN = P20
22640 FV = P21!
22650 PB = P22
22660 GOSUB 23000
22710 IF ANS(P24) = -999 THEN 22800
22715 ANS = ANS(P24)
22720 RT = P23
22730 QN = P24
22740 FV = P25!
22750 PB = P26
22760 GOSUB 23000
22800 REM REDUCE EVALUATION TO PARTIAL CHECK
22810 IF EVAL(RN) = 0 THEN 22880
22820 IF EVAL(RN) = 1 THEN 22880
22830 IF ANS(P8) = -999 THEN EVAL(RN) = 1
22835 IF P11 = 0 THEN 22880
22840 IF ANS(P12) = -999 THEN EVAL(RN) = 1
22845 IF P15 = 0 THEN 22880
22850 IF ANS(P16) = -999 THEN EVAL(RN) = 1
22855 IF P19 = 0 THEN 22880
22860 IF ANS(P20) = -999 THEN EVAL(RN) = 1
22865 IF P23 = 0 THEN 22880
22870 IF ANS(P24) = -999 THEN EVAL(RN) = 1
22880 IF ABS(P5) > 1 THEN GOTO 22910
22890 IF DCHKFLG = 5 THEN 22950
22900 RETURN
22910 REM COMPUTE PROBABILITY FOR CONTINUED PROBLEMS
22915 RNH = RN
22918 DCHKFLG = 5
22920 RN = ABS(P5)
22930 GOSUB 54200
22935 RN = RNH
22940 GOTO 22310
22950 REM RETURN FOR CONTINUED PROBLEMS
22960 RN = RNH
22970 GOSUB 54200
22980 RETURN
23000 REM CALCULATE
23010 TEST = 0
23020 IF RT = 0 THEN RETURN
23100 ON RT GOSUB 23500,23600,23700,23800:REM PRINT RT;QN;FV;PB N;TEST;"-"
23120 IF TEST = 0 THEN RETURN
23130 IF PB < 0 THEN 23300
23140 PFOR(RN) = INT(PFOR(RN) + (100 - PFOR(RN))*(PB/100))
23150 RETURN
23300 PA(RN) = INT(PA(RN) + (100 - PA(RN))*ABS(PB/100))
23310 RETURN
23500 REM EQUALS TEST
23510 IF ANS = FV THEN TEST = 1
23520 RETURN
23600 REM LESS THEN TEST
23610 IF ANS < FV THEN TEST = 1
23620 RETURN
23700 IF ANS > FV THEN TEST = 1
23710 RETURN
23800 REM LESS THEN TEST
23810 IF ANS <> FV THEN TEST = 1
23820 RETURN
24000 REM ***** PRINT NODE
24100 LPRTFLG = 1
24110 PRINT " MAKE SURE YOUR PRINTER IS ON "
24120 PRINT " PRESS ANY KEY TO CONTINUE "
24130 IF INKEY$ = "" THEN 24130
24200 GOTO 20010
30000 REM ASK SEARCH QUESTIONS
30100 RN = ABS(DT#)
30101 IF SB(RN) > 3000 THEN 20000
30102 HRN = RN
30105 EVAL(RN) = 2
30110 GOSUB 54200
30120 RN = P8
30130 GOSUB 54000
30140 PRINT KTQ;P8;TAB(10) Q$;
30145 IF ANS(P8) = -999 THEN PRINT TAB(62)"NA "; ELSE PRINT TAB(61) ANS(P8);
30150 R = P7
30160 GOSUB 32000
30170 PRINT P9!;"  ";TAB(75)P10
30180 GOSUB 17000
30200 IF P11 = 0 THEN 31000
30210 RN = P12
30220 GOSUB 54000
30230 PRINT KTQ;P12;TAB(10) Q$;
30245 IF ANS(P12) = -999 THEN PRINT TAB(62)"NA "; ELSE PRINT TAB(61) ANS(P12);
30250 R = P11
30260 GOSUB 32000
30270 PRINT P13!;"  ";TAB(75)P14
30280 GOSUB 17000
30300 IF P15 = 0 THEN 31000
30310 RN = P16
30320 GOSUB 54000
30330 PRINT KTQ;P16;TAB(10) Q$;
30345 IF ANS(P16) = -999 THEN PRINT TAB(62)"NA "; ELSE PRINT TAB(61) ANS(P16);
30350 R = P15
30360 GOSUB 32000
30370 PRINT P17!;"  ";TAB(75) P18
30380 GOSUB 17000
30400 IF P19 = 0 THEN 31000
30410 RN = P20
30420 GOSUB 54000
30430 PRINT KTQ;P20;TAB(10) Q$;
30445 IF ANS(P20) = -999 THEN PRINT TAB(62)"NA "; ELSE PRINT TAB(61) ANS(P20);
30450 R = P19
30460 GOSUB 32000
30470 PRINT P21!;"  ";TAB(75) P22
30480 GOSUB 17000
30500 IF P23 = 0 THEN 31000
30510 RN = P24
30520 GOSUB 54000
30530 PRINT KTQ;P24;TAB(10) Q$;
30545 IF ANS(P24) = -999 THEN PRINT TAB(62)"NA "; ELSE PRINT TAB(61) ANS(P24);
30550 R = P23
30560 GOSUB 32000
30570 PRINT P25!;"  ";TAB(75) P26
30580 GOSUB 17000
30600 GOTO  32300
31000 PRINT "WHAT QUESTION ? ";"1 TO ";KTQ;", 0 for NONE,  THEN ENTER THE ANSWER"
31100 GOSUB 60000
31110 IF DT# < 1 THEN 33000
31115 IF DT# > KTQ THEN 31000
31120 H = ACT(DT#)
31122 NEFLG = 5
31130 GOSUB 60120
31132 IF DT# = -999 AND NFLG = 0 THEN 10600
31133 NEFLG = 0
31140 ANS(H) = DT#
31500 GOTO 31000
31600 REM CHECK FOR ACCEPTABLE QUESTION TO ANSWER
31605 TEST = 0
31610 FOR T1 = 1 TO KTQ
31620 IF H = ACT(T1) THEN TEST = 1
31630 NEXT T1
31640 IF TEST = 0 THEN 31000
31650 GOTO 31130
32000 REM PRINT RULE
32100 IF R = 1 THEN PRINT "=";
32110 IF R = 2 THEN PRINT "<";
32120 IF R = 3 THEN PRINT ">";
32130 IF R = 4 THEN PRINT "<>";
32140 RETURN
32200 IF R = 1 THEN LPRINT "=";
32210 IF R = 2 THEN LPRINT "<";
32220 IF R = 3 THEN LPRINT ">";
32230 IF R = 4 THEN LPRINT "<>";
32240 RETURN
32300 REM ***** ADDITIONAL RULES FOR THE PROBLEM
32310 IF ABS(P5) < 2 THEN 31000
32320 RN = ABS(P5)
32330 GOTO 30110
32400 REM ***** ADDITIONAL RULES FOR THE PROBLEM
32410 IF ABS(P5) < 2 THEN 34600
32420 RN = ABS(P5)
32430 GOTO 34110
33000 REM
33100 PB = HRN
33110 GOSUB 22000
33115 IF SB(HRN) < 0 THEN 33130
33120 IF PFOR(HRN) > 40 AND PA(HRN) <40 THEN ND=HRN
33130 GOTO 20000
34000 REM PRINT ON PAPER QUESTIONS
34100 RN = T
34102 HRN = RN
34110 GOSUB 54200
34120 RN = P8
34130 GOSUB 54000
34140 LPRINT P8;TAB(8) Q$;
34145 IF ANS(P8) = -999 THEN LPRINT TAB(60)"NA"; ELSE LPRINT TAB(60) ANS(P8);
34150 R = P7
34160 GOSUB 32200
34170 LPRINT P9!;"  ";P10
34180 GOSUB 17200
34200 IF P11 = 0 THEN 34600
34210 RN = P12
34220 GOSUB 54000
34230 LPRINT P12;TAB(8) Q$;
34245 IF ANS(P12) = -999 THEN LPRINT TAB(60)"NA"; ELSE LPRINT TAB(60) ANS(P12);
34250 R = P11
34260 GOSUB 32200
34270 LPRINT P13!;"  ";P14
34280 GOSUB 17200
34300 IF P15 = 0 THEN 34600
34310 RN = P16
34320 GOSUB 54000
34330 LPRINT P16;TAB(8) Q$;
34345 IF ANS(P16) = -999 THEN LPRINT TAB(60)"NA"; ELSE LPRINT TAB(60) ANS(P16);
34350 R = P15
34360 GOSUB 32200
34370 LPRINT P17!;"  ";P18
34380 GOSUB 17200
34400 IF P19 = 0 THEN 34600
34410 RN = P20
34420 GOSUB 54000
34430 LPRINT P20;TAB(8) Q$;
34445 IF ANS(P20) = -999 THEN LPRINT TAB(60)"NA"; ELSE LPRINT TAB(60) ANS(P20);
34450 R = P19
34460 GOSUB 32200
34470 LPRINT P21!;"  ";P22
34480 GOSUB 17200
34500 IF P23 = 0 THEN 34600
34510 RN = P24
34520 GOSUB 54000
34530 LPRINT P24;TAB(8) Q$;
34545 IF ANS(P24) = -999 THEN LPRINT TAB(60)"NA"; ELSE LPRINT TAB(60) ANS(P24);
34550 R = P23
34560 GOSUB 32200
34570 LPRINT P25!;"  ";P26
34580 GOSUB 17200
34590 GOTO 32400
34600 RETURN
35000 REM SAVE
35010 GOSUB 500
35100 PRINT "  WHAT FILE NAME DO YOU WANT TO SAVE THIS ANALYSIS UNDER"
35110 PRINT "          Eight Characters or less no spaces "
35115 PRINT "Just Press return if you do not want to save at this time"
35120 MAX = 8
35130 GOSUB 62030
35135 IF A$ = "" THEN 20000
35140 GOSUB 8000
35150 IF TEST = 4 THEN 35000
35160 CLOSE #3
35170 OPEN "O",#3,A$
35180 WRITE #3, MRN1,MRN2,MRN3
35190 FOR T = 1 TO MRN1
35200 WRITE #3, ANS(T)
35210 NEXT T
35220 FOR T = 1 TO MRN2
35230 WRITE #3, PFOR(T),PA(T),EVAL(T)
35240 NEXT T
35245 CLOSE #3
35250 GOSUB 53300
35260 GOTO 20000
36000 REM READ SAVED FILES
36100 GOSUB 500
36110 PRINT "DIRECTORY OF ALL FILES ON THE DEFAULT DISK DRIVE :"
36115 PRINT ""
36120 FILES
36130 PRINT "ENTER THE NAME OF THE FILE THAT YOU PREVIOUSLY STORED AN ANALYSIS ON"
36135 PRINT ""
36140 MAX = 8
36150 GOSUB 62030
36160 GOSUB 8000
36165 IF TEST = 4 THEN 36000
36170 OPEN "I",#3,A$
36180 INPUT #3, MRN1,MRN2,MRN3
36190 FOR T = 1 TO MRN1
36200 INPUT #3, ANS(T)
36210 NEXT T
36220 FOR T = 1 TO MRN2
36230 INPUT #3, PFOR(T),PA(T),EVAL(T)
36240 NEXT T
36245 CLOSE #3
36260 RETURN
37000 REM PRINT OUT ALL PROBLEMS
37010 NBRT = 0
37100 GOSUB 500
37110 PRINT "                    PRINT OUT PROBLEMS  "
37115 PRINT ""
37120 PRINT "  DO YOU WANT TO CHECK ALL PROBLEMS OR ONLY THOSE SEARCHED ?"
37125 PRINT "            0 - RETURN"
37130 PRINT "            1 - ONLY THOSE AREADY SEARCHED "
37140 PRINT "            2 - ALL - TAKES A LOT LONGER "
37150 GOSUB 60000
37155 IF DT# < 0 OR DT# > 2 THEN 37100
37160 IF DT# = 0 THEN 20000
37170 PEVAL = DT#
37200 PRINT " PRINT OUT ALL PROBLEMS WITH A PROBABLILY FOR HIGHER THEN "
37210 PRINT "            ENTER A NUMBER FROM  -1  TO  100"
37220 GOSUB 60060
37222 IF DT# = -1 THEN 37230
37225 IF DT# < 0 OR DT# > 100 THEN 37200
37230 FMIN = DT#
37240 PRINT "      AND WHOSE PROBABLITY AGAINST IS LOWER THEN "
37250 PRINT "            ENTER A NUMBER FROM  0  TO  101 "
37260 GOSUB 60060
37265 IF DT# < 0 OR DT# > 101 THEN 37240
37270 AMAX = DT#
37300 PRINT "         DO YOU WANT THE PROBLEMS "
37310 PRINT " 1 - SHOWN ON THE SCREEN ONLY "
37320 PRINT " 2 - PRINTED ON PAPER AND SHOWN ON THE SCREEN"
37325 PRINT " 3 - PRINTED ON PAPER WITH SUPPORTING RULES "
37330 GOSUB 60000
37340 IF DT# < 1 OR DT# > 3 THEN 37300
37350 PPRT = DT#
37400 REM ***** START LOOP
37410 FOR T = 1 TO MRN2
37420 IF PEVAL = 1 AND EVAL(T) = 0 THEN 37600
37422 PB = T
37424 GOSUB 22000
37430 IF PFOR(T) > FMIN AND PA(T) < AMAX THEN GOSUB 38000
37600 NEXT T
37610 GOTO 39000
38000 REM ****  SUBROUTINE FOR PROBLEMS THAT MEET THE LIMITS
38005 NBRT = NBRT + 1
38006 IF NBRT > 250 THEN NBRT = 250
38007 PBM(NBRT) = T
38010 RN = T
38020 GOSUB 54200
38025 IF P5 < 0  THEN RETURN
38030 PRINT T;P1$; TAB(55) PFOR(T); TAB(60) PA(T)
38040 IF PPRT > 1 THEN LPRINT T;P1$;TAB(55) PFOR(T);TAB(60) PA(T)
38050 RN = P4
38060 GOSUB 54427
38065 GOSUB 40000
38067 RN = P4
38068 GOSUB 54427
38070 PRINT P4;TAB(6)"SOLUTION ";S1$;" SUCCESS ";SS
38080 IF PPRT > 1 THEN LPRINT P4;TAB(6)"SOLUTION ";S1$;" SUCCESS ";SS
38085 IF PPRT = 3 THEN GOSUB 34000
38200 RETURN
38218 S2H = S2
39000 REM CONT
39010 IF NBRT = 250 THEN PRINT "  THERE ARE TOO MANY PROBLEMS TO DO A SEARCH "
39020 IF NBRT = 250 THEN PRINT "  A SEARCH MAY ONLY BE CONDUCTED ON 249 OR LESS PROBLEMS "
39100 PRINT "DO YOU WANT TO CONDUCT A SEARCH FOR ALL AND MULTIPLE SOLUTIONS ?"
39110 PRINT "               1  - YES SEARCH "
39120 PRINT "               2  - NO "
39130 GOSUB 60000
39140 IF DT# < 1 OR DT# > 2 THEN 39100
39150 IF DT# = 2 THEN 20000
39200 REM  **** START SEARCH
39210 FOR S = 1 TO MRN3
39215 NPRT = 1
39217 RN = S
39220 GOSUB 54427
39225 IF S2 < 1 THEN 39290
39230 FOR N = 1 TO NBRT
39235 IF ABS(S2H) > 1 THEN RN = S
39237 IF ABS(S2H) > 1 THEN GOSUB 54427
39240 T = PBM(N)
39250 SS = 0
39260 GOSUB 40000
39270 IF ABS(SS) > 0 THEN GOSUB 39500
39280 NEXT N
39290 NEXT S
39300 PRINT "*******  PRESS ANY KEY TO CONTINUE  *******"
39310 IF INKEY$ = "" THEN 39310
39480 GOTO 20000
39500 REM PRINT PROBLEM
39502 RN = S
39504 GOSUB 54427
39510 RN = T
39520 GOSUB 54200
39530 IF NPRT = 1 THEN PRINT S;"SOLUTION ";S1$;" SOLVES :"
39535 IF NPRT = 1 AND PPRT > 1 THEN LPRINT S;"SOLUTION ";S1$;" SOLVES :"
39540 PRINT T;TAB(6) P1$;" SUCCESS RATE";SS
39545 IF PPRT > 1 THEN LPRINT T;TAB(6) P1$;" SUCCESS RATE";SS
39550 NPRT = 0
39560 RETURN
39980 GOTO 20000
40000 REM * DETERMINE PROBABILIYTY OF SUCCESS
40100 IF T = S4 THEN SS = S5
40110 IF T = S6 THEN SS = S7
40120 IF T = S8 THEN SS = S9
40130 IF T = S10 THEN SS = S11
40140 IF T = S12 THEN SS = S13
40145 IF ABS(S2) > 1 THEN GOTO 40200
40150 RETURN
40200 REM *** SOLUTIONS CONTINUED
40210 RN = ABS(S2)
40215 S2H = S2
40220 GOSUB 54427
40230 GOTO 40000
41000 REM ** PRINT OUT QUESTIONS
41100 GOSUB 500
41110 PRINT "  DO YOU WANT "
41120 PRINT "   1 - ONLY QUESTIONS ANSWERED SHOWN"
41130 PRINT "   2 - ALL QUESTIONS SHOWN "
41140 GOSUB 60000
41150 IF DT# < 0 OR DT# > 2 THEN 41000
41155 IF DT# = 0 THEN 20000
41160 QT = DT#
41170 PRINT "  DO YOU WANT "
41180 PRINT "   1 - SHOWN ON THE SCREEN ONLY "
41190 PRINT "   2 - SHOWN ON THE SCREEN AND PRINTED ON PAPER"
41195 PRINT "       MAKE SURE YOUR PRINTER IS ON "
41200 GOSUB 60000
41210 IF DT# < 1 OR DT# > 2 THEN 41170
41220 PRTFLG = DT#
41300 REM *** START LOOP
41310 FOR T = 1 TO MRN1
41315 IF INKEY$ >< "" THEN GOSUB 42000
41320 IF ANS(T) = -999 AND QT = 1 THEN 41700
41330 RN = T
41340 GOSUB 54000
41345 IF Q3 < 0 THEN 41700
41350 PRINT T;TAB(5);Q$;
41355 IF ANS(T) = -999 THEN PRINT TAB(60) "NA" ELSE PRINT TAB(60) ANS(T)
41360 IF PRTFLG = 2 THEN LPRINT T;TAB(5);Q$;
41362 IF PRTFLG = 2 THEN GOSUB 41800
41364 GOSUB 17000
41365 REM         IF PRTFLG = 2 THEN GOSUB 17200
41700 NEXT T
41710 PRINT " PRESS ANY KEY TO CONTINUE "
41720 IF INKEY$ = "" THEN 41720
41730 GOTO 20000
41800 IF ANS(T) = -999 THEN LPRINT TAB(60) "NA" ELSE LPRINT TAB(60) ANS(T)
41810 RETURN
42000 REM ******  PAUSE SUBROUTINE
42100 PRINT "  PRESS ANY KEY TO CONTINUE "
42110 IF INKEY$ = "" THEN 42110
42120 RETURN
50000 REM **********  INTRO
50010 GOSUB 500
50100 PRINT "          E X P E R T   S Y S T E M   P R O G R A M    1.0   "
50105 PRINT ""
50110 PRINT "         Copyright 1984 by Potomac Pacific Engineering Inc."
50120 PRINT ""
50130 PRINT "This program is licensed FREE to all users with some restrictions"
50165 PRINT "        See the manual for more information on the license."
50167 PRINT ""
50950 PRINT "***********************  DO YOU WANT TO  ************************"
50960 PRINT "                  1 - START A NEW PROBLEM "
50970 PRINT "                  2 - CONTINUE WITH A PROIR ANALYSIS "
50975 PRINT "*************** ENTER THE NUMBER THEN PRESS RETURN  *************"
50980 GOSUB 60000
50985 IF DT# <1 OR DT# > 2 THEN 50000
50990 RETURN
51000 REM ***** EXIT TO SYSTEM
51010 GOTO 51200
51100 GOSUB 500
51110 CLOSE
51120 PRINT " -BYE, Have a nice day"
51130 END
51200 REM WANRING
51210 GOSUB 500
51220 PRINT "  YOU WILL LOSE YOUR ANSWERS UNLESS YOU HAVE PREVIOUSLY SAVED THEM"
51230 PRINT ""
51240 PRINT "                    DO YOU WANT TO :"
51250 PRINT "                  1 - EXIT THE PROGRAM "
51260 PRINT "                  2 - RETURN TO OPTIONS "
51270 PRINT "            ENTER THE NUMBER THEN PRESS RETURN "
51280 GOSUB 60000
51290 IF DT# < 1 OR DT# > 2 THEN 51280
51300 ON DT# GOTO 51100,19000
52000 REM ***** INTRO 1
52010 GOSUB 500
52100 PRINT "        Put the Expert System disk the default disk drive  "
52110 PRINT ""
52120 PRINT "          *****  THEN PRESS ANY KEY TO CONTINUE  *****"
52130 PRINT ""
52140 PRINT "      The Expert System  ONLY uses the Expert System Disk "
52150 PRINT "Keep it in the default disk drive at all times during this program."
52200 IF INKEY$ = "" GOTO 52200
52210 RETURN
53000 REM OPEN AND FIELD FILES
53100 OPEN "R",#1,"QUESTION",56
53110 FIELD #1, 50 AS Q$,2 AS Q2$,2 AS Q3$,2 AS Q4$
53200 OPEN "R",#2,"PROBLEMS",120
53210 FIELD #2, 50 AS P1$,2 AS P2$,2 AS P3$,2 AS P4$,2 AS P5$,2 AS P6$, 2 AS P7$, 2 AS P8$,4 AS P9$,4 AS P10$,2 AS P11$,2 AS P12$,4 AS P13$,4 AS P14$,2 AS P15$,2 AS P16$
53220 FIELD #2,88 AS DY$,4 AS P17$,4 AS P18$,2 AS P19$,2 AS P20$,4 AS P21$,4 AS P22$,2 AS P23$,2 AS P24$,4 AS P25$,4 AS P26$
53300 OPEN "R",#3,"SOLUTION",74
53310 FIELD #3, 50 AS S1$, 2 AS S2$,2 AS S3$,2 AS S4$,2 AS S5$,2 AS S6$,2 AS S7$,2 AS S8$,2 AS S9$,2 AS S10$,2 AS S11$,2 AS S12$,2 AS S13$
53350 REM GET MAXIMUM NUMBER OF RECORDS
53360 MRN1 = LOF(1) / 56
53370 MRN2 = LOF(2) / 120
53380 MRN3 = LOF(3) / 74
53400 RETURN
54000 REM get and convert files
54010 KTQ = KTQ + 1
54100 REM question file
54105 GET #1,RN
54110 Q2 = CVI(Q2$)
54120 Q3 = CVI(Q3$)
54130 Q4 = CVI(Q4$)
54140 ACT(KTQ) = RN
54160 IF KTQ > 24 THEN KTQ = 1
54170 RETURN
54200 REM PROBLEM FILE
54203 GET #2,RN
54205 P2 = CVI(P2$)
54210 P3 = CVI(P3$)
54220 P4 = CVI(P4$)
54230 P5 = CVI(P5$)
54240 P6 = CVI(P6$)
54250 P7 = CVI(P7$)
54260 P8 = CVI(P8$)
54270 P9!= CVS(P9$)
54280 P10 = CVS(P10$)
54290 P11 = CVI(P11$)
54300 P12 = CVI(P12$)
54310 P13!= CVS(P13$)
54320 P14 = CVS(P14$)
54330 P15 = CVI(P15$)
54340 P16 = CVI(P16$)
54350 P17!= CVS(P17$)
54360 P18 = CVS(P18$)
54370 P19 = CVI(P19$)
54380 P20 = CVI(P20$)
54390 P21!= CVS(P21$)
54400 P22 = CVS(P22$)
54410 P23 = CVI(P23$)
54420 P24 = CVI(P24$)
54422 P25!= CVS(P25$)
54424 P26 = CVS(P26$)
54426 RETURN
54427 GET #3, RN
54428 S2 = CVI(S2$)
54430 S3 = CVI(S3$)
54440 S4 = CVI(S4$)
54450 S5 = CVI(S5$)
54460 S6 = CVI(S6$)
54470 S7 = CVI(S7$)
54480 S8 = CVI(S8$)
54490 S9 = CVI(S9$)
54500 S10 = CVI(S10$)
54510 S11 = CVI(S11$)
54520 S12 = CVI(S12$)
54530 S13 = CVI(S13$)
54540 RETURN
60000 REM *******  INTEGER LESS THEN 100 CHECK  ********
60010 MAX = 2
60020 ACT$ = "1234567890=<>^"
60030 IF NE = 0 THEN ACT$ = "1234567890"
60040 PRINT ">__<";
60050 GOTO 60240
60060 REM *******  INTEGER *******
60070 MAX = 8
60080 ACT$ = "1234567890-+,=<>^"
60090 IF NE = 0 THEN ACT$ = "1234567890-+,"
60100 PRINT ">________<";
60110 GOTO 60240
60120 REM *******  SINGLE PRECISION  *******
60130 MAX = 10
60140 ACT$ = "1234567890-+,.%$=<>^"
60150 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
60160 PRINT ">__________<";
60170 GOTO 60240
60180 REM *******  DOUBLE PRECISION  *******
60190 MAX = 20
60200 ACT$ = "1234567890-+,.%$=<>^"
60210 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
60220 PRINT ">____________________<";
60230 GOTO 60240
60240 REM ********** NUMBER CHECK **********
60245 NFLG = 0
60250 A$ = ""
60260 K$(20) = " "
60270 KTMAX = 0
60280 FOR T9 = 1 TO MAX
60290 K$(T9) = " "
60300 NEXT T9
60310 DIG$ = "1234567890."
60320 DOTFLG = 0
60330 T2 = MAX + 1
60340 FOR T6 = 1 TO T2
60350 PRINT CHR$(CH);
60360 NEXT T6
60370 IF INKEY$ = "" GOTO 60380 ELSE GOTO 60370
60380 KT = 0
60390 REM ***********  CHECK ALFANUMERIC INPUT FOR LENGTH  ***********
60400 KT = KT + 1
60410 REM
60420 W$ = INKEY$
60425 IF W$ = "N" OR W$ = "n" THEN GOTO 63100
60430 IF W$ = "" GOTO 60420
60440 C = ASC(W$)
60450 IF C = 0 THEN GOSUB 61900
60460 IF C = 13 GOTO 60580
60470 IF C = 17 OR C = 8 GOTO 61150
60480 IF C = 19 GOTO 60670
60490 IF C = 4 GOTO 60720
60500 IF C = 6 GOTO 60780
60510 IF C = 1 GOTO 60960
60520 IF KT > MAX GOTO 60410
60530 IF INSTR(ACT$,W$) = 0 GOTO 61230
60540 K$(KT) = W$
60550 PRINT K$(KT);
60560 IF KT > KTMAX THEN KTMAX = KT
60570 GOTO 60400
60580 REM **********  RETURN  **********
60590 FOR T9 = 1 TO KTMAX
60600 A$ = A$ + K$(T9)
60610 NEXT T9
60620 IF KTMAX = 0 THEN PRINT "1"
60630 IF KTMAX = 0 THEN DT# = 1
60640 IF KTMAX = 0 THEN RETURN
60650 IF SPRT >< 5 THEN PRINT ""
60655 SPRT = 0
60660 GOTO 61260
60670 REM ********* MOVE CURSE BACK ********
60680 IF KT = 1 GOTO 60410
60690 KT = KT - 1
60700 PRINT CHR$(CH);
60710 GOTO 60410
60720 REM ********* MOVE CURSER FORWARD *********
60730 IF KT >= MAX GOTO 60410
60740 IF KT > (KTMAX + 1) GOTO 60410
60750 PRINT K$(KT);
60760 KT = KT + 1
60770 GOTO 60410
60780 REM ********** INSERT ***********
60790 IF KT > KTMAX GOTO 60410
60800 X9 = MAX
60810 WHILE X9 > KT
60820 X9 = X9 - 1
60830 K$(X9 + 1) = K$(X9)
60840 WEND
60850 K$(KT) = " "
60860 KTMAX = KTMAX + 1
60870 IF KTMAX > MAX THEN KTMAX = MAX
60880 FOR T9 = KT TO KTMAX
60890 PRINT K$(T9);
60900 NEXT T9
60910 T6 = (KTMAX - KT) + 1
60920 FOR T7 = 1 TO T6
60930 PRINT CHR$(CH);
60940 NEXT T7
60950 GOTO 60410
60960 REM ********** DELETE ***********
60970 IF KT > KTMAX GOTO 60410
60980 IF KTMAX = 1 GOTO 60410
60990 K$(MAX + 1) = ""
61000 X9 = KT
61010 WHILE X9 <= MAX
61020 K$(X9) = K$(X9 + 1)
61030 X9 = X9 + 1
61040 WEND
61050 KTMAX = KTMAX - 1
61060 FOR T9 = KT TO KTMAX
61070 PRINT K$(T9);
61080 NEXT T9
61090 PRINT "_";
61100 T7 = (KTMAX - KT) + 2
61110 FOR T8 = 1 TO T7
61120 PRINT CHR$(CH);
61130 NEXT T8
61140 GOTO 60410
61150 REM ********* BACKSPACE ********
61160 IF KT = 1 GOTO 60410
61170 KT = KT - 1
61180 PRINT CHR$(CH);
61190 K$(KT) = " "
61200 PRINT "_";
61210 PRINT CHR$(CH);
61220 GOTO 60410
61230 REM *******  INPUT NOT ACCEPTABLE  ********
61240 PRINT CHR$(7);
61250 GOTO 60420
61260 REM ********* CLEAR STRINGS ********
61270 MAX = LEN(A$)
61280 D2$ = ""
61290 D1$ = ""
61300 DFLG = 0
61310 FOR Q93 = 1 TO MAX
61320 R$ = MID$(A$,Q93,1)
61330 IF INSTR(DIG$,R$) = 0 GOTO 61400
61340 IF R$ = "." OR DFLG = 1 GOTO 61380
61350 IF DFLG = 1 GOTO 61380
61360 D2$ = D2$ + R$
61370 GOTO 61400
61380 D1$ = D1$ + R$
61390 DFLG = 1
61400 NEXT Q93
61410 DA# = VAL(D2$)
61420 D1# = VAL(D1$)
61430 DT# = DA# + D1#
61440 IF K$(1) = "-" THEN DT# =  -DT#
61450 RETURN
61900 REM ****** CHECK FOR ASC0
61910 SS4$ = INKEY$
61915 IF SS4$ = "" THEN RETURN
61920 C2 =  ASC(SS4$)
61930 IF C2 = 83 THEN C = 1
61940 IF C2 = 82 THEN C = 6
61950 IF C2 = 75 THEN C = 19
61960 IF C2 = 77 THEN C = 4
61970 RETURN
62000 REM **********  ALPHANUMERIC CHECK  **************
62010 REM   MAX = FL(A,Q)
62020 GOTO 62040
62030 REM ********  MAX SET IN PROGRAM  ********
62040 A$ = ""
62050 PRINT ">";
62060 FOR N9 = 1 TO MAX
62070 K$(N9) = ""
62080 PRINT "_";
62090 NEXT N9
62100 PRINT "<";
62110 T2 = MAX + 1
62120 FOR T4 = 1 TO T2
62130 PRINT CHR$(CH);
62140 NEXT T4
62150 KT = 0
62160 KTMAX = 1
62170 REM ***********  CHECK ALFANUMERIC INPUT FOR LENGTH  ***********
62180 KT = KT + 1
62190 PRINT TAB(KT+1)"";
62200 K$ = INKEY$
62210 IF K$ = "" GOTO 62200
62220 C = ASC(K$)
62230 IF C = 0 THEN GOSUB 61900
62240 IF C = 13 GOTO 62350
62250 IF C = 17 OR C = 8 GOTO 62920
62260 IF C = 19 GOTO 62450
62270 IF C = 4  GOTO 62500
62280 IF C = 6 GOTO 62560
62290 IF C = 1 GOTO 62730
62300 IF KT > MAX GOTO 62190
62310 K$(KT) = K$
62320 PRINT K$(KT);
62330 IF KT > KTMAX THEN KTMAX = KT
62340 GOTO 62180
62350 REM **********  RETURN  **********
62360 FOR T9 = 1 TO MAX
62370 A$ = A$ + K$(T9)
62420 NEXT T9
62430 PRINT ""
62440 RETURN
62450 REM ********* MOVE CURSE BACK ********
62460 IF KT = 1 GOTO 62190
62470 KT = KT - 1
62480 PRINT CHR$(CH);
62490 GOTO 62190
62500 REM ********* MOVE CURSER FORWARD *********
62510 IF KT >= MAX GOTO 62190
62520 IF KT >  KTMAX  GOTO 62190
62530 PRINT K$(KT);
62540 KT = KT + 1
62550 GOTO 62190
62560 REM ********** INSERT ***********
62570 X9 = MAX
62580 WHILE X9 > KT
62590 X9 = X9 - 1
62600 K$(X9 + 1) = K$(X9)
62610 WEND
62620 K$(KT) = " "
62630 KTMAX = KTMAX + 1
62640 IF KTMAX > MAX THEN KTMAX = MAX
62650 FOR T9 = KT TO KTMAX
62660 PRINT K$(T9);
62670 NEXT T9
62680 T6 = (KTMAX - KT) +1
62690 FOR T7 = 1 TO T6
62700 PRINT CHR$(CH);
62710 NEXT T7
62720 GOTO 62190
62730 REM ********** DELETE ***********
62740 IF KT > KTMAX GOTO 62200
62750 IF KTMAX = 1 GOTO 62190
62760 K$(MAX + 1) = ""
62770 X9 = KT
62780 WHILE X9 <= KTMAX
62790 K$(X9) = K$(X9 + 1)
62800 X9 = X9 + 1
62810 WEND
62820 KTMAX = KTMAX - 1
62830 FOR T9 = KT TO KTMAX
62840 PRINT K$(T9);
62850 NEXT T9
62860 PRINT "_";
62870 T7 = (KTMAX - KT) + 2
62880 FOR T6 = 1 TO T7
62890 PRINT CHR$(CH);
62900 NEXT T6
62910 GOTO 62190
62920 REM ********* BACKSPACE ********
62930 IF KT = 1 GOTO 62190
62940 K$(KT) = " "
62950 KT = KT - 1
62960 K$(KT) = " "
62970 PRINT CHR$(CH);
62980 PRINT "_";
62990 PRINT CHR$(CH);
63000 GOTO 62190
63100 REM N for no answer
63110 IF NEFLG >< 5 THEN 60430
63120 DT# = -999
63130 PRINT "NA"
63135 NFLG = 5
63140 RETURN

63100 REM N for no answer
63110 IF NEFLG >< 5 THEN 60430
63120 DT# = -999
63130 PRINT