home *** CD-ROM | disk | FTP | other *** search
/ 8bitfiles.net/archives / archives.tar / archives / commodore-scene-files / Coverdisks / CDU / V4D04.D64 / advisor (.txt) < prev    next >
Encoding:
Commodore BASIC  |  2019-04-13  |  8.2 KB  |  346 lines
  1. 10 REM ****************************
  2. 12 REM * A NEW EXPERT SYSTEM PROG *
  3. 14 REM ****************************
  4. 16 CD$=""
  5. 18 CD$(1)=LEFT$(CD$,5)
  6. 20 CD$(2)=LEFT$(CD$,11)
  7. 22 CD$(3)=LEFT$(CD$,19)
  8. 24 IT$=" THE ADVISOR [146]"
  9. 26 PRINT"[147]";TAB(12);IT$
  10. 29 PRINT"";TAB(7);" BOB GARNER APRIL 1990 ":GOSUB482
  11. 30 PRINT"[147]";CD$(2);TAB(7);" SETTING THE DIMENSIONS [146]"
  12. 32 DIM T(10,10,10),A$(15),V$(15,15),C$(20),VT(10)
  13. 34 S1=1065:S2=S1+37:S3=1982:S4=S3-37
  14. 36 DE$(6)="UNKNOWN FACTOR"
  15. 38 GOSUB518
  16. 40 GOSUB 390
  17. 42 POKE 53281,6:GOSUB466
  18. 44 REM ************
  19. 46 REM * THE MENU *
  20. 48 REM ************
  21. 50 PRINT"";TAB(11);IT$
  22. 52 PRINT""TAB(13)"**THE MENU**"
  23. 54 PRINTTAB(10);"1. INPUT DATA"
  24. 56 PRINTTAB(10);"2. VIEW THE DATA"
  25. 58 PRINTTAB(10);"3. SAVE DATA"
  26. 60 PRINTTAB(10);"4. RETRIEVE THE DATA"
  27. 62 PRINTTAB(10);"5. CHANGE THE DATA"
  28. 64 PRINTTAB(10);"6. ANALYSE DATA"
  29. 66 PRINTTAB(10);"7. SCRATCH DATA"
  30. 68 PRINTTAB(10);"8. DISK DIRECTORY"
  31. 70 PRINTTAB(10);"9. RANK DATA"
  32. 72 PRINTTAB(10);"0. QUIT"
  33. 74 PRINTTAB(10)" TYPE THE NUMBER [146]"
  34. 76 GET M$:IF M$="" THEN 76
  35. 78 M=ASC(M$):IF M<48 OR M>57 THEN GOSUB 516:M=0:GOTO76
  36. 80 ON M-47 GOSUB88,92,202,272,320,354,536,402,484,232
  37. 82 GOTO86
  38. 84 GOTO50
  39. 86 GOTO42
  40. 88 SYS 64760
  41. 90 REM *********************
  42. 92 REM * NAMING THE SYSTEM *
  43. 94 REM *********************
  44. 96 PRINT"[147]";TAB(11);IT$
  45. 98 PRINTTAB(10);" NAMING THE SYSTEM [146]"
  46. 100 ZZ=1:PRINT"WHAT WILL YOU CALL THE SYSTEM"
  47. 102 PRINT"BEING CREATED":PRINT"";:INPUT NA$
  48. 104 REM ********************
  49. 106 REM *  THE ATTRIBUTES  *
  50. 108 REM ********************
  51. 110 PRINT"[147]";TAB(11);IT$
  52. 112 PRINTTAB(9);" CREATING ATTRIBUTES [146]"
  53. 114 FOR T=1TO6
  54. 116 PRINT"ATTRIBUTE ";T;
  55. 118 PRINT"";:INPUT A$(T)
  56. 120 NEXT
  57. 122 PRINT"[147]"
  58. 124 REM **************
  59. 126 REM * THE VALUES *
  60. 128 REM **************
  61. 130 PRINT"[147]";TAB(11);IT$
  62. 132 PRINTTAB(11);" CREATING VALUES [146]"
  63. 134 FOR T=1TO6
  64. 136 PRINT"ATTRIBUTE - ";A$(T)
  65. 138 FOR S=1TO3
  66. 140 PRINT "VALUE ";S;
  67. 142 PRINT"";:INPUT V$(T,S)
  68. 144 NEXT:PRINT"":NEXT:PRINT:PRINT:GOSUB390
  69. 146 REM *****************
  70. 148 REM * THE DECISIONS *
  71. 150 REM *****************
  72. 152 X=1
  73. 154 PRINT"[147]";TAB(11);IT$
  74. 156 PRINTTAB(11);" THE DECISIONS [146]"
  75. 158 PRINT"WHAT IF YOU HAVE ALL THESE"
  76. 160 FORT=1TO6
  77. 162 PRINT
  78. 164 FORS=XTO3STEP3
  79. 166 PRINTTAB(5);S;"[157]. ";V$(T,S)
  80. 168 NEXT:NEXT
  81. 170 PRINT"";:INPUT "YOUR DECISION :";DE$(X)
  82. 172 X=X+1:IF X>3 THEN 176
  83. 174 GOTO154
  84. 176 PRINT"[147]";TAB(11);IT$
  85. 178 PRINTTAB(11);" THE DECISIONS [146]"
  86. 180 PRINT"WHAT IF ";DE$(1);"[146] AND "
  87. 182 PRINT"";DE$(2);"[146] ARE MIXED"
  88. 184 PRINT"";:INPUT "YOUR DECISION :";DE$(X)
  89. 186 X=X+1
  90. 188 PRINT"[147]";TAB(11);IT$
  91. 190 PRINTTAB(11);" THE DECISIONS [146]"
  92. 192 PRINT"WHAT IF ";DE$(2);"[146] AND "
  93. 194 PRINT"";DE$(3);"[146] ARE MIXED"
  94. 196 PRINT"";:INPUT "YOUR DECISION :";DE$(X)
  95. 198 RETURN
  96. 200 REM ***********************
  97. 202 REM * SCREEN VIEW OF DATA *
  98. 204 REM ***********************
  99. 206 X=1:Y=3
  100. 208 IF Y>6THEN 226
  101. 210 PRINT"[147]";TAB(8);NA$
  102. 212 FOR T=XTOY
  103. 214 PRINT"ATTRIBUTE ";T;"-  ";A$(T)
  104. 216 PRINT
  105. 218 FOR S=1TO3
  106. 220 PRINTTAB(5);"VALUE";S;"-  ";V$(T,S)
  107. 222 NEXT:NEXT:PRINT:PRINT:PRINT
  108. 224 GOSUB390:Y=Y+3:X=X+3:GOTO208
  109. 226 PRINT"[147]";TAB(5)"THESE ARE YOUR DECISIONS"
  110. 228 PRINT"":FORG=1TO5:PRINTTAB(6);DE$(G):PRINT"":PRINT:NEXT:GOSUB390:RETURN
  111. 230 REM ********************
  112. 232 REM * RANKING THE DATA *
  113. 234 REM ********************
  114. 236 PRINT"[147]";TAB(11);IT$
  115. 238 FORT=1TO6
  116. 240 PRINT" VALUES FOR ATTRIBUTE '";A$(T);"'"
  117. 242 FORS=1TO3
  118. 244 PRINT""S;V$(T,S):NEXT
  119. 246 PRINT"":FOR R=1TO3
  120. 248 IFR=1THENS$="FIRST ":GOTO254
  121. 250 IFR=2THENS$="SECOND":GOTO254
  122. 252 IFR=3THENS$="THIRD "
  123. 254 IF S>1THEN PRINTTAB(10);"[145][145][145][145] ":GOTO 258
  124. 256 PRINT""
  125. 258 PRINT" WHICH WOULD YOU PUT ";S$
  126. 260 PRINTTAB(10)"";:INPUTC(R)
  127. 262 B$(T,R)=V$(T,C(R)):NEXT
  128. 264 PRINTTAB(10)" ";
  129. 266 FOR S=1TO3:V$(T,S)=B$(T,S):NEXTS
  130. 268 PRINT"[147]":NEXTT:GOSUB390:RETURN
  131. 270 REM *****************
  132. 272 REM * SAVE THE DATA *
  133. 274 REM *****************
  134. 276 PRINT"[147]";TAB(12);IT$
  135. 278 PRINT"ARE YOU SURE (Y/N)"
  136. 280 GET B$:IF B$="" THEN 280
  137. 282 IF B$="N" THEN RETURN
  138. 284 PRINT"OK - I HAVE THE NAME FILE  "NA$" "
  139. 286 PRINT"IS THIS CORRECT (Y/N)"
  140. 288 GET B$:IF B$="" THEN 288
  141. 290 IF B$="Y" AND LEN(NA$)>=3 THEN 302
  142. 292 IF B$="N" THEN 296
  143. 294 :
  144. 296 PRINTTAB(7);" TYPE IN THE CORRECT NAME [146]"
  145. 297 PRINTTAB(12);" THEN [RETURN] [146]"
  146. 298 PRINT:PRINTTAB(7);:INPUT NA$
  147. 300 IF LEN(NA$)<3 THEN PRINTCD$(3);TAB(11);" INVALID ENTRY [146]":GOSUB390:RETURN
  148. 302 PRINTTAB(4);"CREATING ";NA$;" DISK FILE"
  149. 304 OPEN 15,8,15
  150. 306 OPEN4,8,4,NA$+",S,W":GOSUB444
  151. 308 PRINT#4,NA$
  152. 310 FOR T=1TO6:PRINT#4,A$(T):NEXT
  153. 312 FORT=1TO6:FOR S=1TO3:PRINT#4,V$(T,S):NEXT:NEXT
  154. 314 FOR T=1TO5:PRINT#4,DE$(T):NEXT
  155. 316 CLOSE15:CLOSE4:PRINT:PRINTTAB(4);"FILE SAVED":GOSUB 390:RETURN
  156. 318 REM *********************
  157. 320 REM * RETRIEVE THE DATA *
  158. 322 REM *********************
  159. 324 PRINT"[147]";TAB(11);IT$
  160. 326 PRINT"WHICH FILE IS TO BE RETRIEVED"
  161. 328 PRINT"";:INPUT NA$
  162. 330 IF LEN(NA$)<3 THEN PRINTCD$(3);TAB(11);"INVALID INPUT":GOSUB390:RETURN
  163. 332 TA3=INT((19-(LEN(NA$)))/2)
  164. 334 PRINTTAB(TA3);"RETRIEVING ";NA$;"[146] DATA FILE"
  165. 336 OPEN 15,8,15
  166. 338 OPEN4,8,4,NA$+",S"
  167. 340 INPUT#4,NA$
  168. 342 FOR T=1TO6:INPUT#4,A$(T):NEXT
  169. 344 FORT=1TO6:FOR S=1TO3:INPUT#4,V$(T,S):NEXT:NEXT:GOSUB 444
  170. 346 FOR T=1TO5:INPUT#4,DE$(T):NEXT
  171. 348 CLOSE15:CLOSE4:ZZ=1
  172. 350 PRINT"";TAB(TA3);"DATA FILE ";NA$;"[146] RETRIEVED":GOSUB390:RETURN
  173. 352 REM *******************
  174. 354 REM * CHANGE THE DATA *
  175. 356 REM *******************
  176. 358 PRINT"[147]";TAB(11);IT$
  177. 360 PRINT"SYSTEM NAME IS ",NA$;:INPUT NA$
  178. 362 FOR T=1TO6
  179. 364 PRINT"ATTRIBUTE ";T;"-  ";A$(T);:INPUT A$(T)
  180. 366 PRINT
  181. 368 FOR S=1TO3
  182. 370 PRINT"VALUE";S;"-  ";V$(T,S);:INPUTV$(T,S)
  183. 372 NEXT:NEXT
  184. 374 PRINT:PRINT:PRINT
  185. 376 PRINT"THESE ARE YOUR DECISIONS"
  186. 378 FOR U=1TO5
  187. 380 PRINT"";U". ";DE$(U):PRINT:INPUT"";DE$(U)
  188. 382 NEXT:PRINT"":GOSUB390:RETURN
  189. 384 REM ****************
  190. 386 REM * PAGE CONTROL *
  191. 388 REM ****************
  192. 390 PRINTCD$;TAB(6);" SPACE=CONTINUE [146]  _ = ABORT [146]"
  193. 392 GET SP$:IF SP$=""THEN 392
  194. 394 IF SP$=CHR$(32) THEN RETURN
  195. 396 IF SP$="_" AND ZZ>0 THEN TT=0:X=6:GOTO42
  196. 398 GOSUB516:GOTO392
  197. 400 REM *********************
  198. 402 REM * SCRATCH DATA FILE *
  199. 404 REM *********************
  200. 406 OPEN15,8,15
  201. 408 PRINT"[147]EXPERT SYSTEMS"
  202. 410 PRINT"CONTINUE AND THE DATA FILE WILL BE"
  203. 412 PRINT"SCRATCHED !"
  204. 414 PRINT:PRINT"  [SPACE] TO CONTINUE - '_' TO ABORT [146]"
  205. 416 GET K$:IF K$="" THEN 416
  206. 418 IF K$=CHR$(32) THEN 422
  207. 420 PRINT:PRINT:PRINTTAB(10)" SCRATCH ABORTED !! ":GOSUB482:GOTO434
  208. 422 PRINT"WHICH FILE TO BE SCRATCHED"
  209. 424 PRINT"";:INPUT NA$
  210. 426 PRINT"ARE YOU SURE [Y/N]"
  211. 428 GET A$:IF A$="" THEN 428
  212. 430 IF A$="Y" THEN PRINT#15,"S:";NA$
  213. 432 PRINT"OK ! BACK TO THE MENU":GOSUB 482
  214. 434 CLOSE15:RETURN
  215. 436 :
  216. 438 :
  217. 440 :
  218. 442 REM ***************
  219. 444 REM * DISK ERRORS *
  220. 446 REM ***************
  221. 448 INPUT#15,EN,EM$,ET,ES
  222. 450 IF EN<20 THEN RETURN
  223. 452 PRINT"[147][158] DISK ERROR HAS OCCURRED "
  224. 454 PRINT"ERROR NUMBER     ";EN
  225. 456 PRINT"ERROR MESSAGE    ";EM$
  226. 458 PRINT"TRACK NUMBER     ";ET
  227. 460 PRINT"SECTOR NUMBER     ";ES
  228. 462 CLOSE 15
  229. 464 REM *****************
  230. 466 REM * SCREEN EDGING *
  231. 468 REM *****************
  232. 470 PRINT"[147]":POKE53281,1:POKE53280,6
  233. 472 FOR K=S1TOS2:POKE K,102:NEXT
  234. 474 FOR K=S2TOS3STEP40:POKE K,102:NEXT
  235. 476 FOR K=S3TOS4STEP-1:POKE K,102:NEXT
  236. 478 FOR K=S4TOS1STEP-40:POKE K,102:NEXT
  237. 480 RETURN
  238. 482 FOR Y=1TO2500:NEXT:RETURN
  239. 484 REM **********************
  240. 486 REM * READ THE DIRECTORY *
  241. 488 REM **********************
  242. 490 GOSUB466
  243. 492 PRINT" THIS IS THE DISK DIRECTORY "
  244. 494 OPEN 1,8,0,"$"
  245. 496 GET#1,X$,X$
  246. 498 GET#1,X$,X$,X$,X$
  247. 500 IF ST THEN CLOSE 1:GOSUB390:RETURN
  248. 502 GET#1,X$:IF X$="" THEN PRINTTAB(5);CHR$(34):GOTO498
  249. 504 IF X$=CHR$(34) THEN Q=NOT Q
  250. 506 IF Q THEN PRINTTAB(5);X$;
  251. 508 GOTO502
  252. 510 REM *******************
  253. 512 REM * SCREEN REVERSER *
  254. 514 REM *******************
  255. 516 FOR L=1TO10:SYS 52992:GOSUB532: NEXT:RETURN
  256. 518 FORJ=52992TO53018:READK:POKEJ,K:NEXT
  257. 520 DATA 169,000,133,251,169,004,133,252
  258. 522 DATA 162,004,160,000,177,251,073,128
  259. 524 DATA 145,251,200,208,247,230,252,202
  260. 526 DATA 208,240,096
  261. 528 :
  262. 530 RETURN
  263. 532 FOR K=1TO80:NEXT:RETURN
  264. 534 REM ****************
  265. 536 REM * THE ANALYSIS *
  266. 538 REM ****************
  267. 540 :
  268. 542 X=1:Q=1
  269. 544 :
  270. 546 :
  271. 548 :
  272. 550 :
  273. 552 IF TT>0 THEN 556
  274. 554 FORT=1TO6:C$(T)="UNKNOWN":NEXT
  275. 556 :
  276. 558 IFZZ=1THENGOTO574
  277. 560 A$(1)="ATTRIBUTE HERE"
  278. 562 T=1:FOR S=1TO3
  279. 564 V$(T,S)="VALUE HERE"
  280. 566 NEXT
  281. 568 DE$(F)="DECISION HERE"
  282. 570 :
  283. 572 PRINT"[147]"
  284. 574 FOR T=1TO6
  285. 576 GOSUB636:REM *PRINT BOXES*
  286. 578 PRINTCD$(1);TAB(9);A$(T):PRINTCD$(2);
  287. 580 FOR S=1TO3:PRINTTAB(5);S;"[157]. ";V$(T,S):NEXT
  288. 582 :
  289. 584 IF ZZ=0 THEN PRINTCD$(3);DE$(T):GOSUB390:RETURN
  290. 586 REM ***********
  291. 588 REM * SCORING *
  292. 590 REM ***********
  293. 592 :
  294. 594 PRINTCD$;
  295. 596 GET B$:IF B$="" THEN 596
  296. 598 IF B$="1" THEN VT(T)=3:GOTO606
  297. 600 IF B$="2" THEN VT(T)=2:GOTO606
  298. 602 IF B$="3" THEN VT(T)=1:GOTO606
  299. 604 GOSUB516:GOTO596
  300. 606 T(Q,T,S)=VT(T)
  301. 608 :
  302. 610 IF Q>1 THEN TT=TT-T(Q-1,T,S)
  303. 612 TT=TT+VT(T)
  304. 614 V=VAL(B$):C$(T)=V$(T,V):TT(Q,T,S)=TT
  305. 616 IF TT=X*3 THEN F=1:GOTO626
  306. 618 IF TT=>(X*2)+1 AND TT<=(X*3)-1 THEN F=4:GOTO626
  307. 620 IF TT=X*2 THEN F=2:GOTO626
  308. 622 IF TT=>X+1 AND TT<=(X*2)-1 THEN F=5:GOTO626
  309. 624 IF TT=X THEN F=3:GOTO626
  310. 626 IF X<=5 THEN F=6
  311. 628 GOSUB668
  312. 630 IF Q=>2 THEN X=6:NEXT:GOTO634
  313. 632 X=X+1:NEXT
  314. 634 Q=Q+1:GOTO572
  315. 636 PRINT"[147]";TAB(11);IT$
  316. 638 PRINTTAB(7);"[176][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][174]
  317. 640 [153][163]7);"PEEK                     PEEK
  318. 642 PRINTTAB(7);"[173][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][189]
  319. 644 [153]:[153]
  320. 646 [153][163]4);"ORLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLEN^
  321. 648 PRINTTAB(4);"[194]                            [194]
  322. 650 [153][163]4);"PEEK                            PEEK
  323. 652 PRINTTAB(4);"[194]                            [194]
  324. 654 [153][163]4);"PEEK                            PEEK
  325. 656 PRINTTAB(4);"[194]                            [194]
  326. 658 [153][163]4);"/LENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENEXP
  327. 660 IF ZZ=0 THEN RETURN
  328. 662 PRINT"TYPE THE NUMBER OF YOUR CHOICE"
  329. 664 RETURN
  330. 666 REM *********************
  331. 668 REM * THE 'WHY' FACTORS *
  332. 670 REM *********************
  333. 672 GOSUB466
  334. 674 PRINT"";TAB(11);IT$
  335. 676 TA1=INT((37-(LEN(NA$)))/2)
  336. 678 PRINT"";TAB(TA1);NA$;" SAYS "
  337. 680 TA1=INT((40-LEN(DE$(F)))/2)
  338. 682 PRINT"";TAB(TA1)DE$(F)
  339. 684 PRINT"";TAB(15)" BECAUSE :"
  340. 686 FOR G=1TO6
  341. 688 TA2=INT((36-(LEN(A$(G))+LEN(C$(G))))/2)
  342. 690 PRINTTAB(TA2);A$(G);" IS ";C$(G)
  343. 692 NEXT
  344. 694 GOSUB390:RETURN
  345. 696 REM *********
  346.