home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Loadstar 226
/
226.d81
/
b.neural
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-08-26
|
6KB
|
270 lines
5 rem neural network
6 deffnh(x)=int(x/256):deffnl(x)=x-fnh(x)*256
7 v$=str$(peek(71)+256*peek(72)):v=val(v$)
8 dimd$(23)
9 poke53272,20
10 rem screen configuration
15 print"[147]":poke214,23:print""
20 poke 53280,13
30 poke 53281,6
40 print "";
60 rem variable declarations
70 dim f1%(42),f2%(42),m%(42,42)
80 dim v%,j,i
90 rem initialise screen
100 print "";
110 print " neuron network associative memory"
120 print
130 print "";
140 print "f1 - teach pattern ";
150 print "f2 - dump matrix"
160 print "f3 - randomize pattern ";
170 print "f4 - forget all"
180 print "f5 - recall pattern ";
190 print "f6 - quit"
200 print "f7 - disc save ";
210 print "f8 - disc load"
220 print
230 print "a-z, 0-9: load pattern"
240 r1 = 4 : c1 = 5 : gosub 600
250 r1 = 4 : c1 = 25 : gosub 600
260 gosub 750
270 gosub 860
280 gosub 970:poke53280,7:poke214,21:print:print " ready "
290 get a$ : if a$="" goto 290
300 gosub 970:print " "
310 k=asc(a$)
320 ifa$>="0"anda$<="9"thenk=k+64:goto340
330 if a$ < "a" or a$ > "z" then 500
340 gosub 970:poke214,21:print:print "fetch ";a$
350 l%=0
360 k=(k-64)*8+53248
370 poke56333,127:poke 1,peek(1)and251
380 fori=0to6:poke49408+i,peek(k+i):next
390 poke 1,peek(1) or 4:poke 56333,129
400 for i = 0 to 6
410 j% = peek(49408+i)/2
420 for k=1 to 6
430 l%=l%+1
440 f1%(l%) = -1 + (2 * (j% and 1))
450 j%=j%/2
460 next k
470 next i
480 gosub 750 : gosub 860 : goto 280
490 rem dispatch function key commands
500 j%=asc(a$)-132
510 if j%=1 then gosub 1000:goto 280
520 if j%=5 then gosub 1080:goto 90
530 if j%=2 then gosub 1210:goto 280
540 if j%=6 then gosub 1680:goto 280
550 if j%=3 then gosub 1290:goto 280
560 if j%=7 then print "";:close15:goto40000
570 if j%=4 then gosub 1800:goto 90
580 if j%=8 then gosub 1990:goto 90
590 (NULL) to 280
600 rem draw borders for fields
610 for i=0 to 1
620 v=1024+40*(r1+(i*8))+c1
630 poke v,112+(-3*i)
640 for j=1 to 8
650 poke v+j,67
660 next j
670 poke v+9,110+(15*i)
680 next i
690 for i=1 to 7
700 v=1024+40*(r1+i)+c1
710 poke v,93
720 poke v+9,93
730 next i
740 return
750 rem update field f2% on screen
760 l%=0
770 for i=0 to 6
780 v% = 1024+40*(i+5)+6
790 for j=2 to 7
800 l%=l%+1
810 iff1%(l%)=1thenpokev%+(8-j),81:goto830
820 poke v%+(8-j),32
830 next j
840 next i
850 return
860 rem update field f1% on screen
870 l%=0
880 for i = 0 to 6
890 v%=1024+40*(i+5)+26
900 for j=2 to 7
910 l%=l%+1
920 if f2%(l%)=1 then poke v%+(8-j),81:goto 940
930 poke v%+(8-j),32
940 next j
950 next i
960 return
970 rem position to status area
980 print "";
990 return
1000 rem train on pattern in f1%
1010 gosub 970:poke214,21:print:print "training"
1020 for i = 1 to 42
1030 for j = 1 to 42
1040 m%(i,j)=m%(i,j)+f1%(i)*f1%(j)
1050 next j:poke53280,(peek(53280)+1)and7
1060 next i
1070 return
1080 rem print part of matrix
1085 poke198,0
1090 print "";
1100 for i=1 to 24
1110 for j=1 to 39
1120 ifm%(i,j)<0thenprint "";:goto1140
1130 print "";
1140 print chr$(asc("0")+abs(m%(i,j)));
1150 next j
1160 print
1170 next i
1180 print "press any key to continue:";
1190 get a$ : if a$="" goto 1190
1195 print"[147]":poke214,23:print
1200 return
1210 rem randomise 10 percent of f1%
1220 gosub 970:poke214,21:print: print "random"
1230 for i=1 to 42
1240 if rnd(0) > 0.1 then 1260
1250 f1%(i)=-f1%(i)
1260 next i
1270 gosub 750
1280 return
1290 rem recall from pattern
1300 gosub 970:poke214,21:print:print "recall"
1310 p%=1024+40*9+19
1320 rem initially copy f1 to f2
1330 poke p%+1,asc("=")
1340 for i=1 to 42
1350 f2%(i)=f1%(i)
1360 next i
1370 gosub 860
1380 rem f1 to f2 pass
1390 poke p%,asc("=")
1400 poke p%+2,asc(">")
1410 for j=1 to 42
1420 v%=0
1430 for i=1 to 42
1440 v%=v%+f1%(i)*m%(i,j)
1450 next i
1460 v%=sgn(v%)
1470 if v%<>0 then f2%(j)=v%
1480 next j
1490 gosub 860
1500 rem f2 to f1 pass
1510 c%=0
1520 poke p%,asc("<")
1530 poke p%+2,asc("=")
1540 for i=1 to 42
1550 v%=0
1560 for j=1 to 42
1570 v%=v%+f2%(j)*m%(i,j)
1580 next j
1590 v%=sgn(v%)
1600 ifv%<>0andv%<>f1%(i)thenf1%(i)=v%:c%=1
1610 next i
1620 gosub 750
1630 if c%<>0 goto 1380
1640 poke p%,asc(" ")
1650 poke p%+1,asc(" ")
1660 poke p%+2,asc(" ")
1670 return
1680 rem forget all - clear memory
1690 gosub 970:poke214,21:print: print "forget"
1700 for i=1 to 42
1710 f1%(i)=0
1720 f2%(i)=0
1730 for j=1 to 42
1740 m%(i,j)=0
1750 next j:poke53280,peek(53280)-1and15
1760 next i
1770 gosub 750
1780 gosub 860
1790 return
1800 rem save state to disc file
1810 gosub 970:poke214,21:print:print "save "
1820 print "";:d=peek(186):ifdv<8thendv=8
1830 input "file name: ";a$
1835 open1,dv,15,"s0:nn."+a$:close1
1840 a$="nn."+a$+",s,w"
1850 open 5,dv,5,a$
1860 for i=1 to 42:print#5,f1%(i):next:poke53281,0
1870 rem gosub 2240
1880 for i=1 to 42:print#5,f2%(i):next:poke53281,7
1890 rem gosub 2240
1900 for i=1 to 42
1910 for j=1 to 42
1920 print#5,m%(i,j)
1930 next j:poke53280,peek(53280)+3and7
1940 rem gosub 2240
1950 next i:poke53281,6
1960 close 5
1970 print"[147]":poke214,23:print
1980 return
1990 rem restore state from disc file
1995 gosub3000
2020 a$=d$(cc)
2040 p%=asc("m")
2050 rem gosub 2240
2060 open 5,dv,5,a$
2070 for i=1 to 42
2080 input#5,f1%(i)
2090 next i:poke53281,2
2100 rem gosub 2240
2110 for i=1 to 42
2120 input#5,f2%(i)
2130 next i:poke53281,3
2140 rem gosub 2240
2150 for i=1 to 42
2160 for j=1 to 42
2170 input#5,m%(i,j)
2180 next j:poke53280,peek(53280)+1and13
2190 rem gosub 2240
2200 next i
2210 close 5
2212 poke53280,7:poke53281,6:print"[147]":poke214,23:print
2220 return
2230 rem disc error check
2240 input#15,en,em$,et,es
2250 if en>0then print en,em$,et,es:stop
2260 return
3000 dv=peek(186):ifdv<8thendv=8
3001 v$=str$(peek(71)+256*peek(72)):v=val(v$)
3002 sys57812"$:nn.*",dv,0:poke780,0:poke781,0:poke782,192:sys65493
3004 print"[147]";:poke53280,0:poke53281,0
3005 printtab(15)"[158]load file"
3010 p0=49152+34:k=0
3011 p1=16:p2=0
3012 pokev,5:pokev+1,fnl(p0):pokev+2,fnh(p0):ifv$="block"then3029
3020 ifpeek(p0+p2)<>34thenp2=p2+1:goto3020
3022 p2=p2+1
3024 ifpeek(p0+p2+p1)<>34thenp1=p1-1:goto3024
3026 pokev,p1:pokev+1,fnl(p0+p2):pokev+2,fnh(p0+p2):d$(k)=v$
3028 p0=p0+32:k=k+1:ifk<24then3011
3029 k=k-1:forx=0tok:poke214,x:print:printtab(12)d$(x):next:cc=0:oc=0
3030 gosub3900
3035 poke198,0:wait198,1:getz$
3040 ifz$=""thencc=cc+1:ifcc>kthencc=0
3041 ifz$="[145]"thencc=cc-1:ifcc<0thencc=k
3042 ifz$=chr$(13)thenreturn
3043 gosub3900
3044 goto3035
3900 poke214,oc:print:printtab(12)d$(oc)
3910 poke214,cc:print:printtab(12)""d$(cc):oc=cc:return
9999 end
10000 d=peek(186):open1,d,15,"i0":close1:n$="b.neural"
10010 open1,d,15,"s0:"+n$:close1:saven$,d:end
40000 fori=0to21:poke828+i,8+i:next
40010 ifdv<8ordv>29ordv=8then40030
40020 a=peek(828):b=peek(828+dv-8):poke828,b:poke828+dv-8,a
40030 a$="hello connect":forj=8to29:i=peek(828+j-8):ifi=14thennext
40040 close2:open2,i,2:close2:ifstthen40060
40050 close15:open15,i,15,"r0:"+a$+"="+a$:input#15,er:close15:ifer=63then40070
40060 next:print"[147]":poke53272,23:poke186,8:end
40070 q$=chr$(34):poke646,peek(53281):print"[147]":poke53272,23
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
40090 print"run:":poke631,13:poke632,13:poke198,2:end