[delphi] siec hopfielda pomoc przy usunieciu bledu

0

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

0

Zacząłem analizę od procedury ustaw_wagi i szczerze powiem nie podoba mi się to bo nie widzę gdzie ustawiasz wartość i a właśnie ją używasz do wyznaczania wag (nigdzie nie widzę i:= ... a widzę w[a, b] := i; co na 100% jest dużym błędem).

0

moj blad zjadlo mi i podczas wklejania

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;

...tak ma byc ale i tak nie chce dzialac w 100% poprawnie.... MarekR22 jesli moglbys / mial chęc pomocy podesla bym Ci caly kod programu (dzialajacy program) i moze bys znalazl gdzie tkwi blad.....

0

...ale w czym tkwi blad ?? wyswietla zle wketor wyjsciowy wtedy kiedy jako testowy dasz wektor skladajacy sie z jednego czarnego i jednego bialego ?? wklej plik main

Pozdrawiam tomek_k

0

tomek_k dokladnie taki jest problem

plik main

unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Buttons, ExtDlgs, Spin, Gauges;

type
  Tmainform = class(TForm)
    Panel1: TPanel;
    wektor_wejsciowy: TImage;
    Bevel1: TBevel;
    Panel4: TPanel;
    wektor_testujacy: TImage;
    Panel5: TPanel;
    wektor_wyjsciowy: TImage;
    wczytaj_wektor_testujacy: TSpeedButton;
    OpenDialog: TOpenPictureDialog;
    wylicz_wagi: TSpeedButton;
    wektor_rozpoznany: TSpeedButton;
    gauge: TGauge;
    wczytaj_wektor_wejsciowy: TSpeedButton;
    Image1: TImage;
    procedure wczytaj_wektor_testujacyClick(Sender: TObject);
    procedure wylicz_wagiClick(Sender: TObject);
    procedure wektor_rozpoznanyClick(Sender: TObject);
    procedure wczytaj_wektor_wejsciowyClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  mainform: Tmainform;

implementation

{$R *.DFM}

uses procedury;



procedure Tmainform.wczytaj_wektor_testujacyClick(Sender: TObject);
begin
if OpenDialog.Execute then begin
  wektor_testujacy.Picture.LoadFromFile( OpenDialog.FileName );
  wektor_rozpoznany.Enabled := true;
  end;
end;


procedure Tmainform.wylicz_wagiClick(Sender: TObject);
var p: P_wzor;
begin
new( p );
p^ := bitmapa_do_wzoru(wektor_wejsciowy.Picture.Bitmap.Canvas, n_max );
wzory.add( p );

ustaw_wagi( waga, wzory, n_max );

wczytaj_wektor_testujacy.Enabled := true;
end;

procedure Tmainform.wektor_rozpoznanyClick(Sender: TObject);
var p: Tab_wzor;
begin
p := bitmapa_do_wzoru( wektor_testujacy.Picture.Bitmap.Canvas, n_max );
rozpoznaj_wzor( p, waga, n_max, 4096 );

with wektor_wyjsciowy.Picture.Bitmap do begin
  Width  := x_max;
  Height := y_max;
  end;
wzor_do_bitmapy( p, n_max, wektor_wyjsciowy.Picture.Bitmap.Canvas );

end;

procedure Tmainform.wczytaj_wektor_wejsciowyClick(Sender: TObject);
begin
if OpenDialog.Execute then begin
  wektor_wejsciowy.Picture.LoadFromFile( OpenDialog.FileName );
  wektor_rozpoznany.Enabled := true;
  end;
end;

end.

1 użytkowników online, w tym zalogowanych: 0, gości: 1