home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 226 / 226.d81 / b.neural (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  6KB  |  270 lines
  1. 5 rem  neural network
  2. 6 deffnh(x)=int(x/256):deffnl(x)=x-fnh(x)*256
  3. 7 v$=str$(peek(71)+256*peek(72)):v=val(v$)
  4. 8 dimd$(23)
  5. 9 poke53272,20
  6. 10 rem screen configuration
  7. 15 print"[147]":poke214,23:print""
  8. 20 poke 53280,13
  9. 30 poke 53281,6
  10. 40 print "";
  11. 60 rem variable declarations
  12. 70 dim f1%(42),f2%(42),m%(42,42)
  13. 80 dim v%,j,i
  14. 90 rem initialise screen
  15. 100 print "";
  16. 110 print "    neuron network associative memory"
  17. 120 print
  18. 130 print "";
  19. 140 print "f1 - teach pattern     ";
  20. 150 print "f2 - dump matrix"
  21. 160 print "f3 - randomize pattern ";
  22. 170 print "f4 - forget all"
  23. 180 print "f5 - recall pattern    ";
  24. 190 print "f6 - quit"
  25. 200 print "f7 - disc save         ";
  26. 210 print "f8 - disc load"
  27. 220 print
  28. 230 print "a-z, 0-9: load pattern"
  29. 240 r1 = 4 : c1 = 5 : gosub 600
  30. 250 r1 = 4 : c1 = 25 : gosub 600
  31. 260 gosub 750
  32. 270 gosub 860
  33. 280 gosub 970:poke53280,7:poke214,21:print:print " ready    "
  34. 290 get a$ : if a$="" goto 290
  35. 300 gosub 970:print "          "
  36. 310 k=asc(a$)
  37. 320 ifa$>="0"anda$<="9"thenk=k+64:goto340
  38. 330 if a$ < "a" or a$ > "z" then 500
  39. 340 gosub 970:poke214,21:print:print "fetch ";a$
  40. 350 l%=0
  41. 360 k=(k-64)*8+53248
  42. 370 poke56333,127:poke 1,peek(1)and251
  43. 380 fori=0to6:poke49408+i,peek(k+i):next
  44. 390 poke 1,peek(1) or 4:poke 56333,129
  45. 400 for i = 0 to 6
  46. 410 j% = peek(49408+i)/2
  47. 420 for k=1 to 6
  48. 430 l%=l%+1
  49. 440 f1%(l%) = -1 + (2 * (j% and 1))
  50. 450 j%=j%/2
  51. 460 next k
  52. 470 next i
  53. 480 gosub 750 : gosub 860 : goto 280
  54. 490 rem dispatch function key commands
  55. 500 j%=asc(a$)-132
  56. 510 if j%=1 then gosub 1000:goto 280
  57. 520 if j%=5 then gosub 1080:goto 90
  58. 530 if j%=2 then gosub 1210:goto 280
  59. 540 if j%=6 then gosub 1680:goto 280
  60. 550 if j%=3 then gosub 1290:goto 280
  61. 560 if j%=7 then print "";:close15:goto40000
  62. 570 if j%=4 then gosub 1800:goto 90
  63. 580 if j%=8 then gosub 1990:goto 90
  64. 590 (NULL) to 280
  65. 600 rem draw borders for fields
  66. 610 for i=0 to 1
  67. 620 v=1024+40*(r1+(i*8))+c1
  68. 630 poke v,112+(-3*i)
  69. 640 for j=1 to 8
  70. 650 poke v+j,67
  71. 660 next j
  72. 670 poke v+9,110+(15*i)
  73. 680 next i
  74. 690 for i=1 to 7
  75. 700 v=1024+40*(r1+i)+c1
  76. 710 poke v,93
  77. 720 poke v+9,93
  78. 730 next i
  79. 740 return
  80. 750 rem update field f2% on screen
  81. 760 l%=0
  82. 770 for i=0 to 6
  83. 780 v% = 1024+40*(i+5)+6
  84. 790 for j=2 to 7
  85. 800 l%=l%+1
  86. 810 iff1%(l%)=1thenpokev%+(8-j),81:goto830
  87. 820 poke v%+(8-j),32
  88. 830 next j
  89. 840 next i
  90. 850 return
  91. 860 rem update field f1% on screen
  92. 870 l%=0
  93. 880 for i = 0 to 6
  94. 890 v%=1024+40*(i+5)+26
  95. 900 for j=2 to 7
  96. 910 l%=l%+1
  97. 920 if f2%(l%)=1 then poke v%+(8-j),81:goto 940
  98. 930 poke v%+(8-j),32
  99. 940 next j
  100. 950 next i
  101. 960 return
  102. 970 rem position to status area
  103. 980 print "";
  104. 990 return
  105. 1000 rem train on pattern in f1%
  106. 1010 gosub 970:poke214,21:print:print "training"
  107. 1020 for i = 1 to 42
  108. 1030 for j = 1 to 42
  109. 1040 m%(i,j)=m%(i,j)+f1%(i)*f1%(j)
  110. 1050 next j:poke53280,(peek(53280)+1)and7
  111. 1060 next i
  112. 1070 return
  113. 1080 rem print part of matrix
  114. 1085 poke198,0
  115. 1090 print "";
  116. 1100 for i=1 to 24
  117. 1110 for j=1 to 39
  118. 1120 ifm%(i,j)<0thenprint "";:goto1140
  119. 1130 print "";
  120. 1140 print chr$(asc("0")+abs(m%(i,j)));
  121. 1150 next j
  122. 1160 print
  123. 1170 next i
  124. 1180 print "press any key to continue:";
  125. 1190 get a$ : if a$="" goto 1190
  126. 1195 print"[147]":poke214,23:print
  127. 1200 return
  128. 1210 rem randomise 10 percent of f1%
  129. 1220 gosub 970:poke214,21:print: print "random"
  130. 1230 for i=1 to 42
  131. 1240 if rnd(0) > 0.1 then 1260
  132. 1250 f1%(i)=-f1%(i)
  133. 1260 next i
  134. 1270 gosub 750
  135. 1280 return
  136. 1290 rem recall from pattern
  137. 1300 gosub 970:poke214,21:print:print "recall"
  138. 1310 p%=1024+40*9+19
  139. 1320 rem initially copy f1 to f2
  140. 1330 poke p%+1,asc("=")
  141. 1340 for i=1 to 42
  142. 1350 f2%(i)=f1%(i)
  143. 1360 next i
  144. 1370 gosub 860
  145. 1380 rem f1 to f2 pass
  146. 1390 poke p%,asc("=")
  147. 1400 poke p%+2,asc(">")
  148. 1410 for j=1 to 42
  149. 1420 v%=0
  150. 1430 for i=1 to 42
  151. 1440 v%=v%+f1%(i)*m%(i,j)
  152. 1450 next i
  153. 1460 v%=sgn(v%)
  154. 1470 if v%<>0 then f2%(j)=v%
  155. 1480 next j
  156. 1490 gosub 860
  157. 1500 rem f2 to f1 pass
  158. 1510 c%=0
  159. 1520 poke p%,asc("<")
  160. 1530 poke p%+2,asc("=")
  161. 1540 for i=1 to 42
  162. 1550 v%=0
  163. 1560 for j=1 to 42
  164. 1570 v%=v%+f2%(j)*m%(i,j)
  165. 1580 next j
  166. 1590 v%=sgn(v%)
  167. 1600 ifv%<>0andv%<>f1%(i)thenf1%(i)=v%:c%=1
  168. 1610 next i
  169. 1620 gosub 750
  170. 1630 if c%<>0 goto 1380
  171. 1640 poke p%,asc(" ")
  172. 1650 poke p%+1,asc(" ")
  173. 1660 poke p%+2,asc(" ")
  174. 1670 return
  175. 1680 rem forget all - clear memory
  176. 1690 gosub 970:poke214,21:print: print "forget"
  177. 1700 for i=1 to 42
  178. 1710 f1%(i)=0
  179. 1720 f2%(i)=0
  180. 1730 for j=1 to 42
  181. 1740 m%(i,j)=0
  182. 1750 next j:poke53280,peek(53280)-1and15
  183. 1760 next i
  184. 1770 gosub 750
  185. 1780 gosub 860
  186. 1790 return
  187. 1800 rem save state to disc file
  188. 1810 gosub 970:poke214,21:print:print "save      "
  189. 1820 print "";:d=peek(186):ifdv<8thendv=8
  190. 1830 input "file name: ";a$
  191. 1835 open1,dv,15,"s0:nn."+a$:close1
  192. 1840 a$="nn."+a$+",s,w"
  193. 1850 open 5,dv,5,a$
  194. 1860 for i=1 to 42:print#5,f1%(i):next:poke53281,0
  195. 1870 rem  gosub 2240
  196. 1880 for i=1 to 42:print#5,f2%(i):next:poke53281,7
  197. 1890 rem  gosub 2240
  198. 1900 for i=1 to 42
  199. 1910 for j=1 to 42
  200. 1920 print#5,m%(i,j)
  201. 1930 next j:poke53280,peek(53280)+3and7
  202. 1940 rem gosub 2240
  203. 1950 next i:poke53281,6
  204. 1960 close 5
  205. 1970 print"[147]":poke214,23:print
  206. 1980 return
  207. 1990 rem restore state from disc file
  208. 1995 gosub3000
  209. 2020 a$=d$(cc)
  210. 2040 p%=asc("m")
  211. 2050 rem  gosub 2240
  212. 2060 open 5,dv,5,a$
  213. 2070 for i=1 to 42
  214. 2080 input#5,f1%(i)
  215. 2090 next i:poke53281,2
  216. 2100 rem  gosub 2240
  217. 2110 for i=1 to 42
  218. 2120 input#5,f2%(i)
  219. 2130 next i:poke53281,3
  220. 2140 rem gosub 2240
  221. 2150 for i=1 to 42
  222. 2160 for j=1 to 42
  223. 2170 input#5,m%(i,j)
  224. 2180 next j:poke53280,peek(53280)+1and13
  225. 2190 rem  gosub 2240
  226. 2200 next i
  227. 2210 close 5
  228. 2212 poke53280,7:poke53281,6:print"[147]":poke214,23:print
  229. 2220 return
  230. 2230 rem disc error check
  231. 2240 input#15,en,em$,et,es
  232. 2250 if en>0then print en,em$,et,es:stop
  233. 2260 return
  234. 3000 dv=peek(186):ifdv<8thendv=8
  235. 3001 v$=str$(peek(71)+256*peek(72)):v=val(v$)
  236. 3002 sys57812"$:nn.*",dv,0:poke780,0:poke781,0:poke782,192:sys65493
  237. 3004 print"[147]";:poke53280,0:poke53281,0
  238. 3005 printtab(15)"[158]load file"
  239. 3010 p0=49152+34:k=0
  240. 3011 p1=16:p2=0
  241. 3012 pokev,5:pokev+1,fnl(p0):pokev+2,fnh(p0):ifv$="block"then3029
  242. 3020 ifpeek(p0+p2)<>34thenp2=p2+1:goto3020
  243. 3022 p2=p2+1
  244. 3024 ifpeek(p0+p2+p1)<>34thenp1=p1-1:goto3024
  245. 3026 pokev,p1:pokev+1,fnl(p0+p2):pokev+2,fnh(p0+p2):d$(k)=v$
  246. 3028 p0=p0+32:k=k+1:ifk<24then3011
  247. 3029 k=k-1:forx=0tok:poke214,x:print:printtab(12)d$(x):next:cc=0:oc=0
  248. 3030 gosub3900
  249. 3035 poke198,0:wait198,1:getz$
  250. 3040 ifz$=""thencc=cc+1:ifcc>kthencc=0
  251. 3041 ifz$="[145]"thencc=cc-1:ifcc<0thencc=k
  252. 3042 ifz$=chr$(13)thenreturn
  253. 3043 gosub3900
  254. 3044 goto3035
  255. 3900 poke214,oc:print:printtab(12)d$(oc)
  256. 3910 poke214,cc:print:printtab(12)""d$(cc):oc=cc:return
  257. 9999 end
  258. 10000 d=peek(186):open1,d,15,"i0":close1:n$="b.neural"
  259. 10010 open1,d,15,"s0:"+n$:close1:saven$,d:end
  260. 40000 fori=0to21:poke828+i,8+i:next
  261. 40010 ifdv<8ordv>29ordv=8then40030
  262. 40020 a=peek(828):b=peek(828+dv-8):poke828,b:poke828+dv-8,a
  263. 40030 a$="hello connect":forj=8to29:i=peek(828+j-8):ifi=14thennext
  264. 40040 close2:open2,i,2:close2:ifstthen40060
  265. 40050 close15:open15,i,15,"r0:"+a$+"="+a$:input#15,er:close15:ifer=63then40070
  266. 40060 next:print"[147]":poke53272,23:poke186,8:end
  267. 40070 q$=chr$(34):poke646,peek(53281):print"[147]":poke53272,23
  268. 40080 print"[147]p[207]2048,0:p[207]44,8:p[207]43,1:p[207]56,160:p[207]55,0:clr:l[207]"q$a$q$","i
  269. 40090 print"run:":poke631,13:poke632,13:poke198,2:end
  270.