Witam
Napisalem / zaadoptowalem do delphi siec hopfielda (uczenie neuronu, rozpoznawanie znaku z obrazka 8 x 8 px 2 kolory) wszystko dziala ok tylko w jednym wypadku gdy jako wektor wejsciowy ustawiam znak ( znak x jest zbudowany w bitmapie 8x8 pixli dwa kolory
czarny i bialy) a wektor testujacy daje jeden pixel z znaku x (kolor czarny) a drugi pixel ze znaku bialego nie nalezacego do znaku x to jako wektor wyjsciowy wyswietla mi albo ten sam znak x albo negatyw a powinno wyswietlac wektor pusty (biala plansza 8 x 8 pixli).
Ponizej zamieszczam glowny kod programu jesli ktos umialby mi wskazac gdzie jest blad bylbym wdzieczny
unit procedury;
interface
uses classes, graphics,
main;
const x_max = 8;
y_max = 8;
const n_max = x_max * y_max; // pixeli
type Tn_out = 0..1; // wyjscie
Tab_wzor = array[1..n_max] of Tn_out;
P_wzor = ^Tab_wzor;
Tab_wzorow = Tlist;
Tab_wag = array[1..n_max, 1..n_max] of shortint;
var wzory: Tab_wzorow;
waga: Tab_wag;
procedure ustaw_wagi( var w: Tab_wag; ps: Tab_wzorow; n_max: longint );
procedure rozpoznaj_wzor( var p: Tab_wzor; const w: Tab_wag; n_max: longint; count: Int64 );
function bitmapa_do_wzoru( const pic: TCanvas; n_max: longint ): Tab_wzor;
procedure wzor_do_bitmapy( const p: Tab_wzor; n_max: longint; c: TCanvas );
implementation
// ---------------------
procedure ustaw_wagi( var w: Tab_wag; ps: Tab_wzorow; n_max: longint );
var a, b, c, i: longint;
p: P_wzor;
begin
for a := 1 to n_max do begin
// mainform.gauge.Progress := round( a / n_max * 100 );
for b := (a + 1) to n_max do begin
// if a=b then w[a][b]:=0;
for c := 1 to ps.count do begin
p := ps.items[c-1];
i:= i + (2 * p^[a] - 1)*(2 * p^[b] - 1);
end;
w[a, b] := i;
w[b, a] := i;
end;
w[a, a] := 0;
end;
end;
// ---------------------
procedure rozpoznaj_wzor( var p: Tab_wzor; const w: Tab_wag; n_max: longint; count: Int64 );
var a, b: longint;
n, pot: longint;
x1 : Tab_wzorow;
function activation( pt: longint; x: Tn_out ): Tn_out;
begin
if( pt > 0 ) then result := 1
else if( pt = 0 ) then result :=x // powinno przypisac wartosc wektora testujacego
else result := 0;
end;
begin
randomize;
for a := 1 to count do begin
mainform.gauge.Progress := round( a / count * 100 );
n := random( n_max ) + 1; // wylosowany neuron
pot := 0; // potencjal membranowy p-tego neuronu
for b := 1 to n_max do pot := pot + w[n, b] * p[b];
p[n] := activation( pot, p[n] );
end;
end;
// -=-=-=-=-=-=-=-=-=-=-
function bitmapa_do_wzoru( const pic: TCanvas; n_max: longint ): Tab_wzor;
var a, b: longint;
q: Tn_out;
begin
for a := 0 to (x_max - 1) do
for b := 0 to (y_max - 1) do begin
q := 1;
if( pic.pixels[a, b] = clWhite ) then q := 0;
result[a + b*x_max + 1] := q;
end;
end;
// ---------------------
procedure wzor_do_bitmapy( const p: Tab_wzor; n_max: longint; c: TCanvas );
var a, b: longint;
kolor: TColor;
begin
for a := 0 to (x_max - 1) do
for b := 0 to (y_max - 1) do begin
if( p[a + b*x_max + 1] = 1 ) then kolor := clBlack else kolor := clWhite;
c.pixels[a, b] := kolor;
end;
end;
initialization
randomize;
wzory := Tab_wzorow.create;
finalization
wzory.Free;
end.
Pozdrawiam