home *** CD-ROM | disk | FTP | other *** search
/ Commodore Disk User Volume 4 #4 / Commodore_Disk_User_Vol.4_4_1991_-.d64 / advisor (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  8KB  |  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.