home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / steel44.zip / REM.BAS < prev    next >
BASIC Source File  |  1980-01-01  |  34KB  |  766 lines

  1. 3 PRINT FRE(0) / PRINT FREE MEMORY
  2. 4 DEFINT B-D,G-Z / DEFINE AS INTEGERS
  3. 5 DIM ANS(3000) / ANSWERS
  4. 13 DIM SB(1000) / SUBPROBLEM TO
  5. 16 DIM PRI(1000) / PRIORITY
  6. 35 DIM K$(80) / COUNT FOR STRING LENGTH
  7. 40 DIM PFOR(1000) / PROBABILITY FOR
  8. 45 DIM PA(1000) / PROBABILITY AGAINST
  9. 50 DIM EVAL(1000) / EVALUATED
  10. 60 DIM PBM(200) / PROBLEM NUMBER
  11. 65 DIM ACT(25) / ACCEPTABLE PROBLEM NUMBER
  12. 70 CH = 8  / BACKSPACE CHARACTER
  13. 75 PRINT FRE(0) / PRINT FREE MEMORY
  14. 80 GOSUB 52000  / INTRODUCTION
  15. 100 GOSUB 50000 / ASK IF  START A NEW PROBLEM / CONTINUE WITH OLD PROBLEM
  16. 150 IF DT# = 2 THEN GOSUB 36000 / IF OLD PROBLEM THEN READ FILE
  17. 200 GOSUB 53000 / OPEN AND FIELD FILES
  18. 300 IF DT# = 1 THEN GOSUB 10000  /IN NEW ANALYSIS THEN ASK INTRODUCTORY QUESTIONS
  19. 310 GOSUB 12000 / READ SUBPROBLEMS AND PRIORITY INTO MEMORY
  20. 320 GOTO 20000 / START
  21. 500 REM ******* CLS
  22. 510 CLS  /CLEAR SCREEN
  23. 520 RETURN
  24. 8000 REM ***** FILE NAME ACCEPLABLE TEST ************
  25. 8010 TEST = 1 / INITIALIZE TO TEST OK
  26. 8100 FOR Q = 1 TO LEN(A$) / FOR THE LENGTH OF THE STRING
  27. 8110 K$(Q) = MID$(A$,Q,1)  / THE Q'th character in the string
  28. 8120 C = ASC(K$(Q)) / ASCII VALUE
  29. 8130 IF C < 48 OR C > 122 THEN TEST = 4  / IF NOT A LETTER OR NUMBER THEN TEST NOT OK
  30. 8140 IF Q = 1 AND ( C < 65 OR C > 122 ) THEN TEST = 4  / IF FIRST CHARACTER AND TEST NOT A LETTER THEN FAIL TEST
  31. 8150 NEXT Q / NEXT CHARACTER
  32. 8190 RETURN
  33. 10000 REM INITAL ASK ALL QUESTIONS
  34. 10010 GOSUB 500 / CLEAR SCREEN
  35. 10020 NEFLG = 5
  36. 10030 PRINT "                       START A NEW ANALYSIS "
  37. 10035 PRINT ""
  38. 10040 PRINT "        The computer will ask you the introductory questions "
  39. 10045 PRINT ""
  40. 10050 PRINT "  Answer the questions by entering the answer then press return "
  41. 10055 PRINT ""
  42. 10060 PRINT "                 You may enter  N  for no answer"
  43. 10065 PRINT ""
  44. 10070 PRINT "                    PRESS ANY KEY TO CONTINUE "
  45. 10080 IF INKEY$ = "" THEN 10080 / STAY HERE UNTILL ANY KEY IS PRESSED
  46. 10100 FOR R = 1 TO MRN1 / FOR ALL RECORDS IN THE SOLUTION FILE
  47. 10103 ANS(R) = -999 / ANSWER EQUALS NO ANSWER
  48. 10104 RN = R / RECORD NUMBER EQUALS R
  49. 10105 GOSUB 54100 / GET QUESTION
  50. 10110 IF Q2 = 2 THEN GOSUB 10200 / IF AN INTRODUCTORY QUESTION, ALWAYS ASKED THEN ASK
  51. 10120 NEXT R
  52. 10125 NEFLG = 0 /NEW ENTRY FLAG OFF
  53. 10130 RETURN
  54. 10200 REM ASK QUESTION
  55. 10210 GOSUB 500 /CLEAR SCREEN
  56. 10240 PRINT Q$ /PRINT QUESTION
  57. 10250 IF ABS(Q3) > 1 THEN 10400 /IF QUESTION IS CONTINUED
  58. 10260 GOSUB 60120 / INPUT ANSWER TO THE QUESTION
  59. 10265 IF DT# = -999 AND NFLG = 0 THEN 10500 / DO NOT ACCEPT -999 AS AN ANSWER
  60. 10270 ANS(R) = DT# / ANSWER
  61. 10290 RETURN
  62. 10400 REM PRINT CONTINUED QUESTIONS
  63. 10410 RN = ABS(Q3)
  64. 10420 GOSUB 54100 /GET RECORD
  65. 10430 PRINT Q$ /PRINT CONTINUED QUESTION
  66. 10440 GOTO 10250 / BACK TO ANSWER QUESTION
  67. 10500 REM DONT ACCEPT -999
  68. 10510 PRINT "  THE COMPUTER WILL NOT ACCEPT -999 FOR AN ANSWER BECAUSE IT IS THE "
  69. 10520 PRINT " CODE FOR NO ANSWER "
  70. 10530 PRINT " PLEASE GIVE ANOTHER ANSWER FOR THE QUESTION "
  71. 10540 GOTO 10260
  72. 10600 REM DONT ACCEPT -999
  73. 10610 PRINT "  THE COMPUTER WILL NOT ACCEPT -999 FOR AN ANSWER BECAUSE IT IS THE "
  74. 10620 PRINT " CODE FOR NO ANSWER "
  75. 10630 PRINT " PLEASE GIVE ANOTHER ANSWER FOR THE QUESTION "
  76. 10640 GOTO 31130
  77. 11000 REM READ OLD DATA
  78. 12000 REM READ SUBPROBLEMS AND PRIORITY
  79. 12100 FOR T = 1 TO MRN2 / FOR ALL PROBLEMS
  80. 12110 GET #2,T / GET PROBLEM RECORD
  81. 12120 SB(T) = CVI(P2$) / SUBPROBLEM TOO
  82. 12130 PRI(T) = CVI(P3$) / PRIORITY
  83. 12140 NEXT T
  84. 12150 RETURN
  85. 17000 REM CHECK FOR CONTINUED QUESTIONS
  86. 17100 IF ABS(Q3) <= 1 THEN RETURN /IF QUESTION NOT CONTINUED THEN RETURN
  87. 17110 RN = ABS(Q3) / RECORD NUMBER EQUALS ABSOLUTE VALUE OF Q3
  88. 17120 GOSUB 54000 / GET QUESTION
  89. 17122 KTQ = KTQ - 1 / DECREMENT QUESTION COUNT
  90. 17130 PRINT TAB(8) Q$ / PRINT CONTINUED QUESTION
  91. 17135 IF PRTFLG = 2 THEN LPRINT TAB(8)Q$ / IF LINE PRINT FLAG THEN PRINT ON PAPER
  92. 17140 GOTO 17100 / GO BACK TO SEE IF QUESTION IS CONTINUED FURTHER
  93. 17200 RN = T 
  94. 17208 IF ABS(Q3) <= 1 THEN RETURN /IF QUESTION NOT CONTINUED THEN RETURN
  95. 17210 RN = ABS(Q3) / RECORD NUMBER EQUALS ABSOLUTE VALUE OF Q3
  96. 17220 GOSUB 54000 / GET RECORD NUMBER
  97. 17230 LPRINT TAB(8) Q$ / PRINT QUESSTION
  98. 17240 GOTO 17200 / GO BACK TO CHECK IF FURTHER CONTINUED
  99. 18000 REM PRINT SINGLE PROBLEM AND SUPPORTING EVIDENCE
  100. 18010 PRINT "******  MAKE SURE YOUR PRINTER IS ON  ******"
  101. 18100 PRINT "WHICH PROBLEM DO YOU WANT PRINTED ON PAPER ?"
  102. 18105 PRINT "          ENTER  0  TO RETURN "
  103. 18110 GOSUB 60060 /INPUT INTEGER SUBROUTINE
  104. 18115 IF DT# = 0 THEN 20000 / OPTION TO RETURN
  105. 18120 RN = DT# / RECORD NUMBER EQUALS NUMBER ENTERED
  106. 18130 GOSUB 54200 /GET PROBLEM 
  107. 18140 LPRINT RN;P1$;TAB(60) PFOR(RN);TAB(65) PA(RN) /PRINT RECORD NUMBER, PROBLEM DESCRIPTION, PROBABLITY FOR AND AGAINST
  108. 18145 T = RN
  109. 18150 GOSUB 34000 / PRINT SUPPORTING QUESTIONS
  110. 18160 GOTO 20000 /BACK TO START
  111. 19000 REM **** OPTIONS MENU
  112. 19100 PRINT "** OPTIONS ** 0 - NONE  1 - SAVE  2 - PRINT OPTIONS DISPLAYED ON PAPER "
  113. 19110 PRINT "3 - REVIEW ALL PROBLEMS  4 - ALL QUESTIONS & ANSWERS 5 - PRINT PROBLEM  6-EXIT"
  114. 19150 GOSUB 60000
  115. 19160 IF DT# < 0 OR DT# > 6 THEN 19150 /LIMIT CHECK
  116. 19170 IF DT# = 0 THEN 20000 /BACK TO START
  117. 19180 ON DT# GOTO 35000,24000,37000,41000,18000,51000 /ON OPTION GOTO
  118. 20000 REM START SEARCH
  119. 20005 LPRTFLG = 0 /LINE PRINT FLAG = NO
  120. 20007 KTQ = 0 / QUESTION COUNT 0
  121. 20008 PRTFLG = 0 / PRINT FLAG 0
  122. 20010 H = 0 / HOLD 0
  123. 20020 GOSUB 500 /CLEAR SCREEN
  124. 20030 KT = 0 / COUNT 0
  125. 20035 IF SB(ND) > 3000 THEN ND = 0 / IF SUBPROBLEM TO > 3000 THEN LET NODE = 0
  126. 20040 GOSUB 21000 /PRINT SUBPROBLEMS
  127. 20050 PRINT " #    PROBLEM  ";TAB(60) " +    -    P CK CONT"
  128. 20055 IF LPRTFLG = 1 THEN LPRINT " #    PROBLEM  ";TAB(60) " +    -    P CK CONT"
  129. 20100 FOR T = 1 TO MRN2 / FOR ALL PROBLEMS
  130. 20110 IF SB(T) = ND OR SB(T) = -ND THEN GOSUB 20500 / IF SUBPROBLEM TO THEN PRINT
  131. 20120 NEXT T / NEXT PROBLEM
  132. 20140 IF ND = 0 AND H = 0 THEN PRINT "END OF COMPUTER RECOMMENDATIONS, EXIT OR CONDUCT MANUAL SEARCH" /ALL START PATHS ALREADY CHECKEC
  133. 20150 IF ND <> 0 AND H = 0 THEN PRINT "COMPUTER RECOMMENDS BACKTRACK TO SUBPROBLEM";SB(ND) /ALL PATHS ALREADY CHECKED
  134. 20200 PRINT "BRANCH ? * NEGATIVE NBR TO OVERRIDE * 9999 TO OPTIONS *";
  135. 20205 IF H > 0 THEN PRINT " COMPUTER RECOMMENDS";H ELSE PRINT " "  /PRINT UNEXPLORED PATH WITH HIGHEST PRIORITY
  136. 20210 RN = P12 /RECORD NUMBER EQUALS QUESTION RULE 1
  137. 20250 GOSUB 60060 / INPUT SUBROUTINE
  138. 20252 IF DT# > 9998 THEN 19000 / TO OPTIONS SUBROUTINE
  139. 20253 IF ABS(DT#) > MRN2 THEN 20250 / LIMIT CHECK
  140. 20255 IF DT# > 0 THEN 30000 / IF GREATER THEN ZERO THEN ASK QUESTIONS
  141. 20260 ND = -DT# / NODE 
  142. 20265 IF SB(ND) < 0 THEN 20250 /REFUSE CONTINUED OR END NODES
  143. 20270 GOTO 20000 /START
  144. 20500 REM PRINT STARTING NODE ON SCREEN
  145. 20504 PB = T /PROBLEM 
  146. 20505 GOSUB 22000 / COMPUTE PROBABILITY
  147. 20510 RN = T /RECORD NUMBER EQUALS T
  148. 20520 GOSUB 54200 /GET RECORD
  149. 20530 PRINT RN;TAB(6) P1$;TAB(60) PFOR(T);TAB(65) PA(T);TAB(70) P3; /PRINT RECORD NUMBER,PROBLEM,PROBABILTY FOR, AGAINST,
  150. 20532 IF EVAL(T) = 1 THEN PRINT TAB(73) "PC "; /PARTIALLY CHECKED
  151. 20533 IF EVAL(T) = 0 THEN PRINT TAB(73) "NC "; /NOT CHECKED
  152. 20534 IF EVAL(T) = 2 THEN PRINT TAB(73) "C  "; / CHECKED
  153. 20535 IF SB(T) >-1 THEN PRINT "CONT" ELSE PRINT "END" / 
  154. 20537 IF PFOR(T) > 89 AND PA(T) > 89 THEN PRINT " PROBABLE CONTRADICTORY EVIDENCE " /IF BOTH PROBABILTY FOR AND AGAINST ARE HIGH THEN PRINT CONTRADICTORY EVIDENCE
  155. 20540 KT = KT + 1 /INCREMENT COUNT
  156. 20545 IF PRI(T) > PRI(H) AND EVAL(T) = 0 THEN H = T /IF HIGHER PRIORITY THEN 
  157. 20547 IF LPRTFLG = 1 THEN GOSUB 20600 /IF LINE PRINT FLAG
  158. 20550 RETURN
  159. 20600 REM PRINT ON PAPER
  160. 20630 LPRINT RN;TAB(6) P1$;TAB(60) PFOR(T);TAB(65) PA(T);TAB(70) P3; /PRINT REOCD NUMBER PROBLEM PROBABILTY FOR PROBABILTY AGAINST 
  161. 20632 IF EVAL(T) = 1 THEN LPRINT TAB(73) "PC "; /PARTIALY CHECKED
  162. 20633 IF EVAL(T) = 0 THEN LPRINT TAB(73) "NC "; /NOT CHECKED
  163. 20634 IF EVAL(T) = 2 THEN LPRINT TAB(73) "C  "; / CHECKED
  164. 20635 IF SB(T) >-1 THEN LPRINT "CONT" ELSE LPRINT "END"
  165. 20637 IF PFOR(T) > 89 AND PA(T) > 89 THEN LPRINT " PROBABLE CONTRADICTORY EVIDENCE "
  166. 20650 RETURN
  167. 21000 REM PRINT SUBRECORDS UP TO 0
  168. 21005 IF ND = 0 THEN PRINT "AT STARTING NODE 0" /AT STARTING NODE
  169. 21006 IF ND = 0 THEN RETURN / IF AT STARTING NODE THEN RETURN
  170. 21010 PRINT "SUBPROBLEMS OF :"
  171. 21015 IF LPRTFLG = 1 THEN LPRINT "SUBPROBLEMS OF :" 
  172. 21100 T = ND / NODE
  173. 21105 T = ABS(T) / CHANGE NEGITIVES TO POSITIVE
  174. 21110 RN = T /RECORD NUMBER
  175. 21115 IF RN = 0 THEN RETURN /IF AT STARTING NODE THEN RETURN
  176. 21120 GOSUB 54200
  177. 21130 PRINT RN;TAB(6) P1$,TAB(60) PFOR(T);TAB(65) PA(T) /PRINT RECORD NUMBER, PROBLEM, PROBABILTY FOR AND PROBABILITY AGAINST
  178. 21135 IF LPRTFLG = 1 THEN  LPRINT RN;TAB(6) P1$,TAB(60) PFOR(T);TAB(65) PA(T)
  179. 21140 T = SB(T) / SUBPROBLEM OF
  180. 21145 T = ABS(T) / CHANGE NEGITIVE TO POSITIVE
  181. 21150 GOTO 21110 / PRINT NEXT SUBPROBLEM
  182. 22000 REM compute probability
  183. 22010 PA(PB) = 0  /INITIALIZE TO 0
  184. 22020 PFOR(PB) = 0 /INITIALIZE TO 0
  185. 22030 DCHKFLG = 0 / DOUBLECHECK FLAG = 0
  186. 22100 RN = PB / RECORD NUMBER = PROBLEM NUMBER
  187. 22105 RNH = RN /RECORD NUMBER HOLD = RECORD NUMBER
  188. 22110 T4= RN
  189. 22120 S = SB(T4) / SUBPROBLEM TO RECORD
  190. 22125 S = ABS(S) / CHANGE NEGITIVES TO POSITIVE
  191. 22128 IF S > 2000 THEN RETURN / IF SUBPROBLEM > 30000 THEN RETURN 
  192. 22130 IF S = 0 THEN 22300 /END OF SUBPROBLEMS
  193. 22140 IF PA(S) > PA(RN) THEN PA(RN) = PA(S) /FIND MAXIMUM PROBILITY AGAINST OF ALL THE SUBPROBLEMS
  194. 22150 S = SB(S) / SUBPROBLEM OF
  195. 22155 S = ABS(S) / CHANGE NEGITIVES TO POSITIVE
  196. 22160 GOTO 22130 / CONTINUE UNTILL AT NODE 0
  197. 22300 GOSUB 54200 / GET RECORD 
  198. 22310 IF ANS(P8) = -999 THEN 22410 /IF NO ANSWER
  199. 22315 ANS = ANS(P8) /ANSWER
  200. 22320 RT = P7 /RULE TYPE
  201. 22330 QN = P8 /QUESTION
  202. 22340 FV = P9! /FACT VALUE
  203. 22350 PB = P10 /PROBABILITY
  204. 22360 GOSUB 23000 /COMPUTE PROBABILITY
  205. 22410 IF ANS(P12) = -999 THEN 22510 / IF NO ANSWER
  206. 22415 ANS = ANS(P12) / ANSWER
  207. 22420 RT = P11 /RULE TYPE
  208. 22430 QN = P12 /QUESTION NUMBER
  209. 22440 FV = P13! /FACT VALUE
  210. 22450 PB = P14 /PROBABILITY
  211. 22460 GOSUB 23000 / COMPUTER PROBABILITY
  212. 22510 IF ANS(P16) = -999 THEN 22610 / NO ANSWER
  213. 22515 ANS = ANS(P16) /ANSWER
  214. 22520 RT = P15 /RULE TYPE
  215. 22530 QN = P16 /QUESTION NUMBER
  216. 22540 FV = P17! /FACT VALUE
  217. 22550 PB = P18 PROBABILITY
  218. 22560 GOSUB 23000 / COMPUTE PROBABILITY
  219. 22610 IF ANS(P20) = -999 THEN 22710 / IF NO ANSWER
  220. 22615 ANS = ANS(P20) /ANSWER
  221. 22620 RT = P19 / RULE TYPE
  222. 22630 QN = P20 / QUESTION NUMBER
  223. 22640 FV = P21! FACT VALUE
  224. 22650 PB = P22 / PROBABILTY
  225. 22660 GOSUB 23000 / COMPUTE PROBABILITY
  226. 22710 IF ANS(P24) = -999 THEN 22800 /IF NO ANSWER
  227. 22715 ANS = ANS(P24) /ANSWER
  228. 22720 RT = P23 /RULE TYPE
  229. 22730 QN = P24 /QUESTION NUMBER
  230. 22740 FV = P25! /FACT VALUE
  231. 22750 PB = P26 /PROBABILITY
  232. 22760 GOSUB 23000
  233. 22800 REM REDUCE EVALUATION TO PARTIAL CHECK
  234. 22810 IF EVAL(RN) = 0 THEN 22880 /SKIP IF NOT EVALUATED
  235. 22820 IF EVAL(RN) = 1 THEN 22880 /SKIP IF ALREADY A PARTIAL CHECK
  236. 22830 IF ANS(P8) = -999 THEN EVAL(RN) = 1 /IF NOT ANSWERED THEN REDUCE TO A PARTIAL CHECK
  237. 22835 IF P11 = 0 THEN 22880 /IF NO QUESTION
  238. 22840 IF ANS(P12) = -999 THEN EVAL(RN) = 1 /IF NOT ANSWERED THEN REDUCE TO PARTIAL CHECK
  239. 22845 IF P15 = 0 THEN 22880 / IF NO QUESTION THEN CONTINUE
  240. 22850 IF ANS(P16) = -999 THEN EVAL(RN) = 1 / IF NOT ANSWERED THE REDUCE TO PARTIAL CHECK
  241. 22855 IF P19 = 0 THEN 22880 / IF NO QUESTION THEN CONTINUE
  242. 22860 IF ANS(P20) = -999 THEN EVAL(RN) = 1 / IF NOT ANSWERED THEN REDUCE TO PARTIAL CHECK
  243. 22865 IF P23 = 0 THEN 22880 / IF NO QUESTION THEN CONTINUE
  244. 22870 IF ANS(P24) = -999 THEN EVAL(RN) = 1 /IF NOT ANSWERED THEN REDUCE TO PARTIAL CHECK
  245. 22880 IF ABS(P5) > 1 THEN GOTO 22910 / IF CONTINUED 
  246. 22890 IF DCHKFLG = 5 THEN 22950 / IF DOUBLECHECKED THEN 
  247. 22900 RETURN
  248. 22910 REM COMPUTE PROBABILITY FOR CONTINUED PROBLEMS
  249. 22915 RNH = RN /RECORD NUMBER HOLD EQUALS RECORD NUMBER
  250. 22918 DCHKFLG = 5 /DOUBLECHECK FLAG 
  251. 22920 RN = ABS(P5) / RECORD NUMBER EQUALS THE CONTINUED ON
  252. 22930 GOSUB 54200 / GET RECORD
  253. 22935 RN = RNH /RESTORE RECORD NUMBER
  254. 22940 GOTO 22310 / CONTINE TO COMPUTER PROBABILITY
  255. 22950 REM RETURN FOR CONTINUED PROBLEMS  
  256. 22960 RN = RNH /RESTORE RECORD NUMBER
  257. 22970 GOSUB 54200 /RESTORE RECORD
  258. 22980 RETURN
  259. 23000 REM CALCULATE
  260. 23010 TEST = 0  / INITIALIZE TO TESET
  261. 23020 IF RT = 0 THEN RETURN /IF RULE TYPE 0 NO RULE THEN RETURN
  262. 23100 ON RT GOSUB 23500,23600,23700,23800 /ON RULE TYPE 
  263. 23120 IF TEST = 0 THEN RETURN / IF FAILED TEST THEN RETURN
  264. 23130 IF PB < 0 THEN 23300 / IF NEGITIVE PROBABILITY
  265. 23140 PFOR(RN) = INT(PFOR(RN) + (100 - PFOR(RN))*(PB/100)) /COMPUTES NEW PROBABILITY FOR
  266. 23150 RETURN
  267. 23300 PA(RN) = INT(PA(RN) + (100 - PA(RN))*ABS(PB/100)) / COMPUTES NEW PROBABILTY AGAINST
  268. 23310 RETURN
  269. 23500 REM EQUALS TEST
  270. 23510 IF ANS = FV THEN TEST = 1 / IF ANSWER EQUALS FACT VALUE THEN TEST GOOD
  271. 23520 RETURN
  272. 23600 REM LESS THEN TEST
  273. 23610 IF ANS < FV THEN TEST = 1 / IF ANSWER LESS THEN FACT VALUE THEN TEST GOOD
  274. 23620 RETURN
  275. 23700 IF ANS > FV THEN TEST = 1 / IF ANSWER GREATER THEN FACT VALUE THEN TEST GOOD
  276. 23710 RETURN
  277. 23800 REM LESS THEN TEST
  278. 23810 IF ANS <> FV THEN TEST = 1 / IF ANSWER NOT EQUAL TO FACT VALUE THEN TEST GOOD
  279. 23820 RETURN
  280. 24000 REM ***** PRINT NODE
  281. 24100 LPRTFLG = 1 /LINE PRINT FLAG IS ON 
  282. 24110 PRINT " MAKE SURE YOUR PRINTER IS ON "
  283. 24120 PRINT " PRESS ANY KEY TO CONTINUE "
  284. 24130 IF INKEY$ = "" THEN 24130 / STAY HERE UNTILL ANY KEY IS PRESSED
  285. 24200 GOTO 20010 
  286. 30000 REM ASK SEARCH QUESTIONS
  287. 30100 RN = ABS(DT#) / CHANGE NEQITIVES TO POSITIVE
  288. 30101 IF SB(RN) > 3000 THEN 20000 / IF SUBPROBLEM TO > 3000 THEN BACK TO START
  289. 30102 HRN = RN / HOLD RECORD NUMBER EQUALS RECORD NUMBER
  290. 30105 EVAL(RN) = 2 / EVALUATION FLAQ = YES
  291. 30110 GOSUB 54200 /QET PROBLEM 
  292. 30120 RN = P8 / RECORD NUMBER
  293. 30130 GOSUB 54000 /QET QUESTION
  294. 30140 PRINT KTQ;P8;TAB(10) Q$; /PRINT QUESTION
  295. 30145 IF ANS(P8) = -999 THEN PRINT TAB(62)"NA "; ELSE PRINT TAB(61) ANS(P8); /PRINT NO ANSWER OR ANSWER
  296. 30150 R = P7 /RULE
  297. 30160 GOSUB 32000 / PRINT = OR < OR >
  298. 30170 PRINT P9!;"  ";TAB(75)P10 /PRINT FACT VALUE, PROBABILITY
  299. 30180 GOSUB 17000 / CHECK FOR CONTINUED QUESTION
  300. 30200 IF P11 = 0 THEN 31000 / IF NO MORE QUESTIONS THEN
  301. 30210 RN = P12 / RECORD NUMBER
  302. 30220 GOSUB 54000 / GET QUESTION
  303. 30230 PRINT KTQ;P12;TAB(10) Q$; /PRINT QUESTION
  304. 30245 IF ANS(P12) = -999 THEN PRINT TAB(62)"NA "; ELSE PRINT TAB(61) ANS(P12);
  305. 30250 R = P11
  306. 30260 GOSUB 32000 /PRINT = > < 
  307. 30270 PRINT P13!;"  ";TAB(75)P14 /PRINT FACT VALUE PROBABLITY
  308. 30280 GOSUB 17000 / CHECK FOR CONTINUED PROBLEM
  309. 30300 IF P15 = 0 THEN 31000 / IF NO MORE QUESTIONS THEN
  310. 30310 RN = P16 / RECORD NUMBER
  311. 30320 GOSUB 54000 / GET QUESTION 
  312. 30330 PRINT KTQ;P16;TAB(10) Q$; / PRINT QUESTION
  313. 30345 IF ANS(P16) = -999 THEN PRINT TAB(62)"NA "; ELSE PRINT TAB(61) ANS(P16);
  314. 30350 R = P15 /RULE
  315. 30360 GOSUB 32000 /PRINT = < > 
  316. 30370 PRINT P17!;"  ";TAB(75) P18 /PRINT FACT VALUE, PROBABILITY
  317. 30380 GOSUB 17000 / CHECK FOR CONTINUED QUESTIONS
  318. 30400 IF P19 = 0 THEN 31000 / IF NO MORE QUESTIONS THEN
  319. 30410 RN = P20 / RECORD NUMBER
  320. 30420 GOSUB 54000 / GET QUESTION
  321. 30430 PRINT KTQ;P20;TAB(10) Q$; / PRINT QUESTION
  322. 30445 IF ANS(P20) = -999 THEN PRINT TAB(62)"NA "; ELSE PRINT TAB(61) ANS(P20);
  323. 30450 R = P19 / RULE 
  324. 30460 GOSUB 32000 / PRINT = > <
  325. 30470 PRINT P21!;"  ";TAB(75) P22 / PRINT FACT VALUE PROBABILITY
  326. 30480 GOSUB 17000 / CHECK FOR CONTINUED QUESTION
  327. 30500 IF P23 = 0 THEN 31000 / IF NO MORE QUESTIONS THEN
  328. 30510 RN = P24 / RECORD NUMBER
  329. 30520 GOSUB 54000 /GET QUESTION
  330. 30530 PRINT KTQ;P24;TAB(10) Q$; /PRINT QUESTION
  331. 30545 IF ANS(P24) = -999 THEN PRINT TAB(62)"NA "; ELSE PRINT TAB(61) ANS(P24);
  332. 30550 R = P23 /RULE
  333. 30560 GOSUB 32000 / PRINT = > <
  334. 30570 PRINT P25!;"  ";TAB(75) P26
  335. 30580 GOSUB 17000 /CHECK FOR CONTINED QUESTION
  336. 30600 GOTO  32300 / CHECK FOR CONTINUED PROBLEM
  337. 31000 PRINT "WHAT QUESTION ? ";"1 TO ";KTQ;", 0 for NONE,  THEN ENTER THE ANSWER"
  338. 31100 GOSUB 60000 / INPUT SUBROUTINE
  339. 31110 IF DT# < 1 THEN 33000 / IF NO ANSWERS
  340. 31115 IF DT# > KTQ THEN 31000 / IF NUMBER EXCEEDS MAXIMUM QUESTION THEN
  341. 31120 H = ACT(DT#) / THE QUESTION RECORD NUMBER 
  342. 31122 NEFLG = 5 / FLAG ON
  343. 31130 GOSUB 60120 / INPUT SINGLE PRECISION SUBROUTINE
  344. 31132 IF DT# = -999 AND NFLG = 0 THEN 10600 / DONT ACCEPT -999 AS AN ANSWER
  345. 31133 NEFLG = 0 / FLAG OFF
  346. 31140 ANS(H) = DT# / ANSWER EQUALS VALUE ENTERED
  347. 31500 GOTO 31000 / ASK FOR ANOTHER QUESTION
  348. 31600 REM CHECK FOR ACCEPTABLE QUESTION TO ANSWER / not used anymore
  349. 31605 TEST = 0
  350. 31610 FOR T1 = 1 TO KTQ
  351. 31620 IF H = ACT(T1) THEN TEST = 1
  352. 31630 NEXT T1
  353. 31640 IF TEST = 0 THEN 31000
  354. 31650 GOTO 31130
  355. 32000 REM PRINT RULE
  356. 32100 IF R = 1 THEN PRINT "=";
  357. 32110 IF R = 2 THEN PRINT "<";
  358. 32120 IF R = 3 THEN PRINT ">";
  359. 32130 IF R = 4 THEN PRINT "<>";
  360. 32140 RETURN
  361. 32200 IF R = 1 THEN LPRINT "=";
  362. 32210 IF R = 2 THEN LPRINT "<";
  363. 32220 IF R = 3 THEN LPRINT ">";
  364. 32230 IF R = 4 THEN LPRINT "<>";
  365. 32240 RETURN
  366. 32300 REM ***** ADDITIONAL RULES FOR THE PROBLEM
  367. 32310 IF ABS(P5) < 2 THEN 31000 / IF NO MORE RULES THEN ASK QUESTION
  368. 32320 RN = ABS(P5) / RECORD NUMBER EQUALS RECORD NUMBER CONTINED ON
  369. 32330 GOTO 30110 / SHOW QUESTIONS ON SCREEN AGAIN
  370. 32400 REM ***** ADDITIONAL RULES FOR THE PROBLEM
  371. 32410 IF ABS(P5) < 2 THEN 34600 / IF NO MORE RULES
  372. 32420 RN = ABS(P5) / RECORD NUMBER EQUALS RECORD NUMBER CONTINUED ON
  373. 32430 GOTO 34110 
  374. 33000 REM / change nodes
  375. 33100 PB = HRN / PROBLEM EQUALS HOLD RECORD NUMBER
  376. 33110 GOSUB 22000 / COMPUTE PROBABILITY
  377. 33115 IF SB(HRN) < 0 THEN 33130  / IF NO MORE SUBRECORDS
  378. 33120 IF PFOR(HRN) > 40 AND PA(HRN) <40 THEN ND=HRN / IF PROBABILTY FOR IS GREATER THEN 40 AND PROBABILITY AGAINS IS LESS THEN 40 THEN NODE EQUALS HOLD RECORD 
  379. 33130 GOTO 20000
  380. 34000 REM PRINT ON PAPER QUESTIONS  / this section is the same as the 30000
  381. 34100 RN = T                        / SECTION EXCEPT FOR THE PRINTS ARE 
  382. 34102 HRN = RN                      / LPRINT
  383. 34110 GOSUB 54200
  384. 34120 RN = P8
  385. 34130 GOSUB 54000
  386. 34140 LPRINT P8;TAB(8) Q$;
  387. 34145 IF ANS(P8) = -999 THEN LPRINT TAB(60)"NA"; ELSE LPRINT TAB(60) ANS(P8);
  388. 34150 R = P7
  389. 34160 GOSUB 32200
  390. 34170 LPRINT P9!;"  ";P10
  391. 34180 GOSUB 17200
  392. 34200 IF P11 = 0 THEN 34600
  393. 34210 RN = P12
  394. 34220 GOSUB 54000
  395. 34230 LPRINT P12;TAB(8) Q$;
  396. 34245 IF ANS(P12) = -999 THEN LPRINT TAB(60)"NA"; ELSE LPRINT TAB(60) ANS(P12);
  397. 34250 R = P11
  398. 34260 GOSUB 32200
  399. 34270 LPRINT P13!;"  ";P14
  400. 34280 GOSUB 17200
  401. 34300 IF P15 = 0 THEN 34600
  402. 34310 RN = P16
  403. 34320 GOSUB 54000
  404. 34330 LPRINT P16;TAB(8) Q$;
  405. 34345 IF ANS(P16) = -999 THEN LPRINT TAB(60)"NA"; ELSE LPRINT TAB(60) ANS(P16);
  406. 34350 R = P15
  407. 34360 GOSUB 32200
  408. 34370 LPRINT P17!;"  ";P18
  409. 34380 GOSUB 17200
  410. 34400 IF P19 = 0 THEN 34600
  411. 34410 RN = P20
  412. 34420 GOSUB 54000
  413. 34430 LPRINT P20;TAB(8) Q$;
  414. 34445 IF ANS(P20) = -999 THEN LPRINT TAB(60)"NA"; ELSE LPRINT TAB(60) ANS(P20);
  415. 34450 R = P19
  416. 34460 GOSUB 32200
  417. 34470 LPRINT P21!;"  ";P22
  418. 34480 GOSUB 17200
  419. 34500 IF P23 = 0 THEN 34600
  420. 34510 RN = P24
  421. 34520 GOSUB 54000
  422. 34530 LPRINT P24;TAB(8) Q$;
  423. 34545 IF ANS(P24) = -999 THEN LPRINT TAB(60)"NA"; ELSE LPRINT TAB(60) ANS(P24);
  424. 34550 R = P23
  425. 34560 GOSUB 32200
  426. 34570 LPRINT P25!;"  ";P26
  427. 34580 GOSUB 17200
  428. 34590 GOTO 32400
  429. 34600 RETURN
  430. 35000 REM SAVE 
  431. 35010 GOSUB 500 / CLEAR SCREEN
  432. 35100 PRINT "  WHAT FILE NAME DO YOU WANT TO SAVE THIS ANALYSIS UNDER"
  433. 35110 PRINT "          Eight Characters or less no spaces "
  434. 35115 PRINT "Just Press return if you do not want to save at this time"
  435. 35120 MAX = 8 / STRING LENGTH EQUALS 8
  436. 35130 GOSUB 62030 / STRING INPUT SUBROUTINE
  437. 35135 IF A$ = "" THEN 20000 / BACK TO START
  438. 35140 GOSUB 8000 /CHECK FOR ACCEPTABLE FILE NAME
  439. 35150 IF TEST = 4 THEN 35000 / IF BAD FILE NAME
  440. 35160 CLOSE #3 / CLOSE FILE 3
  441. 35170 OPEN "O",#3,A$  / OPEN A SEQUENTIAL ACCESS FILE WITH NAME THAT WAS JUST ENTERED
  442. 35180 WRITE #3, MRN1,MRN2,MRN3 / STORE NUMBER OF QUESTIONS, NUMBER OF PROBLEMS, NUMBER OF SOLUTINS
  443. 35190 FOR T = 1 TO MRN1 / FOR ALL QUESTION
  444. 35200 WRITE #3, ANS(T)  / SAVE ANSWERS
  445. 35210 NEXT T
  446. 35220 FOR T = 1 TO MRN2  / FOR ALL PROBLEMS
  447. 35230 WRITE #3, PFOR(T),PA(T),EVAL(T) / SAVE PROBABILITY FOR, PROBABILTY AGAINST AND EVALUATION
  448. 35240 NEXT T
  449. 35245 CLOSE #3
  450. 35250 GOSUB 53300 / REOPEN SOLUTION FILE
  451. 35260 GOTO 20000 / TO START
  452. 36000 REM READ SAVED FILES
  453. 36100 GOSUB 500 /CLEAR SCREEN
  454. 36110 PRINT "DIRECTORY OF ALL FILES ON THE DEFAULT DISK DRIVE :"
  455. 36115 PRINT ""
  456. 36120 FILES
  457. 36130 PRINT "ENTER THE NAME OF THE FILE THAT YOU PREVIOUSLY STORED AN ANALYSIS ON"
  458. 36135 PRINT ""
  459. 36140 MAX = 8 /LENGTH OF STRING TO INPUT
  460. 36150 GOSUB 62030 /INPUT STRING SUBROUTINE
  461. 36160 GOSUB 8000 / CHECK FOR VALID FILE NAME
  462. 36165 IF TEST = 4 THEN 36000 /IF TEST BAD THEN ASK FOR A NEW FILE NAME
  463. 36170 OPEN "I",#3,A$ / OPEN THE FILE
  464. 36180 INPUT #3, MRN1,MRN2,MRN3 / READ MAXIMUM RECORD NUMBER FOR QUESTION PROBLEM AND SOLUTIONS
  465. 36190 FOR T = 1 TO MRN1 / FOR ALL QUESTIONS 
  466. 36200 INPUT #3, ANS(T) /READ ANSWERS
  467. 36210 NEXT T
  468. 36220 FOR T = 1 TO MRN2 / FOR ALL PROBLEMS
  469. 36230 INPUT #3, PFOR(T),PA(T),EVAL(T) / READ PROBABILITY FOR, PROBABILTY AGAINST AND EVALUATION
  470. 36240 NEXT T
  471. 36245 CLOSE #3
  472. 36260 RETURN
  473. 37000 REM PRINT OUT ALL PROBLEMS
  474. 37010 NBRT = 0 / NUMBER OF PROBLEMS EQUALS
  475. 37100 GOSUB 500 /CLEAR SCREEN
  476. 37110 PRINT "                    PRINT OUT PROBLEMS  "
  477. 37115 PRINT ""
  478. 37120 PRINT "  DO YOU WANT TO CHECK ALL PROBLEMS OR ONLY THOSE SEARCHED ?"
  479. 37125 PRINT "            0 - RETURN"
  480. 37130 PRINT "            1 - ONLY THOSE AREADY SEARCHED "
  481. 37140 PRINT "            2 - ALL - TAKES ALOT LONGER "
  482. 37150 GOSUB 60000 / INPUT INTEGER SUBROUTINE
  483. 37155 IF DT# < 0 OR DT# > 2 THEN 37100 / LIMITS CHECK
  484. 37160 IF DT# = 0 THEN 20000 / TO START
  485. 37170 PEVAL = DT# / PROBLEM EVALUTION EQUALS NUMBER INPUT 
  486. 37200 PRINT " PRINT OUT ALL PROBLEMS WITH A PROBABLILY FOR HIGHER THEN "
  487. 37210 PRINT "            ENTER A NUMBER FROM  -1  TO  100"
  488. 37220 GOSUB 60060
  489. 37222 IF DT# = -1 THEN 37230 
  490. 37225 IF DT# < 0 OR DT# > 100 THEN 37200 / LIMITS CHECK
  491. 37230 FMIN = DT# /FOR MINIMUM
  492. 37240 PRINT "      AND WHOSE PROBABLITY AGAINST IS LOWER THEN "
  493. 37250 PRINT "            ENTER A NUMBER FROM  0  TO  101 "
  494. 37260 GOSUB 60060 /INPUT SUBROUTIME FOR INTEGERS
  495. 37265 IF DT# < 0 OR DT# > 101 THEN 37240 /LIMITS CHECK
  496. 37270 AMAX = DT#  /AGAINST MAXIMUM
  497. 37300 PRINT "         DO YOU WANT THE PROBLEMS "
  498. 37310 PRINT " 1 - SHOWN ON THE SCREEN ONLY "
  499. 37320 PRINT " 2 - PRINTED ON PAPER AND SHOWN ON THE SCREEN"
  500. 37325 PRINT " 3 - PRINTED ON PAPER WITH SUPPORTING RULES "
  501. 37330 GOSUB 60000 / INPUT SUBROUTINE
  502. 37340 IF DT# < 1 OR DT# > 3 THEN 37300 /LIMITS CHECK
  503. 37350 PPRT = DT# /PRINT FLAG
  504. 37400 REM ***** START LOOP 
  505. 37410 FOR T = 1 TO MRN2 / FOR ALL PROBLEMS
  506. 37420 IF PEVAL = 1 AND EVAL(T) = 0 THEN 37600 / IF NOT EVALUATED AND ON TO CHECK EVALUATED PROBLEMS THEN SKIP
  507. 37422 PB = T / PROBLEM
  508. 37424 GOSUB 22000 / COMPUTE PROBABILITY
  509. 37430 IF PFOR(T) > FMIN AND PA(T) < AMAX THEN GOSUB 38000 / IF MEETS THE PROBABILTY LIMITS
  510. 37600 NEXT T
  511. 37610 GOTO 39000 
  512. 38000 REM ****  SUBROUTINE FOR PROBLEMS THAT MEET THE LIMITS
  513. 38005 NBRT = NBRT + 1 / INCREMENT PROBLEM COUNT
  514. 38006 IF NBRT > 250 THEN NBRT = 250 / AT LIMIT OF DIMENSION
  515. 38007 PBM(NBRT) = T / THE NBRT'th problem that meets the limits is
  516. 38010 RN = T / RECORD NUMBER
  517. 38020 GOSUB 54200 / GET PROBLEM
  518. 38025 IF P5 < 0  THEN RETURN / IF IS A CONTINUATION THEN RETURN
  519. 38030 PRINT T;P1$; TAB(55) PFOR(T); TAB(60) PA(T) 
  520. 38040 IF PPRT > 1 THEN LPRINT T;P1$;TAB(55) PFOR(T);TAB(60) PA(T)
  521. 38050 RN = P4 /RECORD NUMBER 
  522. 38060 GOSUB 54427 / GET SOLUTION
  523. 38065 GOSUB 40000 / DETERMINE PROBABILITY OF SUCCESS
  524. 38067 RN = P4 / RECORD NUMBER
  525. 38068 GOSUB 54427 / GET SOLUTIN 
  526. 38070 PRINT P4;TAB(6)"SOLUTION ";S1$;" SUCCESS ";SS
  527. 38080 IF PPRT > 1 THEN LPRINT P4;TAB(6)"SOLUTION ";S1$;" SUCCESS ";SS
  528. 38085 IF PPRT = 3 THEN GOSUB 34000 / PRINT SUPPORTING QUESTIONS ON PAPER
  529. 38200 RETURN
  530. 38218 S2H = S2 / SOLUTIN HOLD
  531. 39000 REM CONT
  532. 39010 IF NBRT = 250 THEN PRINT "  THERE ARE TOO MANY PROBLEMS TO DO A SEARCH "
  533. 39020 IF NBRT = 250 THEN PRINT "  A SEARCH MAY ONLY BE CONDUCTED ON 249 OR LESS PROBLEMS "
  534. 39100 PRINT "DO YOU WANT TO CONDUCT A SEARCH FOR ALL AND MULTIPLE SOLUTIONS ?"
  535. 39110 PRINT "               1  - YES SEARCH "
  536. 39120 PRINT "               2  - NO "
  537. 39130 GOSUB 60000 / INPUT SUBROUTINE 
  538. 39140 IF DT# < 1 OR DT# > 2 THEN 39100 /LIMITS CHECK
  539. 39150 IF DT# = 2 THEN 20000 / BACK TO START
  540. 39200 REM  **** START SEARCH  
  541. 39210 FOR S = 1 TO MRN3 / FOR ALL SOLUTIONS
  542. 39215 NPRT = 1 
  543. 39217 RN = S /RECORD NUMBER
  544. 39220 GOSUB 54427 / GET SOLUTION
  545. 39225 IF S2 < 1 THEN 39290 / SKIP IF A CONTINUED SOLUTION
  546. 39230 FOR N = 1 TO NBRT  / FOR ALL PROBLEMS THAT MEET THE LIMITS
  547. 39235 IF ABS(S2H) > 1 THEN RN = S  / RESTORE RECORD NUMBER
  548. 39237 IF ABS(S2H) > 1 THEN GOSUB 54427 / REGET RECORD
  549. 39240 T = PBM(N)  / PROBLEM
  550. 39250 SS = 0
  551. 39260 GOSUB 40000 / GET SUCCESS RATE
  552. 39270 IF SS > 0 THEN GOSUB 39500 / PRINT SOLUTION
  553. 39280 NEXT N / NEXT PROBLEM
  554. 39290 NEXT S / NEXT SOLUTION
  555. 39300 PRINT "*******  PRESS ANY KEY TO CONTINUE  *******"
  556. 39310 IF INKEY$ = "" THEN 39310 / STAY HERE UNTILL ANY KEY IS PRESSED
  557. 39480 GOTO 20000 / BACK TO START
  558. 39500 REM PRINT PROBLEM
  559. 39502 RN = S / RECORD NUMBER
  560. 39504 GOSUB 54427 / GET SOLUTION
  561. 39510 RN = T / RECORD NUMBER
  562. 39520 GOSUB 54200 / GET PROBLEM
  563. 39530 IF NPRT = 1 THEN PRINT S;"SOLUTION ";S1$;" SOLVES :" / IF NOT ALREADY PRINTED THEN PRINT
  564. 39535 IF NPRT = 1 AND PPRT > 1 THEN LPRINT S;"SOLUTION ";S1$;" SOLVES :" / IF NOT ALREADY PRINTED THEN PRINT
  565. 39540 PRINT T;TAB(6) P1$;" SUCCESS RATE";SS
  566. 39545 IF PPRT > 1 THEN LPRINT T;TAB(6) P1$;" SUCCESS RATE";SS
  567. 39550 NPRT = 0 / ALREADY PRINTED 
  568. 39560 RETURN
  569. 39980 GOTO 20000
  570. 40000 REM * DETERMINE PROBABILIYTY OF SUCCESS
  571. 40100 IF T = S4 THEN SS = S5  / IF THE PROBLEM NUMBER THEN SUCCESS RATE IS
  572. 40110 IF T = S6 THEN SS = S7  /  " "
  573. 40120 IF T = S8 THEN SS = S9  /  " "
  574. 40130 IF T = S10 THEN SS = S11/  " "
  575. 40140 IF T = S12 THEN SS = S13/  " "
  576. 40145 IF ABS(S2) > 1 THEN GOTO 40200 / IF CONTINUED SOLUTIONS
  577. 40150 RETURN
  578. 40200 REM *** SOLUTIONS CONTINUED
  579. 40210 RN = ABS(S2) / CHANGE NEGATIVES TO POSITIVE
  580. 40215 S2H = S2  / SOLUTION HOLD 
  581. 40220 GOSUB 54427 / GET NEW SOLUTION
  582. 40230 GOTO 40000 / CONTINUE TO LOOK FOR SUCCESS RATE
  583. 41000 REM ** PRINT OUT QUESTIONS
  584. 41100 GOSUB 500 / CLEAR SCREEN
  585. 41110 PRINT "  DO YOU WANT "
  586. 41120 PRINT "   1 - ONLY QUESTIONS ANSWERED SHOWN"
  587. 41130 PRINT "   2 - ALL QUESTIONS SHOWN "
  588. 41140 GOSUB 60000 / INPUT INTEGERS
  589. 41150 IF DT# < 0 OR DT# > 2 THEN 41000 / LIMITS CHECK
  590. 41155 IF DT# = 0 THEN 20000 / RETURN TO START
  591. 41160 QT = DT#
  592. 41170 PRINT "  DO YOU WANT "
  593. 41180 PRINT "   1 - SHOWN ON THE SCREEN ONLY "
  594. 41190 PRINT "   2 - SHOWN ON THE SCREEN AND PRINTED ON PAPER"
  595. 41195 PRINT "       MAKE SURE YOUR PRINTER IS ON "
  596. 41200 GOSUB 60000
  597. 41210 IF DT# < 1 OR DT# > 2 THEN 41170 / LIMITS CHECK
  598. 41220 PRTFLG = DT# / PRINTFLAG
  599. 41300 REM *** START LOOP 
  600. 41310 FOR T = 1 TO MRN1 / FOR ALL QUESTIONS
  601. 41315 IF INKEY$ >< "" THEN GOSUB 42000 / TO PAUSE SUBROUTINE
  602. 41320 IF ANS(T) = -999 AND QT = 1 THEN 41700 / SKIP IF NO ANSWER AND OPTION TO SKIP THOSE NOT ANSWERED
  603. 41330 RN = T / RECORD NUMBER
  604. 41340 GOSUB 54000 /GET QUESTION
  605. 41345 IF Q3 < 0 THEN 41700 / IF A CONTINUED QUESTION THEN SKIP
  606. 41350 PRINT T;TAB(5);Q$; / PRINT QUESTION
  607. 41355 IF ANS(T) = -999 THEN PRINT TAB(60) "NA" ELSE PRINT TAB(60) ANS(T)  / PRINT ANSWER
  608. 41360 IF PRTFLG = 2 THEN LPRINT T;TAB(5);Q$; / IF PRINTFLAG 1 THEN PRINT
  609. 41362 IF PRTFLG = 2 THEN GOSUB 41800 
  610. 41364 GOSUB 17000 / CHECK FOR CONTINUED QUESTION
  611. 41365 REM         IF PRTFLG = 2 THEN GOSUB 17200
  612. 41700 NEXT T
  613. 41710 PRINT " PRESS ANY KEY TO CONTINUE "
  614. 41720 IF INKEY$ = "" THEN 41720 / STAY HERE UNTILL A KEY IS PRESSED
  615. 41730 GOTO 20000 / BACK TO START
  616. 41800 IF ANS(T) = -999 THEN LPRINT TAB(60) "NA" ELSE LPRINT TAB(60) ANS(T)
  617. 41810 RETURN
  618. 42000 REM ******  PAUSE SUBROUTINE  
  619. 42100 PRINT "  PRESS ANY KEY TO CONTINUE "
  620. 42110 IF INKEY$ = "" THEN 42110 / STAY HERE UNTILL A KEY IS PRESSED
  621. 42120 RETURN
  622. 50000 REM **********  INTRO
  623. 50010 GOSUB 500  / CLEAR SCREEN
  624. 50100 PRINT "          E X P E R T   S Y S T E M   P R O G R A M    1.0   "
  625. 50105 PRINT ""
  626. 50110 PRINT "         Copyright 1984 by Potomac Pacific Engineering Inc."
  627. 50120 PRINT ""
  628. 50130 PRINT "This program is licensed FREE to all users with some restrictions"
  629. 50165 PRINT "        See the manual for more information on the license."
  630. 50167 PRINT ""
  631. 50950 PRINT "***********************  DO YOU WANT TO  ************************"
  632. 50960 PRINT "                  1 - START A NEW PROBLEM "
  633. 50970 PRINT "                  2 - CONTINUE WITH A PROIR ANALYSIS "
  634. 50975 PRINT "*************** ENTER THE NUMBER THEN PRESS RETURN  *************"
  635. 50980 GOSUB 60000 / INPUT SUBROUTINE
  636. 50985 IF DT# <1 OR DT# > 2 THEN 50000 / LIMITS CHECK
  637. 50990 RETURN
  638. 51000 REM ***** EXIT TO SYSTEM
  639. 51010 GOTO 51200 / GIVE WARNING
  640. 51100 GOSUB 500 / CLEAR SCREEN
  641. 51110 CLOSE  / CLOSE ALL FILES
  642. 51120 PRINT " -BYE, Have a nice day"
  643. 51130 END
  644. 51200 REM WANRING 
  645. 51210 GOSUB 500 / CLEAR SCREEN
  646. 51220 PRINT "  YOU WILL LOSE YOUR ANSWERS UNLESS YOU HAVE PREVIOUSLY SAVED THEM"
  647. 51230 PRINT ""
  648. 51240 PRINT "                    DO YOU WANT TO :"
  649. 51250 PRINT "                  1 - EXIT THE PROGRAM "
  650. 51260 PRINT "                  2 - RETURN TO OPTIONS "
  651. 51270 PRINT "            ENTER THE NUMBER THEN PRESS RETURN "
  652. 51280 GOSUB 60000 / INPUT SUBROUTINE
  653. 51290 IF DT# < 1 OR DT# > 2 THEN 51280 / LIMITS CHECK
  654. 51300 ON DT# GOTO 51100,19000  / ON NUMBER ENTERED GOTO
  655. 52000 REM ***** INTRO 1
  656. 52010 GOSUB 500 / CLEAR SCREEN
  657. 52100 PRINT "        Put the Expert System disk the default disk drive  "
  658. 52110 PRINT ""
  659. 52120 PRINT "          *****  THEN PRESS ANY KEY TO CONTINUE  *****"
  660. 52130 PRINT ""
  661. 52140 PRINT "      The Expert System  ONLY uses the Expert System Disk "
  662. 52150 PRINT "Keep it in the default disk drive at all times during this program."
  663. 52200 IF INKEY$ = "" GOTO 52200  /STAY HERE UNTILL ANY KEY IS PRESSED
  664. 52210 RETURN
  665. 53000 REM OPEN AND FIELD FILES
  666. 53100 OPEN "R",#1,"QUESTION",56  / OPEN QUESTON FILE
  667. 53110 FIELD #1, 50 AS Q$,2 AS Q2$,2 AS Q3$,2 AS Q4$
  668. 53200 OPEN "R",#2,"PROBLEMS",120 / OPEN PROBLEM FILE
  669. 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$
  670. 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$
  671. 53300 OPEN "R",#3,"SOLUTION",74 / OPEN SOLUTION FILE
  672. 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$
  673. 53350 REM GET MAXIMUM NUMBER OF RECORDS
  674. 53360 MRN1 = LOF(1) / 56      / NUMBER OF QUESTION
  675. 53370 MRN2 = LOF(2) / 120     / NUMBER OF PROBLEMS
  676. 53380 MRN3 = LOF(3) / 74      / NUMBER OF SOLUTIONS
  677. 53400 RETURN                         
  678. 54000 REM get and convert files
  679. 54010 KTQ = KTQ + 1  / INCREMENT QUESTION COUNT
  680. 54100 REM question file
  681. 54105 GET #1,RN    / GET QUESTION WITH RECORD
  682. 54110 Q2 = CVI(Q2$) / ALWAYS ASKED
  683. 54120 Q3 = CVI(Q3$) / CONTINUED ON 
  684. 54130 Q4 = CVI(Q4$) / DUMMY
  685. 54140 ACT(KTQ) = RN  / ACCEPTABLE QUESTION EQUALS RECORD NUMBER
  686. 54160 IF KTQ > 20 THEN KTQ = 1
  687. 54170 RETURN
  688. 54200 REM PROBLEM FILE
  689. 54203 GET #2,RN
  690. 54205 P2 = CVI(P2$)  / SUBPROBLEM TO
  691. 54210 P3 = CVI(P3$)  /  PRIORITY
  692. 54220 P4 = CVI(P4$)  /  PRIMARY SOLUTION
  693. 54230 P5 = CVI(P5$)  / CONTINUED ON RECORD NUMBER
  694. 54240 P6 = CVI(P6$)  / DUMMY
  695. 54250 P7 = CVI(P7$)  / RULE TYPE
  696. 54260 P8 = CVI(P8$)  / QUESTION
  697. 54270 P9!= CVS(P9$)  / FACT VALUE
  698. 54280 P10 = CVS(P10$)  / PROBABILITY
  699. 54290 P11 = CVI(P11$)  / RULE TYPE 2
  700. 54300 P12 = CVI(P12$)  / QUESTION 2
  701. 54310 P13!= CVS(P13$)  / FACT VALUE 2
  702. 54320 P14 = CVS(P14$)  / PROBABILIY 2
  703. 54330 P15 = CVI(P15$)  / RULE TYPE 3
  704. 54340 P16 = CVI(P16$)  / QUESTION 3
  705. 54350 P17!= CVS(P17$) / FACT VALUE 3
  706. 54360 P18 = CVS(P18$) / PROBABILITY 3
  707. 54370 P19 = CVI(P19$) / RULE TYPE 4
  708. 54380 P20 = CVI(P20$) / QUESTION 4
  709. 54390 P21!= CVS(P21$) / FACT VALUE 4
  710. 54400 P22 = CVS(P22$) / PROBABILITY 4
  711. 54410 P23 = CVI(P23$) / RULE TYPE
  712. 54420 P24 = CVI(P24$) / QUESTION
  713. 54422 P25!= CVS(P25$) / FACT VALUE
  714. 54424 P26 = CVS(P26$) / PROBABILITY
  715. 54426 RETURN
  716. 54427 GET #3, RN  / GET SOLUTION
  717. 54428 S2 = CVI(S2$) / CONTINUED ON
  718. 54430 S3 = CVI(S3$) / DUMMY
  719. 54440 S4 = CVI(S4$) / PROBLEM 1
  720. 54450 S5 = CVI(S5$) / SUCCESS RATE 1
  721. 54460 S6 = CVI(S6$) / PROBLEM 2
  722. 54470 S7 = CVI(S7$) / SUCCESS RATE 2
  723. 54480 S8 = CVI(S8$) / PROBLEM 3
  724. 54490 S9 = CVI(S9$) / SUCCESS RATE 3
  725. 54500 S10 = CVI(S10$) / PROBLEM 4
  726. 54510 S11 = CVI(S11$) / SUCCESS RATE 4
  727. 54520 S12 = CVI(S12$) / PROBLEM 5
  728. 54530 S13 = CVI(S13$) / SUCCESS RATE 5
  729. 54540 RETURN
  730. 60000 REM *******  INTEGER LESS THEN 100 CHECK  ********
  731. 60010 MAX = 2                                / SEE THE REMARKS FOR THE MAIN PROGAM IF YOU WANT TO SEE HOW THIS INPUT SUBROUTINE WORKS
  732. 60020 ACT$ = "1234567890=<>^"
  733. 60030 IF NE = 0 THEN ACT$ = "1234567890"
  734. 60040 PRINT ">__<";
  735. 60050 GOTO 60240
  736. 60060 REM *******  INTEGER *******                        
  737. 60070 MAX = 8
  738. 60080 ACT$ = "1234567890-+,=<>^"
  739. 60090 IF NE = 0 THEN ACT$ = "1234567890-+,"
  740. 60100 PRINT ">________<";
  741. 60110 GOTO 60240
  742. 60120 REM *******  SINGLE PRECISION  *******                        
  743. 60130 MAX = 10
  744. 60140 ACT$ = "1234567890-+,.%$=<>^"
  745. 60150 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
  746. 60160 PRINT ">__________<";
  747. 60170 GOTO 60240
  748. 60180 REM *******  DOUBLE PRECISION  *******                        
  749. 60190 MAX = 20
  750. 60200 ACT$ = "1234567890-+,.%$=<>^"
  751. 60210 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
  752. 60220 PRINT ">____________________<";
  753. 60230 GOTO 60240
  754. 60240 REM ********** NUMBER CHECK **********
  755. 60245 NFLG = 0
  756. 60250 A$ = ""
  757. 60260 K$(20) = " "
  758. 60270 KTMAX = 0
  759. 60280 FOR T9 = 1 TO MAX
  760. 60290 K$(T9) = " "
  761. K **********
  762. 60245 NFLG = 0
  763. 60250 A$ = ""
  764. 60260 K$(20) = " "
  765. 60270 KTMAX = 0
  766. 60280 FO