求模拟退火算法和神经网络的delphi程序
求模拟退火算法和神经网络的delphi程序,谢谢[ 本帖最后由 xinyuxf 于 2007-6-7 09:45 编辑 ] 来自：中国人工智能创业研发俱乐部
ART神经网络的Delphi实现
unit ARTUnit;
interface
uses Windows, SysUtils, Classes, Extctrls, Math, LPR_HUnit, Dialogs;
type
TArtNet = class(TObject)
private
//F1到F2的连接权
Wb : array of Double;
//F2到F1的连接权
Wt : array of Integer;
//警戒值
VigilThresh : Double;
L : Double;
//识别层的神经元数
M : Integer;
//比较层的神经元数
N : Integer;
//权文件名
FileName : string;
//输入向量
XVect : array of Integer;
//比较层的输出向量
CVect : array of Integer;
//最优识别层神经元
BestNeuron : Integer;
Reset : Boolean;
//识别层输出向量
RVect : array of Integer;
//识别层最优神经元到比较层的权
PVect : array of Integer;
//识别层禁止标志
Disabled : array of Boolean;
//对应识别字符
RecoCharASCII : array of string;
procedure ClearPVect;
procedure ClearRVect;
procedure ClearDisabled;
//Calc comparison by 2/3 rule
procedure RunCompLayer;
function RunRecoLayer : Boolean;
procedure RVect2PVect(best : Integer);
//比较层增益
function Gain1 : Integer;
//识别层增益
function Gain2 : Integer;
//计算警戒值
function Vigilence : Double;
//初始化权重
procedure InitWeights;
//调整连接权
procedure Train;
//保存权值
procedure SaveWeights(CharImg : TGrayImg);
//加载权值
procedure LoadWeights(CharImg : TGrayImg);
procedure LoadInVects(SrcCharImg : TGrayImg);
function GetRecoChar : string;
public
constructor Create;
procedure InitARTNET(VT : Double);
function Run(CharImg : TGrayImg; var No : string) : Boolean;
end; //出口函数
function GetCharByCharImg(SrcCharImg : TGrayImg;
CharType : Integer; var No : string) : Boolean;
implementation
uses MainUnit;
constructor TArtNet.Create;
begin
inherited Create;
end;
procedure TArtNet.ClearPVect;
var
i : Integer;
begin
fori := 0 to N - 1 do
PVect := 0;
end;
procedure TArtNet.ClearRVect;
var
i : Integer;
begin
fori := 0 to N - 1 do
RVect := 0;
end;
procedure TArtNet.ClearDisabled;
var
i : Integer;
begin
for i := 0 to M - 1 do
Disabled := False;
end;
procedure TArtNet.RunCompLayer;
var
i, x : Integer;
begin
for i := 0 to N - 1 do
begin
x := XVect + Gain1() + PVect;
if x >= 2 then
CVect := 1
else
CVect := 0;
end;
end;
function TArtNet.RunRecoLayer : Boolean;
var
i, j : Integer;
Net : array of Double;
NetMax : Double;
begin
NetMax := -1;
BestNeuron := -1;
for j := 0 to M - 1 do
begin
Net := 0;
for i := 0 to N - 1 do
begin
Net := Net + Wb * CVect;
end;
if (Net > NetMax) and (not Disabled) then
begin
BestNeuron := j;
NetMax := Net;
end;
end;
if BestNeuron = -1 then
begin
//新分配一个识别单元
BestNeuron := M;
if BestNeuron > MAXRNN - 1 then
begin
Result := False;
Exit;
end;
end;
RVect := 1;
Result := True;
end;
procedure TArtNet.RVect2PVect(best : Integer);
var
i : Integer;
begin
for i := 0 to N - 1 do
PVect := Wt;
end;
procedure TArtNet.InitWeights;
var
i, j : Integer;
b : Double;
begin
b := L / (L - 1 + N);
for i := 0 to N - 1 do
for j := 0 to MaxRNN - 1 do
Wb := b;
for i := 0 to N - 1 do
for j := 0 to MaxRNN - 1 do
Wt := 1;
end;
procedure TArtNet.Train;
var
i ,z : Integer;
begin
z := 0;
for i := 0 to N - 1 do
Inc(z, CVect);
for i := 0 to N - 1 do
begin
Wb := L * CVect / (L - 1 + z);
Wt := CVect;
end;
end;
procedure TArtNet.LoadInVects(SrcCharImg : TGrayImg);
var
i, j : Integer;
begin
for i := 0 to SrcCharImg.Height - 1 do
for j := 0 to SrcCharImg.Width - 1 do
XVect := SrcCharImg.Img div
255;
end;
[ 本帖最后由 frogfish 于 2007-7-6 02:23 编辑 ] function TArtNet.Run(CharImg : TGrayImg; var No : string) : Boolean;
var
S : Double;
begin
LoadInVects(CharImg);
LoadWeights(CharImg);
While Reset do
begin
ClearRVect;
ClearPVect;
RunCompLayer; //XVect => CVect
if not RunRecoLayer then //Get BestNeuron
begin
Result := False; //分类超出最大识别单元数
Exit;
end;
RVect2PVect(BestNeuron); //Wt = >
PVect
RunCompLayer; //XVect * PVect => CVect
S := Vigilence; //Sum(CVect) / Sum(XVect)
if S < VigilThresh then
begin
Reset := True;
RVect := 0;
Disabled := True;
end
else begin
Reset := False;
Train;
end;
end;
SaveWeights(CharImg);
No := GetRecoChar;
Result := True;
end;
procedure TArtNet.SaveWeights(CharImg : TGrayImg);
var
FileStream : TFileStream;
WeightRecord : TWeightRecord;
WeightRecordLength : Integer;
i, k : Integer;
TempM : Integer;
begin
WeightRecordLength := sizeof(TWeightRecord);
//权库文件不存在
if FileExists(FileName) then
begin
//打开权文件
FileStream := TFileStream.Create(FileName, fmOpenReadWrite);
//如果有新分配单元，则修改文件中的M
if BestNeuron >= M then
begin
TempM := M + 1;
FileStream.WriteBuffer(TempM, sizeof(TempM));
//索引
WeightRecord.RecordIndex := BestNeuron;
//权值
for i := 0 to N - 1 do
begin
WeightRecord.PWb := Wb;
WeightRecord.PWt := Wt;
end;
//结果
WeightRecord.CharResult := '?';
//该次识别对应的字符图象
WeightRecord.CharImgWidth := CharImg.Width;
WeightRecord.CharImgHeight := CharImg.Height;
for i := 0 to CharImg.Height - 1 do
for k := 0 to CharImg.Width - 1 do
WeightRecord.CharImg :=
CharImg.Img;
//写入文件
FileStream.Seek(BestNeuron * WeightRecordLength + sizeof(M),
soFromBeginning);
FileStream.WriteBuffer(WeightRecord, WeightRecordLength);
end
else begin
//如果不是新分配的单元，则先填充WeightRecord结构
FileStream.Seek(BestNeuron * WeightRecordLength +
sizeof(M),0);
FileStream.ReadBuffer(WeightRecord, WeightRecordLength);
//修改WeightRecord结构的权值
for i := 0 to N - 1 do
begin
WeightRecord.PWb := Wb; //权值
WeightRecord.PWt := Wt;
end;
//写入文件
FileStream.Seek(BestNeuron * WeightRecordLength + sizeof(M),
soFromBeginning);
FileStream.WriteBuffer(WeightRecord, WeightRecordLength);
end;
FileStream.Free;
end;
end;
procedure TArtNet.LoadWeights(CharImg : TGrayImg);
var
FileStream : TFileStream;
WeightRecord : TWeightRecord;
i, j, k : Integer;
WeightRecordLength : LongInt;
begin
WeightRecordLength := sizeof(TWeightRecord);
InitWeights;
//权库文件不存在
if not FileExists(FileName) then
begin
//创建权文件
FileStream := TFileStream.Create(FileName, fmCreate);
//先写入识别层单元数
FileStream.WriteBuffer(M, sizeof(M));
//填充WeightRecord结构
for j := 0 to M - 1 do
begin
WeightRecord.RecordIndex := j; //索引
for i := 0 to N - 1 do
begin
WeightRecord.PWb := Wb; //权值
WeightRecord.PWt := Wt;
end;
WeightRecord.CharResult := '?';//结果
WeightRecord.CharImgWidth := CharImg.Width;
WeightRecord.CharImgHeight := CharImg.Height;
for i := 0 to CharImg.Height - 1 do
for k := 0 to CharImg.Width - 1 do
WeightRecord.CharImg :=
CharImg.Img;
FileStream.WriteBuffer(WeightRecord, WeightRecordLength);
end;
FileStream.Free;
end
else begin
FileStream := TFileStream.Create(FileName, fmOpenRead);
//跳过识别层单元数
FileStream.Seek(sizeof(M), soFromBeginning);
for j := 0 to M - 1 do
begin
FileStream.ReadBuffer(WeightRecord, WeightRecordLength);
//从文件中读入权值
for i := 0 to N - 1 do
begin
Wb := WeightRecord.PWb;
Wt := WeightRecord.PWt;
end;
//读入对应识别字符的ASCII
RecoCharASCII := WeightRecord.CharResult;
end;
FileStream.Free;
end;
end; function TArtNet.Gain1;
var
i, G : Integer;
begin
G := Gain2;
for i := 0 to N - 1 do
begin
if RVect = 1 then
begin
Result := 0;
Exit;
end;
end;
Result := G;
end;
function TArtNet.Gain2;
var
i : Integer;
begin
for i := 0 to N - 1 do
begin
if XVect = 1 then
begin
Result := 1;
Exit;
end;
end;
Result := 0;
end;
function TArtNet.Vigilence : Double;
var
i : Integer;
S, K , D : Double;
begin
K := 0.0;
D := 0.0;
for i := 0 to N - 1 do
begin
K := K + CVect;
D := D + XVect;
end;
S := K / D;
Result := S;
end;
procedure TArtNet.InitARTNET(VT : Double);
var
i : Integer;
PPath : PChar;
FileStream : TFileStream;
begin
L := 2.0;
N := MaxCNN;
PPath := AllocMem(MAX_PATH);
GetModuleFileName(0, PPath, MAX_PATH);
FileName := ExtractFilePath(string(PPath)) + 'Lpr.art';
if not FileExists(FileName) then
M := 1
else begin
FileStream := TFileStream.Create(FileName,fmOpenRead);
FileStream.ReadBuffer(M,sizeof(M));
FileStream.Free;
end;
Reset := True;
VigilThresh := VT;
ClearDisabled;
//初始化识别字符
for i := 0 to MaxRNN - 1 do
RecoCharASCII := '?';
end; function TARTNET.GetRecoChar : string;
var
Temp : string;
TempChr : Char;
begin
Temp := RecoCharASCII;
TempChr := Temp;
if Ord(TempChr) < 128 then
begin
Result := Temp;
end
else begin
Result := '粤';
end;
end;
function GetCharByCharImg(SrcCharImg : TGrayImg;
CharType : Integer; var No : string) :
Boolean;
var
ARTNET : TARTNET;
TempImg : TGrayImg;
CharASCII : Byte;
begin
if SrcCharImg.Width / SrcCharImg.Height < 0.2 then
begin
No := '1';
Result := True;
Exit;
end;
if not Zoom(SrcCharImg, 15, 30,TempImg) then
begin
Result := False;
Exit;
end;
ARTNET := TARTNET.Create;
ARTNET.InitARTNET(0.8);
if not ARTNET.Run(TempImg, No) then
begin
Result := False;
Exit;
end;
Result := True;
end;
end. 其实神经网络有专门的Delphi库可以调用，比如 Neuro VCL1.2
至于模拟退火算法，没有看到
页:
[1]