Neuronowa sieć BAM
Wstęp
Czym się różni sieć neuronowa od tablicy asocjacyjnej?
Jedno i drugie oszczędza miejsce w pamięci. Jednak sieć neuronowa nie wymaga zapisania w niej
wszystkich odpowiedzi (wartości w tablicy asocjacyjnej) na znane pytania (klucze tablicy
asocjacyjnej). To tak jakbyśmy podali tablicy asocjacyjnej fragment istniejącego klucza lub klucz
nieistniejący, a mimo to otrzymali logicznie uzasadnioną odpowiedź. Zwykle człowiek jest w stanie
zrozumieć tę logikę, ale należy analizować wszystkie wzorce pytań i odpowiedzi równocześnie, a także
wiedzieć jak uczy się i działa sieć danego typu. Kosztem takiej możliwości podania niepełnego lub
nieznanego klucza jest to, że czasami przy znanym kluczu sieć się myli, choć i te błędy daje się
uzasadnić. Liczba błędów jest różna dla różnych sieci i różnych zestawów par wejście-wyjście
(klucz-wartość).
Przykład 1
Opisuje sieć BAM zgodnie z opisem z książki Ryszarda Tadeusiewicza "Sieci neuronowe".
Zawiera również niezbędną teorię.
Maksymalne wyniki
Przy odpowiednim doborze ciągu uczącego (o czym dalej):
≈75% poprawnych odpowiedzi
Przy odpowiednim doborze ciągu uczącego i podwojeniu (czasem kilkakrotnym) liczby neuronów:
≈100% poprawnych odpowiedzi
Przykład 2
Znacznie uproszczona, szybka, pozwalająca zapisać znacznie więcej wzorców sieć,
stworzona przeze mnie na bazie przykładu 1.
Bardziej do praktycznych zastosowań w logice rozmytej (o czym dalej).
Maksymalne wyniki
≈100% poprawnych odpowiedzi przy liczbie wzorców równej kwadratowi ilczby neuronów
w przypadkach szczególnych
≈80% poprawnie odpowiadających neuronów, ale ≈0% całkowicie poprawnych odpowiedzi
Przykład 1
Podstawowe pojęcia
Wektor
Tablica jednowymiarowa np. array [1..N] of integer
Macierz
Tablica dwuwymiarowa np. array [1..M, 1..N] of integer
W moim programie M = N.
Ciąg uczący
Ciąg par (wartość wejściowa, poprawna wartość wyjściowa). Są to pary wektorów (X, Y), co zapisujemy:
(X1, Y1), (X2, Y2), (X3, Y3),…
Mówiąc najprościej, jest to zbiór poprawnych odpowiedzi Y na znane pytania X.
Neuron
Jeśli mówię o wektorach, wartościach X lub Y, jest to jednoznaczne ze wszystkimi neuronami warstwy
wejściowej lub wyjściowej. Neuron to pojedynczy element warstwy sieci, czyli i-ty element wektora np.
X[i1] = X[1], Y[i2] = Y[5].
Nie byłoby mowy o neuronie, gdyby jego wejścia nie były mnożone przez wagi
Y[i] = W[i, j] * X[j],
co stwarza podobieństwo do działania neuronu w mózgu człowieka. W tym miejscu dodatkowo należy
wspomnieć o wartości progowej (p) występującej także u człowieka, tj. takiej, przy której neuron
zadziała (pobudzi się). Można to zapisać:
y = 1 dla w1 * x1 + w2 * x2 + … ≥ p
y = 0 dla w1 * x1 + w2 * x2 + … <p
To tytułem uzupełnienia, bo w mojej sieci BAM nie korzystam z wartości progowych, jedynie z funkcji
signum (znak) dla zamiany np. -5 na -1.
Warstwa sieci
Zbiór neuronów, który opisujemy jednym wektorem.
Ogólnie sieć może mieć jedną warstwę wejściowo-wyjściową lub warstwę wejściową i warstwę wyjściową,
także warstwy wewnętrzne.
Wartości bipolarne
W omawianej sieci wartości X[i], Y[i] należą do zbioru [-1, 1] i są nazywane bipolarnymi. Jest to
też podobieństwo do neuronu człowieka, gdzie w grę wchodzą ładunki elektryczne (+) i (-).
Co to jest BAM?
BAM
Bidirectional Associative Memory – dwukierunkowa sieć skojarzeniowa.
Pomijam temat dwukierunkowości. Chodzi o to, że sieć BAM na X ze zbioru Y1, Y2, Y3,…
odpowie X1, X2, X3,…
Sieć BAM ma 2 warstwy, ale tak naprawdę są to dwa kroki obliczeniowe algorytmu.
BAM może mieć różne ilości neuronów wejściowych i wyjściowych.
Pojęcia minimalnie trudniejsze
Korelacja
Zależność między X i Y tu wyliczana w bardzo prosty sposób, a mianowicie
X[i] * Y[i], co przy wartościach [-1, 1] daje odpowiedź na pytanie, czy iloczyn zmienia znak dla
i-tego elementu wektora.
Macierz wag i uczenie sieci
Macierz wag jest sumą wszystkich korelacji miedzy X i Y pochodzących z ciągu uczącego.
Dla ścisłości podaję, że mnożymy X * T(Y), gdzie T oznacza transpozycję wektora.
Tworzenie macierzy wag nazywa się uczeniem sieci.
Energia sieci
Wyraża się wzorem:
E = -T(X) * W * Y,
gdzie T-transpozycja.
Gdybyśmy narysowali wykres energii w układzie współrzędnych (X, Y, E = f(X,Y)), to energia E byłaby
pofalowaną powierzchnią, w której występują pagórki i doliny o różnych wysokościach i głębokościach.
Głębokości tych dolin to lokalne minima energii sieci. Nauczona sieć BAM poszukując rozwiązania dla
określonego X trafia zawsze w jakieś minimum lokalne. Jednak nie zawsze jest to minimum lokalne
odpowiadające poprawnej odpowiedzi Y.
Warto wiedzieć
Zabezpieczenia
W ogólnym przypadku uczenia lub poszukiwania rozwiązania przez sieć neuronową mogą występować
oscylacje (powroty do tego samego punktu wspomnianej powierzchni) i niestabilności (dążenie do
nieskończonej energii). Dlatego warto się zabezpieczyć i określić maksymalną liczbę iteracji przy
szukaniu rozwiązania oraz wprowadzić ograniczenie zakresu energii, co uczyniłem.
Nawiasem mówiąc warto w ten sposób zabezpieczać wszystkie algorytmy optymalizacji poszukujące
minimum jakiejś funkcji.
Spotkałem się nawet z określeniem, że sieć neuronowa jest niczym innym, jak algorytmem
optymalizacji.
Algorytm i jego jakość
Jak to działa?
Sieć jest uczona ciągiem uczącym, w wyniku czego powstaje macierz wag.
Nauczona sieć BAM szukając rozwiązania powtarza dwa kroki:
(Krok 1) Y := F(W * X)
(Krok 2) X := F(W * Y), gdzie W to macierz wag.
Funkcja F po pierwsze zamienia i-ty iloczyn na znak i-tego iloczynu [-1, 0, 1].
Po drugie, jeżeli Y[i] = 0, pobiera poprzednią wartość Y[i] należącą do zbioru [-1, 1].
(Na początku poszukiwania rozwiązania ustawia się Y[i] = 1. Ta liczba nie ma znaczenia dla sieci
BAM, ważne, żeby była -1 lub 1 a nie 0)
W moim przykładzie po każdym kroku 1 sprawdzana jest wartość energii sieci i jeżeli energia nie
ulega zmianie na mniejszą, oznacza to, że w poprzednim kroku sieć znalazła minimum energetyczne i
rozwiązanie, choć wcale nie musi być ono idealnie poprawne.
Jakość znajdowanych rozwiązań
Jeśli chodzi o poprawność rozwiązań, to dla zupełnie losowych ciągów uczących, co masz możliwość
sprawdzić, jest ona mała – w moim przykładzie dla 4-ech różnych wzorców i 4-ech neuronów na
wejściu tylko 16 na 100 prób to całkowicie prawidłowe rozwiązania (całkowicie oznacza, że wszystkie
Y[i] odpowiadały Y[i] z ciągu uczącego dla danego X z ciągu uczącego). Częściowa zgodność to
statystycznie 60% wyjść.
Poprawienie jakości
Istnieją możliwości poprawienia jakości wyniku.
Umożliwiłem Ci robienie testów dla 1, 2, 3 i 4-elementowgo ciągu uczącego. Zmniejszenie liczby
wzorców spowoduje poprawę jakości odpowiedzi.
Możesz także posłużyć się symetrią w ciągu uczącym. Dla 4-ech wzorców jest to:
(X1, Y1 = X4), (X2, Y2 = X3), (X3, Y3 = X2), (X4, Y4 = X1).
Taka symetria (odbicia lustrzanego) dla 4-ech wzorców podnosi jakość względem jakości bez symetrii
z ok. 16% do ok. 75%. Dla trzech wzorców do ok. 88%, dla dwóch do 100%.
Należy zauważyć, że istotne są proporcję między ilością elementów X a ilością wzorców, żeby nie
myśleć: „co to za sieć, co tylko przy dwóch wzorcach się nie myli?” 2 wzorce to 50% z 4-ech
neuronów. Czyli można oszacować, że sieć potrzebuje 2 razy więcej neuronów wejścia, niż wzorców
(plus symetria) i będzie nieomylna.
Na potrzeby artykułu zastosowałem bardzo prostą symetrię, jednak wcześniej eksperymentowałem
z bardziej zawiłymi sposobami tworzenia symetrii. Ryszard Tadeusiewicz w swojej książce, z której
korzystałem, podaje przykład wręcz idealny, który daje 100% poprawnych odpowiedzi i maksymalnie
wykorzystuje sieć.
Co cechuje taki idealny dobór ciągu uczącego?
Ilość wzorców jest równa ilości neuronów i jest nieparzysta,
a gdyby umieścić wszystkie wzorce X w macierzy to poszczególne elementy macierzy byłyby
swoimi odbiciami lustrzanymi względem centralnego elementu i miałyby zmieniony przez to odbicie
znak. Natomiast środkowy wiersz i środkowa kolumna byłaby symetryczna np. (-1, 1, -1).
Macierz wzorców Y byłaby również tak skontruowanym odbiciem macierzy wzorców X.
Testowałem różne tego typu macierze dla znacznie większych niż 4 ilości wzorców i neuronów.
Rzeczywiście rezultaty są wtedy rewelacyjne. Jednak takich macierzy 3 x 3 można utworzyć
niewiele, a przyjąłem, że pokażę najwyżej 4 x 4, żeby można było przyjrzeć się logice odpowiedzi
sieci, co np. dla 1000 x 1000 byłoby niemożliwe.
Jeśli interesuje Cię bardzo wysoka jakość częściowo poprawnych odpowiedzi sieci
i bardzo duża ilość wzorców względem ilości neuronów przejdź do przykładu 2.
Skąd się biorą błędy?
Sieć ma swoją pojemność i jest w stanie zapamiętać tylko pewną ilość wzorców zależnie od ilości
neuronów. Istnieją różne oszacowania pojemności sieci BAM. Znalazłem takie, które mówią, że BAM
złożona z 1024 neuronów może zapamiętać 1024 wzorce, a inne oszacowanie mówi, że ta sama sieć tylko
25. Jak pokazują eksperymenty z symetrią, na pewno jakość odpowiedzi sieci jest zależna od specyfiki
ciągu uczącego.
Idealny wynik, a może wynik podobny?
Sieci BAM są w sumie wdzięcznym tematem, chętnie wykorzystywanym przez inżynierów. W porównaniu z
innymi sieciami znacznie szybciej się je uczy – w jednym kroku (jednorazowo wykonanej procedurze bez
jej powtarzania). Rozwiązania również odnajdują w jednym, kilku krokach. Nie wymagają
skomplikowanych wzorów. A przede wszystkim, jak we wszystkich sieciach asocjacyjnych
(skojarzeniowych), nawet jeśli na wejściu X pojawi się wektor nieznany, którego nie było w ciągu
uczącym, potrafią podać logicznie uzasadnioną odpowiedź. Jeśli się mylą, to w ich błędnych
odpowiedziach, można znaleźć podobieństwo do znanych wektorów Y, częściową zgodność lub symetrię
znaków.
Uruchomienie programu
Wystarczy utworzyć projekt z Form1, Unit1. Wkleić cały Unit1 i powiązać OnCreate formy z tym w
kodzie. Kontrolki zostaną automatycznie utworzone. Reszta to tylko klikanie.
Literatura
Ryszard Tadeusiewicz, „Sieci neuronowe”, Akademicka Oficyna Wydawnicza 1993, Rozdziały 8.3-8.7
Wykorzystałem algorytm mnożenia macierzy Aldonix’a z 4programmers.net.
Kod do przykładu 1
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, Grids;
(* Dla Delphi Tokyo 10.2
uses
System.SysUtils, System.Classes, Vcl.Forms, Vcl.Grids, Vcl.StdCtrls, Vcl.Buttons;
*)
const
LiczbaElemWektora = 4;
LiczbaWzorcowMax = 4;
type
TWektor = array [0..LiczbaElemWektora - 1] of integer;
TMacierz = array [0..LiczbaElemWektora - 1, 0..LiczbaElemWektora - 1] of integer;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
public
Grid: array [0..1, 0..1] of record
G: TStringGrid;
L: TLabel;
end;
Button: array [0..1, 0..2, 0..3] of TSpeedButton;
CheckBox: TCheckBox;
Edit: array [0..1] of record
E: TEdit;
L: TLabel;
end;
procedure GenerujWzorceiUcz(Sender: TObject);
procedure KopiujXiZnajdzRozw(Sender: TObject);
procedure LiczbaWzorcowClick(Sender: TObject);
procedure Testuj(aLiczbaTestow: integer; Symetria: boolean);
procedure TestLosowy(Sender: TObject);
procedure TestSymetryczny(Sender: TObject);
procedure Ucz;
procedure ZnajdzRozw(var NajlepszyY: TWektor);
function EnergiaSieci(var PozaZakresem: boolean): integer;
end;
var
Form1: TForm1;
WzorceX, WzorceY: array [0..LiczbaWzorcowMax - 1] of TWektor;
WektorX, WektorY: TWektor;
MacierzWag: TMacierz;
ProcentYi, ProcentY100: real;
LiczbaTestow: integer;
Korelacje: array [0..LiczbaWzorcowMax - 1] of TMacierz;
LiczbaWzorcow: integer = 4;
//Aldonix
procedure MnozenieMacierzy(var ParA, ParB, ParC: TMacierz;
LiczWierszyA, LiczKolumnA,
LiczWierszyB, LiczKolumnB: integer);
implementation
{$R *.dfm}
uses
Math;
function Znak(x: integer): integer;
begin
Result := Sign(x);
end;
function LosujBipolarnie: integer;
begin
Result := Random(2);
if Result = 0 then
Result := -1;
end;
procedure TForm1.Ucz;
var
i, j, k: integer;
begin
for j := 0 to LiczbaElemWektora - 1 do
for i := 0 to LiczbaElemWektora - 1 do
MacierzWag[i, j] := 0;
for k := 0 to LiczbaWzorcow - 1 do
for j := 0 to LiczbaElemWektora - 1 do
for i := 0 to LiczbaElemWektora - 1 do
Korelacje[k, i, j] := WzorceX[k, i] * WzorceY[k, j];
for k := 0 to LiczbaWzorcow - 1 do
for j := 0 to LiczbaElemWektora - 1 do
for i := 0 to LiczbaElemWektora - 1 do
MacierzWag[i, j] := MacierzWag[i, j] + Korelacje[k, i, j];
end;
function TForm1.EnergiaSieci(var PozaZakresem: boolean): integer;
var
i: integer;
WektorYJakoMacierz: TMacierz;
WektorXTranspJakoMacierz: TMacierz;
Pomocn, Energia: TMacierz;
begin
for i := 0 to LiczbaElemWektora - 1 do
begin
WektorYJakoMacierz[i, 0] := WektorY[i];
WektorXTranspJakoMacierz[0, i] := WektorX[i];
end;
MnozenieMacierzy(WektorXTranspJakoMacierz, MacierzWag, Pomocn,
1, LiczbaElemWektora,
LiczbaElemWektora, LiczbaElemWektora);
MnozenieMacierzy(Pomocn, WektorYJakoMacierz, Energia,
1, LiczbaElemWektora,
LiczbaElemWektora, 1);
Result := -Energia[0, 0];
if Result < -(MaxInt div 2) then
PozaZakresem := true;
end;
procedure TForm1.ZnajdzRozw(var NajlepszyY: TWektor);
var
i, Iteracja: integer;
NastEnergia: integer;
PoprzEnergia: integer;
PozaZakresem: boolean;
WektorXJakoMacierz: TMacierz;
WektorYJakoMacierz: TMacierz;
PoprzWektorY: TWektor;
begin
PozaZakresem := false;
for i := 0 to LiczbaElemWektora - 1 do
PoprzWektorY[i] := 1;
Iteracja := 0;
PoprzEnergia := MaxInt;
repeat
Inc(Iteracja);
for i := 0 to LiczbaElemWektora - 1 do
begin
WektorXJakoMacierz[i, 0] := WektorX[i];
WektorYJakoMacierz[i, 0] := WektorY[i];
end;
MnozenieMacierzy(MacierzWag, WektorXJakoMacierz, WektorYJakoMacierz,
LiczbaElemWektora, LiczbaElemWektora,
LiczbaElemWektora, 1);
for i := 0 to LiczbaElemWektora - 1 do
begin
WektorX[i] := WektorXJakoMacierz[i, 0];
WektorY[i] := WektorYJakoMacierz[i, 0];
end;
for i := 0 to LiczbaElemWektora - 1 do
WektorY[i] := Znak(WektorY[i]);
for i := 0 to LiczbaElemWektora - 1 do
if WektorY[i] = 0 then
WektorY[i] := PoprzWektorY[i];
for i := 0 to LiczbaElemWektora - 1 do
PoprzWektorY[i] := WektorY[i];
if Iteracja = 1 then
begin
for i := 0 to LiczbaElemWektora - 1 do
NajlepszyY[i] := WektorY[i];
PoprzEnergia := EnergiaSieci(PozaZakresem);
if PozaZakresem then
Break
end
else
begin
NastEnergia := EnergiaSieci(PozaZakresem);
if (NastEnergia >= PoprzEnergia) or PozaZakresem then
Break
else
if NastEnergia < PoprzEnergia then
begin
for i := 0 to LiczbaElemWektora - 1 do
NajlepszyY[i] := WektorY[i];
PoprzEnergia := NastEnergia;
end;
end;
for i := 0 to LiczbaElemWektora - 1 do
begin
WektorXJakoMacierz[i, 0] := WektorX[i];
WektorYJakoMacierz[i, 0] := WektorY[i];
end;
MnozenieMacierzy(MacierzWag, WektorXJakoMacierz, WektorYJakoMacierz,
LiczbaElemWektora, LiczbaElemWektora,
LiczbaElemWektora, 1);
for i := 0 to LiczbaElemWektora - 1 do
begin
WektorX[i] := WektorXJakoMacierz[i, 0];
WektorY[i] := WektorYJakoMacierz[i, 0];
end;
for i := 0 to LiczbaElemWektora - 1 do
WektorX[i] := Znak(WektorX[i]);
until Iteracja = 1000;
end;
procedure TForm1.GenerujWzorceiUcz(Sender: TObject);
var
i, j: integer;
slX, slY: TStringList;
s: string;
begin
slX := TStringList.Create;
slY := TStringList.Create;
i := 0;
repeat
s := '';
for j := 0 to LiczbaElemWektora - 1 do
begin
WzorceX[i, j] := LosujBipolarnie;
s := s + IntToStr(WzorceX[i, j]);
end;
if slX.IndexOf(s) < 0 then
begin
slX.Add(s);
Inc(i);
end;
until slX.Count = LiczbaWzorcow;
if not CheckBox.Checked then
begin
i := 0;
repeat
s := '';
for j := 0 to LiczbaElemWektora - 1 do
begin
WzorceY[i, j] := LosujBipolarnie;
s := s + IntToStr(WzorceY[i, j]);
end;
if slY.IndexOf(s) < 0 then
begin
slY.Add(s);
Inc(i);
end;
until slY.Count = LiczbaWzorcow;
end
else
if CheckBox.Checked then
for i := 1 to LiczbaWzorcow do
for j := 1 to LiczbaElemWektora do
WzorceY[i - 1, j - 1] := WzorceX[LiczbaWzorcow - i, j - 1];
slX.Free;
slY.Free;
Ucz;
for j := 0 to LiczbaWzorcow - 1 do
for i := 0 to LiczbaElemWektora - 1 do
Grid[0, 0].G.Cells[j + 1, i + 1] := IntToStr(WzorceX[j, i]);
for j := 0 to LiczbaWzorcow - 1 do
for i := 0 to LiczbaElemWektora - 1 do
Grid[0, 1].G.Cells[j + 1, i + 1] := IntToStr(WzorceY[j, i]);
end;
procedure TForm1.KopiujXiZnajdzRozw(Sender: TObject);
var
i, j, k: integer;
WynikY: TWektor;
Procent100: boolean;
begin
if Sender <> nil then
begin
LiczbaTestow := 0;
ProcentYi := 0;
ProcentY100 := 0;
end;
for j := 0 to LiczbaWzorcow - 1 do
begin
for i := 0 to LiczbaElemWektora - 1 do
begin
Grid[1, 0].G.Cells[j + 1, i + 1] := IntToStr(WzorceX[j, i]);
WektorX[i] := WzorceX[j, i];
end;
ZnajdzRozw(WynikY);
Inc(LiczbaTestow);
Procent100 := true;
for k := 0 to LiczbaElemWektora - 1 do
begin
if WynikY[k] = WzorceY[j, k] then
ProcentYi := ProcentYi + 1
else
Procent100 := false;
end;
if Procent100 then
ProcentY100 := ProcentY100 + 1;
for i := 0 to LiczbaElemWektora - 1 do
Grid[1, 1].G.Cells[j + 1, i + 1] := IntToStr(WynikY[i]);
end;
if Sender <> nil then
begin
Edit[0].E.Text := IntToStr(Round(100 * ProcentYi/ (LiczbaTestow * LiczbaElemWektora))) + '%';
Edit[1].E.Text := IntToStr(Round(100 * ProcentY100 / LiczbaTestow)) + '%';
end;
end;
procedure TForm1.Testuj(aLiczbaTestow: integer; Symetria: boolean);
var
i: integer;
begin
LiczbaTestow := 0;
ProcentYi := 0;
ProcentY100 := 0;
CheckBox.Checked := Symetria;
for i := 1 to aLiczbaTestow do
begin
GenerujWzorceiUcz(nil);
KopiujXiZnajdzRozw(nil);
end;
Edit[0].E.Text := IntToStr(Round(100 * ProcentYi/ (LiczbaTestow * LiczbaElemWektora))) + '%';
Edit[1].E.Text := IntToStr(Round(100 * ProcentY100 / LiczbaTestow)) + '%';
end;
procedure TForm1.TestLosowy(Sender: TObject);
begin
Testuj(1000, false);
end;
procedure TForm1.TestSymetryczny(Sender: TObject);
begin
Testuj(1000, true);
end;
procedure TForm1.LiczbaWzorcowClick(Sender: TObject);
var
x, y: integer;
begin
if (Sender as TSpeedButton).Down then
LiczbaWzorcow := (Sender as TSpeedButton).Tag;
for x := 0 to 1 do
for y := 0 to 1 do
Grid[x, y].G.ColCount := LiczbaWzorcow + 1;
GenerujWzorceiUcz(nil);
end;
procedure MnozenieMacierzy(var ParA, ParB, ParC: TMacierz;
LiczWierszyA, LiczKolumnA,
LiczWierszyB, LiczKolumnB: integer);
//Aldonix
var
A, B, C: array of array of integer;
i, j, k, l: integer;
Suma : integer;
begin
SetLength(A, LiczWierszyA);
for i:= Low(A) to High(A) do
SetLength(A[i], LiczKolumnA);
SetLength(B, LiczWierszyB);
for i:= Low(B) to High(B) do
SetLength(B[i],LiczKolumnB);
SetLength(C,LiczWierszyA);
for i:= Low(C) to High(C) do
SetLength(C[i],LiczKolumnB);
for i := Low(A) to High(A) do
for j := Low(A[0]) to High(A[0]) do
A[i, j] := ParA[i, j];
for i := Low(B) to High(B) do
for j := Low(B[0]) to High(B[0]) do
B[i, j] := ParB[i, j];
if LiczKolumnA = LiczWierszyB then
begin
l:=0;
for i := Low(A) to High(A) do
begin
while l <= High(B[0]) do
begin
Suma := 0;
k := 0;
for j:=Low(A[0]) to High(A[0]) do
begin
Suma := Suma + A[i, j] * B[k, l];
Inc(k);
end;
C[i, l] := Suma;
Inc(l);
end;
l := 0;
end;
end;
for i := Low(C) to High(C) do
for j := Low(C[0]) to High(C[0]) do
ParC[i, j] := C[i, j];
end;
procedure TForm1.FormCreate(Sender: TObject);
var
x, y, i: integer;
begin
Randomize;
for x := 0 to 1 do
begin
for y := 0 to 1 do
begin
Grid[x, y].G := TStringGrid.Create(Self);
Grid[x, y].G.ColCount := 5;
Grid[x, y].G.RowCount := 5;
Grid[x, y].G.Width := 5 * (Grid[x, y].G.DefaultColWidth + 2);
Grid[x, y].G.Left := 8 + (8 + Grid[x, y].G.Width) * x;
Grid[x, y].G.Height := 5 * (Grid[x, y].G.DefaultRowHeight + 2);
Grid[x, y].G.Top := 27 + (27 + Grid[x, y].G.Height) * y;
InsertControl(Grid[x, y].G);
for i := 1 to LiczbaWzorcow do
case y of
0: Grid[x, y].G.Cells[i, 0] := 'X' + IntToStr(i);
1: Grid[x, y].G.Cells[i, 0] := 'Y' + IntToStr(i);
end;
Grid[x, y].L := TLabel.Create(Self);
Grid[x, y].L.Left := Grid[x, y].G.Left;
Grid[x, y].L.Top := Grid[x, y].G.Top - 19;
case x of
0: case y of
0: Grid[x, y].L.Caption := 'Ciąg uczący X (wejścia)';
1: Grid[x, y].L.Caption := 'Ciąg uczący Y (wyjścia)';
end;
1: case y of
0: Grid[x, y].L.Caption := 'Wektory testowe X (wejścia)';
1: Grid[x, y].L.Caption := 'Odpowiedzi sieci Y (wyjścia)';
end;
end;
InsertControl(Grid[x, y].L);
end;
for y := 0 to 2 do
if not ((y > 0) and (x = 1)) then
begin
Button[x, y, 0] := TSpeedButton.Create(Self);
Button[x, y, 0].Left := Grid[x, 0].G.Left;
Button[x, y, 0].Width := Grid[x, 0].G.Width;
Button[x, y, 0].Top := 339 + 31 * y;
case x of
0: case y of
0: Button[x, y, 0].Caption := 'Generuj ciąg uczący i naucz sieć';
1: Button[x, y, 0].Caption := 'Testuj 1000 ciągów uczących ' +
'(losowych)';
2: Button[x, y, 0].Caption := 'Testuj 1000 ciągów uczących ' +
'(symetria)';
end;
1: case y of
0: Button[x, y, 0].Caption := 'Kopiuj X z ciągu uczącego ' +
'i znajdź odpowiedzi';
end;
end;
case x of
0: case y of
0: Button[x, y, 0].OnClick := GenerujWzorceiUcz;
1: Button[x, y, 0].OnClick := TestLosowy;
2: Button[x, y, 0].OnClick := TestSymetryczny;
end;
1: case y of
0: Button[x, y, 0].OnClick := KopiujXiZnajdzRozw;
end;
end;
InsertControl(Button[x, y, 0]);
end;
end;
for x := 0 to 3 do
begin
Button[1, 1, x] := TSpeedButton.Create(Self);
Button[1, 1, x].Top := 339 + 31 * 1;
Button[1, 1, x].Width := Grid[1, 0].G.Width div 4;
Button[1, 1, x].Left := Grid[1, 0].G.Left + Button[1, 1, x].Width * x;
Button[1, 1, x].GroupIndex := 1;
if x = 3 then
Button[1, 1, x].Down := true;
if x = 0 then
Button[1, 1, x].Caption := IntToStr(x + 1) + ' wzorzec X'
else
Button[1, 1, x].Caption := IntToStr(x + 1) + ' wzorce X';
Button[1, 1, x].Tag := x + 1;
Button[1, 1, x].OnClick := LiczbaWzorcowClick;
InsertControl(Button[1, 1, x]);
end;
for y := 0 to 1 do
begin
Edit[y].E := TEdit.Create(Self);
Edit[y].E.Left := 8;
Edit[y].E.Top := 451 + 46 * y;
InsertControl(Edit[y].E);
Edit[y].L := TLabel.Create(Self);
Edit[y].L.Left := 8;
Edit[y].L.Top := 432 + 46 * y;
case y of
0: Edit[y].L.Caption := 'Częściowo poprawne odpowiedzi sieci';
1: Edit[y].L.Caption := 'Całkowicie poprawne odpowiedzi sieci';
end;
InsertControl(Edit[y].L);
end;
CheckBox := TCheckBox.Create(Self);
CheckBox.Left := Grid[0, 0].G.Left;
CheckBox.Top := 316;
CheckBox.Width := Grid[0, 0].G.Width;
CheckBox.Caption := 'Symetria';
InsertControl(CheckBox);
Position := poScreenCenter;
Width := 730;
Height := 670;
GenerujWzorceiUcz(nil);
end;
end.
Przykład 2
Zmiany względem przykładu 1
Generalnie
Wprowadzone zmiany zmniejszają złożoność obliczeniową
oraz zwiększają pojemność sieci.
Rezygnacja z poszukiwania minimalnej energii
Zrezygnowałem z poszukiwania minimalnej energii,
Bo taka sieć zwykle i tak znajduje minimum lokalne w pierwszym kroku. Moim celem w pierwszym przykładzie było
pokazanie, poszukiwania minimum energetycznego.
Dzięki tej rezygnacji jest tylko jeden krok obliczeniowy.
Zezwolenie na pojawianie się zer w wektorze Y
Zrezygnowałem z ustawiania wartości początkowej Y[i] = 1
i sprawdzania, czy Y[i] = 0.
Kosztem tego w Y mogą pojawić się zera. Należy je traktować jako niepewność sieci
lub jednakowe prawdopodobieństwo 50%, że Y[i] = -1 lub Y[i] = 1.
Obliczając procent częściowo poprawnych odpowiedzi odrzucam te wyniki.
Ich odsetek jest znikomy, chociaż są przypadki, w których są same zera.
Wektory jako macierze
Przekształcanie wektorów na macierze i w drugą stronę zabiera czas.
Zastosowałem więc macierze, w których istotny wektor jest w pierwszej kolumnie.
Użycie typu shortint
Ponieważ X[i] = [-1, 1], a Y[i] = [-1, 0, 1], wystarczającym typem danych jest shortint,
co pozwala na konstruowanie macierzy o znacznie większej ilości elementów.
Uproszczenie algorytmu mnożenia macierzy
Zrezygnowałem z każdorazowej alokacji pamięci SetLength, bo macierze są już zaalokowane
i gotowe do obliczeń.
Opis sieci
Założenia
Ze względu na zastosowany algorytm tworzenia ciągu uczącego,
Jest wymagane, aby liczba neuronów była wielokrotnością 4.
Pojemność sieci
Pojemność sieci wzrosła i jest kwadratem liczby neuronów.
Nadal symetria
Przykład 2 jest poświęcony tylko symetrii ciągu uczącego, jaką stosowałem w przykładzie 1,
czyli odbiciu lustrzanemu WzorzecX[i] = WzorzecY[LiczbaWzorcow – i].
Korzystne rozwiązanie
WzorceX są kolejnymi liczbami 0, 1, 2,… przedstawionymi w postaci binarnej, w której 0 zamienia się na -1.
Logika rozmyta
W tej sieci z wyjątkiem przypadków szczególnych istotne jest częściowo poprawne
rozwiązanie. Jeżeli 80% neuronów odpowiada poprawnie, nie należy tego marnować.
Pojawia się odpowiedź Y, która w 80% jest prawidłowym WzorcemY, a 20% czymś innym.
Taka sytuacja ma miejsce w logice rozmytej, w której np. o kolorze fioletowym powiemy, że jest w 50% kolorem czerwonym, w
50% kolorem niebieskim i w 0% kolorem zielonym, co możemy zapisać:
RGB(128, 0, 128)
Przypadki szczególne
W moim programie pokazałem, że pewne wielokrotności liczby 4 (wielokrotności liczby neuronów) dają 100% poprawności
odpowiedzi sieci skonstruowanej jw.
Ale nie jest to reguła dla wszystkich sieci tak skonstruowanych i niektóre będę dawały same zera w Y. Jednak przy
parametrach, które są w programie takie przypadki szczególne istnieją.
Pokazałem też, że ilości wzorców różne od ww. wielokrotności dają gorsze rezultaty, ale wystarczająco dobre w logice
rozmytej.
Perspektywy
Przypadki szczególne stwarzają możliwość łączenia pojedynczych sieci w układy sieci złożone z tych pojedynczych.
Pozostają nadal asocjacyjne, ponieważ wszystkie wzorce są powiązane macierzą wag.
Byli inni przede mną
Prace nad sieciami neuronowymi trwają od wielu lat. Przykład 2, to zaledwie początki ich rozwoju. Bibliografia jest
ogromna, chociaż w większości bardzo trudna. Mam nadzieję, że przybliżyłem Ci temat na możliwie najprostszych
przykładach.
Uruchomienie programu
Wystarczy utworzyć projekt z Form1, Unit1. Wkleić cały Unit1 i powiązać OnCreate formy z tym w
kodzie. Kontrolki zostaną automatycznie utworzone. Reszta to tylko klikanie.
Kod do przykładu 2
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, Grids;
const
LiczbaElemWektora = 8;
LiczbaWzorcowMax = LiczbaElemWektora * LiczbaElemWektora;
PaintGrid = true;
type
TWektor = array [0..LiczbaElemWektora - 1] of shortint;
TMacierz = array [0..LiczbaElemWektora - 1, 0..LiczbaElemWektora - 1] of integer;
TMacierzBipolar = array [0..LiczbaElemWektora - 1, 0..LiczbaElemWektora - 1] of shortint;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
public
Grid: array [0..1, 0..1] of record
G: TStringGrid;
L: TLabel;
end;
Button: array [0..2, 0..3] of TSpeedButton;
Edit: array [0..2] of record
E: TEdit;
L: TLabel;
end;
procedure GenerujWzorceiUcz(Sender: TObject);
procedure KopiujXiZnajdzRozw(Sender: TObject);
procedure LiczbaWzorcowClick(Sender: TObject);
procedure TestKolejnychBin(Sender: TObject);
procedure Ucz;
procedure ZnajdzRozw(var NajlepszyY: TWektor);
end;
var
Form1: TForm1;
WzorceX, WzorceY: array [0..LiczbaWzorcowMax - 1] of TWektor;
WektorX, WektorY: TWektor;
MacierzWag: TMacierz;
ProcentYi, ProcentY100: real;
Procent0: real;
LiczbaTestow: integer;
Korelacje: array [0..LiczbaWzorcowMax - 1] of TMacierzBipolar;
LiczbaWzorcow: integer = LiczbaWzorcowMax;
WektorXJakoMacierz: TMacierzBipolar;
WektorYJakoMacierz: TMacierzBipolar;
//Aldonix
procedure MnozenieMacierzy(var ParA: TMacierz; var ParB, ParC: TMacierzBipolar;
LiczWierszyA, LiczKolumnA,
LiczWierszyB, LiczKolumnB: integer);
implementation
{$R *.dfm}
uses
Math;
function Znak(x: integer): integer;
begin
Result := Sign(x);
end;
procedure TForm1.Ucz;
var
i, j, k: integer;
begin
for j := 0 to LiczbaElemWektora - 1 do
for i := 0 to LiczbaElemWektora - 1 do
MacierzWag[i, j] := 0;
for k := 0 to LiczbaWzorcow - 1 do
for j := 0 to LiczbaElemWektora - 1 do
for i := 0 to LiczbaElemWektora - 1 do
Korelacje[k, i, j] := WzorceX[k, i] * WzorceY[k, j];
for k := 0 to LiczbaWzorcow - 1 do
for j := 0 to LiczbaElemWektora - 1 do
for i := 0 to LiczbaElemWektora - 1 do
MacierzWag[i, j] := MacierzWag[i, j] + Korelacje[k, i, j];
end;
procedure TForm1.ZnajdzRozw(var NajlepszyY: TWektor);
var
i: integer;
begin
for i := 0 to LiczbaElemWektora - 1 do
WektorXJakoMacierz[i, 0] := WektorX[i];
MnozenieMacierzy(MacierzWag, WektorXJakoMacierz, WektorYJakoMacierz,
LiczbaElemWektora, LiczbaElemWektora,
LiczbaElemWektora, 1);
for i := 0 to LiczbaElemWektora - 1 do
WektorYJakoMacierz[i, 0] := Znak(WektorYJakoMacierz[i, 0]);
for i := 0 to LiczbaElemWektora - 1 do
NajlepszyY[i] := WektorYJakoMacierz[i, 0];
end;
procedure TForm1.GenerujWzorceiUcz(Sender: TObject);
var
sBin: string;
Bipolar: TWektor;
procedure IntToBipolar(Int: integer);
var
i, j: integer;
sHex: string;
c: char;
begin
sHex := IntToHex(Int, 4);
sBin := '';
for j := 1 to Length(sHex) do
case LowerCase(sHex[j])[1] of
'0': sBin := sBin + '0000';
'1': sBin := sBin + '0001';
'2': sBin := sBin + '0010';
'3': sBin := sBin + '0011';
'4': sBin := sBin + '0100';
'5': sBin := sBin + '0101';
'6': sBin := sBin + '0110';
'7': sBin := sBin + '0111';
'8': sBin := sBin + '1000';
'9': sBin := sBin + '1001';
'a': sBin := sBin + '1010';
'b': sBin := sBin + '1011';
'c': sBin := sBin + '1100';
'd': sBin := sBin + '1101';
'e': sBin := sBin + '1110';
'f': sBin := sBin + '1111';
end;
j := 0;
for i := 0 to LiczbaElemWektora - 1 do
begin
c := sBin[Length(sBin) - j];
case c of
'0': Bipolar[i] := -1;
'1': Bipolar[i] := +1;
end;
Inc(j);
end;
end;
var
i, j, x: integer;
begin
for i := 0 to LiczbaWzorcowMax - 1 do
for j := 0 to LiczbaElemWektora - 1 do
begin
WzorceX[i, j] := 0;
WzorceY[LiczbaWzorcow - i - 1, j] := 0;
end;
for x := 0 to LiczbaWzorcow - 1 do
begin
IntToBipolar(x);
for j := 0 to LiczbaElemWektora - 1 do
begin
WzorceX[x, j] := Bipolar[j];
WzorceY[LiczbaWzorcow - x - 1, j] := Bipolar[j];
end;
end;
Ucz;
if PaintGrid then
begin
for j := 0 to LiczbaWzorcow - 1 do
for i := 0 to LiczbaElemWektora - 1 do
Grid[0, 0].G.Cells[j + 1, i + 1] := IntToStr(WzorceX[j, i]);
for j := 0 to LiczbaWzorcow - 1 do
for i := 0 to LiczbaElemWektora - 1 do
Grid[0, 1].G.Cells[j + 1, i + 1] := IntToStr(WzorceY[j, i]);
end;
end;
procedure TForm1.KopiujXiZnajdzRozw(Sender: TObject);
var
i, j, k: integer;
WynikY: TWektor;
Procent100: boolean;
begin
for j := 0 to LiczbaWzorcow - 1 do
begin
for i := 0 to LiczbaElemWektora - 1 do
begin
if PaintGrid then
Grid[1, 0].G.Cells[j + 1, i + 1] := IntToStr(WzorceX[j, i]);
WektorX[i] := WzorceX[j, i];
end;
ZnajdzRozw(WynikY);
Inc(LiczbaTestow);
Procent100 := true;
for k := 0 to LiczbaElemWektora - 1 do
begin
if WynikY[k] = WzorceY[j, k] then
ProcentYi := ProcentYi + 1
else
if WynikY[k] = 0 then
begin
Procent0 := Procent0 + 1;
Procent100 := false;
end
else
Procent100 := false;
end;
if Procent100 then
ProcentY100 := ProcentY100 + 1;
if PaintGrid then
for i := 0 to LiczbaElemWektora - 1 do
Grid[1, 1].G.Cells[j + 1, i + 1] := IntToStr(WynikY[i]);
end;
end;
procedure TForm1.TestKolejnychBin(Sender: TObject);
begin
LiczbaTestow := 0;
ProcentYi := 0;
ProcentY100 := 0;
Procent0 := 0;
GenerujWzorceiUcz(nil);
KopiujXiZnajdzRozw(nil);
Edit[0].E.Text := IntToStr(Round(100 * ProcentYi/ (LiczbaTestow * LiczbaElemWektora))) + '%';
Edit[1].E.Text := IntToStr(Round(100 * ProcentY100 / LiczbaTestow)) + '%';
Edit[2].E.Text := IntToStr(Round(100 * Procent0 / (LiczbaTestow * LiczbaElemWektora))) + '%';
end;
procedure TForm1.LiczbaWzorcowClick(Sender: TObject);
var
x, y, i: integer;
begin
if (Sender as TSpeedButton).Down then
LiczbaWzorcow := (Sender as TSpeedButton).Tag;
for x := 0 to 1 do
for y := 0 to 1 do
begin
Grid[x, y].G.ColCount := LiczbaWzorcow + 1;
for i := 1 to LiczbaWzorcowMax do
case y of
0: Grid[x, y].G.Cells[i, 0] := 'X' + IntToStr(i);
1: Grid[x, y].G.Cells[i, 0] := 'Y' + IntToStr(i);
end;
for i := 1 to LiczbaElemWektora do
case y of
0: Grid[x, y].G.Cells[0, i] := IntToStr(i);
1: Grid[x, y].G.Cells[0, i] := IntToStr(i);
end;
end;
end;
procedure MnozenieMacierzy(var ParA: TMacierz; var ParB, ParC: TMacierzBipolar;
LiczWierszyA, LiczKolumnA,
LiczWierszyB, LiczKolumnB: integer);
//Aldonix
var
i, j, k, l: integer;
Suma : integer;
begin
if LiczKolumnA = LiczWierszyB then
begin
l:=0;
for i := Low(ParA) to High(ParA) do
begin
while l <= High(ParB[0]) do
begin
Suma := 0;
k := 0;
for j:=Low(ParA[0]) to High(ParA[0]) do
begin
Suma := Suma + ParA[i, j] * ParB[k, l];
Inc(k);
end;
ParC[i, l] := Suma;
Inc(l);
end;
l := 0;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
x, y, j: integer;
begin
for x := 0 to 1 do
for y := 0 to 1 do
begin
Grid[x, y].G := TStringGrid.Create(Self);
Grid[x, y].G.ColCount := LiczbaWzorcowMax + 1;
Grid[x, y].G.RowCount := LiczbaElemWektora + 1;
Grid[x, y].G.Width := 5 * (Grid[x, y].G.DefaultColWidth + 2);
Grid[x, y].G.Left := 8 + (8 + Grid[x, y].G.Width) * x;
Grid[x, y].G.Height := 5 * (Grid[x, y].G.DefaultRowHeight + 2) + 16;
Grid[x, y].G.Top := 27 + (27 + Grid[x, y].G.Height) * y;
Grid[x, y].G.ScrollBars := ssBoth;
InsertControl(Grid[x, y].G);
Grid[x, y].L := TLabel.Create(Self);
Grid[x, y].L.Left := Grid[x, y].G.Left;
Grid[x, y].L.Top := Grid[x, y].G.Top - 19;
case x of
0: case y of
0: Grid[x, y].L.Caption := 'Ciąg uczący X (wejścia)';
1: Grid[x, y].L.Caption := 'Ciąg uczący Y (wyjścia)';
end;
1: case y of
0: Grid[x, y].L.Caption := 'Wektory testowe X (wejścia)';
1: Grid[x, y].L.Caption := 'Odpowiedzi sieci Y (wyjścia)';
end;
end;
InsertControl(Grid[x, y].L);
end;
Button[0, 0] := TSpeedButton.Create(Self);
Button[0, 0].Left := Grid[0, 0].G.Left;
Button[0, 0].Width := Grid[0, 0].G.Width;
Button[0, 0].Top := 371;
Button[0, 0].Caption := 'Testuj ciąg uczący (ciąg binarny + symetria)';
Button[0, 0].OnClick := TestKolejnychBin;
InsertControl(Button[0, 0]);
j := 1;
for x := 0 to 3 do
begin
Button[1, x] := TSpeedButton.Create(Self);
Button[1, x].Top := 371;
Button[1, x].Width := Grid[1, 0].G.Width div 4;
Button[1, x].Left := Grid[1, 0].G.Left + Button[1, x].Width * x;
Button[1, x].GroupIndex := 1;
Button[1, x].Caption := IntToStr(LiczbaWzorcowMax div j) + ' wz X';
Button[1, x].Tag := LiczbaWzorcowMax div j;
if x = 0 then
Button[1, x].Down := true;
Button[1, x].OnClick := LiczbaWzorcowClick;
InsertControl(Button[1, x]);
j := j * 2;
end;
j := 1;
for x := 0 to 3 do
begin
Button[2, x] := TSpeedButton.Create(Self);
Button[2, x].Top := 402;
Button[2, x].Width := Grid[1, 0].G.Width div 4;
Button[2, x].Left := Grid[1, 0].G.Left + Button[1, x].Width * x;
Button[2, x].GroupIndex := 1;
Button[2, x].Caption := IntToStr(LiczbaWzorcowMax - j) + ' wz X';
Button[2, x].Tag := LiczbaWzorcowMax - j;
Button[2, x].OnClick := LiczbaWzorcowClick;
InsertControl(Button[2, x]);
j := j + 1;
end;
for y := 0 to 2 do
begin
Edit[y].E := TEdit.Create(Self);
Edit[y].E.Width := 100;
Edit[y].E.Left := 8;
Edit[y].E.Top := 451 + 46 * y;
InsertControl(Edit[y].E);
Edit[y].L := TLabel.Create(Self);
Edit[y].L.Left := 8;
Edit[y].L.Top := 432 + 46 * y;
case y of
0: Edit[y].L.Caption := 'Poprawne odpowiedzi pojedynczych neuronów';
1: Edit[y].L.Caption := 'Całkowicie poprawne odpowiedzi sieci';
2: Edit[y].L.Caption := 'Zera w odpowiedziach';
end;
InsertControl(Edit[y].L);
end;
Position := poScreenCenter;
Width := 730;
Height := 670;
LiczbaWzorcowClick(Button[1, 0]);
end;
end.
Poprawiłem błąd w sposobie obliczania średniej jakości odpowiedzi sieci.
Dodałem informacje na temat idealnie przygotowanych ciągów uczących dających jakość 100%
Dodałem drugi przykład o mniejszej złożoności obliczeniowej i większej pojemności sieci