Category : Miscellaneous Language Source Code
Archive   : NEURAL.ZIP
Filename : BAM.BAS

1000 CLS
1010 PRINT
1020 PRINT
1030 PRINT
1040 PRINT " *********************************************************"
1050 PRINT " * *"
1060 PRINT " * BIDIRECTIONAL ASSOCIATIVE MEMORY *"
1070 PRINT " * DEMONSTRAION PROGRAM *"
1080 PRINT " * *"
1090 PRINT " * (C) COPYRIGHT 1987 LOGICAL DESIGNS CONSULTING INC. *"
1100 PRINT " * 3229 ERIE ST. SAN DIEGO, CA 92117 *"
1110 PRINT " * (619) 276-3955 *"
1120 PRINT " * *"
1130 PRINT " * BY DUANE DESIENO *"
1140 PRINT " * *"
1150 PRINT " *********************************************************"
1160 PRINT
1170 PRINT
1180 PRINT
1190 PRINT
1200 PRINT " PRESS (Y) FOR INSTRUCTIONS"
1210 S$=INKEY$
1220 IF LEN(S$)=0 THEN GOTO 1210
1230 IF S$<>"Y" AND S$<>"y" THEN GOTO 1760
1240 CLS
1250 PRINT
1260 PRINT " USING THE BAM DEMONSTRATION PROGRAM"
1270 PRINT
1280 PRINT " - CHANGE NETWORK PARAMETERS to set new values of the A and B"
1290 PRINT " dimensions, the number of cells updated per iteration of the"
1300 PRINT " network, and the percentage of elements to change state when"
1310 PRINT " random noise is added to the A and B fields. The maximun"
1320 PRINT " size of the A or B fields is 144 elements (12x12)."
1330 PRINT
1340 PRINT " - CLEAR NETWORK fills the matrix M with 0. All stored patterns"
1350 PRINT " will be lost when this command is executed, so be sure to"
1360 PRINT " save the M matrix before executing this command."
1370 PRINT
1380 PRINT " - LOAD MEMORY MATRIX M displays all current BAM interconnect"
1390 PRINT " matrix files stored on disk. Enter the desired file name"
1400 PRINT " to load that file into the M matrix."
1410 PRINT
1420 PRINT " - SAVE MEMORY MATRIX M to store the current M matrix to a disk"
1430 PRINT " file. The dimensions of the A and B fields are also saved."
1440 PRINT
1450 PRINT
1460 PRINT " PRESS ANY KEY TO CONTINUE"
1470 S$=INKEY$
1480 IF LEN(S$)=0 THEN GOTO 1470
1490 CLS
1500 PRINT
1510 PRINT " - EDIT/RUN NETWORK to input new patterns to the A and B fields."
1520 PRINT " Once input the network can either learn the new pattern or"
1530 PRINT " execute one or more iterations of the network.
1540 PRINT
1550 PRINT " - LEARN CURRENT PATTERN takes the current state of the A and B"
1560 PRINT " fields and changes the M matrix to learn this pattern. The"
1570 PRINT " cursor will disappear until this operation is complete.
1580 PRINT
1590 PRINT " - ADD RANDOM NOISE will flip the state of a certain percentage"
1600 PRINT " of elements in both the A and B fields. The percentage is"
1610 PRINT " set in the NETWORK PARAMETERS. This can be used to see how"
1620 PRINT " different a pattern can be to still be recalled.
1630 PRINT
1640 PRINT " - RUN THE NETWORK will execute two complete iterations of the"
1650 PRINT " network when the parameter is set for synchronous operation."
1660 PRINT " When the number of cells updated per iteration is greater "
1670 PRINT " than 0, ten iterations of the network are executed. At each"
1680 PRINT " iteration, only the number of cells specified in the parameter"
1690 PRINT " are updated per field."
1700 PRINT
1710 PRINT
1720 PRINT " PRESS ANY KEY TO CONTINUE"
1730 S$=INKEY$
1740 IF LEN(S$)=0 THEN GOTO 1730
1750 REM
1760 ON ERROR GOTO 4720
1770 DIM A%(144),B%(144),X%(144),Y%(144),M%(144,144)
1780 AXSIZE=12: AYSIZE=12: BXSIZE=12: BYSIZE=12
1790 CLS
1800 KEY OFF
1810 PRINT " BIDIRECTIONAL ASSOCIATIVE MEMORY "
1820 PRINT " DEMONSTRATION PROGRAM"
1830 PRINT
1840 PRINT
1850 PRINT " BY DUANE DESIENO"
1860 PRINT
1870 PRINT
1880 PRINT
1890 PRINT " MAIN MENUE"
1900 PRINT
1910 PRINT " 1 - CHANGE NETWORK PARAMETERS"
1920 PRINT " 2 - CLEAR NETWORK"
1930 PRINT " 3 - LOAD MEMORY MATRIX M"
1940 PRINT " 4 - SAVE MEMORY MATRIX M"
1950 PRINT " 5 - EDIT/RUN NETWORK"
1960 PRINT " 6 - QUIT"
1970 PRINT
1980 INPUT " INPUT CHOICE (1-6): "; CHOICE
1990 ON CHOICE GOSUB 2010,2370,4240,4480,3000,4750
2000 GOTO 1790 'THIS IS THE MAIN LOOP OF THE PROGRAM
2010 REM *************************************
2020 REM CHANGE NETWORK PARAMETERS
2030 REM *************************************
2040 CLS
2050 LOCATE 5,1
2060 PRINT " CURRENT NETWORK PARAMETERS"
2070 PRINT
2080 PRINT
2090 PRINT " 1 - A FIELD X DIMENSION : ";AXSIZE
2100 PRINT " 2 - A FIELD Y DIMENSION : ";AYSIZE
2110 PRINT " 3 - B FIELD X DIMENSION : ";BXSIZE
2120 PRINT " 4 - B FIELD Y DIMENSION : ";BYSIZE
2130 PRINT " 5 - NUMBER OF CELLS CHANGED PER "
2140 PRINT " ITERATION (0=SYNCHRONOUS) : ";ASYN
2150 PRINT " 6 - RANDOM NOISE PERCENTAGE : ";NOISE
2160 PRINT " 7 - RETURN"
2170 PRINT
2180 INPUT " ENTER CHOICE :";CHOICE
2190 IF CHOICE=7 THEN GOTO 2290
2200 INPUT " ENTER NEW VALUE :";NVAL
2210 ON CHOICE GOTO 2230,2240,2250,2260,2270,2280
2220 RETURN
2230 AXSIZE=NVAL: GOTO 2010 ' LOOP TILL DONE
2240 AYSIZE=NVAL: GOTO 2010
2250 BXSIZE=NVAL: GOTO 2010
2260 BYSIZE=NVAL: GOTO 2010
2270 ASYN=NVAL: GOTO 2010
2280 NOISE=NVAL: GOTO 2010
2290 IF AXSIZE*AYSIZE>144 THEN PRINT "A FIELD TOO LARGE";: GOTO 2050
2300 IF AYSIZE>16 THEN PRINT "A FIELD Y DIM TO LARGE";: GOTO 2050
2310 IF BXSIZE*BYSIZE>144 THEN PRINT "B FIELD TOO LARGE";: GOTO 2050
2320 IF BYSIZE>16 THEN PRINT "B FIELD Y DIM TO LARGE";: GOTO 2050
2330 RETURN ' END OF CHANGE NETWORK PARAMETERS
2340 REM **************************************
2350 REM CLEAR NETWORK MATRIX M,A,B
2360 REM **************************************
2370 FOR I=1 TO 144
2380 A%(I)=0
2390 B%(I)=0
2400 NEXT I
2410 FOR I=1 TO AXSIZE*AYSIZE 'CLEAR THE MEMORY MATRIX M
2420 FOR J=1 TO BXSIZE*BYSIZE
2430 M%(I,J)=0
2440 NEXT J
2450 PRINT ".";
2460 NEXT I
2470 RETURN ' END OF CLEAR NETWORK
2480 REM ***********************
2490 REM DISPLAY A AND B FIELDS
2500 REM ***********************
2510 CLS
2520 LOCATE 1,19: PRINT "A FIELD";
2530 LOCATE 1,59: PRINT "B FIELD";
2540 REM **** DRAW BOX AROUND A FIELD ****
2550 LOCATE 3,15: PRINT CHR$(218)
2560 FOR I=1 TO AXSIZE: LOCATE 3,15+I: PRINT CHR$(196);: NEXT I
2570 PRINT CHR$(191);
2580 FOR J=1 TO AYSIZE
2590 LOCATE 3+J,15: PRINT CHR$(179);
2600 LOCATE 3+J,15+AXSIZE+1: PRINT CHR$(179);
2610 NEXT J
2620 LOCATE 3+AYSIZE+1,15: PRINT CHR$(192);
2630 FOR I=1 TO AXSIZE: LOCATE 3+AYSIZE+1,15+I: PRINT CHR$(196);: NEXT I
2640 PRINT CHR$(217);
2650 REM **** DRAW BOX AROUND B FIELD ****
2660 LOCATE 3,55: PRINT CHR$(218)
2670 FOR I=1 TO BXSIZE: LOCATE 3,55+I: PRINT CHR$(196);: NEXT I
2680 PRINT CHR$(191);
2690 FOR J=1 TO BYSIZE
2700 LOCATE 3+J,55: PRINT CHR$(179);
2710 LOCATE 3+J,55+BXSIZE+1: PRINT CHR$(179);
2720 NEXT J
2730 LOCATE 3+BYSIZE+1,55: PRINT CHR$(192)
2740 FOR I=1 TO BXSIZE: LOCATE 3+BYSIZE+1,55+I: PRINT CHR$(196);: NEXT I
2750 PRINT CHR$(217);
2760 LOCATE 21,1:PRINT "OPTIONS: 1. LEARN CURRENT PATTERN";
2770 LOCATE 21,41:PRINT " ARROW KEYS TO MOVE CURSOR";
2780 LOCATE 22,1:PRINT " 2. ADD RANDOM NOISE";
2790 LOCATE 22,41:PRINT " A OR B TO SWITCH FIELDS"
2800 LOCATE 23,1:PRINT " 3. RUN THE NETWORK";
2810 LOCATE 23,41:PRINT " + TO SET LEVEL TO 1";
2820 LOCATE 24,1:PRINT " 4. CLEAR A AND B FIELDS";
2830 LOCATE 24,41:PRINT " - TO SET LEVEL TO 0";
2840 LOCATE 25,1:PRINT " ESC. RETURN TO MAIN MENUE ";
2850 REM **** DISPLAY THE A FIELD ARRAY IN THE BOX ****
2860 FOR J=1 TO AYSIZE
2870 FOR I=1 TO AXSIZE
2880 LOCATE 3+J,15+I
2890 PRINT CHR$(219*A%((J-1)*AXSIZE+I));
2900 NEXT I
2910 NEXT J
2920 REM **** DISPLAY THE B FIELD ARRAY IN THE BOX ****
2930 FOR J=1 TO BYSIZE
2940 FOR I=1 TO BXSIZE
2950 LOCATE 3+J,55+I
2960 PRINT CHR$(219*B%((J-1)*BXSIZE+I));
2970 NEXT I
2980 NEXT J
2990 RETURN
3000 REM ***********************************************
3010 REM EDIT THE A AND B FIELDS
3020 REM ***********************************************
3030 GOSUB 2480 'DISPLAY THE FIELDS BEFORE EDITING
3040 PX=1: PY=1: FLD=0 'START ON A FIELD UPPER LEFT CORNER
3050 S$=INKEY$ 'GET KEYBOARD ENTRY
3060 LOCATE 3+PY,15+PX+40*FLD 'POSITION CURSOR IN FIELD BOX
3070 PRINT "*";
3080 FOR ZZ=1 TO 4: NEXT ZZ
3090 LOCATE 3+PY,15+PX+40*FLD
3100 IF FLD=0 THEN XSIZE=AXSIZE: YSIZE=AYSIZE
3110 IF FLD=1 THEN XSIZE=BXSIZE: YSIZE=BYSIZE
3120 OFS=((PY-1)*XSIZE+PX)
3130 IF FLD=0 THEN STAT=A%(OFS) ELSE STAT=B%(OFS)
3140 PRINT CHR$(219*STAT);
3150 IF LEN(S$)=2 THEN S$=RIGHT$(S$,1)
3160 IF S$=CHR$(77) THEN PX=PX+1
3170 IF S$=CHR$(75) THEN PX=PX-1
3180 IF S$=CHR$(72) THEN PY=PY-1
3190 IF S$=CHR$(80) THEN PY=PY+1
3200 IF S$="A" OR S$="a" THEN FLD=0: PX=1: PY=1
3210 IF S$="B" OR S$="b" THEN FLD=1: PX=1: PY=1
3220 IF S$="+" AND FLD=0 THEN A%(OFS)=1
3230 IF S$="+" AND FLD=1 THEN B%(OFS)=1
3240 IF S$="-" AND FLD=0 THEN A%(OFS)=0
3250 IF S$="-" AND FLD=1 THEN B%(OFS)=0
3260 IF S$="1" THEN GOSUB 3370 ' LEARN CURRENT PATTERN
3270 IF S$="2" THEN GOSUB 3530 ' ADD RANDOM NOISE TO PATTERN
3280 IF S$="3" THEN GOSUB 3660 ' RUN THE NETWORK
3290 IF S$="4" THEN GOSUB 4150 ' CLEAR THE A AND B FIELDS
3300 IF PX<1 THEN PX=1
3310 IF PX>XSIZE THEN PX=1: PY=PY+1
3320 IF PY<1 THEN PY=1
3330 IF PY>YSIZE THEN PY=YSIZE
3340 IF S$=CHR$(27) THEN RETURN
3350 FOR ZZ=1 TO 4: NEXT ZZ
3360 GOTO 3050
3370 REM *********************************************
3380 REM LEARN CURRENT PATTERN IN A AND B FIELDS
3390 REM *********************************************
3400 FOR I=1 TO AXSIZE*AYSIZE ' TRANSFER A FIELD TO BIPOLAR X FIELD
3410 IF A%(I)=0 THEN X%(I)=-1 ELSE X%(I)=1
3420 NEXT I
3430 FOR I=1 TO BXSIZE*BYSIZE ' TRANSFER B FIELD TO BIPOLAR Y FIELD
3440 IF B%(I)=0 THEN Y%(I)=-1 ELSE Y%(I)=1
3450 NEXT I
3460 REM **** THE CORRELATION MATRIX M IS UPDATED HERE ****
3470 FOR J=1 TO BXSIZE*BYSIZE
3480 FOR I=1 TO AXSIZE*AYSIZE
3490 M%(I,J)=M%(I,J)+X%(I)*Y%(J)
3500 NEXT I
3510 NEXT J
3520 RETURN
3530 REM *********************************************
3540 REM ADD RANDOM NOISE TO THE A AND B FIELDS
3550 REM *********************************************
3560 FOR I=1 TO AXSIZE*AYSIZE
3570 IF 100*RND>=NOISE THEN 3590
3580 IF A%(I)=0 THEN A%(I)=1 ELSE A%(I)=0 'FLIP THE STATE
3590 NEXT I
3600 FOR I=1 TO BXSIZE*BYSIZE
3610 IF 100*RND>=NOISE THEN 3630
3620 IF B%(I)=0 THEN B%(I)=1 ELSE B%(I)=0 'FLIP THE STATE
3630 NEXT I
3640 GOSUB 2850 'UPDATE THE A AND B FIELD DISPLAYS
3650 RETURN
3660 REM *********************************************
3670 REM RUN ITERATIONS OF THE NETWORK
3680 REM *********************************************
3690 IF ASYN=0 THEN GOTO 3940
3700 REM **** PERFORM ASYNCHRONOUS UPDATE OF ASYN RANDON NEURONS/FIELD ****
3710 FOR CC=1 TO 10 ' LIMIT THE NUMBER OF ASYNCHRONOUS ITERATIONS
3720 FOR K=1 TO ASYN
3730 PIK=INT((AXSIZE*AYSIZE)*RND+1)
3740 TSUM = 0
3750 FOR J=1 TO BXSIZE*BYSIZE 'UPDATE A FIELD NEURON
3760 TSUM = TSUM + B%(J)*M%(PIK,J)
3770 NEXT J
3780 IF TSUM>0 THEN A%(PIK)=1 ' THRESHOLD FUNCTION
3790 IF TSUM<0 THEN A%(PIK)=0
3800 NEXT K
3810 FOR K=1 TO ASYN
3820 PIK=INT((BXSIZE*BYSIZE)*RND+1)
3830 TSUM = 0
3840 FOR I=1 TO AXSIZE*AYSIZE 'UPDATE B FIELD NEURON
3850 TSUM = TSUM + A%(I)*M%(I,PIK)
3860 NEXT I
3870 IF TSUM>0 THEN B%(PIK)=1 ' THRESHOLD FUNCTION
3880 IF TSUM<0 THEN B%(PIK)=0
3890 NEXT K
3900 GOSUB 2850 'WANT TO WATCH THE PROGRESS
3910 NEXT CC
3920 RETURN ' COMPLETED ASYN ITERATION
3930 REM **** PERFORM SYNCHRONOUS UPDATE OF ALL NEURONS IN BOTH FIELDS ****
3940 FOR CC = 1 TO 2 ' ONLY TWO ITERATIONS NEEDED
3950 FOR J=1 TO BXSIZE*BYSIZE
3960 TSUM = 0
3970 FOR I=1 TO AXSIZE*AYSIZE 'UPDATE B FIELD NEURON
3980 TSUM = TSUM + A%(I)*M%(I,J)
3990 NEXT I
4000 IF TSUM>0 THEN B%(J)=1 ' THRESHOLD FUNCTION
4010 IF TSUM<0 THEN B%(J)=0
4020 NEXT J
4030 FOR I=1 TO AXSIZE*AYSIZE
4040 TSUM = 0
4050 FOR J=1 TO BXSIZE*BYSIZE 'UPDATE A FIELD NEURON
4060 TSUM = TSUM + B%(J)*M%(I,J)
4070 NEXT J
4080 IF TSUM>0 THEN A%(I)=1 ' THRESHOLD FUNCTION
4090 IF TSUM<0 THEN A%(I)=0
4100 NEXT I
4110 GOSUB 2850 'UPDATE THE A AND B FIELD DISPLAYS
4120 NEXT CC ' ITERATION OF BOTH FIELDS
4130 RETURN
4140 RETURN
4150 REM ********************************
4160 REM CLEAR THE A AND B FIELDS
4170 REM ********************************
4180 FOR I=1 TO 144
4190 A%(I)=0
4200 B%(I)=0
4210 NEXT I
4220 GOSUB 2850 'UPDATE THE A AND B FIELD DISPLAYS
4230 RETURN
4240 REM ********************************************************
4250 REM LOAD CORRELATION MATRIX M FROM DISK FILE
4260 REM ********************************************************
4270 CLS
4280 PRINT " CURRENT MEMORY MATRIX FILES ON DISK"
4290 PRINT
4300 FILES "*.BAM"
4310 PRINT
4320 PRINT
4330 INPUT " ENTER FILE NAME TO LOAD MEMORY MATRIX : "; FILESPEC$
4340 IF FILESPEC$ = "" THEN RETURN
4350 IF INSTR(".",FILESPEC$) = 0 THEN FILESPEC$ = FILESPEC$ + ".BAM"
4360 OPEN FILESPEC$ FOR INPUT AS #1
4370 INPUT #1, AXSIZE
4380 INPUT #1, AYSIZE
4390 INPUT #1, BXSIZE
4400 INPUT #1, BYSIZE
4410 FOR J=1 TO BXSIZE*BYSIZE
4420 FOR I=1 TO AXSIZE*AYSIZE
4430 INPUT #1, M%(I,J)
4440 NEXT I
4450 NEXT J
4460 CLOSE #1
4470 RETURN
4480 REM ********************************************************
4490 REM SAVE CORRELATION MATRIX M TO DISK FILE
4500 REM ********************************************************
4510 CLS
4520 PRINT " CURRENT MEMORY MATRIX FILES ON DISK"
4530 PRINT
4540 FILES "*.BAM"
4550 PRINT
4560 PRINT
4570 INPUT " ENTER FILE NAME TO SAVE MEMORY MATRIX : "; FILESPEC$
4580 IF FILESPEC$ = "" THEN RETURN
4590 IF INSTR(".",FILESPEC$) = 0 THEN FILESPEC$ = FILESPEC$ + ".BAM"
4600 OPEN FILESPEC$ FOR OUTPUT AS #1
4610 PRINT #1, AXSIZE
4620 PRINT #1, AYSIZE
4630 PRINT #1, BXSIZE
4640 PRINT #1, BYSIZE
4650 FOR J=1 TO BXSIZE*BYSIZE
4660 FOR I=1 TO AXSIZE*AYSIZE
4670 PRINT #1, M%(I,J)
4680 NEXT I
4690 NEXT J
4700 CLOSE #1
4710 RETURN
4720 IF ERL=4540 THEN PRINT "NO FILES": RESUME 4550
4730 IF ERL=4300 THEN PRINT "NO FILES": RESUME 4310
4740 RESUME 1790
4750 CLOSE
4760 ON ERROR GOTO 0
4770 END