Rakitskij Sergey AS-15

1. My Hopfield neural network can store & recognize 7 images. Images resolution are 10x10 pixels. The maximal noise is 34%.

1. 2. 3.

4. 5. 6.

Train with 3 patterns: Training completed successfully. Noise=34%

Iteration	Pattern1	Pattern2	Pattern3
1

2

Train with 3 patterns. Noise=40%

Iteration	Pattern1	Pattern2	Pattern3
1

2

Train with 7 patterns. Noise=0%

Iteration	Pattern1	Pattern2	Pattern3	Pattern4	Pattern5	Pattern6	Pattern7
1

2
Result	success	success	success	success	success	success	success

Train with 7 patterns. Noise=8%

Iteration	Pattern1	Pattern2	Pattern3	Pattern4	Pattern5	Pattern6	Pattern7
1

2
Result	successful	successful	successful	successful	successful	successful	successful

Train with 7 patterns. Noise=22%

Iteration	Pattern1	Pattern2	Pattern3	Pattern4	Pattern5	Pattern6	Pattern7
1

2

3
Result	successful	successful	successful	unsuccessful	successful	successful	successful

Train with 7 patterns. Noise=34%

Iteration	Pattern1	Pattern2	Pattern3	Pattern4	Pattern5	Pattern6	Pattern7
1

2
Result	successful	successful	unsuccessful	unsuccessful	unsuccessful	successful	successful

Train with 8 patterns. Noise=22%, where pattern 8:

Iteration	Pattern1	Pattern2	Pattern3	Pattern4	Pattern5	Pattern6	Pattern7	Pattern8
1

2

3

4
Result	successful	successful	successful	unsuccessful	unsuccessful	successful	successful	unsuccessful

Program:

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, ExtCtrls, Spin;

type

private

{ Private declarations }

public

{ Public declarations }

end;

const N=10;

type TPattern=array [1..N,1..N] of byte;

var

CurPattern:byte=1;

PatternCount:byte=1;

Patterns:array [1..15] of TPattern;

InPattern:TPattern;

W:array[1..N*N,1..N*N] of real;

var

Form1: TForm1;

function Sign(x:real):real;

Procedure showInPattern;

implementation

uses Unit2;

function Sign(x:real):real;

begin

if x>0

then

Sign:=1

else

Sign:=-1;

end;

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);

begin

form2.show;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

ReadPatterns;

SpinEdit3.MaxValue:=PatternCount;

SpinEdit1.MaxValue:=SpinEdit3.value;

InPattern:=Patterns[1];

showinPattern;

end;

Procedure showInPattern;

var

i,j:Integer;

begin

with Form1.Image1.Canvas do

begin

brush.Color:=clWhite;

FillRect(rect(0,0,20*N,20*N));

for i:=1 to N do

for j:=1 to N do

begin

if InPattern[i,j]=1

then

brush.Color:=clBlack

else

brush.Color:=clWhite;

FillRect(rect((j-1)*20,(i-1)*20,j*20,i*20));

end;

end;//whith

end;//Procedure

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

var

i,j:byte;

begin

j:=(X div 20)+1;

i:=(Y div 20)+1;

if InPattern[i,j]=1

then

InPattern[i,j]:=0

else

InPattern[i,j]:=1;

showinPattern;

end;

procedure TForm1.SpinEdit3Change(Sender: TObject);

begin

SpinEdit1.MaxValue:=SpinEdit3.value;

end;

procedure TForm1.SpinEdit1Change(Sender: TObject);

begin

InPattern:=Patterns[SpinEdit1.Value];

showInPattern;

end;

procedure TForm1.Button2Click(Sender: TObject);

var

i,j:byte;

begin

Randomize;

for i:=1 to N do

for j:=1 to N do

if Random(101)<SpinEdit2.Value

then

if InPattern[i,j]=1

then

InPattern[i,j]:=0

else

InPattern[i,j]:=1;

showInPattern;

end;

procedure TForm1.Button3Click(Sender: TObject);

var

i,j,p:Integer;

begin

for i:=1 to sqr(N) do

for j:=1 to sqr(N) do

begin

W[i,j]:=0;

for p:=1 to form1.spinEdit3.value do

W[i,j]:=W[i,j]+(sign(Patterns[p][((i-1) div N)+1,((i-1) mod N)+1]-0.5)*sign(Patterns[p][((j-1) div N)+1,((j-1) mod N)+1]-0.5));

{ if i=j

then

W[i,j]:=0; }

end;

procedure TForm1.Button4Click(Sender: TObject);

var

i,j:Integer;

s:real;

begin

for i:=1 to sqr(N) do

begin

S:=0;

for j:=1 to sqr(N) do

S:=S+(W[i,j]*sign(InPattern[((j-1) div N)+1,((j-1) mod N)+1]-0.5));

InPattern[((i-1) div N)+1,((i-1) mod N)+1]:=round((Sign(S)+1)/2);

end;

showInPattern;

end;

end.

unit Unit2;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, ExtCtrls;

type

TForm2 = class(TForm)

Image1: TImage;

Button1: TButton;

Button2: TButton;

Button3: TButton;

Button4: TButton;

Button5: TButton;

procedure Button4Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure Button5Click(Sender: TObject);

procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure Button2Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

Procedure showCurrentPattern;

Procedure SavePatterns;

Procedure ReadPatterns;

var

Form2: TForm2;

implementation

uses unit1;

{$R *.DFM}

procedure TForm2.Button4Click(Sender: TObject);

begin

inc(PatternCount);

CurPattern:=PatternCount;

showCurrentPattern;

end;

procedure TForm2.Button3Click(Sender: TObject);

begin

if CurPattern>1

then

dec(CurPattern);

showCurrentPattern;

end;

Procedure showCurrentPattern;

var

i,j:byte;

begin

Form2.Caption:='pattern '+inttostr(CurPattern)+'/'+inttostr(PatternCount);

with Form2.Image1.{Picture.Bitmap.}Canvas do

begin

brush.Color:=clWhite;

FillRect(rect(0,0,20*N,20*N));

for i:=1 to N do

for j:=1 to N do

begin

if Patterns[CurPattern][i,j]=1

then

brush.Color:=clBlack

else

brush.Color:=clWhite;

FillRect(rect((j-1)*20,(i-1)*20,j*20,i*20));

end;

end;//whith

end;//Procedure

procedure TForm2.Button5Click(Sender: TObject);

begin

if CurPattern<PatternCount

then

inc(CurPattern);

showCurrentPattern;

end;

procedure TForm2.Image1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

var

i,j:byte;

begin

j:=(X div 20)+1;

i:=(Y div 20)+1;

if Patterns[CurPattern][i,j]=1

then

Patterns[CurPattern][i,j]:=0

else

Patterns[CurPattern][i,j]:=1;

showCurrentPattern;

end;

procedure TForm2.Button2Click(Sender: TObject);

begin

SavePatterns;

end;

procedure TForm2.Button1Click(Sender: TObject);

begin

ReadPatterns;

end;

Procedure SavePatterns;

var

FP:file of TPattern;

i:byte;

begin

assignfile(FP,'Patterns.dat');

Rewrite(FP);

for i:=1 to PatternCount do

write(FP,Patterns[i]);

closefile(FP);

end;//Procedure

Procedure ReadPatterns;

var

FP:file of TPattern;

i:byte;

begin

assignfile(FP,'Patterns.dat');

Reset(FP);

PatternCount:=filesize(FP);

for i:=1 to PatternCount do

read(FP,Patterns[i]);

closefile(FP);

CurPattern:=1;

end;//Procedure

end.