10 REM ************************************
20 REM * BACK PROPAGATION NEURAL NETWORKS *
30 REM * ORIGINAL SOFTWARE BY A. MAZZETTI *
40 REM * (1991) - PORT TO LM80C BASIC BY  *
50 REM *     LEONARDO MILIANI (2022)      *
60 REM ************************************
100 GOSUB 2500:X=RND(-ABS(TMR(0))):BE$=CHR$(163)+CHR$(163)+CHR$(163)
110 MX=51:MH=51:MY=50:ME=200
120 DIM XI(MX):REM UNITA' DI INPUT + BIAS
130 DIM H(MH):REM UNITA' NASCOSTE + BIAS
140 DIM Y(MY):REM UNITA' DI OUTPUT
150 DIM D(MY):REM UNITA' DI OUTPUT DESIDERATO
160 DIM W1(MX,MH):REM MATRICE PESI DI LIVELLO 1
170 DIM W2(MH,MY):REM MATRICE PESI DI LIVELLO 2
180 DIM EH(MH):REM ERRORE SU UNITA' NASCOSTE
190 NX=0:NH=0:NY=O:NE=0:REM NUMERO UNITA', NUMERO ESENTI
200 EP=0.0:ER=0.0:REM TASSO APPRENDIMENTO, ERRORE RETE
220 AM=0.0:GM=0.0:TM=0.0:REM altezza, gittata, tempo caduta
230 DIM E(ME,4):REM ESEMPI DI VE,AN,Git,Tem
240 DEF FNT(X)=1.0/(1.0+EXP(-X)):REM funzione di trasferimento T a sigmoide
245 DEF FNV(X)=(INT(X*100))/100
250 GOTO 2200
299 REM *** <ROUTINE DI BACK PROPAGATION> ***
300 FOR K=1 TO NH+1:EH(K)=0.0:NEXT:ER=0.0
310 FOR J=1 TO NY
320 IF ABS(D(J)-Y(J))>ER THEN ER=ABS(D(J)-Y(J))
330 DE=(D(J)-Y(J))*Y(J)*(1.0-Y(J))
340 FOR K=1 TO NH+1
350 EH(K)=EH(K)+(DE*W2(K,J))
360 W2(K,J)=W2(K,J)+(EP*DE*H(K))
370 NEXT:NEXT
380 FOR K=1 TO NH
390 DE=EH(K)*H(K)*(1.0-H(K))
400 FOR I=1 TO NX+1
410 W1(I,K)=W1(I,K)+(EP*DE*XI(I))
420 NEXT:NEXT
430 RETURN
499 REM *** <ESEGUI> ***
500 FOR K=1 TO NH:H(K)=0.0:NEXT
510 FOR J=1 TO NY:Y(J)=0.0:NEXT
520 FOR K=1 TO NH:A=0.0
530 FOR I=1 TO NX+1:A=A+(W1(I,K)*XI(I)):NEXT
540 H(K)=FNT(A):NEXT
550 FOR J=1 TO NY:A=0.0
560 FOR K=1 TO NH+1:A=A+(W2(K,J)*H(K)):NEXT
570 Y(J)=FNT(A):NEXT
580 RETURN
599 REM *** <TRACCIAMENTO A VIDEO> ***
600 T=0.1
610 C=INT(VE*COS(AN)*T*(40/GM))
620 R=24-INT(((VE*SIN(AN)*T)-(0.5*9.8*T*T))*(24/AM))
623 IF C<0 OR C>39 THEN 640
626 IF R<0 OR R>23 THEN 640
630 LOCATE C,R:PRINT "*";
640 T=T+0.1
650 IF T<=((2*VE*SIN(AN))/9.8) THEN 610
655 IF TT=1 THEN 680:REM IN APPRENDIMENTO NON CHIEDE TASTI
660 LOCATE 0,0:PRINT "Premere un tasto":I=INKEY(10)
670 IF INKEY(10)=0 THEN 670
680 CLS:RETURN
699 REM *** <GENERA ESEMPI PER ADDESTRAMENTO> ***
700 CLS
710 FOR P=1 TO NE
720 E(P,1)=((RND(1)*100)*(70/100))+30:REM E.Vel
730 E(P,2)=(((RND(1)*90)*(50/90))+30)*(3.14/180):REM E.Ang
740 E(P,3)=(E(P,1)*E(P,1)*SIN(2*E(P,2)))/9.8:REM E.Git
750 E(P,4)=(E(P,1)*2*SIN(E(P,2)))/9.8:REM E.Tem
760 VE=E(P,1):AN=E(P,2):LOCATE 0,0:PRINT "Test n.";P:GOSUB 600
770 NEXT
780 RETURN
799 REM *** <APPRENDIMENTO> ***
800 PRINT "Quanti esempi (1-";ME;")";:INPUT NE$
810 NE=VAL(NE$):IF NE<1 OR NE>ME THEN 800
820 PRINT "Errore massimo (0.001-0.999)";:INPUT EA$
830 EA=VAL(EA$):IF EA<0.001 OR EA>0.999 THEN 820
840 PRINT "Tasso di apprendimento 'epsilon' (0.001-0.999)";:INPUT EP$
850 EP=VAL(EP$):IF EP<0.001 OR EP>0.999 THEN 840
860 PRINT "Pausa ogni quante epoche (0-10000)";:INPUT PA$
870 PA=INT(VAL(PA$)):IF PA<0 OR PA>10000 THEN 860
880 GOSUB 700:EC=0:CLS
890 EE=0.0:PRINT:PRINT "Apprendimento...":REM CICLO SULLE EPOCHE
900 FOR P=1 TO NE:REM CICLO SUGLI ESEMPI
910 XI(1)=E(P,3)/GM:XI(2)=E(P,4)/TM
920 D(1)=E(P,1)/100:D(2)=E(P,2)/(3.14/2)
930 GOSUB 500:GOSUB 300
940 IF ER>EE THEN EE=ER
950 NEXT:EC=EC+1
960 PRINT "Epoca =";EC:PRINT "Errore =";EE
970 IF EC%PA<>0 THEN 1020
980 PRINT "Ancora (S/N)? ";:X=INKEY(10)
990 X=INKEY(400) AND 223:IF X=0 THEN X=83:REM NESSUN TASTO = S
995 IF X=ASC("N") THEN PRINT:EE=-1.0:GOTO 1020
1000 IF X=ASC("S") THEN PRINT "S":GOTO 1020
1010 GOTO 990
1020 IF EE>=EA THEN 890
1030 RETURN
1099 REM *** <IMPOSTAZIONI DELLA RETE> ***
1100 PRINT "Unita' di input (1 -";MX-1;")";:INPUT NX$
1110 NX=VAL(NX$):IF NX<1 OR NX>MX-1 THEN 1100
1120 PRINT "Unita' nascoste (1 -";MH-1;")";:INPUT NH$
1130 NH=VAL(NH$):IF NH<1 OR NH>MH-1 THEN 1120
1140 PRINT "Unita' di ouput (1 -";MY;")";:INPUT NY$
1150 NY=VAL(NY$):IF NY<1 OR NY>MY THEN 1140
1160 FOR I=1 TO NX:XI(I)=0.0:NEXT
1165 XI(NX+1)=1.0:REM IMPOSTA IL BIAS DEL PRIMO LIVELLO
1170 FOR K=1 TO NH:H(K)=0.0:NEXT
1175 H(NH+1)=1.0:REM IMPOSTA IL BIAS DEL SECONDO LIVELLO
1180 FOR J=1 TO NY:Y(J)=0.0:NEXT
1190 FOR I=1 TO NX+1:FOR K=1 TO NH
1200 W1(I,K)=((RND(1)*100)-50)/100:NEXT:NEXT
1210 FOR K=1 TO NH+1:FOR J=1 TO NY
1220 W2(K,J)=((RND(1)*100)-50)/100:NEXT:NEXT
1230 AM=10000/(2*9.8):GM=10000/9.8:TM=200/9.8
1240 RETURN
1299 REM *** <VISUALIZZAZIONE DATI RETE> ***
1300 PRINT "Unita' di input: "
1310 FOR I=1 TO NX+1:PRINT XI(I);" ";:PRINT:NEXT
1320 PRINT "Unita' nascoste: "
1330 FOR K=1 TO NH+1:PRINT H(K);" ";:PRINT:NEXT
1340 PRINT "Unita' di output: "
1350 FOR J=1 TO NY:PRINT Y(J);" ";:PRINT:NEXT
1360 PRINT:PRINT "Vuoi vedere la matrice W1 (S/N)?":X=INKEY(10)
1370 X=INKEY(10) AND 223:IF X=0 THEN 1370
1380 IF X<>ASC("S") THEN 1430
1390 PRINT "    ";
1400 FOR K=1 TO NH:PRINT K;"H ";:NEXT:PRINT:PRINT
1410 FOR I=1 TO NX+1:PRINT I;"X ";
1420 FOR K=1 TO NH:PRINT FNV(W1(I,K));" ";:NEXT:PRINT:NEXT
1430 PRINT:PRINT "Vuoi vedere la matrice W2 (S/N)?":X=INKEY(10)
1440 X=INKEY(10) AND 223:IF X=0 THEN 1440
1450 IF X<>ASC("S") THEN 1500
1460 PRINT " ";
1470 FOR J=1 TO NY:PRINT J;"Y ";:NEXT:PRINT:PRINT
1480 FOR K=1 TO NH+1:PRINT K;"H ";
1490 FOR J=1 TO NY:PRINT FNV(W2(K,J));" ";:NEXT:PRINT:NEXT
1500 RETURN
1599 REM *** <SALVATAGGIO DATI> ***
1600 CLS:PRINT "Nome del file su cui salvare i dati"
1610 INPUT FL$:IF FL$="" THEN RETURN
1620 OPEN FL$,1,1:PRINT "Salvo dati primo livello..."
1630 BN=NX:GOSUB 6000:BN=NH:GOSUB 6000:BN=NY:GOSUB 6000
1640 FOR K=1 TO NH:FOR I=1 TO NX+1
1650 BN=W1(I,K):GOSUB 6000
1660 NEXT:NEXT:PRINT "Salvo dati secondo livello..."
1670 FOR J=1 TO NY:FOR K=1 TO NH+1
1680 BW=W2(K,J):GOSUB 6000
1690 NEXT:NEXT
1700 CLOSE 1:PRINT "Fatto":PAUSE 100
1710 RETURN
1799 REM *** <CARICAMENTO DATI> ***
1800 CLS:PRINT "Nome del file da cui caricare i dati"
1810 INPUT FL$:IF FL$="" THEN RETURN
1820 OPEN FL$,1,0:PRINT "Carico dati primo livello..."
1830 GOSUB 7000:NX=BN:GOSUB 7000:NH=BN:GOSUB 7000:NY=BN
1840 FOR K=1 TO NH:FOR I=1 TO NX+1
1850 GOSUB 7000:W1(I,K)=BN
1860 NEXT:NEXT:PRINT "Carico dati secondo livello..."
1870 FOR J=1 TO NY:FOR K=1 TO NH+1
1880 GOSUB 7000:W2(K,J)=BN
1890 NEXT:NEXT
1900 CLOSE 1:PRINT "Fatto":PAUSE 100
1910 RETURN
1999 REM *** <DEFINISCI LANCIO> ***
2000 CLS
2010 PRINT "Sposta il bersaglio con le frecce, poi":PRINT "premi INVIO"
2020 C=19:LOCATE C-1,23:PRINT BE$;:X=INKEY(10)
2030 X=INKEY(10):IF X=0 THEN 2030
2040 IF X=28 THEN IF C>2 THEN C=C-1:REM FRECCIA SX
2050 IF X=29 THEN IF C<37 THEN C=C+1:REM FRECCIA DX
2060 LOCATE 0,23:PRINT SPC(39);:LOCATE C-1,23:PRINT BE$;
2070 IF X=13 THEN 2090
2080 GOTO 2030
2090 XI(1)=C/40
2100 LOCATE 0,0:PRINT SPC(80);:LOCATE 0,0
2110 PRINT "Tempo di caduta (1 -";TM;")";:INPUT T$
2120 T=VAL(T$):IF T<1 OR T>TM THEN 2100
2130 LOCATE 0,0:PRINT SPC(39);:LOCATE 0,1:PRINT SPC(39);
2140 XI(2)=T/TM
2150 RETURN
2199 REM *** <ROUTINE PRINCIPALE> ***
2200 GOSUB 1100:PRINT
2210 PRINT:PRINT "<A>pprendi <E>segui <C>arica <S>alva"
2220 PRINT "<V>isualizza <M>odifica <F>ine":X=INKEY(10)
2230 X=INKEY(10) AND 223:IF X=0 THEN 2230
2240 IF X=ASC("A") THEN TT=1:GOSUB 800:GOTO 2310
2250 IF X=ASC("E") THEN 2260:ELSE 2270
2260 TT=0:GOSUB 2000:GOSUB 500
2265 VE=Y(1)*100:AN=Y(2)*(3.14/2):GOSUB 600:GOTO 2310
2270 IF X=ASC("C") THEN GOSUB 1800:GOTO 2310
2280 IF X=ASC("S") THEN GOSUB 1600:GOTO 2310
2290 IF X=ASC("V") THEN GOSUB 1300:GOTO 2310
2295 IF X=ASC("M") THEN GOSUB 1100:GOTO 2310
2300 IF X=ASC("F") THEN END
2310 GOTO 2210
2500 SCREEN 0
2510 PRINT:PRINT "    >>> R E T I   N E U R A L I <<<":PRINT
2520 PRINT:PRINT " attendi mentre configuro le matrici..."
2530 PRINT:PRINT:PRINT:RETURN
5999 REM *** <SALVA NUMERI NEL FILE> ***
6000 BN$=STR$(BN)
6010 FOR VB=1 TO LEN(BN$)
6020 PUT 1,ASC(MID$(BN$,VB,1))
6030 NEXT
6040 PUT 1,0:REM CARATTERE DI FINE STRINGA
6050 RETURN
6999 REM *** <CARICA NUMERI DAL FILE> ***
7000 BN$=""
7010 BN=GET(1):IF BN=0 THEN 7030
7020 BN$=BN$+CHR$(BN):GOTO 7010
7030 BN=VAL(BN$):RETURN