常用算法集合

俺写的BP算法源程序(Pascal) delphi 2005下编译通过。支持变学习率。具有通用性，传递函数可自己写（动态调用）。 下面是程序和使用的例子。学习《人工智能与专家系统》时写的。 //////////////////主程序//////////////////////// program BP; { 输入文件：BP.in 第一行：DLL文件名 第二行：layer_count, n(1), n(2), ... , n(layer_count) ;n(i) <--第i层神经元个数 第三行：允许误差ε 学习率η 学习实例个数N 附加测试输入个数M 迭代次数（若0则不计迭代次数） 最低学习率min_yita // 若迭代次数为零，则最低学习率可以不用写 // 若迭代次数不为零，则学习率为最高学习率，且必须输入最低学习率 接下来是学习实例，每个学习实例2行： 第一行：输入的n(1)个数 第二行：期望的输出 再接下来是M个测试输入 测试输入 N<=40,M<=100 n(i)<=10 3<=layer_count<=10 0<η<1，推荐0.3<=η<=0.9 输入：[0,1] 注意：误差E[j,k]=1/2*(y*[j,k]-y[j,k])^2<=ε 输出文件：BP.out 第一行：总迭代次数 接下来N行：对应每个学习实例的输出和测试输入的输出 接下来为所有权值 } uses SysUtils, Windows, ClassFunctionsUnit in 'ClassFunctionsUnit.pas'; { Global Variables } var yita,epsilon,min_yita,delta_yita:Extended; layer_count,t,k,instance_count,total_time,ExtraCount:integer; // t - 迭代次数，k - 学习实例序号，total_time - 总迭代次数 func:TFunctions; n:array[1..10] of integer; // 每层的神经元个数 instances:array[1..140] of record // 学习实例 X,Y:array[1..10] of Extended; end; W:array[1..9] of array[1..10,1..10] of Extended; IO_map:array[1..10,1..10] of record I,Extended; end; E:array[1..10] of Extended; // E - 神经网络输出误差 delta:array[1..10,1..10] of Extended; { Global Procedures } procedure LoadFromFile; var F:TextFile; FileName:String; i,j:integer; begin AssignFile(F,'BP.in'); Reset(F); Readln(F,FileName); func:=TFunctions.Create(FileName); Read(F,layer_count); for i:=1 to layer_count do read(f,n[i]); Readln(F); Read(F,epsilon); read(F,yita); Read(F,instance_count); Read(F,ExtraCount); Read(F,total_time); if total_time>0 then Read(F,min_yita); Readln(F); for i:=1 to instance_count do begin for j:=1 to n[1] do read(f,instances[i].X[j]); Readln(F); for j:=1 to n[layer_count] do read(F,Instances[i].Y[j]); Readln(F); end; if ExtraCount>0 then for i:=instance_count+1 to ExtraCount+instance_count do begin for j:=1 to n[1] do read(f,instances[i].X[j]); Readln(F); end; CloseFile(F); end; procedure MapIO;forward; procedure WriteResultToFile; var F:TextFile; i,j,r:integer; begin AssignFile(F,'BP.out'); Rewrite(F); Writeln(F,t-1); //for k:=1 to instance_count do k:=1; while k<=instance_count+ExtraCount do begin MapIO; if n[1]>1 then for i:=1 to n[1]-1 do write(F,Format('%f,',[Instances[k].X[i]])); write(F,Format('%f',[Instances[k].X[n[1]]])); write(F,' --> '); if n[layer_count]>1 then for i:=1 to n[layer_count]-1 do write(F,Format('%f,',[IO_map[layer_count,i].O])); writeln(F,Format('%f',[IO_map[layer_count,n[layer_count]].O])); k:=k+1; end; for i:=1 to layer_count-1 do for j:=1 to n[i] do for r:=1 to n[i+1] do Writeln(F,Format('w(%d,%d->%d,%d): %f',[i,j,i+1,r,W[i][j,r]])); CloseFile(F); end; procedure Init; var i,j,r:integer; begin // init W for i:=1 to layer_count-1 do for j:=1 to n[i] do for r:=1 to n[i+1] do W[i][j,r]:=Random(100)/1000; //init t,k t:=1; k:=1; // init delta_yita if total_time>0 then delta_yita:=(yita-min_yita)/total_time else delta_yita:=0; end; function computeIn(layer,q:integer):Extended; { TEST OK } // 计算layer层第q个神经元的输入 var j:integer; a,b:Extended; begin if layer=1 then begin Result:=Instances[k].X[q]; Exit; end; Result:=0; for j:=1 to n[layer-1] do begin a:=IO_map[layer-1,j].O; b:=W[layer-1][j,q]; Result:=Result+a*b; end; end; { MapIO 搞定所有神经元的输入输出值 } procedure MapIO; var i,j:integer; begin for i:=1 to layer_count do for j:=1 to n[i] do begin IO_map[i,j].I:=computeIn(i,j); if i=1 then IO_map[i,j].=func.layer1(IO_map[i,j].I) else begin if i=layer_count then IO_map[i,j].=func.last_layer(IO_map[i,j].I) else IO_map[i,j].=func.middle_layer(IO_map[i,j].I); end; end; end; { computeE 计算神经网络的输出误差，在 调用该过程前要先MapIO } procedure computeE; var i:integer; begin for i:=1 to n[layer_count] do E[i]:=sqr(Instances[k].Y[i]-IO_map[layer_count,i].O)/2; end; procedure computeDelta; { maybe test OK } var i,j,r:integer; x:Extended; begin for i:=1 to n[layer_count] do delta[layer_count,i]:=(IO_map[layer_count,i].O-Instances[k].Y[i])* func.d_last_layer(IO_map[layer_count,i].I); for i:=layer_count-1 downto 1 do for j:=1 to n[i] do begin x:=0; for r:=1 to n[i+1] do x:=x+delta[i+1,r]*W[i][j,r]; if i>1 then // middle layer x:=x*func.d_middle_layer(IO_map[i,j].I) else // first layer x:=x*func.d_layer1(IO_map[i,j].I); delta[i,j]:=x; end; end; procedure makeWChange; { maybe Test OK } var deltaW:Extended; i,j,r:integer; begin for i:=1 to layer_count-1 do for j:=1 to n[i] do for r:=1 to n[i+1] do begin deltaW:=-yita*delta[i+1,r]*IO_map[i,j].O; W[i][j,r]:=W[i][j,r]+deltaW; end; end; function isInRange:Boolean; var i:integer; begin Result:=True; for i:=1 to n[layer_count] do if E[i]>epsilon then begin Result:=False; break; end; end; function isAllInRange:Boolean; var old_k:integer; begin old_k:=k; k:=1; Result:=True; while (k<=instance_count)and(k<>old_k) do // 增加几行代码，减少了不少不必要的浮点运算 :) begin MapIO; computeE; if not isInRange then begin Result:=False; Break; end; k:=k+1; end; k:=old_k; MapIO; computeE; if not isInRange then Result:=False; end; procedure MainCompute; begin while true do begin if (total_time>0) and (t>total_time) then break; if isAllInRange then Break; // MapIO; <-- included in isAllInRange // computeE; computeDelta; makeWChange; t:=t+1; k:=((k+1) mod instance_count)+1; yita:=yita-delta_yita; end; end; begin Randomize; LoadFromFile; Init; MainCompute; WriteResultToFile; func.Free; end. ////////////////////file: ClassFunctionsUnit.pas///////////////////////// unit ClassFunctionsUnit; interface type TFunction=function (input:Extended):Extended;stdcall; TFunctions=class // 这个类定义了所有的传递函数以及他们的导数 private DLLHandle:Cardinal; public layer1:TFunction; //输入层传递函数 d_layer1:TFunction; //输入层传递函数的导数 middle_layer:TFunction; //隐层传递函数 d_middle_layer:TFunction; //隐层传递函数的导数 last_layer:TFunction; //输出层传递函数 d_last_layer:TFunction; //输出层传递函数的导数 //所有的这些都是在Create的时候从动态连接库导入 //若DLL读入失败，则使用默认 constructor Create(DLLFileName:string); destructor Destroy;override; end; implementation uses Windows; { Default Functions } function TDefaultFunctions_d_last_layer(input: Extended): Extended;stdcall; begin Result:=1; end; function TDefaultFunctions_d_layer1(input: Extended): Extended;stdcall; begin Re