BP神经网络演示类-Delphi版 - 旷野轻尘一个人

unitUBP;

{代码-智能办公http://iofai.com}

interface

usesMath,SysUtils;

type

ObjNeurons =object

_U:Single;

_B:Single;

_PB:Single;

_Type:Byte;

_Offset:Single;//at

_SumOffset:Single;//sum at

_OldSumOffset:Single;//old

function_V():Single;

end;

RNeuronsOfLevel =record

_NeruronsCount:Integer;

_NeruronsArray:arrayofObjNeurons;//OBJ ARRAY

end;

RSynaptic =record//突触

_Weight:Single;

_PW:Single;

_Offset:Single;

_SumOffset:Single;

_OldSumOffset:Single;

end;

RMatrix =record

Matrix:arrayofarrayofRSynaptic;

end;

RSample =record

X:arrayofSingle;

Y:arrayofSingle;

end;

ObjNeuronsNet =class

constructorcreate(); overload;

constructorCreate(constLevelArray:arrayofInteger); overload;

destructorDestroy(); override;

public

_SampleCount:Integer;

_SampleArray:arrayofRSample;

_MaxStudyCount:Integer;//最大学习次数

_MaxError:Single;

_UpN:Single;//N上升

_DownN:Single;//N下降

_MaxN:Single;//最大N

procedureMemSample();//分配

procedureStudy();//day day Study haha

private

_StudyCount:Integer;

_LevelCount:Integer;//Level Count I to Calc

_WeightMatrix:arrayofRMatrix;//Synaptic Matrix

_NeruronsLevelArray:arrayofRNeuronsOfLevel;// Nerurons Of level

_ExportArray:arrayofSingle;

procedureFreeNet();//Free

procedureChangle();//权值

//-----

//-----

procedureInitNet(constLevelArray:arrayofInteger);//init BP Net,get Array of Level

procedureInitWeightMatrix();//init Matrix of Weight is random

procedureCalcExport();//Calc to

procedureCalcExportReturn();//return

procedureCalcOffset(constLevelID:Integer;constNeuronsID:Integer);//Neurons Offset

procedureSaveOffset();//save

procedureAddOffset();//Sum Offset

functionGetError():Single;

end;

implementation

usesUMain;

{ ObjNeurons }

functionObjNeurons._V:Single;

begin

case_Typeof

0:begin

Result := _U;

end;

1:begin

Result :=1/ (1+ Exp(-(_U - _B)));

end;

end;

end;

{ ObjNeuronsNet }

procedureObjNeuronsNet.AddOffset;

vari, j, k:Integer;

Count:Integer;

ACount:Integer;

begin

fori :=0to_LevelCount -1do

begin

count := _NeruronsLevelArray[i]._NeruronsCount;

Acount := _NeruronsLevelArray[i +1]._NeruronsCount;

forj :=0toCount -1do

begin

_NeruronsLevelArray[i]._NeruronsArray[j]._SumOffset := _NeruronsLevelArray[i]._NeruronsArray[j]._SumOffset + _NeruronsLevelArray[i]._NeruronsArray[j]._Offset;

ifi < (_LevelCount -1)then

begin

fork :=0toACount -1do

begin

_WeightMatrix[i].Matrix[J, K]._SumOffset := _WeightMatrix[i].Matrix[J, K]._SumOffset + _WeightMatrix[i].Matrix[J, K]._Offset;

end;

end;

end;

end;

end;

procedureObjNeuronsNet.CalcExport;

vari, j, k:Integer;

FCount:Integer;

Sum:Single;

begin

fori :=1to_LevelCount -1do

begin

FCount := _NeruronsLevelArray[i -1]._NeruronsCount;

forj :=0to_NeruronsLevelArray[i]._NeruronsCount -1do

begin

Sum :=0;

forK :=0toFCount -1do

begin

Sum := Sum + _WeightMatrix[i -1].Matrix[K, J]._Weight * _NeruronsLevelArray[i -1]._NeruronsArray[k]._V;

end;

_NeruronsLevelArray[i]._NeruronsArray[j]._U := Sum;

end;

end;

end;

procedureObjNeuronsNet.CalcExportReturn;

vari, j, k:Integer;

Count:Integer;

Acount:Integer;

begin

fori := _LevelCount -1downto1do

begin

count := _NeruronsLevelArray[i]._NeruronsCount;

forj :=0toCount -1do

begin

CalcOffset(i, j);

end;

end;

fori :=0to_LevelCount -2do

begin

count := _NeruronsLevelArray[i]._NeruronsCount;

Acount := _NeruronsLevelArray[i +1]._NeruronsCount;

forj :=0toCount -1do

begin

fork :=0toAcount -1do

begin

_WeightMatrix[i].Matrix[j, k]._Offset := Self._NeruronsLevelArray[i]._NeruronsArray[j]._V * Self._NeruronsLevelArray[i +1]._NeruronsArray[K]._Offset;

end;

end;

end;

end;

procedureObjNeuronsNet.CalcOffset(constLevelID, NeuronsID:Integer);

vari:Integer;

YExport, DExport:Single;

Sum:Single;

ACount:Integer;

begin

Sum :=0;

{本段已经加入一个负号}

YExport := _NeruronsLevelArray[LevelID]._NeruronsArray[NeuronsID]._V;

ifLevelID = (_LevelCount -1)then

begin

DExport := _ExportArray[NeuronsID];

_NeruronsLevelArray[LevelID]._NeruronsArray[NeuronsID]._Offset := -YExport * (1- YExport) * (DExport - YExport);

end

elsebegin

ACount := _NeruronsLevelArray[LevelID +1]._NeruronsCount;

fori :=0toACount -1do

begin

Sum := Sum + _NeruronsLevelArray[LevelID +1]._NeruronsArray[i]._Offset * _WeightMatrix[LevelID].Matrix[NeuronsID, i]._Weight;

end;

_NeruronsLevelArray[LevelID]._NeruronsArray[NeuronsID]._Offset := -YExport * (1- YExport) * Sum;

end;

end;

constructorObjNeuronsNet.create;

begin

end;

procedureObjNeuronsNet.Changle;

vari, j, k:Integer;

FCount:Integer;

ACount:Integer;

PB:Single;

oldPb:Single;

PW:Single;

OldPw:Single;

T:Single;

B:Single;

W:Single;

begin

fori :=0to_LevelCount -1do

begin

FCount := _NeruronsLevelArray[i]._NeruronsCount;

forj :=0toFCount -1do

begin

PB := _NeruronsLevelArray[i]._NeruronsArray[j]._SumOffset;

oldPb := _NeruronsLevelArray[i]._NeruronsArray[j]._OldSumOffset;

T := PB * OLDPB;

ifT >0then

begin

_NeruronsLevelArray[i]._NeruronsArray[j]._PB := _UpN * _NeruronsLevelArray[i]._NeruronsArray[j]._PB;

endelseif(T <0)then

begin

_NeruronsLevelArray[i]._NeruronsArray[j]._PB := _DownN * _NeruronsLevelArray[i]._NeruronsArray[j]._PB;

end;

if_NeruronsLevelArray[i]._NeruronsArray[j]._PB>_MaxNthen_NeruronsLevelArray[i]._NeruronsArray[j]._PB:=_MaxN;

ifPB >0then

begin

B := -_NeruronsLevelArray[i]._NeruronsArray[j]._PB;

endelseif(PB <0)then

begin

B := _NeruronsLevelArray[i]._NeruronsArray[j]._PB;

endelsebegin

B :=0;

end;

_NeruronsLevelArray[i]._NeruronsArray[j]._B := _NeruronsLevelArray[i]._NeruronsArray[j]._B + B;

//--------------------------------

ifI < (_LevelCount -1)then

begin

ACount := _NeruronsLevelArray[i +1]._NeruronsCount;

forK :=0toACount -1do

begin

PW := _WeightMatrix[i].Matrix[j, k]._SumOffset;

OldPw := _WeightMatrix[i].Matrix[j, k]._OldSumOffset;

T := PW * OldPw;

ifT >0then

begin

_WeightMatrix[i].Matrix[j, k]._PW := _UpN * _WeightMatrix[i].Matrix[j, k]._PW;

endelseif(T <0)then

begin

_WeightMatrix[i].Matrix[j, k]._PW := _DownN * _WeightMatrix[i].Matrix[j, k]._PW;

end;

if_WeightMatrix[i].Matrix[j, k]._PW >_MaxNthen_WeightMatrix[i].Matrix[j, k]._PW:=_Maxn;

ifPW >0then

begin

W := -_WeightMatrix[i].Matrix[j, k]._PW;

endelseif(PW <0)then

begin

W := _WeightMatrix[i].Matrix[j, k]._PW;

endelsebegin

W :=0;

end;

_WeightMatrix[i].Matrix[j, k]._Weight := _WeightMatrix[i].Matrix[j, k]._Weight + w;

end;

end;

end;

end;

end;

constructorObjNeuronsNet.create(constLevelArray:arrayofInteger);

begin

InitNet(LevelArray);

end;

destructorObjNeuronsNet.Destroy;

begin

FreeNet;//hoho

inherited;

end;

procedureObjNeuronsNet.FreeNet;

begin

Self._WeightMatrix :=nil;

Self._NeruronsLevelArray :=nil;

Self._SampleArray :=nil;

end;

procedureObjNeuronsNet.InitNet(constLevelArray:arrayofInteger);

vari, j:Integer;

begin

_LevelCount := High(LevelArray) +1;

SetLength(_NeruronsLevelArray, _LevelCount);// Mem of Nerurons to Level

SetLength(_WeightMatrix, _LevelCount -1);//mem

SetLength(_ExportArray, LevelArray[_LevelCount -1]);

Randomize;

fori :=0to_LevelCount -1do

begin

_NeruronsLevelArray[i]._NeruronsCount := LevelArray[i];

SetLength(_NeruronsLevelArray[i]._NeruronsArray, _NeruronsLevelArray[i]._NeruronsCount);//Mem

ifi < (_LevelCount -1)then

begin

SetLength(_WeightMatrix[i].Matrix, LevelArray[i], LevelArray[i +1]);//Hoho

end;

forj :=0to_NeruronsLevelArray[i]._NeruronsCount -1do

begin

ifi =0then

begin

_NeruronsLevelArray[i]._NeruronsArray[j]._Type :=0;

endelsebegin

_NeruronsLevelArray[i]._NeruronsArray[j]._Type :=1;

end;

_NeruronsLevelArray[i]._NeruronsArray[j]._PB :=0.1;

_NeruronsLevelArray[i]._NeruronsArray[j]._B := Random *2-1;//+/-1

end;

end;

//Init Neurons

InitWeightMatrix;

_StudyCount :=0;

end;

procedureObjNeuronsNet.InitWeightMatrix;//init Matrix Random

vari, j, k:Integer;

FCount:Integer;

ACount:Integer;

F:Single;

begin

Randomize;

fori :=0to_LevelCount -2do

begin

Fcount := _NeruronsLevelArray[i]._NeruronsCount;

ACount := _NeruronsLevelArray[i +1]._NeruronsCount;

forj :=0toFcount -1do

begin

forK :=0toACount -1do

begin

_WeightMatrix[i].Matrix[j, k]._Weight :=2* Random * F - F;

_WeightMatrix[i].Matrix[j, k]._Offset :=0;

_WeightMatrix[i].Matrix[j, k]._SumOffset :=0;

_WeightMatrix[i].Matrix[j, k]._OldSumOffset :=0;

_WeightMatrix[i].Matrix[j, k]._PW :=0.1;

end;

end;

end;

end;

procedureObjNeuronsNet.MemSample;

vari:Integer;

begin

SetLength(_SampleArray, _SampleCount);

fori :=0to_SampleCount -1do

begin

SetLength(_SampleArray[i].X, _NeruronsLevelArray[0]._NeruronsCount);

SetLength(_SampleArray[i].Y, _NeruronsLevelArray[_LevelCount -1]._NeruronsCount);

end;

end;

procedureObjNeuronsNet.SaveOffset;

vari, j, k:Integer;

FCount:Integer;

ACount:Integer;

begin

fori :=0to_LevelCount -1do

begin

Fcount := _NeruronsLevelArray[i]._NeruronsCount;

forj :=0toFcount -1do

begin

_NeruronsLevelArray[i]._NeruronsArray[j]._OldSumOffset := _NeruronsLevelArray[i]._NeruronsArray[j]._SumOffset;

_NeruronsLevelArray[i]._NeruronsArray[j]._SumOffset :=0;

ifi < (_LevelCount -1)then

begin

ACount := _NeruronsLevelArray[i+1]._NeruronsCount;

forK :=0toACount -1do

begin

_WeightMatrix[i].Matrix[j, k]._OldSumOffset := _WeightMatrix[i].Matrix[j, k]._SumOffset;

_WeightMatrix[i].Matrix[j, k]._SumOffset :=0;

end;

end;

end;

end;

end;

procedureObjNeuronsNet.Study;

vari:Integer;

SumErr:Single;

begin

if_StudyCount > _MaxStudyCountthenExit;

SumErr :=0;

fori :=0to_SampleCount -1do

begin

CalcExport;//正向计算

CalcExportReturn;//反向

AddOffset;//累计偏差

SumErr := SumErr + GetError();

end;

Form1.mmo1.Lines.Add(IntToStr(_StudyCount)+\':\'+FloatToStr(SumErr)) ;

Form1.img1.Canvas.Pixels[Integer(_StudyCount*5),floor(150-SumErr*100)]:=255;

if(SumErr/self._SampleCount ) <= _MaxErrorthen

Exit;

Changle;//改变

SaveOffset;//存储

_StudyCount := _StudyCount +1;

Study();//迭代

end;

functionObjNeuronsNet.GetError:Single;

varSumErr:Single;

i:Integer;

begin

SumErr :=0;

fori :=0to_NeruronsLevelArray[_LevelCount -1]._NeruronsCount -1do

begin

SumErr := Sumerr + Power((_ExportArray[i] - _NeruronsLevelArray[_LevelCount -1]._NeruronsArray[i]._V),2);

end;

Result := SumErr /2;

end;

end.