home *** CD-ROM | disk | FTP | other *** search
/ Transactor / Transactor_13_1986_Transactor_Publishing.d64 / animals (.txt) < prev    next >
Commodore BASIC  |  2023-02-26  |  5KB  |  179 lines
  1. 100 rem  "animals" ai program
  2. 110 rem  a simple expert system
  3. 120 rem  run 51000 to create file
  4. 130 rem  run 51100 to initialize file
  5. 140 rem  run 50000 to print file
  6. 150 rem    save"@0:animals",8
  7. 160 :
  8. 170 z$=chr$(0)
  9. 180 sp$="                                                            "
  10. 190 rl=44: rem  rel record size-1
  11. 200 input"[206]ame of data file    animals.dat[157][157][157][157][157][157][157][157][157][157][157][157][157]";f$
  12. 210 :
  13. 220 rem* main program loop *
  14. 230 open 15,8,15
  15. 240 open 1,8,9,f$
  16. 250 print#15,"p";chr$(9)chr$(1)chr$(0)chr$(1)
  17. 260 rem  first record holds next available record
  18. 270 get#1,m1$,m2$: rem  in low, hi format
  19. 280 m1$=left$(m1$+z$,1): m2$=left$(m2$+z$,1)
  20. 290 max=asc(m1$) + 256*asc(m2$)
  21. 300 :
  22. 310 print"[147]**        [212]hink of an animal          **";
  23. 320 print"**  [193]nswer questions with 'y' or 'n'  **"
  24. 330 rp=2: rem  point to first question
  25. 340 :
  26. 350 r=rp: gosub 20000'read in (NULL)
  27. 360 if yes=0 and no=0 then 460'end of chain
  28. 370 rem  chain to next branch
  29. 380 print m$;"? ";
  30. 390 gosub 10000: rem  get y/n response
  31. 400 bp=rp: remember old record #
  32. 410 if yn$="y" then a$="yes": rp=yes:  ob=0
  33. 420 if yn$="n" then a$="no" : rp=no :  ob=1
  34. 430 print a$: rem  yes or no
  35. 440 goto 350
  36. 450 :
  37. 460 rem end of chain - give guess
  38. 470 print"*** [201]t might be a ";m$
  39. 480 print"> [201]s that correct (y/n) ";
  40. 490 gosub 10000'get answer yes or no
  41. 500 if yn$="y" then 950'found answer, wrap up
  42. 510 rem got wrong answer, let's learn from it
  43. 520 print" no": print"[207][203], what were you actually thinking of"
  44. 530 input" >";animal$
  45. 540 print"[215]hat yes/no question could [201] ask"
  46. 550 print"to distinguish a"
  47. 560 print"  ";m$
  48. 570 print"from a"
  49. 580 print"  ";animal$
  50. 590 input q$
  51. 600 print"[193]nd regarding a"
  52. 610 print"  ";m$;",": print q$
  53. 620 print">  (y/n)";
  54. 630 gosub 10000'get yes/no
  55. 640 rem create new question pointing to current or new animal
  56. 650 if yn$="y" then a$="yes": yn=rp: nn=max+1: rem new yes/no pointers
  57. 660 if yn$="n" then a$="no" : yn=max+1: nn=rp: rem new yes/no pointers
  58. 670 print a$: rem  yes or no
  59. 680 rr=max: gosub 40000'(NULL)#(max)
  60. 690 n=yn: gosub 30000: yn$=lh$: rem  convert n to lh$ (low+hi)
  61. 700 n=nn: gosub 30000: nn$=lh$: rem  convert n to lh$ (low+hi)
  62. 710 print#1,yn$;nn$;left$(q$+sp$,rl-4)
  63. 720 gosub 40000're-position to foil bug
  64. 730 rem  point old question to new
  65. 740 r=bp : gosub 20000'read in old question
  66. 750 n=max: gosub 30000'find low,hi of new (NULL) position
  67. 760 if ob=0 then yes$=lh$: rem  point 'yes' ptr to new question
  68. 770 if ob=1 then no$ =lh$: rem  point 'no' ptr to new question
  69. 780 rr=bp: gosub 40000'(NULL)#1,(bp)
  70. 790 print#1,yes$;no$;m$: rem re-write modified record
  71. 800 gosub 40000're-position to foil bug
  72. 810 rem  now put new animal in next available record
  73. 820 rr=max+1: gosub 40000'(NULL)#1,(max+1)
  74. 830 print#1,z$;z$;z$;z$;left$(animal$+sp$,rl-4)
  75. 840 gosub 40000're-position to foil bug
  76. 850 rem  now update max. record pointer
  77. 860 rr=1: gosub 40000'1st rec has ptr
  78. 870 max=max+2 : rem  2 records have been added to file
  79. 880 n=max: gosub 30000'convert to 2-byte pointer
  80. 890 print#1,lh$;left$(sp$,rl-2): rem  pad with spaces
  81. 900 gosub 40000're-position to foil bug
  82. 910 print: print"[212]hank you for teaching me a new animal!"
  83. 920 goto 970
  84. 930 :
  85. 940 rem got right answer, wrap up
  86. 950 print" yes": print"[193]lright! [199]uess [201]'m pretty smart."
  87. 960 :
  88. 970 close 1: close 15
  89. 980 input"play again   y[157][157][157]";yn$
  90. 990 if yn$="y" then 230
  91. 1000 end
  92. 1010 :
  93. 1020 :
  94. 10000 rem* subroutine to accept y or n
  95. 10010 k=0: for i=0 to 1
  96. 10020 get yn$
  97. 10030 rem  flash fake cursor
  98. 10040 print mid$("[146]",sgn(k and 8)+1,1);" [157]";
  99. 10050 k=(k+1) and 255
  100. 10060 i=-(yn$="y"or yn$="n"): next
  101. 10070 rem  until 'y' or 'n' pressed
  102. 10080 print"[146] ";: rem erase cursor
  103. 10090 return
  104. 10100 :
  105. 10110 :
  106. 20000 rem subroutine to read record# (r) in yes$,no$,m$
  107. 20010 rr=r: gosub 40000: rem  record#1,(r)
  108. 20020 get#1,y1$,y2$,n1$,n2$
  109. 20030 yes$=left$(y1$+z$,1) + left$(y2$+z$,1)
  110. 20040 no$ =left$(n1$+z$,1) + left$(n2$+z$,1)
  111. 20050 yes=asc(y1$+z$) + 256*asc(y2$+z$)
  112. 20060 no =asc(n1$+z$) + 256*asc(n2$+z$)
  113. 20070 input#1,m$
  114. 20080 rem  strip trailing spaces
  115. 20090 lc=0: for k=1tolen(m$):if mid$(m$,k,1)<>" "then lc=k
  116. 20100 next: if lc then m$=left$(m$,lc)
  117. 20110 return
  118. 20120 :
  119. 20130 :
  120. 30000 rem* subroutine to convert 16-bit 'n' to low,hi 'lh$' *
  121. 30010 hh%=n/256: ll%=n-256*hh%: lh$=chr$(ll%)+chr$(hh%)
  122. 30020 return
  123. 30030 :
  124. 30040 :
  125. 40000 rem* subroutine to simulate 'record#1,(rr)' using basic 2.0 *
  126. 40010 rh%=rr/256: rl%=rr-256*rh%
  127. 40020 print#15,"p";chr$(96+9)chr$(rl%)chr$(rh%)chr$(1)
  128. 40030 return
  129. 40040 :
  130. 40050 :
  131. 50000 rem**  dump relative file
  132. 50010 open 15,8,15
  133. 50020 input"[206]ame of data file    animals.dat[157][157][157][157][157][157][157][157][157][157][157][157][157]";f$
  134. 50030 open 1,8,9,f$
  135. 50040 z$=chr$(0)
  136. 50050 print#15,"p";chr$(9)chr$(1)chr$(0)chr$(1): get#1,l$,h$
  137. 50060 nr=asc(l$+z$)+256*asc(h$+z$)-1
  138. 50070 print " 1 :"nr"records in file"
  139. 50080 rl=2: rh=0: rem  record #, lo/hi
  140. 50090 for i=2 to nr
  141. 50100 print#15,"p";chr$(9)chr$(rl)chr$(rh)chr$(1)
  142. 50110 get#1,x1$,x2$,x3$,x4$: input#1,a$
  143. 50120 p1=asc(x1$+z$)+256*asc(x2$+z$)
  144. 50130 p2=asc(x3$+z$)+256*asc(x4$+z$)
  145. 50140 print i;":";p1,p2,"["a$"]"
  146. 50150 rl=rl+1: if rl>255 then rl=0: rh=rh+1
  147. 50160 next: close 15
  148. 50170 end
  149. 50180 :
  150. 50190 :
  151. 51000 rem**  create new animal file
  152. 51010 input"[206]ame of data file    animals.dat[157][157][157][157][157][157][157][157][157][157][157][157][157]";f$
  153. 51020 input"maximum number of records      2000[157][157][157][157][157][157]";m
  154. 51030 open 15,8,15
  155. 51040 open 1,8,9,f$+",l,"+chr$(45): rem  rec len = 45
  156. 51050 rr=m: gosub 40000
  157. 51060 print#1,left$(sp$,44)
  158. 51070 close 1: close 15: goto 51110
  159. 51080 input"[206]ame of data file    animals.dat[157][157][157][157][157][157][157][157][157][157][157][157][157]";f$
  160. 51090 :
  161. 51100 rem** teach first two animals
  162. 51110 r1$="[196]oes it live in the water":rem  first question
  163. 51120 r2$="[198]ish" : rem  'yes' answer
  164. 51130 r3$="[200]orse": rem  'no' answer
  165. 51140 z$=chr$(0)
  166. 51150 sp$="                                                        "
  167. 51160 open 15,8,15
  168. 51170 open 1,8,9,f$
  169. 51180 rr=1: gosub 40000
  170. 51190 print#1,chr$(5);z$;left$(sp$,40)
  171. 51200 gosub 40000: rr=rr+1: gosub 40000
  172. 51210 print#1,chr$(3);z$;chr$(4);z$;left$(r1$+sp$,40)
  173. 51220 gosub 40000: rr=rr+1: gosub 40000
  174. 51230 print#1,z$z$z$z$;left$(r2$+sp$,40)
  175. 51240 gosub 40000: rr=rr+1: gosub 40000
  176. 51250 print#1,z$z$z$z$;left$(r3$+sp$,40)
  177. 51260 close 15
  178. 51270 end
  179.