求模拟退火算法和神经网络的delphi程序

phj · 发表于 2006-6-6 11:40

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？我要加入

x

求模拟退火算法和神经网络的delphi程序,谢谢

[ 本帖最后由 xinyuxf 于 2007-6-7 09:45 编辑 ]

frogfish · 发表于 2007-7-6 02:20

来自：中国人工智能创业研发俱乐部

ART神经网络的Delphi实现

unit ARTUnit;
interface
uses Windows, SysUtils, Classes, Extctrls, Math, LPR_HUnit, Dialogs;
type
TArtNet = class(TObject)
private
//F1到F2的连接权
Wb : array[0..MaxCNN - 1, 0..MaxRNN - 1] of Double;
//F2到F1的连接权
Wt : array[0..MaxRNN - 1, 0..MaxCNN - 1] of Integer;
//警戒值
VigilThresh : Double;
L : Double;
//识别层的神经元数
M : Integer;
//比较层的神经元数
N : Integer;
//权文件名
FileName : string;
//输入向量
XVect : array[0..MaxCNN - 1] of Integer;
//比较层的输出向量
CVect : array[0..MaxCNN - 1] of Integer;
//最优识别层神经元
BestNeuron : Integer;
Reset : Boolean;
//识别层输出向量
RVect : array[0..MaxRNN - 1] of Integer;
//识别层最优神经元到比较层的权
PVect : array[0..MaxCNN - 1] of Integer;
//识别层禁止标志
Disabled : array[0..MaxRNN - 1] of Boolean;
//对应识别字符
RecoCharASCII : array[0..MaxRNN - 1] of string[2];
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;

复制代码

frogfish · 发表于 2007-7-6 02:22

//出口函数
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
for i := 0 to N - 1 do
PVect[i] := 0;
end;
procedure TArtNet.ClearRVect;
var
i : Integer;
begin
for i := 0 to N - 1 do
RVect[i] := 0;
end;
procedure TArtNet.ClearDisabled;
var
i : Integer;
begin
for i := 0 to M - 1 do
Disabled[i] := False;
end;
procedure TArtNet.RunCompLayer;
var
i, x : Integer;
begin
for i := 0 to N - 1 do
begin
x := XVect[i] + Gain1() + PVect[i];
if x >= 2 then
CVect[i] := 1
else
CVect[i] := 0;
end;
end;
function TArtNet.RunRecoLayer : Boolean;
var
i, j : Integer;
Net : array[0..MaxRNN] of Double;
NetMax : Double;
begin
NetMax := -1;
BestNeuron := -1;
for j := 0 to M - 1 do
begin
Net[j] := 0;
for i := 0 to N - 1 do
begin
Net[j] := Net[j] + Wb[i, j] * CVect[i];
end;
if (Net[j] > NetMax) and (not Disabled[j]) then
begin
BestNeuron := j;
NetMax := Net[j];
end;
end;
if BestNeuron = -1 then
begin
//新分配一个识别单元
BestNeuron := M;
if BestNeuron > MAXRNN - 1 then
begin
Result := False;
Exit;
end;
end;
RVect[BestNeuron] := 1;
Result := True;
end;
procedure TArtNet.RVect2PVect(best : Integer);
var
i : Integer;
begin
for i := 0 to N - 1 do
PVect[i] := Wt[best, i];
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[i, j] := b;
for i := 0 to N - 1 do
for j := 0 to MaxRNN - 1 do
Wt[j, i] := 1;
end;
procedure TArtNet.Train;
var
i ,z : Integer;
begin
z := 0;
for i := 0 to N - 1 do
Inc(z, CVect[i]);
for i := 0 to N - 1 do
begin
Wb[i, BestNeuron] := L * CVect[i] / (L - 1 + z);
Wt[BestNeuron, i] := CVect[i];
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[i * SrcCharImg.Width + j] := SrcCharImg.Img[i, j] div
255;
end;

复制代码

[ 本帖最后由 frogfish 于 2007-7-6 02:23 编辑 ]

frogfish · 发表于 2007-7-6 02:24

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); [color=#008000]//Wt[BestNeuron,i] = >
PVect[/color]
RunCompLayer; //XVect * PVect => CVect
S := Vigilence; //Sum(CVect) / Sum(XVect)
if S < VigilThresh then
begin
Reset := True;
RVect[BestNeuron] := 0;
Disabled[BestNeuron] := 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[i] := Wb[i, BestNeuron];
WeightRecord.PWt[i] := Wt[BestNeuron, i];
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[i * CharImg.Width + k] :=
CharImg.Img[i, k];
//写入文件
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[i] := Wb[i, BestNeuron]; //权值
WeightRecord.PWt[i] := Wt[BestNeuron, i];
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[i] := Wb[i, j]; //权值
WeightRecord.PWt[i] := Wt[j, i];
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[i * CharImg.Width + k] :=
CharImg.Img[i, k];
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[i, j] := WeightRecord.PWb[i];
Wt[j, i] := WeightRecord.PWt[i];
end;
//读入对应识别字符的ASCII
RecoCharASCII[j] := WeightRecord.CharResult;
end;
FileStream.Free;
end;
end;

复制代码

frogfish · 发表于 2007-7-6 02:25

function TArtNet.Gain1;
var
i, G : Integer;
begin
G := Gain2;
for i := 0 to N - 1 do
begin
if RVect[i] = 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[i] = 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[i];
D := D + XVect[i];
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[i] := '?';
end;

复制代码

frogfish · 发表于 2007-7-6 02:25

function TARTNET.GetRecoChar : string;
var
Temp : string[2];
TempChr : Char;
begin
Temp := RecoCharASCII[BestNeuron];
TempChr := Temp[1];
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.

复制代码

frogfish · 发表于 2007-7-6 02:28

其实神经网络有专门的Delphi库可以调用，比如 Neuro VCL1.2

至于模拟退火算法，没有看到

账号		自动登录	找回密码
密码			我要加入

[人工智能] 求模拟退火算法和神经网络的delphi程序

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。