?? unitfp.pas
字號:
end
else
begin
REAgainValue:=sumAgain;
REAgain:=0;
end;
if (sumAgain<properties0) or (REAgain=10) then //重來
begin
for j:=low(MyabcList) to high(MyabcList) do
begin
iAgain:=iAgain*properties3;
MyabcList[j]:=abcList[j];
//MyabcList[j].MinV:=max(abcList[j].MinV,abcMax[j]-(abcList[j].MaxV-abcList[j].MinV)/iAgain/2);
//MyabcList[j].MaxV:=min(abcList[j].MaxV,abcMax[j]+(abcList[j].MaxV-abcList[j].MinV)/iAgain/2);
MyabcList[j].Precision:=trunc(abcList[j].Precision*iAgain); //屬性
end;
MydMax:=MaxExtended;
end
else
begin
for j:=low(MyabcList) to high(MyabcList) do
begin
MyabcList[j].MinV:=max(MyabcList[j].MinV,MyabcMax[j]-(MyabcList[j].MaxV-MyabcList[j].MinV)/(properties1)/2);//屬性 //局部爬山
MyabcList[j].MaxV:=min(MyabcList[j].maxV,MyabcMax[j]+(MyabcList[j].MaxV-MyabcList[j].MinV)/(properties1)/2);
if MyabcList[j].PType=2 then
begin
MyabcList[j].MinV:=trunc(MyabcList[j].MinV);
MyabcList[j].MaxV:=trunc(MyabcList[j].MaxV);
end;
MyabcList[j].Precision:=trunc(max(2.0,MyabcList[j].Precision/properties2));//屬性
end;
end;
end;
end;
//==============================================================================
type TDNA_Order =record
ID :integer;
Value :Extended;
end;
type PArrayTDNA_Order=array of TDNA_Order;
procedure OrderBY(var Order :array of TDNA_Order;var OrderTemp :array of TDNA_Order);
var
i,j :integer;
L,R :integer;
LR2 :integer;
InID :integer;
begin
OrderTemp[0]:=Order[0];
for i:=1 to high(Order) do //中值插入法排序
begin
L:=0;
R:=i-1;
while L<=R do
begin
LR2:=(R+L) div 2;
if Order[i].Value<OrderTemp[LR2].Value then
R:=LR2-1
else
L:=LR2+1;
end;
InID:=L;
if InID<i then
begin
for j:=i-1 downto InID do
begin
OrderTemp[j+1]:=OrderTemp[j];
end;
end ;
OrderTemp[InID]:=Order[i];
end;
for i:=0 to high(Order) do
begin
Order[i]:=OrderTemp[i];
end;
end;
procedure GetK(var k1:integer;const Pr:array of Extended); overload;
var
i :integer;
Psum :Extended;
r :extended;
begin
r:=random;
Psum:=0;
for i:=0 to high(Pr) do
begin
Psum:=Psum+Pr[i];
if r<=Psum then
begin
K1:=i;
exit;
end;
end;
k1:=high(Pr); //不可能到這里執行 因為Pr的和為1
end;
procedure GetK(var k1,k2:integer;const Pr:array of Extended); overload;
begin
GetK(K1,Pr);
GetK(K2,Pr);
while K1=K2 do //使K1<>K2
begin
GetK(K2,Pr);
end;
end;
procedure RunOptimize4(); //基因算法
var
MyTime :extended;
i,j,k1,k2,k0:integer;
dTemp :extended;
Temp :extended;
MyabcList :array of TabcList;
Pr :array of Extended; //繁殖概率
DNA :array of array of Extended; //基因 種群
DNA_Temp :array of array of Extended; //臨時交換的 基因 種群
DNA_Order :array of TDNA_Order; //基因適應值 排序用
OrderTemp :array of TDNA_Order; //臨時 基因適應值 排序用
t :integer; //當前繁殖代數
DetaX :extended; //非一致變異步長
properties0 :integer;
properties1 :Extended;
properties2 :Extended;
properties3 :Extended;
properties4 :Extended;
properties5 :Extended;
properties6 :Extended;
properties7 :Extended;
properties8 :Extended;
properties9 :Extended;
begin
//初始設定
SetThreadPriority(GetCurrentThread(),THREAD_PRIORITY_LOWEST);
randomize;
setlength(MyabcList,high(abcList)+1);
for i:=low(MyabcList) to high(MyabcList) do
MyabcList[i]:=abcList[i];
setlength(abcMax,high(abcList)+1);
properties0:=trunc(GetKeyValue('基因算法.種群大小'));
if properties0<1 then properties0:=2;
properties0:=((properties0+1 )div 2)*2; // 2的倍數
properties1:=GetKeyValue('基因算法.繁殖選擇壓力(0-1)');
properties1:=(properties1+1)/properties0;
if properties1>1 then properties1:=1 else if properties1<0 then properties1:=0;
properties2:=GetKeyValue('基因算法.最大代數');
if properties2<1 then properties2:=1;
properties3:=GetKeyValue('基因算法.局部微調系數');
properties4:=abs(GetKeyValue('基因算法.一致變異強度(強度和為種群大小)'));
properties5:=abs(GetKeyValue('基因算法.非一致變異強度(局部微調)'));
properties6:=abs(GetKeyValue('基因算法.單點一致交叉強度'));
properties7:=abs(GetKeyValue('基因算法.啟發式交叉強度'));
properties8:=abs(GetKeyValue('基因算法.一般算術交叉強度'));
properties9:=abs(GetKeyValue('基因算法.完全算術交叉強度'));
//強度
temp:=properties4+properties5+properties6+properties7+properties8+properties9;
if temp=0 then
begin
properties4:=properties0 div 6;
properties5:=properties4+(properties0 div 6);
properties6:=properties5+(properties0 div 6);
properties7:=properties6+(properties0 div 6);
properties8:=properties7+(properties0 div 6);
properties9:=properties0;
end
else
begin
properties4:=trunc(properties4*properties0/Temp );
properties5:=properties4+trunc(properties5*properties0/Temp );
properties6:=properties5+trunc(properties6*properties0/Temp );
properties7:=properties6+trunc(properties7*properties0/Temp );
properties8:=properties7+trunc(properties8*properties0/Temp );
properties9:=properties0;
end;
properties9:=properties9-1;//留下一個名額給最優的基因
//繁殖幾率
setlength(Pr,(properties0));
Temp:=properties1/(properties0-1);
for i:=0 to (properties0)-1 do
begin
Pr[i]:=properties1-i*Temp; // pr[0..properties0-1]的和為1
end;
{Temp:=0;
for i:=0 to (properties0)-1 do
begin
temp:=Temp+pr[i];
end;}
//
setLength(DNA,properties0);
setLength(DNA_Temp,properties0);
for i:=0 to properties0-1 do
begin
setLength(DNA[i],high(MyAbcList)+1);
setLength(DNA_Temp[i],high(MyAbcList)+1);
end;
setLength(DNA_Order,properties0);
setLength(OrderTemp,properties0);
//循環
NowTime:=windows.GetTickCount();
MyTime:=NowTime;
while MyTime=NowTime do //不按“停止”鍵就一直運行
begin
application.ProcessMessages;
//產生初始基因
for j:=0 to high(MyAbcList) do
begin
DNA[0,j]:=MyAbcList[j].Default;
end;
for i:=1 to properties0-1 do
begin
for j:=0 to high(MyAbcList) do
begin
DNA[i,j]:=random*(MyAbcList[j].MaxV-MyAbcList[j].MinV)+MyAbcList[j].MinV;
end;
end;
//
t:=0;
while t<=properties2 do
begin
t:=t+1;
//計算適應值
for i:=0 to properties0-1 do
begin
for j:=0 to high(MyAbcList) do
begin
MyAbcList[j].Default:=DNA[i,j];
if MyAbcList[j].PType=2 then
MyAbcList[j].Default:=trunc(MyAbcList[j].Default);
end;
DNA_Order[i].Value:=abs(GetFBValue(MyabcList));
DNA_Order[i].ID:=i;
end;
//按適應值大小排名
OrderBY(DNA_Order,OrderTemp); //從小到大排序
if DNA_Order[0].Value<dMax then //最優值
begin
dMax:=DNA_Order[0].Value;
for j:=low(abcMax) to high(abcMax) do
abcMax[j]:=DNA[DNA_Order[0].ID,j];
application.ProcessMessages;
end;
//產生后代
for j:=0 to high(MyAbcList) do //保留最優秀的基因
begin
DNA_Temp[properties0-1,j]:=DNA[DNA_Order[0].ID,j];
end;
for i:=0 to trunc(properties4)-1 do //一致變異
begin
GetK(k1,pr);
for j:=0 to high(DNA[0]) do
DNA_Temp[i,j]:=DNA[DNA_Order[k1].ID,j];
K0:=random(high(DNA[0])+1);
DNA_Temp[i,K0]:=random*(MyabcList[K0].MaxV-MyabcList[k0].MinV)+MyabcList[k0].MinV;
end;
for i:=trunc(properties4) to trunc(properties5)-1 do //非一致變異(局部微調)
begin
GetK(k1,pr);
for j:=0 to high(DNA[0]) do
DNA_Temp[i,j]:=DNA[DNA_Order[k1].ID,j];
K0:=random(high(DNA[0])+1);
TEmp:=DNA_Temp[i,k0];
if random<0.5 then
begin
DetaX:=(MyabcList[k0].MaxV-TEmp)*random*power(1-t/properties2,properties3);
DNA_Temp[i,k0]:=min(MyabcList[k0].MaxV,TEmp+DetaX);
end
else
begin
DetaX:=(TEmp-MyabcList[k0].MinV)*random*power(1-t/properties2,properties3);
DNA_Temp[i,k0]:=max(MyabcList[k0].MinV,TEmp-DetaX);
end;
end;
for i:=trunc(properties5) to trunc(properties6)-1 do //單點一致交叉
begin
GetK(k1,k2,pr);
K0:=random(high(DNA[0])+1);
for j:=0 to k0 do
DNA_Temp[i,j]:=DNA[DNA_Order[k1].ID,j];
for j:=k0+1 to high(DNA[0]) do
DNA_Temp[i,j]:=DNA[DNA_Order[k2].ID,j];
end;
for i:=trunc(properties6) to trunc(properties7)-1 do //啟發式交叉
begin
GetK(k1,k2,pr);
if DNA_Order[k1].Value<DNA_Order[k2].Value then
begin
for j:=0 to high(DNA[0]) do
begin
DNA_Temp[i,j]:=random*(DNA[DNA_Order[k1].ID,j]-DNA[DNA_Order[k2].ID,j])+DNA[DNA_Order[k1].ID,j];
if DNA_Temp[i,j]>MyabcList[j].MaxV then DNA_Temp[i,j]:=MyabcList[j].MaxV;
if DNA_Temp[i,j]<MyabcList[j].MinV then DNA_Temp[i,j]:=MyabcList[j].MinV;
end;
end
else
begin
for j:=0 to high(DNA[0]) do
begin
DNA_Temp[i,j]:=random*(DNA[DNA_Order[k2].ID,j]-DNA[DNA_Order[k1].ID,j])+DNA[DNA_Order[k2].ID,j];
if DNA_Temp[i,j]>MyabcList[j].MaxV then DNA_Temp[i,j]:=MyabcList[j].MaxV;
if DNA_Temp[i,j]<MyabcList[j].MinV then DNA_Temp[i,j]:=MyabcList[j].MinV;
end;
end;
end;
for i:=trunc(properties7) to trunc(properties8)-1 do //一般算術交叉
begin
GetK(k1,k2,pr);
K0:=random(high(DNA[0])+1);
Temp:=random;
if random<0.5 then
begin
for j:=0 to k0 do
DNA_Temp[i,j]:=DNA[DNA_Order[k1].ID,j];
for j:=k0+1 to high(DNA[0]) do
begin
DNA_Temp[i,j]:=Temp*DNA[DNA_Order[k1].ID,j]+(1-Temp)*DNA[DNA_Order[k2].ID,j];
if DNA_Temp[i,j]>MyabcList[j].MaxV then DNA_Temp[i,j]:=MyabcList[j].MaxV;
if DNA_Temp[i,j]<MyabcList[j].MinV then DNA_Temp[i,j]:=MyabcList[j].MinV;
end;
end
else
begin
for j:=0 to k0 do
begin
DNA_Temp[i,j]:=Temp*DNA[DNA_Order[k1].ID,j]+(1-Temp)*DNA[DNA_Order[k2].ID,j];
if DNA_Temp[i,j]>MyabcList[j].MaxV then DNA_Temp[i,j]:=MyabcList[j].MaxV;
if DNA_Temp[i,j]<MyabcList[j].MinV then DNA_Temp[i,j]:=MyabcList[j].MinV;
end;
for j:=k0+1 to high(DNA[0]) do
DNA_Temp[i,j]:=DNA[DNA_Order[k1].ID,j];
end;
end;
for i:=trunc(properties8) to trunc(properties9)-1 do //完全算術交叉
begin
GetK(k1,k2,pr);
Temp:=random;
for j:=0 to high(DNA[0]) do
begin
DNA_Temp[i,j]:=Temp*DNA[DNA_Order[k1].ID,j]+(1-Temp)*DNA[DNA_Order[k2].ID,j];
if DNA_Temp[i,j]>MyabcList[j].MaxV then DNA_Temp[i,j]:=MyabcList[j].MaxV;
if DNA_Temp[i,j]<MyabcList[j].MinV then DNA_Temp[i,j]:=MyabcList[j].MinV;
end;
end;
//復制
for i:=0 to properties0-1 do
begin
for j:=0 to high(DNA[0]) do
DNA[i,j]:=DNA_Temp[i,j];
end;
//系統
application.ProcessMessages;
while runPause=true do
begin
application.ProcessMessages;
sleep(1);
end;
application.ProcessMessages;
if MyTime<>NowTime then exit;
application.ProcessMessages;
end;//while t<=properties2 do
end;//while MyTime=NowTime do
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -