通用图像识别的神经网络代码描述

王朝delphi·作者佚名 2006-01-09

宽屏版字体: 小|中|大|超大

写人脸检测程序的时候顺带写的，网络格式是靠读入一个文件定义的，文件的格式如下：

输入图像长输入图像宽隐层神经元个数输出神经元个数

不同网络结构数量

[连接位置不同的隐层神经元的个数连接的隐层神经元个数]

[隐层神经元连接的输入神经元的位置表]

下面是一个例子：

24 28 52 1

16 32

1 1 1 1 1 1 2 2 2 2 2 2 3 3 3 3 3 3 4 4 4 4 4 4

5 5 5 5 5 5 6 6 6 6 6 6 7 7 7 7 7 7 8 8 8 8 8 8

9 9 9 9 9 9 10 10 10 10 10 10 11 11 11 11 11 11 12 12 12 12 12 12

13 13 13 13 13 13 14 14 14 14 14 14 15 15 15 15 15 15 16 16 16 16 16 16

4 8

1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2

3 3 3 3 3 3 3 3 3 3 3 3 4 4 4 4 4 4 4 4 4 4 4 4

6 12

1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1

2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2

3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3

4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4

5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5

6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6

下面是程序代码：

type

TSingleExtendedArray = array of extended;

TDoubleExtendedArray = array of array of extended;

TSamples = packed record

Ins: TSingleExtendedArray;

Outs: TSingleExtendedArray;

end;

type

TGraphicBpnn = class

private

procedure BackPropagate(t: TSingleExtendedArray; n, m: extended);

function UpDate(inputs: TSingleExtendedArray): extended;

public

samplecounts, TestCounts: longint;

procedure AddToTrain(Ins, Outs: TSingleExtendedArray);

procedure AddToTest(Ins, Outs: TSingleExtendedArray);

procedure SaveToFile(FileName: string);

procedure LoadFromFile(FileName: string);

procedure Train(n, m: extended);

function Init(FileName: string): boolean;

function Predict(Ins: TSingleExtendedArray): extended;

function Test: extended;

destructor Destroy; override;

private

nI, nH, nO: longint;

aI, aH, aO, Output_Deltas, Hidden_Deltas: TSingleExtendedArray;

wI, wO, cI, cO: TDoubleExtendedArray;

Connections: array of array of boolean;

Samples: array of TSamples;

TestSet: array of TSamples;

end;

implementation

function TGraphicBpnn.Init(FileName: string): boolean;

var

i, j, k, fi, fj: longint;

nIw, nIh, RopMax, RopNum, RopTypes: longint;

RopMap: array of longint;

begin

AssignFile(Input, FileName);

ReSet(Input);

Readln(Input, nIw, nIh, nH, nO);

nI := nIw * nIh;

setlength(aI, nI);

setlength(aH, nH);

setlength(aO, nO);

for i := 0 to nI - 1 do aI[i] := 1;

for i := 0 to nH - 1 do aH[i] := 1;

for i := 0 to nO - 1 do aO[i] := 1;

setlength(wI, nI, nH);

setlength(wO, nH, nO);

setlength(cI, nI, nH);

setlength(cO, nH, nO);

setlength(Connections, nI, nH);

for i := 0 to nI - 1 do

for j := 0 to nH - 1 do

Connections[i, j] := False;

Readln(RopTypes); fj := 0;

for k := 1 to RopTypes do begin

Readln(RopMax, RopNum);

setlength(RopMap, nI);

fi := 0;

for i := 1 to nIh do begin

for j := 1 to nIw do begin

Read(RopMap[fi]);

Inc(fi);

end;

Readln;

end;

fi := 0;

for i := 1 to RopNum do begin

Inc(fi);

if fi > RopMax then fi := 1;

for j := 0 to nI - 1 do

if RopMap[j] = fi then Connections[j, fj] := true;

Inc(fj);

end;

setlength(Output_Deltas, nO);

setlength(Hidden_Deltas, nH);

randomize;

for i := 0 to nI - 1 do

for j := 0 to nH - 1 do begin

cI[i, j] := 0;

wI[i, j] := random(40000) / 10000 - 2;

end;

for i := 0 to nH - 1 do

for j := 0 to nO - 1 do begin

cO[i, j] := 0;

wO[i, j] := random(40000) / 10000 - 2;

end;

setlength(Samples, $100); setlength(TestSet, $100);

samplecounts := 0; TestCounts := 0;

CloseFile(Input);

end;

procedure TGraphicBpnn.BackPropagate(t: TSingleExtendedArray; n, m: extended);

var

i, j, k: Longint;

Sum, Change: extended;

begin

for i := 0 to nO - 1 do

Output_Deltas[i] := aO[i] * (1 - aO[i]) * (t[i] - aO[i]);

for j := 0 to nH - 1 do begin

Sum := 0;

for k := 0 to nO - 1 do

Sum := Sum + Output_Deltas[k] * wO[j, k];

Hidden_Deltas[j] := aH[j] * (1 - aH[j]) * Sum;

end;

for j := 0 to nH - 1 do

for k := 0 to nO - 1 do begin

Change := Output_Deltas[k] * aH[j];

wO[j, k] := wO[j, k] + n * Change + m * cO[j, k];

cO[j, k] := Change;

end;

for i := 0 to nI - 1 do

for j := 0 to nH - 1 do

if Connections[i, j] then begin

Change := Hidden_Deltas[j] * aI[i];

wI[i, j] := wI[i, j] + n * Change + m * cI[i, j];

cI[i, j] := Change;

end;

function TGraphicBpnn.UpDate(inputs: TSingleExtendedArray): extended;

var

i, j, k: Longint;

Sum: extended;

begin

for i := 0 to nI - 1 do

aI[i] := Inputs[i];

for j := 0 to nH - 1 do begin

Sum := 0;

for i := 0 to nI - 1 do

if Connections[i, j] then

Sum := Sum + aI[i] * wI[i, j];

aH[j] := 1 / (1 + Exp(-Sum));

end;

for k := 0 to nO - 1 do begin

Sum := 0;

for j := 0 to nH - 1 do

Sum := Sum + aH[j] * wO[j, k];

aO[k] := 1 / (1 + Exp(-Sum));

end;

UpDate := aO[0];

end;

procedure TGraphicBpnn.Train(n, m: extended);

var i: Longint;

begin

for i := 0 to samplecounts - 1 do begin

UpDate(Samples[i].Ins);

BackPropagate(Samples[i].Outs, n, m);

end;

procedure TGraphicBpnn.AddToTrain(Ins, Outs: TSingleExtendedArray);

var i: longint;

begin

if samplecounts > High(Samples) then setlength(Samples, samplecounts + $100);

setlength(Samples[samplecounts].Ins, nI);

setlength(Samples[samplecounts].Outs, nO);

for i := 0 to nI - 1 do Samples[samplecounts].Ins[i] := Ins[i];

for i := 0 to nO - 1 do Samples[samplecounts].Outs[i] := Outs[i];

Inc(samplecounts);

end;

procedure TGraphicBpnn.AddToTest(Ins, Outs: TSingleExtendedArray);

var i: longint;

begin

if TestCounts > High(TestSet) then setlength(TestSet, TestCounts + $100);

setlength(TestSet[TestCounts].Ins, nI);

setlength(TestSet[TestCounts].Outs, nO);

for i := 0 to nI - 1 do TestSet[TestCounts].Ins[i] := Ins[i];

for i := 0 to nO - 1 do TestSet[TestCounts].Outs[i] := Outs[i];

Inc(TestCounts);

end;

procedure TGraphicBpnn.SaveToFile(FileName: string);

var

i, j, k: longint;

SaveStream: TMemoryStream;

begin

SaveStream := TMemoryStream.Create;

SaveStream.Seek(0, 0);

for i := 0 to nI - 1 do

for j := 0 to nH - 1 do begin

SaveStream.Write(wI[i, j], sizeof(wI[i, j]));

SaveStream.Write(cI[i, j], sizeof(cI[i, j]));

end;

for j := 0 to nH - 1 do

for k := 0 to nO - 1 do begin

SaveStream.Write(wO[j, k], sizeof(wO[j, k]));

SaveStream.Write(cO[j, k], sizeof(cO[j, k]));

end;

SaveStream.SaveToFile(FileName);

SaveStream.Free;

end;

procedure TGraphicBpnn.LoadFromFile(FileName: string);

var

i, j, k: longint;

ReadStream: TMemoryStream;

begin

ReadStream := TMemoryStream.Create;

ReadStream.LoadFromFile(FileName);

ReadStream.Seek(0, 0);

for i := 0 to nI - 1 do

for j := 0 to nH - 1 do begin

ReadStream.Read(wI[i, j], sizeof(wI[i, j]));

ReadStream.Read(cI[i, j], sizeof(cI[i, j]));

end;

for j := 0 to nH - 1 do

for k := 0 to nO - 1 do begin

ReadStream.Read(wO[j, k], sizeof(wO[j, k]));

ReadStream.Read(cO[j, k], sizeof(cO[j, k]));

end;

ReadStream.Free;

end;

function TGraphicBpnn.Predict(Ins: TSingleExtendedArray): extended;

begin

try

Predict := Update(Ins);

except

Predict := 0;

end;

function TGraphicBpnn.Test: extended;

var

PreRet: extended;

i, Counts, Ret: longint;

begin

Counts := 0;

for i := 0 to TestCounts - 1 do begin

PreRet := Predict(TestSet[i].Ins);

if PreRet > 0.5 then Ret := 1 else Ret := 0;

if Ret = TestSet[i].Outs[0] then Inc(Counts);

end;

Result := Counts / TestCounts;

end;

destructor TGraphicBpnn.Destroy;

begin

setlength(aI, 0);

setlength(aH, 0);

setlength(aO, 0);

setlength(Output_Deltas, 0);

setlength(Hidden_Deltas, 0);

setlength(wI, 0, 0);

setlength(wO, 0, 0);

setlength(cI, 0, 0);

setlength(cO, 0, 0);

setlength(Connections, 0, 0);

setlength(Samples, 0);

inherited;

end;