日志
模拟退火算法
||
模拟退火算法
模拟退火算法来源于固体退火原理，将固体加温至充分高，再让其徐徐冷却，加温时，固体内部粒子随温升变为无序状，
内能增大，而徐徐冷却时粒子渐趋有序，在每个温度都达到平衡态，最后在常温时达到基态，内能减为最小。根据Metropolis
准则，粒子在温度T时趋于平衡的概率为e-ΔE/(kT)，其中E为温度T时的内能，ΔE为其改变量，k为Boltzmann常数。用固体退
火模拟组合优化问题，将内能E模拟为目标函数值f，温度T演化成控制参数t，即得到解组合优化问题的模拟退火算法：由初始
解i和控制参数初值t开始，对当前解重复“产生新解→计算目标函数差→接受或舍弃”的迭代，并逐步衰减t值，算法终止时的
当前解即为所得近似最优解，这是基于蒙特卡罗迭代求解法的一种启发式随机搜索过程。退火过程由冷却进度表(Cooling
Schedule)控制，包括控制参数的初值t及其衰减因子Δt、每个t值时的迭代次数L和停止条件S。
3.5.1 模拟退火算法的模型
模拟退火算法可以分解为解空间、目标函数和初始解三部分。
模拟退火的基本思想:
(1) 初始化：初始温度T(充分大)，初始解状态S(是算法迭代的起点)， 每个T值的迭代次数L
(2) 对k=1，……，L做第(3)至第6步：
(3) 产生新解S′
(4) 计算增量Δt′=C(S′)-C(S)，其中C(S)为评价函数
(5) 若Δt′<0则接受S′作为新的当前解，否则以概率exp(-Δt′/T)接受S′作为新的当前解.
(6) 如果满足终止条件则输出当前解作为最优解，结束程序。
终止条件通常取为连续若干个新解都没有被接受时终止算法。
(7) T逐渐减少，且T->0，然后转第2步。
算法对应动态演示图：
模拟退火算法新解的产生和接受可分为如下四个步骤：
第一步是由一个产生函数从当前解产生一个位于解空间的新解；为便于后续的计算和接受，减少算法耗时，通常选择由当
前新解经过简单地变换即可产生新解的方法，如对构成新解的全部或部分元素进行置换、互换等，注意到产生新解的变换方法
决定了当前新解的邻域结构，因而对冷却进度表的选取有一定的影响。
第二步是计算与新解所对应的目标函数差。因为目标函数差仅由变换部分产生，所以目标函数差的计算最好按增量计算。
事实表明，对大多数应用而言，这是计算目标函数差的最快方法。
第三步是判断新解是否被接受,判断的依据是一个接受准则，最常用的接受准则是Metropo1is准则: 若Δt′<0则接受S′作
为新的当前解S，否则以概率exp(-Δt′/T)接受S′作为新的当前解S。
第四步是当新解被确定接受时，用新解代替当前解，这只需将当前解中对应于产生新解时的变换部分予以实现，同时修正
目标函数值即可。此时，当前解实现了一次迭代。可在此基础上开始下一轮试验。而当新解被判定为舍弃时，则在原当前解的
基础上继续下一轮试验。
模拟退火算法与初始值无关，算法求得的解与初始解状态S(是算法迭代的起点)无关；模拟退火算法具有渐近收敛性，已在
理论上被证明是一种以概率l 收敛于全局最优解的全局优化算法；模拟退火算法具有并行性。
3.5.2 模拟退火算法的简单应用
作为模拟退火算法应用，讨论货郎担问题(Travelling Salesman Problem，简记为TSP)：设有n个城市，用数码1,…,n代表
。城市i和城市j之间的距离为d(i，j) i, j=1,…,n．TSP问题是要找遍访每个域市恰好一次的一条回路，且其路径总长度为最
短.。
求解TSP的模拟退火算法模型可描述如下：
解空间 解空间S是遍访每个城市恰好一次的所有回路，是{1，……，n}的所有循环排列的集合，S中的成员记为(w1,w2 ,…
…，wn)，并记wn+1= w1。初始解可选为(1，……，n)
目标函数 此时的目标函数即为访问所有城市的路径总长度或称为代价函数：
我们要求此代价函数的最小值。
新解的产生 随机产生1和n之间的两相异数k和m，若k<m，则将
(w1, w2 ,…，wk , wk+1 ,…，wm ,…，wn)
变为：
(w1, w2 ,…，wm , wm-1 ,…，wk+1 , wk ,…，wn).
如果是k>m，则将
(w1, w2 ,…，wk , wk+1 ,…，wm ,…，wn)
变为：
(wm, wm-1 ,…，w1 , wm+1 ,…，wk-1 ,wn , wn-1 ,…，wk).
上述变换方法可简单说成是“逆转中间或者逆转两端”。
也可以采用其他的变换方法，有些变换有独特的优越性，有时也将它们交替使用，得到一种更好方法。
代价函数差 设将(w1, w2 ,……，wn)变换为(u1, u2 ,……，un), 则代价函数差为：
根据上述分析，可写出用模拟退火算法求解TSP问题的伪程序：
Procedure TSPSA:
begin
init-of-T; { T为初始温度}
S={1，……，n}; {S为初始值}
termination=false;
while termination=false
begin
for i=1 to L do
begin
generate(S′form S); { 从当前回路S产生新回路S′}
Δt:=f(S′))-f(S);{f(S)为路径总长}
IF(Δt<0) OR (EXP(-Δt/T)>Random-of-[0,1])
S=S′;
IF the-halt-condition-is-TRUE THEN
termination=true;
End;
T_lower;
End;
End
模拟退火算法的应用很广泛，可以较高的效率求解最大截问题(Max Cut Problem)、0-1背包问题(Zero One Knapsack
Problem)、图着色问题(Graph Colouring Problem)、调度问题(Scheduling Problem)等等。
3.5.3 模拟退火算法的参数控制问题
模拟退火算法的应用很广泛，可以求解NP完全问题，但其参数难以控制，其主要问题有以下三点：
(1) 温度T的初始值设置问题。
温度T的初始值设置是影响模拟退火算法全局搜索性能的重要因素之一、初始温度高，则搜索到全局最优解的可能性大，但
因此要花费大量的计算时间；反之，则可节约计算时间，但全局搜索性能可能受到影响。实际应用过程中，初始温度一般需要
依据实验结果进行若干次调整。
(2) 退火速度问题。
模拟退火算法的全局搜索性能也与退火速度密切相关。一般来说，同一温度下的“充分”搜索(退火)是相当必要的，但这
需要计算时间。实际应用中，要针对具体问题的性质和特征设置合理的退火平衡条件。
(3) 温度管理问题。
温度管理问题也是模拟退火算法难以处理的问题之一。实际应用中，由于必须考虑计算复杂度的切实可行性等问题，常采
用如下所示的降温方式：
T(t+1)＝k×T(t)
式中k为正的略小于1.00的常数，t为降温的次数
使用SA解决TSP问题的Matlab程序：
function out = tsp(loc)
% TSP Traveling salesman problem (TSP) using SA (simulated annealing).
% TSP by itself will generate 20 cities within a unit cube and
% then use SA to slove this problem.
%
% TSP(LOC) solve the traveling salesman problem with cities'
% coordinates given by LOC, which is an M by 2 matrix and M is
% the number of cities.
%
% For example:
%
% loc = rand(50, 2);
% tsp(loc);
if nargin == 0,
% The following data is from the post by Jennifer Myers (jmyers@nwu.
edu)
edu)
% to comp.ai.neural-nets. It's obtained from the figure in
% Hopfield & Tank's 1985 paper in Biological Cybernetics
% (Vol 52, pp. 141-152).
loc = [0.3663, 0.9076; 0.7459, 0.8713; 0.4521, 0.8465;
0.7624, 0.7459; 0.7096, 0.7228; 0.0710, 0.7426;
0.4224, 0.7129; 0.5908, 0.6931; 0.3201, 0.6403;
0.5974, 0.6436; 0.3630, 0.5908; 0.6700, 0.5908;
0.6172, 0.5495; 0.6667, 0.5446; 0.1980, 0.4686;
0.3498, 0.4488; 0.2673, 0.4274; 0.9439, 0.4208;
0.8218, 0.3795; 0.3729, 0.2690; 0.6073, 0.2640;
0.4158, 0.2475; 0.5990, 0.2261; 0.3927, 0.1947;
0.5347, 0.1898; 0.3960, 0.1320; 0.6287, 0.0842;
0.5000, 0.0396; 0.9802, 0.0182; 0.6832, 0.8515];
end
NumCity = length(loc); % Number of cities
distance = zeros(NumCity); % Initialize a distance matrix
% Fill the distance matrix
for i = 1:NumCity,
for j = 1:NumCity,
distance(i, j) = norm(loc(i, - loc(j, );
distance(i, j) = norm(loc(i, - loc(j, );
end
end
% To generate energy (objective function) from path
%path = randperm(NumCity);
%energy = sum(distance((path-1)*NumCity + [path(2:NumCity) path(1)]));
% Find typical values of dE
count = 20;
all_dE = zeros(count, 1);
for i = 1:count
path = randperm(NumCity);
energy = sum(distance((path-1)*NumCity + [path(2:NumCity)
path(1)]));
new_path = path;
index = round(rand(2,1)*NumCity+.5);
inversion_index = (min(index):max(index));
new_path(inversion_index) = fliplr(path(inversion_index));
all_dE(i) = abs(energy - ...
sum(sum(diff(loc([new_path new_path(1)],)'.^2)));
end
dE = max(all_dE);
dE = max(all_dE);
temp = 10*dE; % Choose the temperature to be large enough
fprintf('Initial energy = %f\n\n',energy);
% Initial plots
out = [path path(1)];
plot(loc(out(, 1), loc(out(, 2),'r.', 'Markersize', 20);
axis square; hold on
h = plot(loc(out(, 1), loc(out(, 2)); hold off
MaxTrialN = NumCity*100; % Max. # of trials at a
temperature
MaxAcceptN = NumCity*10; % Max. # of acceptances at a
temperature
StopTolerance = 0.005; % Stopping tolerance
TempRatio = 0.5; % Temperature decrease ratio
minE = inf; % Initial value for min. energy
maxE = -1; % Initial value for max. energy
% Major annealing loop
while (maxE - minE)/maxE > StopTolerance,
minE = inf;
minE = inf;
maxE = 0;
TrialN = 0; % Number of trial moves
AcceptN = 0; % Number of actual moves
while TrialN < MaxTrialN & AcceptN < MaxAcceptN,
new_path = path;
index = round(rand(2,1)*NumCity+.5);
inversion_index = (min(index):max(index));
new_path(inversion_index) =
fliplr(path(inversion_index));
new_energy = sum(distance( ...
(new_path-1)*NumCity+[new_path(2:NumCity)
new_path(1)]));
if rand < exp((energy - new_energy)/temp), %
accept
it!
energy = new_energy;
path = new_path;
minE = min(minE, energy);
maxE = max(maxE, energy);
AcceptN = AcceptN + 1;
end
TrialN = TrialN + 1;
end
end
% Update plot
out = [path path(1)];
set(h, 'xdata', loc(out(, 1), 'ydata', loc(out(, 2));
drawnow;
% Print information in command window
fprintf('temp. = %f\n', temp);
tmp = sprintf('%d ',path);
fprintf('path = %s\n', tmp);
fprintf('energy = %f\n', energy);
fprintf('[minE maxE] = [%f %f]\n', minE, maxE);
fprintf('[AcceptN TrialN] = [%d %d]\n\n', AcceptN, TrialN);
% Lower the temperature
temp = temp*TempRatio;
end
% Print sequential numbers in the graphic window
for i = 1:NumCity,
text(loc(path(i),1)+0.01, loc(path(i),2)+0.01, int2str(i), ...
'fontsize', 8);
end
又一个相关的Matlab程序
function[X,P]=zkp(w,c,M,t0,tf)
[m,n]=size(w);
L=100*n;
t=t0;
clear m;
x=zeros(1,n)
xmax=x;
fmax=0;
while t>tf
for k=1:L
xr=change(x)
gx=g_0_1(w,x);
gxr=g_0_1(w,xr);
if gxr<=M
fr=f_0_1(xr,c);
f=f_0_1(x,c);
df=fr-f;
if df>0
x=xr;
if fr>fmax
fmax=fr;
xmax=xr;
end
else
p=rand;
if p<exp(df/t)
x=xr;
end
end
end
end
t=0.87*t
end
P=fmax;
X=xmax;
%下面的函数产生新解
function [d_f,pi_r]=exchange_2(pi0,d)
[m,n]=size(d);
clear m;
u=rand;
u=u*(n-2);
u=round(u);
if u<2
u=2;
end
if u>n-2
u=n-2;
end
v=rand;
v=v*(n-u+1);
v=round(v);
if v<1
v=1;
end
v=v+u;
if v>n
v=n;
end
pi_1(u)=pi0(v);
pi_1(u)=pi0(u);
if u>1
for k=1:(u-1)
pi_1(k)=pi0(k);
end
end
if v>(u+1)
for k=1:(v-u-1)
pi_1(u+k)=pi0(v-k);
end
end
if v<n
for k=(v+1):n
pi_1(k)=pi0(k);
end
end
d_f=0;
if v<n
d_f=d(pi0(u-1),pi0(v))+d(pi0(u),pi0(v+1));
for k=(u+1):n
d_f=d_f+d(pi0(k),pi0(k-1))-d(pi0(v),pi0(v+1));
end
d_f=d_f-d(pi0(u-1),pi0(u));
for k=(u+1):n
d_f=d_f-d(pi0(k-1),pi0(k));
end
else
d_f=d(pi0(u-1),pi0(v))+d(pi0(u),pi0(1))-d(pi0(u-1),pi0(u))-d(pi0(v),pi0(1));
for k=(u+1):n
d_f=d_f-d(pi0(k),pi0(k-1));
end
for k=(u+1):n
d_f=d_f-d(pi0(k-1),pi0(k));
end
end
pi_r=pi_1;
遗传算法GA
遗传算法：
旅行商问题(traveling saleman problem,简称tsp)：
已知n个城市之间的相互距离，现有一个推销员必须遍访这n个城市，并且每个城市只能访问一次，最后又必须返回出发城市。如何安排他对这些城市的访问次序，可使其旅行路线的总长度最短？
用图论的术语来说，假设有一个图 g=(v,e)，其中v是顶点集，e是边集，设d=(dij)是由顶点i和顶点j之间的距离所组成的距离矩阵，旅行商问题就是求出一条通过所有顶点且每个顶点只通过一次的具有最短距离的回路。
这个问题可分为对称旅行商问题(dij=dji,,任意i,j=1,2,3，…,n)和非对称旅行商问题(dij≠dji,,任意i,j=1,2,3，…,n)。
若对于城市v={v1,v2,v3,…,vn}的一个访问顺序为t=(t1,t2,t3,…,ti,…,tn),其中ti∈v(i=1,2,3,…,n)，且记tn+1= t1，则旅行商问题的数学模型为：
min l=σd(t(i),t(i+1)) （i=1,…,n）
旅行商问题是一个典型的组合优化问题，并且是一个np难问题，其可能的路径数目与城市数目n是成指数型增长的，所以一般很难精确地求出其最优解，本文采用遗传算法求其近似解。
遗传算法：
初始化过程：用v1,v2,v3,…,vn代表所选n个城市。定义整数pop-size作为染色体的个数，并且随机产生pop-size个初始染色体，每个染色体为1到18的整数组成的随机序列。
适应度f的计算：对种群中的每个染色体vi，计算其适应度，f=σd(t(i),t(i+1)).
评价函数eval(vi)：用来对种群中的每个染色体vi设定一个概率，以使该染色体被选中的可能性与其种群中其它染色体的适应性成比例，既通过轮盘赌，适应性强的染色体被选择产生后台的机会要大，设alpha∈(0,1)，本文定义基于序的评价函数为eval(vi)=alpha*(1-alpha).^(i-1) 。[随机规划与模糊规划]
选择过程：选择过程是以旋转赌轮pop-size次为基础，每次旋转都为新的种群选择一个染色体。赌轮是按每个染色体的适应度进行选择染色体的。
step1 、对每个染色体vi,计算累计概率qi，q0=0;qi=σeval(vj) j=1,…,i;i=1,…pop-size.
step2、从区间(0,pop-size)中产生一个随机数r；
step3、若qi-1<r<qi,则选择第i个染色体 ；
step4、重复step2和step3共pop-size次，这样可以得到pop-size个复制的染色体。
grefenstette编码：由于常规的交叉运算和变异运算会使种群中产生一些无实际意义的染色体，本文采用grefenstette编码《遗传算法原理及应用》可以避免这种情况的出现。所谓的grefenstette编码就是用所选队员在未选（不含淘汰）队员中的位置，如：
8 15 2 16 10 7 4 3 11 14 6 12 9 5 18 13 17 1
对应：
8 14 2 13 8 6 3 2 5 7 3 4 3 2 4 2 2 1。
交叉过程：本文采用常规单点交叉。为确定交叉操作的父代，从 到pop-size重复以下过程：从[0，1]中产生一个随机数r，如果r<pc ，则选择vi作为一个父代。
将所选的父代两两组队，随机产生一个位置进行交叉，如：
8 14 2 13 8 6 3 2 5 7 3 4 3 2 4 2 2 1
6 12 3 5 6 8 5 6 3 1 8 5 6 3 3 2 1 1
交叉后为：
8 14 2 13 8 6 3 2 5 1 8 5 6 3 3 2 1 1
6 12 3 5 6 8 5 6 3 7 3 4 3 2 4 2 2 1
变异过程：本文采用均匀多点变异。类似交叉操作中选择父代的过程，在r<pm 的标准下选择多个染色体vi作为父代。对每一个选择的父代，随机选择多个位置，使其在每位置按均匀变异（该变异点xk的取值范围为[ukmin,ukmax],产生一个[0，1]中随机数r，该点变异为x'k=ukmin+r(ukmax-ukmin)）操作。如：
8 14 2 13 8 6 3 2 5 7 3 4 3 2 4 2 2 1
变异后：
8 14 2 13 10 6 3 2 2 7 3 4 5 2 4 1 2 1
反grefenstette编码：交叉和变异都是在grefenstette编码之后进行的，为了循环操作和返回最终结果，必须逆grefenstette编码过程，将编码恢复到自然编码。
循环操作：判断是否满足设定的带数xzome，否，则跳入适应度f的计算；是，结束遗传操作，跳出。
Matlab程序：
function [bestpop,trace]=ga(d,termops,num,pc,cxops,pm,alpha)
%
%————————————————————————
%[bestpop,trace]=ga(d,termops,num,pc,cxops,pm,alpha)
%d:距离矩阵
%termops:种群代数
%num:每代染色体的个数
%pc:交叉概率
%cxops:由于本程序采用单点交叉，交叉点的设置在本程序中没有很好的解决，所以本文了采用定点，即第cxops，可以随机产生。
%pm:变异概率
%alpha:评价函数eval(vi)=alpha*(1-alpha).^(i-1).
%bestpop:返回的最优种群
%trace:进化轨迹
%------------------------------------------------
%####@@@##版权所有！欢迎广大网友改正，改进！##@@@####
%e-mail:tobysidney33@sohu.com
%####################################################
%
citynum=size(d,2);
n=nargin;
if n<2
disp('缺少变量！！')
disp('^_^开个玩笑^_^')
end
if n<2
termops=500;
num=50;
pc=0.25;
cxops=3;
pm=0.30;
alpha=0.10;
end
if n<3
num=50;
pc=0.25;
cxops=3;
pm=0.30;
alpha=0.10;
end
if n<4
pc=0.25;
cxops=3;
pm=0.30;
alpha=0.10;
end
if n<5
cxops=3;
pm=0.30;
alpha=0.10;
end
if n<6
pm=0.30;
alpha=0.10;
end
if n<7
alpha=0.10;
end
if isempty(cxops)
cxops=3;
end
[t]=initializega(num,citynum);
for i=1:termops
[l]=f(d,t);
[x,y]=find(l==max(l));
trace(i)=-l(y(1));
bestpop=t(y(1),:);
[t]=select(t,l,alpha);
[g]=grefenstette(t);
[g1]=crossover(g,pc,cxops);
[g]=mutation(g1,pm); %均匀变异
[t]=congrefenstette(g);
end
---------------------------------------------------------
function [t]=initializega(num,citynum)
for i=1:num
t(i,:)=randperm(citynum);
end
-----------------------------------------------------------
function [l]=f(d,t)
[m,n]=size(t);
for k=1:m
for i=1:n-1
l(k,i)=d(t(k,i),t(k,i+1));
end
l(k,n)=d(t(k,n),t(k,1));
l(k)=-sum(l(k,:));
end
-----------------------------------------------------------
function [t]=select(t,l,alpha)
[m,n]=size(l);
t1=t;
[beforesort,aftersort1]=sort(l,2);%fsort from l to u
for i=1:n
aftersort(i)=aftersort1(n+1-i); %change
end
for k=1:n;
t(k,:)=t1(aftersort(k),:);
l1(k)=l(aftersort(k));
end
t1=t;
l=l1;
for i=1:size(aftersort,2)
evalv(i)=alpha*(1-alpha).^(i-1);
end
m=size(t,1);
q=cumsum(evalv);
qmax=max(q);
for k=1:m
r=qmax*rand(1);
for j=1:m
if j==1&r<=q(1)
t(k,:)=t1(1,:);
elseif j~=1&r>q(j-1)&r<=q(j)
t(k,:)=t1(j,:);
end
end
end
--------------------------------------------------
function [g]=grefenstette(t)
[m,n]=size(t);
for k=1:m
t0=1:n;
for i=1:n
for j=1:length(t0)
if t(k,i)==t0(j)
g(k,i)=j;
t0(j)=[];
break
end
end
end
end
-------------------------------------------
function [g]=crossover(g,pc,cxops)
[m,n]=size(g);
ran=rand(1,m);
r=cxops;
[x,ru]=find(ran<pc);
if ru>=2
for k=1:2:length(ru)-1
g1(ru(k),:)=[g(ru(k),[1:r]),g(ru(k+1),[(r+1):n])];
g(ru(k+1),:)=[g(ru(k+1),[1:r]),g(ru(k),[(r+1):n])];
g(ru(k),:)=g1(ru(k),:);
end
end
--------------------------------------------
function [g]=mutation(g,pm) %均匀变异
[m,n]=size(g);
ran=rand(1,m);
r=rand(1,3); %dai gai jin
rr=floor(n*rand(1,3)+1);
[x,mu]=find(ran<pm);
for k=1:length(mu)
for i=1:length(r)
umax(i)=n+1-rr(i);
umin(i)=1;
g(mu(k),rr(i))=umin(i)+floor((umax(i)-umin(i))*r(i));
end
end
---------------------------------------------------
function [t]=congrefenstette(g)
[m,n]=size(g);
for k=1:m
t0=1:n;
for i=1:n
t(k,i)=t0(g(k,i));
t0(g(k,i))=[];
end
end
-------------------------------------------------
又一个Matlab程序，其中交叉算法采用的是由Goldberg和Lingle于1985年提出的PMX(部分匹配交叉)，淘汰保护指数alpha是我自己设计的，起到了加速优胜劣汰的作用。
%TSP问题（又名：旅行商问题，货郎担问题）遗传算法通用matlab程序
%D是距离矩阵，n为种群个数,建议取为城市个数的1~2倍，
%C为停止代数，遗传到第 C代时程序停止,C的具体取值视问题的规模和耗费的时间而定
%m为适应值归一化淘汰加速指数 ,最好取为1,2,3,4 ,不宜太大
%alpha为淘汰保护指数,可取为0~1之间任意小数,取1时关闭保护功能,最好取为0.8~1.0
%R为最短路径,Rlength为路径长度
function [R,Rlength]=geneticTSP(D,n,C,m,alpha)
[N,NN]=size(D);
farm=zeros(n,N);%用于存储种群
for i=1:n
farm(i,:)=randperm(N);%随机生成初始种群
end
R=farm(1,:);%存储最优种群
len=zeros(n,1);%存储路径长度
fitness=zeros(n,1);%存储归一化适应值
counter=0;
while counter<C
for i=1:n
len(i,1)=myLength(D,farm(i,:));%计算路径长度
end
maxlen=max(len);
minlen=min(len);
fitness=fit(len,m,maxlen,minlen);%计算归一化适应值
rr=find(len==minlen);
R=farm(rr(1,1),:);%更新最短路径
FARM=farm;%优胜劣汰，nn记录了复制的个数
nn=0;
for i=1:n
if fitness(i,1)>=alpha*rand
nn=nn+1;
FARM(nn,:)=farm(i,:);
end
end
FARM=FARM(1:nn,:);
[aa,bb]=size(FARM);%交叉和变异
while aa<n
if nn<=2
nnper=randperm(2);
else
nnper=randperm(nn);
end
A=FARM(nnper(1),:);
B=FARM(nnper(2),:);
[A,B]=intercross(A,B);
FARM=[FARM;A;B];
[aa,bb]=size(FARM);
end
if aa>n
FARM=FARM(1:n,:);%保持种群规模为n
end
farm=FARM;
clear FARM
counter=counter+1
end
Rlength=myLength(D,R);
function [a,b]=intercross(a,b)
L=length(a);
if L<=10%确定交叉宽度
W=1;
elseif ((L/10)-floor(L/10))>=rand&&L>10
W=ceil(L/10);
else
W=floor(L/10);
end
p=unidrnd(L-W+1);%随机选择交叉范围，从p到p+W
for i=1:W%交叉
x=find(a==b(1,p+i-1));
y=find(b==a(1,p+i-1));
[a(1,p+i-1),b(1,p+i-1)]=exchange(a(1,p+i-1),b(1,p+i-1));
[a(1,x),b(1,y)]=exchange(a(1,x),b(1,y));
end
function [x,y]=exchange(x,y)
temp=x;
x=y;
y=temp;
% 计算路径的子程序
function len=myLength(D,p)
[N,NN]=size(D);
len=D(p(1,N),p(1,1));
for i=1:(N-1)
len=len+D(p(1,i),p(1,i+1));
end
%计算归一化适应值子程序
function fitness=fit(len,m,maxlen,minlen)
fitness=len;
for i=1:length(len)
fitness(i,1)=(1-((len(i,1)-minlen)/(maxlen-minlen+0.000001))).^m;
end
一个C++的程序：
//c++的程序
#include<iostream.h>
#include<stdlib.h>
template<class T>
class Graph
{
public:
Graph(int vertices=10)
{
n=vertices;
e=0;
}
~Graph(){}
virtual bool Add(int u,int v,const T& w)=0;
virtual bool Delete(int u,int v)=0;
virtual bool Exist(int u,int v)const=0;
int Vertices()const{return n;}
int Edges()const{return e;}
protected:
int n;
int e;
};
template<class T>
class MGraph:public Graph<T>
{
public:
MGraph(int Vertices=10,T noEdge=0);
~MGraph();
bool Add(int u,int v,const T& w);
bool Delete(int u,int v);
bool Exist(int u,int v)const;
void Floyd(T**& d,int**& path);
void print(int Vertices);
private:
T NoEdge;
T** a;
};
template<class T>
MGraph<T>::MGraph(int Vertices,T noEdge)
{
n=Vertices;
NoEdge=noEdge;
a=new T* [n];
for(int i=0;i<n;i++){
a[i]=new T[n];
a[i][i]=0;
for(int j=0;j<n;j++)if(i!=j)a[i][j]=NoEdge;
}
}
template<class T>
MGraph<T>::~MGraph()
{
for(int i=0;i<n;i++)delete[]a[i];
delete[]a;
}
template<class T>
bool MGraph<T>::Exist(int u,int v)const
{
if(u<0||v<0||u>n-1||v>n-1||u==v||a[u][v]==NoEdge)return false;
return true;
}
template<class T>
bool MGraph<T>::Add(int u,int v,const T& w)
{
if(u<0||v<0||u>n-1||v>n-1||u==v||a[u][v]!=NoEdge){
cerr<<"BadInput!"<<endl;
return false;
}
a[u][v]=w;
e++;
return true;
}
template<class T>
bool MGraph<T>:delete(int u,int v)
{
if(u<0||v<0||u>n-1||v>n-1||u==v||a[u][v]==NoEdge){
cerr<<"BadInput!"<<endl;
return false;
}
a[u][v]=NoEdge;
e--;
return true;
}
template<class T>
void MGraph<T>::Floyd(T**& d,int**& path)
{
d=new T* [n];
path=new int* [n];
for(int i=0;i<n;i++){
d[i]=new T[n];
path[i]=new int[n];
for(int j=0;j<n;j++){
d[i][j]=a[i][j];
if(i!=j&&a[i][j]<NoEdge)path[i][j]=i;
else path[i][j]=-1;
}
}
for(int k=0;k<n;k++){
for(i=0;i<n;i++)
for(int j=0;j<n;j++)
if(d[i][k]+d[k][j]<d[i][j]){
d[i][j]=d[i][k]+d[k][j];
path[i][j]=path[k][j];
}
}
}
template<class T>
void MGraph<T>::print(int Vertices)
{
for(int i=0;i<Vertices;i++)
for(int j=0;j<Vertices;j++)
{
cout<<a[i][j]<<' ';if(j==Vertices-1)cout<<endl;
}
}
#define noEdge 10000
#include<iostream.h>
void main()
{
cout<<"请输入该图的节点数："<<endl;
int vertices;
cin>>vertices;
MGraph<float> b(vertices,noEdge);
cout<<"请输入u,v,w:"<<endl;
int u,v;
float w;
cin>>u>>v>>w;
while(w!=noEdge){
//u=u-1;
b.Add(u-1,v-1,w);
b.Add(v-1,u-1,w);
cout<<"请输入u,v,w:"<<endl;
cin>>u>>v>>w;
}
b.print(vertices);
int** Path;
int**& path=Path;
float** D;
float**& d=D;
b.Floyd(d,path);
for(int i=0;i<vertices;i++){
for(int j=0;j<vertices;j++){
cout<<Path[i][j]<<' ';
if(j==vertices-1)cout<<endl;
}
}
int *V;
V=new int[vertices+1];
cout<<"请输入任意一个初始H-圈："<<endl;
for(int n=0;n<=vertices;n++){
cin>>V[n];
}
for(n=0;n<55;n++){
for(i=0;i<n-1;i++){
for(int j=0;j<n-1;j++)
{
if(i+1>0&&j>i+1&&j<n-1){
if(D[V[i]][V[j]]+D[V[i+1]][V[j+1]]<D[V[i]][V[i+1]]+D[V[j]][V[j+1]]){
int l;
l=V[i+1];V[i+1]=V[j];V[j]=l;
}
}
}
}
}
float total=0;
cout<<"最小回路："<<endl;
for(i=0;i<=vertices;i++){
cout<<V[i]+1<<' ';
}
cout<<endl;
for(i=0;i<vertices;i++)
total+=D[V[i]][V[i+1]];
cout<<"最短路径长度："<<endl;
cout<<total;
}
C语言程序
模拟退火算法来源于固体退火原理，将固体加温至充分高，再让其徐徐冷却，加温时，固体内部粒子随温升变为无序状，
内能增大，而徐徐冷却时粒子渐趋有序，在每个温度都达到平衡态，最后在常温时达到基态，内能减为最小。根据Metropolis
准则，粒子在温度T时趋于平衡的概率为e-ΔE/(kT)，其中E为温度T时的内能，ΔE为其改变量，k为Boltzmann常数。用固体退
火模拟组合优化问题，将内能E模拟为目标函数值f，温度T演化成控制参数t，即得到解组合优化问题的模拟退火算法：由初始
解i和控制参数初值t开始，对当前解重复“产生新解→计算目标函数差→接受或舍弃”的迭代，并逐步衰减t值，算法终止时的
当前解即为所得近似最优解，这是基于蒙特卡罗迭代求解法的一种启发式随机搜索过程。退火过程由冷却进度表(Cooling
Schedule)控制，包括控制参数的初值t及其衰减因子Δt、每个t值时的迭代次数L和停止条件S。
3.5.1 模拟退火算法的模型
模拟退火算法可以分解为解空间、目标函数和初始解三部分。
模拟退火的基本思想:
(1) 初始化：初始温度T(充分大)，初始解状态S(是算法迭代的起点)， 每个T值的迭代次数L
(2) 对k=1，……，L做第(3)至第6步：
(3) 产生新解S′
(4) 计算增量Δt′=C(S′)-C(S)，其中C(S)为评价函数
(5) 若Δt′<0则接受S′作为新的当前解，否则以概率exp(-Δt′/T)接受S′作为新的当前解.
(6) 如果满足终止条件则输出当前解作为最优解，结束程序。
终止条件通常取为连续若干个新解都没有被接受时终止算法。
(7) T逐渐减少，且T->0，然后转第2步。
算法对应动态演示图：
模拟退火算法新解的产生和接受可分为如下四个步骤：
第一步是由一个产生函数从当前解产生一个位于解空间的新解；为便于后续的计算和接受，减少算法耗时，通常选择由当
前新解经过简单地变换即可产生新解的方法，如对构成新解的全部或部分元素进行置换、互换等，注意到产生新解的变换方法
决定了当前新解的邻域结构，因而对冷却进度表的选取有一定的影响。
第二步是计算与新解所对应的目标函数差。因为目标函数差仅由变换部分产生，所以目标函数差的计算最好按增量计算。
事实表明，对大多数应用而言，这是计算目标函数差的最快方法。
第三步是判断新解是否被接受,判断的依据是一个接受准则，最常用的接受准则是Metropo1is准则: 若Δt′<0则接受S′作
为新的当前解S，否则以概率exp(-Δt′/T)接受S′作为新的当前解S。
第四步是当新解被确定接受时，用新解代替当前解，这只需将当前解中对应于产生新解时的变换部分予以实现，同时修正
目标函数值即可。此时，当前解实现了一次迭代。可在此基础上开始下一轮试验。而当新解被判定为舍弃时，则在原当前解的
基础上继续下一轮试验。
模拟退火算法与初始值无关，算法求得的解与初始解状态S(是算法迭代的起点)无关；模拟退火算法具有渐近收敛性，已在
理论上被证明是一种以概率l 收敛于全局最优解的全局优化算法；模拟退火算法具有并行性。
3.5.2 模拟退火算法的简单应用
作为模拟退火算法应用，讨论货郎担问题(Travelling Salesman Problem，简记为TSP)：设有n个城市，用数码1,…,n代表
。城市i和城市j之间的距离为d(i，j) i, j=1,…,n．TSP问题是要找遍访每个域市恰好一次的一条回路，且其路径总长度为最
短.。
求解TSP的模拟退火算法模型可描述如下：
解空间 解空间S是遍访每个城市恰好一次的所有回路，是{1，……，n}的所有循环排列的集合，S中的成员记为(w1,w2 ,…
…，wn)，并记wn+1= w1。初始解可选为(1，……，n)
目标函数 此时的目标函数即为访问所有城市的路径总长度或称为代价函数：
我们要求此代价函数的最小值。
新解的产生 随机产生1和n之间的两相异数k和m，若k<m，则将
(w1, w2 ,…，wk , wk+1 ,…，wm ,…，wn)
变为：
(w1, w2 ,…，wm , wm-1 ,…，wk+1 , wk ,…，wn).
如果是k>m，则将
(w1, w2 ,…，wk , wk+1 ,…，wm ,…，wn)
变为：
(wm, wm-1 ,…，w1 , wm+1 ,…，wk-1 ,wn , wn-1 ,…，wk).
上述变换方法可简单说成是“逆转中间或者逆转两端”。
也可以采用其他的变换方法，有些变换有独特的优越性，有时也将它们交替使用，得到一种更好方法。
代价函数差 设将(w1, w2 ,……，wn)变换为(u1, u2 ,……，un), 则代价函数差为：
根据上述分析，可写出用模拟退火算法求解TSP问题的伪程序：
Procedure TSPSA:
begin
init-of-T; { T为初始温度}
S={1，……，n}; {S为初始值}
termination=false;
while termination=false
begin
for i=1 to L do
begin
generate(S′form S); { 从当前回路S产生新回路S′}
Δt:=f(S′))-f(S);{f(S)为路径总长}
IF(Δt<0) OR (EXP(-Δt/T)>Random-of-[0,1])
S=S′;
IF the-halt-condition-is-TRUE THEN
termination=true;
End;
T_lower;
End;
End
模拟退火算法的应用很广泛，可以较高的效率求解最大截问题(Max Cut Problem)、0-1背包问题(Zero One Knapsack
Problem)、图着色问题(Graph Colouring Problem)、调度问题(Scheduling Problem)等等。
3.5.3 模拟退火算法的参数控制问题
模拟退火算法的应用很广泛，可以求解NP完全问题，但其参数难以控制，其主要问题有以下三点：
(1) 温度T的初始值设置问题。
温度T的初始值设置是影响模拟退火算法全局搜索性能的重要因素之一、初始温度高，则搜索到全局最优解的可能性大，但
因此要花费大量的计算时间；反之，则可节约计算时间，但全局搜索性能可能受到影响。实际应用过程中，初始温度一般需要
依据实验结果进行若干次调整。
(2) 退火速度问题。
模拟退火算法的全局搜索性能也与退火速度密切相关。一般来说，同一温度下的“充分”搜索(退火)是相当必要的，但这
需要计算时间。实际应用中，要针对具体问题的性质和特征设置合理的退火平衡条件。
(3) 温度管理问题。
温度管理问题也是模拟退火算法难以处理的问题之一。实际应用中，由于必须考虑计算复杂度的切实可行性等问题，常采
用如下所示的降温方式：
T(t+1)＝k×T(t)
式中k为正的略小于1.00的常数，t为降温的次数
使用SA解决TSP问题的Matlab程序：
function out = tsp(loc)
% TSP Traveling salesman problem (TSP) using SA (simulated annealing).
% TSP by itself will generate 20 cities within a unit cube and
% then use SA to slove this problem.
%
% TSP(LOC) solve the traveling salesman problem with cities'
% coordinates given by LOC, which is an M by 2 matrix and M is
% the number of cities.
%
% For example:
%
% loc = rand(50, 2);
% tsp(loc);
if nargin == 0,
% The following data is from the post by Jennifer Myers (jmyers@nwu.
edu)
edu)
% to comp.ai.neural-nets. It's obtained from the figure in
% Hopfield & Tank's 1985 paper in Biological Cybernetics
% (Vol 52, pp. 141-152).
loc = [0.3663, 0.9076; 0.7459, 0.8713; 0.4521, 0.8465;
0.7624, 0.7459; 0.7096, 0.7228; 0.0710, 0.7426;
0.4224, 0.7129; 0.5908, 0.6931; 0.3201, 0.6403;
0.5974, 0.6436; 0.3630, 0.5908; 0.6700, 0.5908;
0.6172, 0.5495; 0.6667, 0.5446; 0.1980, 0.4686;
0.3498, 0.4488; 0.2673, 0.4274; 0.9439, 0.4208;
0.8218, 0.3795; 0.3729, 0.2690; 0.6073, 0.2640;
0.4158, 0.2475; 0.5990, 0.2261; 0.3927, 0.1947;
0.5347, 0.1898; 0.3960, 0.1320; 0.6287, 0.0842;
0.5000, 0.0396; 0.9802, 0.0182; 0.6832, 0.8515];
end
NumCity = length(loc); % Number of cities
distance = zeros(NumCity); % Initialize a distance matrix
% Fill the distance matrix
for i = 1:NumCity,
for j = 1:NumCity,
distance(i, j) = norm(loc(i, - loc(j, );
distance(i, j) = norm(loc(i, - loc(j, );
end
end
% To generate energy (objective function) from path
%path = randperm(NumCity);
%energy = sum(distance((path-1)*NumCity + [path(2:NumCity) path(1)]));
% Find typical values of dE
count = 20;
all_dE = zeros(count, 1);
for i = 1:count
path = randperm(NumCity);
energy = sum(distance((path-1)*NumCity + [path(2:NumCity)
path(1)]));
new_path = path;
index = round(rand(2,1)*NumCity+.5);
inversion_index = (min(index):max(index));
new_path(inversion_index) = fliplr(path(inversion_index));
all_dE(i) = abs(energy - ...
sum(sum(diff(loc([new_path new_path(1)],)'.^2)));
end
dE = max(all_dE);
dE = max(all_dE);
temp = 10*dE; % Choose the temperature to be large enough
fprintf('Initial energy = %f\n\n',energy);
% Initial plots
out = [path path(1)];
plot(loc(out(, 1), loc(out(, 2),'r.', 'Markersize', 20);
axis square; hold on
h = plot(loc(out(, 1), loc(out(, 2)); hold off
MaxTrialN = NumCity*100; % Max. # of trials at a
temperature
MaxAcceptN = NumCity*10; % Max. # of acceptances at a
temperature
StopTolerance = 0.005; % Stopping tolerance
TempRatio = 0.5; % Temperature decrease ratio
minE = inf; % Initial value for min. energy
maxE = -1; % Initial value for max. energy
% Major annealing loop
while (maxE - minE)/maxE > StopTolerance,
minE = inf;
minE = inf;
maxE = 0;
TrialN = 0; % Number of trial moves
AcceptN = 0; % Number of actual moves
while TrialN < MaxTrialN & AcceptN < MaxAcceptN,
new_path = path;
index = round(rand(2,1)*NumCity+.5);
inversion_index = (min(index):max(index));
new_path(inversion_index) =
fliplr(path(inversion_index));
new_energy = sum(distance( ...
(new_path-1)*NumCity+[new_path(2:NumCity)
new_path(1)]));
if rand < exp((energy - new_energy)/temp), %
accept
it!
energy = new_energy;
path = new_path;
minE = min(minE, energy);
maxE = max(maxE, energy);
AcceptN = AcceptN + 1;
end
TrialN = TrialN + 1;
end
end
% Update plot
out = [path path(1)];
set(h, 'xdata', loc(out(, 1), 'ydata', loc(out(, 2));
drawnow;
% Print information in command window
fprintf('temp. = %f\n', temp);
tmp = sprintf('%d ',path);
fprintf('path = %s\n', tmp);
fprintf('energy = %f\n', energy);
fprintf('[minE maxE] = [%f %f]\n', minE, maxE);
fprintf('[AcceptN TrialN] = [%d %d]\n\n', AcceptN, TrialN);
% Lower the temperature
temp = temp*TempRatio;
end
% Print sequential numbers in the graphic window
for i = 1:NumCity,
text(loc(path(i),1)+0.01, loc(path(i),2)+0.01, int2str(i), ...
'fontsize', 8);
end
又一个相关的Matlab程序
function[X,P]=zkp(w,c,M,t0,tf)
[m,n]=size(w);
L=100*n;
t=t0;
clear m;
x=zeros(1,n)
xmax=x;
fmax=0;
while t>tf
for k=1:L
xr=change(x)
gx=g_0_1(w,x);
gxr=g_0_1(w,xr);
if gxr<=M
fr=f_0_1(xr,c);
f=f_0_1(x,c);
df=fr-f;
if df>0
x=xr;
if fr>fmax
fmax=fr;
xmax=xr;
end
else
p=rand;
if p<exp(df/t)
x=xr;
end
end
end
end
t=0.87*t
end
P=fmax;
X=xmax;
%下面的函数产生新解
function [d_f,pi_r]=exchange_2(pi0,d)
[m,n]=size(d);
clear m;
u=rand;
u=u*(n-2);
u=round(u);
if u<2
u=2;
end
if u>n-2
u=n-2;
end
v=rand;
v=v*(n-u+1);
v=round(v);
if v<1
v=1;
end
v=v+u;
if v>n
v=n;
end
pi_1(u)=pi0(v);
pi_1(u)=pi0(u);
if u>1
for k=1:(u-1)
pi_1(k)=pi0(k);
end
end
if v>(u+1)
for k=1:(v-u-1)
pi_1(u+k)=pi0(v-k);
end
end
if v<n
for k=(v+1):n
pi_1(k)=pi0(k);
end
end
d_f=0;
if v<n
d_f=d(pi0(u-1),pi0(v))+d(pi0(u),pi0(v+1));
for k=(u+1):n
d_f=d_f+d(pi0(k),pi0(k-1))-d(pi0(v),pi0(v+1));
end
d_f=d_f-d(pi0(u-1),pi0(u));
for k=(u+1):n
d_f=d_f-d(pi0(k-1),pi0(k));
end
else
d_f=d(pi0(u-1),pi0(v))+d(pi0(u),pi0(1))-d(pi0(u-1),pi0(u))-d(pi0(v),pi0(1));
for k=(u+1):n
d_f=d_f-d(pi0(k),pi0(k-1));
end
for k=(u+1):n
d_f=d_f-d(pi0(k-1),pi0(k));
end
end
pi_r=pi_1;
遗传算法GA
遗传算法：
旅行商问题(traveling saleman problem,简称tsp)：
已知n个城市之间的相互距离，现有一个推销员必须遍访这n个城市，并且每个城市只能访问一次，最后又必须返回出发城市。如何安排他对这些城市的访问次序，可使其旅行路线的总长度最短？
用图论的术语来说，假设有一个图 g=(v,e)，其中v是顶点集，e是边集，设d=(dij)是由顶点i和顶点j之间的距离所组成的距离矩阵，旅行商问题就是求出一条通过所有顶点且每个顶点只通过一次的具有最短距离的回路。
这个问题可分为对称旅行商问题(dij=dji,,任意i,j=1,2,3，…,n)和非对称旅行商问题(dij≠dji,,任意i,j=1,2,3，…,n)。
若对于城市v={v1,v2,v3,…,vn}的一个访问顺序为t=(t1,t2,t3,…,ti,…,tn),其中ti∈v(i=1,2,3,…,n)，且记tn+1= t1，则旅行商问题的数学模型为：
min l=σd(t(i),t(i+1)) （i=1,…,n）
旅行商问题是一个典型的组合优化问题，并且是一个np难问题，其可能的路径数目与城市数目n是成指数型增长的，所以一般很难精确地求出其最优解，本文采用遗传算法求其近似解。
遗传算法：
初始化过程：用v1,v2,v3,…,vn代表所选n个城市。定义整数pop-size作为染色体的个数，并且随机产生pop-size个初始染色体，每个染色体为1到18的整数组成的随机序列。
适应度f的计算：对种群中的每个染色体vi，计算其适应度，f=σd(t(i),t(i+1)).
评价函数eval(vi)：用来对种群中的每个染色体vi设定一个概率，以使该染色体被选中的可能性与其种群中其它染色体的适应性成比例，既通过轮盘赌，适应性强的染色体被选择产生后台的机会要大，设alpha∈(0,1)，本文定义基于序的评价函数为eval(vi)=alpha*(1-alpha).^(i-1) 。[随机规划与模糊规划]
选择过程：选择过程是以旋转赌轮pop-size次为基础，每次旋转都为新的种群选择一个染色体。赌轮是按每个染色体的适应度进行选择染色体的。
step1 、对每个染色体vi,计算累计概率qi，q0=0;qi=σeval(vj) j=1,…,i;i=1,…pop-size.
step2、从区间(0,pop-size)中产生一个随机数r；
step3、若qi-1<r<qi,则选择第i个染色体 ；
step4、重复step2和step3共pop-size次，这样可以得到pop-size个复制的染色体。
grefenstette编码：由于常规的交叉运算和变异运算会使种群中产生一些无实际意义的染色体，本文采用grefenstette编码《遗传算法原理及应用》可以避免这种情况的出现。所谓的grefenstette编码就是用所选队员在未选（不含淘汰）队员中的位置，如：
8 15 2 16 10 7 4 3 11 14 6 12 9 5 18 13 17 1
对应：
8 14 2 13 8 6 3 2 5 7 3 4 3 2 4 2 2 1。
交叉过程：本文采用常规单点交叉。为确定交叉操作的父代，从 到pop-size重复以下过程：从[0，1]中产生一个随机数r，如果r<pc ，则选择vi作为一个父代。
将所选的父代两两组队，随机产生一个位置进行交叉，如：
8 14 2 13 8 6 3 2 5 7 3 4 3 2 4 2 2 1
6 12 3 5 6 8 5 6 3 1 8 5 6 3 3 2 1 1
交叉后为：
8 14 2 13 8 6 3 2 5 1 8 5 6 3 3 2 1 1
6 12 3 5 6 8 5 6 3 7 3 4 3 2 4 2 2 1
变异过程：本文采用均匀多点变异。类似交叉操作中选择父代的过程，在r<pm 的标准下选择多个染色体vi作为父代。对每一个选择的父代，随机选择多个位置，使其在每位置按均匀变异（该变异点xk的取值范围为[ukmin,ukmax],产生一个[0，1]中随机数r，该点变异为x'k=ukmin+r(ukmax-ukmin)）操作。如：
8 14 2 13 8 6 3 2 5 7 3 4 3 2 4 2 2 1
变异后：
8 14 2 13 10 6 3 2 2 7 3 4 5 2 4 1 2 1
反grefenstette编码：交叉和变异都是在grefenstette编码之后进行的，为了循环操作和返回最终结果，必须逆grefenstette编码过程，将编码恢复到自然编码。
循环操作：判断是否满足设定的带数xzome，否，则跳入适应度f的计算；是，结束遗传操作，跳出。
Matlab程序：
function [bestpop,trace]=ga(d,termops,num,pc,cxops,pm,alpha)
%
%————————————————————————
%[bestpop,trace]=ga(d,termops,num,pc,cxops,pm,alpha)
%d:距离矩阵
%termops:种群代数
%num:每代染色体的个数
%pc:交叉概率
%cxops:由于本程序采用单点交叉，交叉点的设置在本程序中没有很好的解决，所以本文了采用定点，即第cxops，可以随机产生。
%pm:变异概率
%alpha:评价函数eval(vi)=alpha*(1-alpha).^(i-1).
%bestpop:返回的最优种群
%trace:进化轨迹
%------------------------------------------------
%####@@@##版权所有！欢迎广大网友改正，改进！##@@@####
%e-mail:tobysidney33@sohu.com
%####################################################
%
citynum=size(d,2);
n=nargin;
if n<2
disp('缺少变量！！')
disp('^_^开个玩笑^_^')
end
if n<2
termops=500;
num=50;
pc=0.25;
cxops=3;
pm=0.30;
alpha=0.10;
end
if n<3
num=50;
pc=0.25;
cxops=3;
pm=0.30;
alpha=0.10;
end
if n<4
pc=0.25;
cxops=3;
pm=0.30;
alpha=0.10;
end
if n<5
cxops=3;
pm=0.30;
alpha=0.10;
end
if n<6
pm=0.30;
alpha=0.10;
end
if n<7
alpha=0.10;
end
if isempty(cxops)
cxops=3;
end
[t]=initializega(num,citynum);
for i=1:termops
[l]=f(d,t);
[x,y]=find(l==max(l));
trace(i)=-l(y(1));
bestpop=t(y(1),:);
[t]=select(t,l,alpha);
[g]=grefenstette(t);
[g1]=crossover(g,pc,cxops);
[g]=mutation(g1,pm); %均匀变异
[t]=congrefenstette(g);
end
---------------------------------------------------------
function [t]=initializega(num,citynum)
for i=1:num
t(i,:)=randperm(citynum);
end
-----------------------------------------------------------
function [l]=f(d,t)
[m,n]=size(t);
for k=1:m
for i=1:n-1
l(k,i)=d(t(k,i),t(k,i+1));
end
l(k,n)=d(t(k,n),t(k,1));
l(k)=-sum(l(k,:));
end
-----------------------------------------------------------
function [t]=select(t,l,alpha)
[m,n]=size(l);
t1=t;
[beforesort,aftersort1]=sort(l,2);%fsort from l to u
for i=1:n
aftersort(i)=aftersort1(n+1-i); %change
end
for k=1:n;
t(k,:)=t1(aftersort(k),:);
l1(k)=l(aftersort(k));
end
t1=t;
l=l1;
for i=1:size(aftersort,2)
evalv(i)=alpha*(1-alpha).^(i-1);
end
m=size(t,1);
q=cumsum(evalv);
qmax=max(q);
for k=1:m
r=qmax*rand(1);
for j=1:m
if j==1&r<=q(1)
t(k,:)=t1(1,:);
elseif j~=1&r>q(j-1)&r<=q(j)
t(k,:)=t1(j,:);
end
end
end
--------------------------------------------------
function [g]=grefenstette(t)
[m,n]=size(t);
for k=1:m
t0=1:n;
for i=1:n
for j=1:length(t0)
if t(k,i)==t0(j)
g(k,i)=j;
t0(j)=[];
break
end
end
end
end
-------------------------------------------
function [g]=crossover(g,pc,cxops)
[m,n]=size(g);
ran=rand(1,m);
r=cxops;
[x,ru]=find(ran<pc);
if ru>=2
for k=1:2:length(ru)-1
g1(ru(k),:)=[g(ru(k),[1:r]),g(ru(k+1),[(r+1):n])];
g(ru(k+1),:)=[g(ru(k+1),[1:r]),g(ru(k),[(r+1):n])];
g(ru(k),:)=g1(ru(k),:);
end
end
--------------------------------------------
function [g]=mutation(g,pm) %均匀变异
[m,n]=size(g);
ran=rand(1,m);
r=rand(1,3); %dai gai jin
rr=floor(n*rand(1,3)+1);
[x,mu]=find(ran<pm);
for k=1:length(mu)
for i=1:length(r)
umax(i)=n+1-rr(i);
umin(i)=1;
g(mu(k),rr(i))=umin(i)+floor((umax(i)-umin(i))*r(i));
end
end
---------------------------------------------------
function [t]=congrefenstette(g)
[m,n]=size(g);
for k=1:m
t0=1:n;
for i=1:n
t(k,i)=t0(g(k,i));
t0(g(k,i))=[];
end
end
-------------------------------------------------
又一个Matlab程序，其中交叉算法采用的是由Goldberg和Lingle于1985年提出的PMX(部分匹配交叉)，淘汰保护指数alpha是我自己设计的，起到了加速优胜劣汰的作用。
%TSP问题（又名：旅行商问题，货郎担问题）遗传算法通用matlab程序
%D是距离矩阵，n为种群个数,建议取为城市个数的1~2倍，
%C为停止代数，遗传到第 C代时程序停止,C的具体取值视问题的规模和耗费的时间而定
%m为适应值归一化淘汰加速指数 ,最好取为1,2,3,4 ,不宜太大
%alpha为淘汰保护指数,可取为0~1之间任意小数,取1时关闭保护功能,最好取为0.8~1.0
%R为最短路径,Rlength为路径长度
function [R,Rlength]=geneticTSP(D,n,C,m,alpha)
[N,NN]=size(D);
farm=zeros(n,N);%用于存储种群
for i=1:n
farm(i,:)=randperm(N);%随机生成初始种群
end
R=farm(1,:);%存储最优种群
len=zeros(n,1);%存储路径长度
fitness=zeros(n,1);%存储归一化适应值
counter=0;
while counter<C
for i=1:n
len(i,1)=myLength(D,farm(i,:));%计算路径长度
end
maxlen=max(len);
minlen=min(len);
fitness=fit(len,m,maxlen,minlen);%计算归一化适应值
rr=find(len==minlen);
R=farm(rr(1,1),:);%更新最短路径
FARM=farm;%优胜劣汰，nn记录了复制的个数
nn=0;
for i=1:n
if fitness(i,1)>=alpha*rand
nn=nn+1;
FARM(nn,:)=farm(i,:);
end
end
FARM=FARM(1:nn,:);
[aa,bb]=size(FARM);%交叉和变异
while aa<n
if nn<=2
nnper=randperm(2);
else
nnper=randperm(nn);
end
A=FARM(nnper(1),:);
B=FARM(nnper(2),:);
[A,B]=intercross(A,B);
FARM=[FARM;A;B];
[aa,bb]=size(FARM);
end
if aa>n
FARM=FARM(1:n,:);%保持种群规模为n
end
farm=FARM;
clear FARM
counter=counter+1
end
Rlength=myLength(D,R);
function [a,b]=intercross(a,b)
L=length(a);
if L<=10%确定交叉宽度
W=1;
elseif ((L/10)-floor(L/10))>=rand&&L>10
W=ceil(L/10);
else
W=floor(L/10);
end
p=unidrnd(L-W+1);%随机选择交叉范围，从p到p+W
for i=1:W%交叉
x=find(a==b(1,p+i-1));
y=find(b==a(1,p+i-1));
[a(1,p+i-1),b(1,p+i-1)]=exchange(a(1,p+i-1),b(1,p+i-1));
[a(1,x),b(1,y)]=exchange(a(1,x),b(1,y));
end
function [x,y]=exchange(x,y)
temp=x;
x=y;
y=temp;
% 计算路径的子程序
function len=myLength(D,p)
[N,NN]=size(D);
len=D(p(1,N),p(1,1));
for i=1:(N-1)
len=len+D(p(1,i),p(1,i+1));
end
%计算归一化适应值子程序
function fitness=fit(len,m,maxlen,minlen)
fitness=len;
for i=1:length(len)
fitness(i,1)=(1-((len(i,1)-minlen)/(maxlen-minlen+0.000001))).^m;
end
一个C++的程序：
//c++的程序
#include<iostream.h>
#include<stdlib.h>
template<class T>
class Graph
{
public:
Graph(int vertices=10)
{
n=vertices;
e=0;
}
~Graph(){}
virtual bool Add(int u,int v,const T& w)=0;
virtual bool Delete(int u,int v)=0;
virtual bool Exist(int u,int v)const=0;
int Vertices()const{return n;}
int Edges()const{return e;}
protected:
int n;
int e;
};
template<class T>
class MGraph:public Graph<T>
{
public:
MGraph(int Vertices=10,T noEdge=0);
~MGraph();
bool Add(int u,int v,const T& w);
bool Delete(int u,int v);
bool Exist(int u,int v)const;
void Floyd(T**& d,int**& path);
void print(int Vertices);
private:
T NoEdge;
T** a;
};
template<class T>
MGraph<T>::MGraph(int Vertices,T noEdge)
{
n=Vertices;
NoEdge=noEdge;
a=new T* [n];
for(int i=0;i<n;i++){
a[i]=new T[n];
a[i][i]=0;
for(int j=0;j<n;j++)if(i!=j)a[i][j]=NoEdge;
}
}
template<class T>
MGraph<T>::~MGraph()
{
for(int i=0;i<n;i++)delete[]a[i];
delete[]a;
}
template<class T>
bool MGraph<T>::Exist(int u,int v)const
{
if(u<0||v<0||u>n-1||v>n-1||u==v||a[u][v]==NoEdge)return false;
return true;
}
template<class T>
bool MGraph<T>::Add(int u,int v,const T& w)
{
if(u<0||v<0||u>n-1||v>n-1||u==v||a[u][v]!=NoEdge){
cerr<<"BadInput!"<<endl;
return false;
}
a[u][v]=w;
e++;
return true;
}
template<class T>
bool MGraph<T>:delete(int u,int v)
{
if(u<0||v<0||u>n-1||v>n-1||u==v||a[u][v]==NoEdge){
cerr<<"BadInput!"<<endl;
return false;
}
a[u][v]=NoEdge;
e--;
return true;
}
template<class T>
void MGraph<T>::Floyd(T**& d,int**& path)
{
d=new T* [n];
path=new int* [n];
for(int i=0;i<n;i++){
d[i]=new T[n];
path[i]=new int[n];
for(int j=0;j<n;j++){
d[i][j]=a[i][j];
if(i!=j&&a[i][j]<NoEdge)path[i][j]=i;
else path[i][j]=-1;
}
}
for(int k=0;k<n;k++){
for(i=0;i<n;i++)
for(int j=0;j<n;j++)
if(d[i][k]+d[k][j]<d[i][j]){
d[i][j]=d[i][k]+d[k][j];
path[i][j]=path[k][j];
}
}
}
template<class T>
void MGraph<T>::print(int Vertices)
{
for(int i=0;i<Vertices;i++)
for(int j=0;j<Vertices;j++)
{
cout<<a[i][j]<<' ';if(j==Vertices-1)cout<<endl;
}
}
#define noEdge 10000
#include<iostream.h>
void main()
{
cout<<"请输入该图的节点数："<<endl;
int vertices;
cin>>vertices;
MGraph<float> b(vertices,noEdge);
cout<<"请输入u,v,w:"<<endl;
int u,v;
float w;
cin>>u>>v>>w;
while(w!=noEdge){
//u=u-1;
b.Add(u-1,v-1,w);
b.Add(v-1,u-1,w);
cout<<"请输入u,v,w:"<<endl;
cin>>u>>v>>w;
}
b.print(vertices);
int** Path;
int**& path=Path;
float** D;
float**& d=D;
b.Floyd(d,path);
for(int i=0;i<vertices;i++){
for(int j=0;j<vertices;j++){
cout<<Path[i][j]<<' ';
if(j==vertices-1)cout<<endl;
}
}
int *V;
V=new int[vertices+1];
cout<<"请输入任意一个初始H-圈："<<endl;
for(int n=0;n<=vertices;n++){
cin>>V[n];
}
for(n=0;n<55;n++){
for(i=0;i<n-1;i++){
for(int j=0;j<n-1;j++)
{
if(i+1>0&&j>i+1&&j<n-1){
if(D[V[i]][V[j]]+D[V[i+1]][V[j+1]]<D[V[i]][V[i+1]]+D[V[j]][V[j+1]]){
int l;
l=V[i+1];V[i+1]=V[j];V[j]=l;
}
}
}
}
}
float total=0;
cout<<"最小回路："<<endl;
for(i=0;i<=vertices;i++){
cout<<V[i]+1<<' ';
}
cout<<endl;
for(i=0;i<vertices;i++)
total+=D[V[i]][V[i+1]];
cout<<"最短路径长度："<<endl;
cout<<total;
}
C语言程序
#include<stdio.h>
#include<stdlib.h>
#include<math.h>
#include<alloc.h>
#include<conio.h>
#include<float.h>
#include<time.h>
#include<graphics.h>
#include<bios.h>
#define maxpop 100
#define maxstring 100
#include<stdlib.h>
#include<math.h>
#include<alloc.h>
#include<conio.h>
#include<float.h>
#include<time.h>
#include<graphics.h>
#include<bios.h>
#define maxpop 100
#define maxstring 100
struct pp{unsigned char chrom[maxstring];
float x,fitness;
unsigned int parent1,parent2,xsite;
};
struct pp *oldpop,*newpop,*p1;
unsigned int popsize,lchrom,gem,maxgen,co_min,jrand;
unsigned int nmutation,ncross,jcross,maxpp,minpp,maxxy;
float pcross,pmutation,sumfitness,avg,max,min,seed,maxold,oldrand[maxstring];
unsigned char x[maxstring],y[maxstring];
float *dd,ff,maxdd,refpd,fm[201];
FILE *fp,*fp1;
float objfunc(float);
void statistics();
int select();
int flip(float);
int crossover();
void generation();
void initialize();
void report();
float decode();
void crtinit();
void inversion();
float random1();
void randomize1();
main()
{unsigned int gen,k,j,tt;
char fname[10];
float ttt;
clrscr();
co_min=0;
if((oldpop=(struct pp *)farmalloc(maxpop*sizeof(struct pp)))==NULL)
{printf("memory requst fail!\n");exit(0);}
if((dd=(float *)farmalloc(maxstring*maxstring*sizeof(float)))==NULL)
{printf("memory requst fail!\n");exit(0);}
if((newpop=(struct pp *)farmalloc(maxpop*sizeof(struct pp)))==NULL)
{printf("memory requst fail!\n");exit(0);}
if((p1=(struct pp *)farmalloc(sizeof(struct pp)))==NULL)
{printf("memory requst fail!\n");exit(0);}
for(k=0;k<maxpop;k++) oldpop[k].chrom[0]='\0';
for(k=0;k<maxpop;k++) newpop[k].chrom[0]='\0';
printf("Enter Result Data Filename:");
gets(fname);
if((fp=fopen(fname,"w+"))==NULL)
{printf("cannot open file\n");exit(0);}
float x,fitness;
unsigned int parent1,parent2,xsite;
};
struct pp *oldpop,*newpop,*p1;
unsigned int popsize,lchrom,gem,maxgen,co_min,jrand;
unsigned int nmutation,ncross,jcross,maxpp,minpp,maxxy;
float pcross,pmutation,sumfitness,avg,max,min,seed,maxold,oldrand[maxstring];
unsigned char x[maxstring],y[maxstring];
float *dd,ff,maxdd,refpd,fm[201];
FILE *fp,*fp1;
float objfunc(float);
void statistics();
int select();
int flip(float);
int crossover();
void generation();
void initialize();
void report();
float decode();
void crtinit();
void inversion();
float random1();
void randomize1();
main()
{unsigned int gen,k,j,tt;
char fname[10];
float ttt;
clrscr();
co_min=0;
if((oldpop=(struct pp *)farmalloc(maxpop*sizeof(struct pp)))==NULL)
{printf("memory requst fail!\n");exit(0);}
if((dd=(float *)farmalloc(maxstring*maxstring*sizeof(float)))==NULL)
{printf("memory requst fail!\n");exit(0);}
if((newpop=(struct pp *)farmalloc(maxpop*sizeof(struct pp)))==NULL)
{printf("memory requst fail!\n");exit(0);}
if((p1=(struct pp *)farmalloc(sizeof(struct pp)))==NULL)
{printf("memory requst fail!\n");exit(0);}
for(k=0;k<maxpop;k++) oldpop[k].chrom[0]='\0';
for(k=0;k<maxpop;k++) newpop[k].chrom[0]='\0';
printf("Enter Result Data Filename:");
gets(fname);
if((fp=fopen(fname,"w+"))==NULL)
{printf("cannot open file\n");exit(0);}
gen=0;
randomize();
initialize();
fputs("this is result of the TSP problem:",fp);
fprintf(fp,"city: %2d psize: %3d Ref.TSP_path: %f\n",lchrom,popsize,refpd);
fprintf(fp,"Pc: %f Pm: %f Seed: %f\n",pcross,pmutation,seed);
fprintf(fp,"X site:\n");
for(k=0;k<lchrom;k++)
{if((k%16)==0) fprintf(fp,"\n");
fprintf(fp,"%5d",x[k]);
}
fprintf(fp,"\n Y site:\n");
for(k=0;k<lchrom;k++)
{if((k%16)==0) fprintf(fp,"\n");
fprintf(fp,"%5d",y[k]);
}
fprintf(fp,"\n");
randomize();
initialize();
fputs("this is result of the TSP problem:",fp);
fprintf(fp,"city: %2d psize: %3d Ref.TSP_path: %f\n",lchrom,popsize,refpd);
fprintf(fp,"Pc: %f Pm: %f Seed: %f\n",pcross,pmutation,seed);
fprintf(fp,"X site:\n");
for(k=0;k<lchrom;k++)
{if((k%16)==0) fprintf(fp,"\n");
fprintf(fp,"%5d",x[k]);
}
fprintf(fp,"\n Y site:\n");
for(k=0;k<lchrom;k++)
{if((k%16)==0) fprintf(fp,"\n");
fprintf(fp,"%5d",y[k]);
}
fprintf(fp,"\n");
crtinit();
statistics(oldpop);
report(gen,oldpop);
getch();
maxold=min;
fm[0]=100.0*oldpop[maxpp].x/ff;
do {
gen=gen+1;
generation();
statistics(oldpop);
if(max>maxold)
{maxold=max;
co_min=0;
}
fm[gen%200]=100.0*oldpop[maxpp].x/ff;
report(gen,oldpop);
gotoxy(30,25);
ttt=clock()/18.2;
tt=ttt/60;
printf("Run Clock: %2d: %2d: %4.2f",tt/60,tt%60,ttt-tt*60.0);
printf("Min=%6.4f Nm:%d\n",min,co_min);
}while((gen<100)&&!bioskey(1));
printf("\n gen= %d",gen);
do{
gen=gen+1;
generation();
statistics(oldpop);
if(max>maxold)
{maxold=max;
co_min=0;
}
fm[gen%200]=100.0*oldpop[maxpp].x/ff;
report(gen,oldpop);
if((gen%100)==0)report(gen,oldpop);
gotoxy(30,25);
ttt=clock()/18.2;
tt=ttt/60;
printf("Run Clock: %2d: %2d: %4.2f",tt/60,tt%60,ttt-tt*60.0);
printf("Min=%6.4f Nm:%d\n",min,co_min);
}while((gen<maxgen)&&!bioskey(1));
getch();
for(k=0;k<lchrom;k++)
{if((k%16)==0)fprintf(fp,"\n");
fprintf(fp,"%5d",oldpop[maxpp].chrom[k]);
}
fprintf(fp,"\n");
fclose(fp);
farfree(dd);
farfree(p1);
farfree(oldpop);
farfree(newpop);
restorecrtmode();
exit(0);
}
/*%%%%%%%%%%%%%%%%*/
float objfunc(float x1)
{float y;
y=100.0*ff/x1;
return y;
}
/*&&&&&&&&&&&&&&&&&&&*/
void statistics(pop)
struct pp *pop;
{int j;
sumfitness=pop[0].fitness;
min=pop[0].fitness;
max=pop[0].fitness;
maxpp=0;
minpp=0;
for(j=1;j<popsize;j++)
{sumfitness=sumfitness+pop[j].fitness;
if(pop[j].fitness>max)
{max=pop[j].fitness;
maxpp=j;
}
if(pop[j].fitness<min)
{min=pop[j].fitness;
minpp=j;
}
}
avg=sumfitness/(float)popsize;
}
/*%%%%%%%%%%%%%%%%%%%%*/
void generation()
{unsigned int k,j,j1,j2,i1,i2,mate1,mate2;
float f1,f2;
j=0;
do{
mate1=select();
pp:mate2=select();
if(mate1==mate2)goto pp;
crossover(oldpop[mate1].chrom,oldpop[mate2].chrom,j);
newpop[j].x=(float)decode(newpop[j].chrom);
newpop[j].fitness=objfunc(newpop[j].x);
newpop[j].parent1=mate1;
newpop[j].parent2=mate2;
newpop[j].xsite=jcross;
newpop[j+1].x=(float)decode(newpop[j+1].chrom);
newpop[j+1].fitness=objfunc(newpop[j+1].x);
newpop[j+1].parent1=mate1;
newpop[j+1].parent2=mate2;
newpop[j+1].xsite=jcross;
if(newpop[j].fitness>min)
{for(k=0;k<lchrom;k++)
oldpop[minpp].chrom[k]=newpop[j].chrom[k];
oldpop[minpp].x=newpop[j].x;
oldpop[minpp].fitness=newpop[j].fitness;
co_min++;
return;
}
if(newpop[j+1].fitness>min)
{for(k=0;k<lchrom;k++)
oldpop[minpp].chrom[k]=newpop[j+1].chrom[k];
oldpop[minpp].x=newpop[j+1].x;
oldpop[minpp].fitness=newpop[j+1].fitness;
co_min++;
return;
}
j=j+2;
}while(j<popsize);
}
/*%%%%%%%%%%%%%%%%%*/
void initdata()
{unsigned int ch,j;
clrscr();
printf("-----------------------\n");
printf("A SGA\n");
printf("------------------------\n");
/*pause();*/clrscr();
printf("*******SGA DATA ENTRY AND INITILIZATION *******\n");
printf("\n");
printf("input pop size");scanf("%d",&popsize);
printf("input chrom length");scanf("%d",&lchrom);
printf("input max generations");scanf("%d",&maxgen);
printf("input crossover probability");scanf("%f",&pcross);
printf("input mutation prob");scanf("%f",&pmutation);
randomize1();
clrscr();
nmutation=0;
ncross=0;
}
/*%%%%%%%%%%%%%%%%%%%%*/
void initreport()
{int j,k;
printf("pop size=%d\n",popsize);
printf("chromosome length=%d\n",lchrom);
printf("maxgen=%d\n",maxgen);
printf("pmutation=%f\n",pmutation);
printf("pcross=%f\n",pcross);
printf("initial generation statistics\n");
printf("ini pop max fitness=%f\n",max);
printf("ini pop avr fitness=%f\n",avg);
printf("ini pop min fitness=%f\n",min);
printf("ini pop sum fit=%f\n",sumfitness);
}
statistics(oldpop);
report(gen,oldpop);
getch();
maxold=min;
fm[0]=100.0*oldpop[maxpp].x/ff;
do {
gen=gen+1;
generation();
statistics(oldpop);
if(max>maxold)
{maxold=max;
co_min=0;
}
fm[gen%200]=100.0*oldpop[maxpp].x/ff;
report(gen,oldpop);
gotoxy(30,25);
ttt=clock()/18.2;
tt=ttt/60;
printf("Run Clock: %2d: %2d: %4.2f",tt/60,tt%60,ttt-tt*60.0);
printf("Min=%6.4f Nm:%d\n",min,co_min);
}while((gen<100)&&!bioskey(1));
printf("\n gen= %d",gen);
do{
gen=gen+1;
generation();
statistics(oldpop);
if(max>maxold)
{maxold=max;
co_min=0;
}
fm[gen%200]=100.0*oldpop[maxpp].x/ff;
report(gen,oldpop);
if((gen%100)==0)report(gen,oldpop);
gotoxy(30,25);
ttt=clock()/18.2;
tt=ttt/60;
printf("Run Clock: %2d: %2d: %4.2f",tt/60,tt%60,ttt-tt*60.0);
printf("Min=%6.4f Nm:%d\n",min,co_min);
}while((gen<maxgen)&&!bioskey(1));
getch();
for(k=0;k<lchrom;k++)
{if((k%16)==0)fprintf(fp,"\n");
fprintf(fp,"%5d",oldpop[maxpp].chrom[k]);
}
fprintf(fp,"\n");
fclose(fp);
farfree(dd);
farfree(p1);
farfree(oldpop);
farfree(newpop);
restorecrtmode();
exit(0);
}
/*%%%%%%%%%%%%%%%%*/
float objfunc(float x1)
{float y;
y=100.0*ff/x1;
return y;
}
/*&&&&&&&&&&&&&&&&&&&*/
void statistics(pop)
struct pp *pop;
{int j;
sumfitness=pop[0].fitness;
min=pop[0].fitness;
max=pop[0].fitness;
maxpp=0;
minpp=0;
for(j=1;j<popsize;j++)
{sumfitness=sumfitness+pop[j].fitness;
if(pop[j].fitness>max)
{max=pop[j].fitness;
maxpp=j;
}
if(pop[j].fitness<min)
{min=pop[j].fitness;
minpp=j;
}
}
avg=sumfitness/(float)popsize;
}
/*%%%%%%%%%%%%%%%%%%%%*/
void generation()
{unsigned int k,j,j1,j2,i1,i2,mate1,mate2;
float f1,f2;
j=0;
do{
mate1=select();
pp:mate2=select();
if(mate1==mate2)goto pp;
crossover(oldpop[mate1].chrom,oldpop[mate2].chrom,j);
newpop[j].x=(float)decode(newpop[j].chrom);
newpop[j].fitness=objfunc(newpop[j].x);
newpop[j].parent1=mate1;
newpop[j].parent2=mate2;
newpop[j].xsite=jcross;
newpop[j+1].x=(float)decode(newpop[j+1].chrom);
newpop[j+1].fitness=objfunc(newpop[j+1].x);
newpop[j+1].parent1=mate1;
newpop[j+1].parent2=mate2;
newpop[j+1].xsite=jcross;
if(newpop[j].fitness>min)
{for(k=0;k<lchrom;k++)
oldpop[minpp].chrom[k]=newpop[j].chrom[k];
oldpop[minpp].x=newpop[j].x;
oldpop[minpp].fitness=newpop[j].fitness;
co_min++;
return;
}
if(newpop[j+1].fitness>min)
{for(k=0;k<lchrom;k++)
oldpop[minpp].chrom[k]=newpop[j+1].chrom[k];
oldpop[minpp].x=newpop[j+1].x;
oldpop[minpp].fitness=newpop[j+1].fitness;
co_min++;
return;
}
j=j+2;
}while(j<popsize);
}
/*%%%%%%%%%%%%%%%%%*/
void initdata()
{unsigned int ch,j;
clrscr();
printf("-----------------------\n");
printf("A SGA\n");
printf("------------------------\n");
/*pause();*/clrscr();
printf("*******SGA DATA ENTRY AND INITILIZATION *******\n");
printf("\n");
printf("input pop size");scanf("%d",&popsize);
printf("input chrom length");scanf("%d",&lchrom);
printf("input max generations");scanf("%d",&maxgen);
printf("input crossover probability");scanf("%f",&pcross);
printf("input mutation prob");scanf("%f",&pmutation);
randomize1();
clrscr();
nmutation=0;
ncross=0;
}
/*%%%%%%%%%%%%%%%%%%%%*/
void initreport()
{int j,k;
printf("pop size=%d\n",popsize);
printf("chromosome length=%d\n",lchrom);
printf("maxgen=%d\n",maxgen);
printf("pmutation=%f\n",pmutation);
printf("pcross=%f\n",pcross);
printf("initial generation statistics\n");
printf("ini pop max fitness=%f\n",max);
printf("ini pop avr fitness=%f\n",avg);
printf("ini pop min fitness=%f\n",min);
printf("ini pop sum fit=%f\n",sumfitness);
}
void initpop()
{unsigned char j1;
unsigned int k5,i1,i2,j,i,k,j2,j3,j4,p5[maxstring];
float f1,f2;
j=0;
for(k=0;k<lchrom;k++)
oldpop[j].chrom[k]=k;
for(k=0;k<lchrom;k++)
p5[k]=oldpop[j].chrom[k];
randomize();
for(;j<popsize;j++)
{j2=random(lchrom);
for(k=0;k<j2+20;k++)
{j3=random(lchrom);
j4=random(lchrom);
j1=p5[j3];
p5[j3]=p5[j4];
p5[j4]=j1;
}
for(k=0;k<lchrom;k++)
oldpop[j].chrom[k]=p5[k];
}
for(k=0;k<lchrom;k++)
for(j=0;j<lchrom;j++)
dd[k*lchrom+j]=hypot(x[k]-x[j],y[k]-y[j]);
for(j=0;j<popsize;j++)
{oldpop[j].x=(float)decode(oldpop[j].chrom);
oldpop[j].fitness=objfunc(oldpop[j].x);
oldpop[j].parent1=0;
oldpop[j].parent2=0;
oldpop[j].xsite=0;
}
}
/*&&&&&&&&&&&&&&&&&*/
void initialize()
{int k,j,minx,miny,maxx,maxy;
initdata();
minx=0;
miny=0;
maxx=0;maxy=0;
for(k=0;k<lchrom;k++)
{x[k]=rand();
if(x[k]>maxx)maxx=x[k];
if(x[k]<minx)minx=x[k];
y[k]=rand();
if(y[k]>maxy)maxy=y[k];
if(y[k]<miny)miny=y[k];
}
if((maxx-minx)>(maxy-miny))
{maxxy=maxx-minx;}
else {maxxy=maxy-miny;}
maxdd=0.0;
for(k=0;k<lchrom;k++)
for(j=0;j<lchrom;j++)
{dd[k*lchrom+j]=hypot(x[k]-x[j],y[k]-y[j]);
if(maxdd<dd[k*lchrom+j])maxdd=dd[k*lchrom+j];
}
refpd=dd[lchrom-1];
for(k=0;k<lchrom;k++)
refpd=refpd+dd[k*lchrom+k+2];
for(j=0;j<lchrom;j++)
dd[j*lchrom+j]=4.0*maxdd;
ff=(0.765*maxxy*pow(lchrom,0.5));
minpp=0;
min=dd[lchrom-1];
for(j=0;j<lchrom-1;j++)
{if(dd[lchrom*j+lchrom-1]<min)
{min=dd[lchrom*j+lchrom-1];
minpp=j;
}
}
initpop();
statistics(oldpop);
initreport();
}
/*&&&&&&&&&&&&&&&&&&*/
void report(int l,struct pp *pop)
{int k,ix,iy,jx,jy;
unsigned int tt;
float ttt;
cleardevice();
gotoxy(1,1);
printf("city:%4d para_size:%4d maxgen:%4d ref_tour:%f\n"
,lchrom,popsize,maxgen,refpd);
printf("ncross:%4d Nmutation:%4d Rungen:%4d AVG=%8.4f MIN=%8.4f\n\n"
,ncross,nmutation,l,avg,min);
printf("Ref.cominpath:%6.4f Minpath length:%10.4f Ref_co_tour:%f\n"
,pop[maxpp].x/maxxy,pop[maxpp].x,ff);
printf("Co_minpath:%6.4f Maxfit:%10.8f"
,100.0*pop[maxpp].x/ff,pop[maxpp].fitness);
ttt=clock()/18.2;
tt=ttt/60;
printf("Run clock:%2d:%2d:%4d.2f\n",tt/60,tt%60,ttt-tt*60.0);
setcolor(1%15+1);
for(k=0;k<lchrom-1;k++)
{ix=x[pop[maxpp].chrom[k]];
iy=y[pop[maxpp].chrom[k]]+110;
jx=x[pop[maxpp].chrom[k+1]];
jy=y[pop[maxpp].chrom[k+1]]+110;
line(ix,iy,jx,jy);
putpixel(ix,iy,RED);
}
ix=x[pop[maxpp].chrom[0]];
iy=y[pop[maxpp].chrom[0]]+110;
jx=x[pop[maxpp].chrom[lchrom-1]];
jy=y[pop[maxpp].chrom[lchrom-1]]+110;
line(ix,iy,jx,jy);
putpixel(jx,jy,RED);
setcolor(11);
outtextxy(ix,iy,"*");
setcolor(12);
for(k=0;k<1%200;k++)
{ix=k+280;
iy=366-fm[k]/3;
jx=ix+1;
jy=366-fm[k+1]/3;
line(ix,iy,jx,jy);
putpixel(ix,iy,RED);
}
printf("GEN:%3d",l);
printf("Minpath:%f Maxfit:%f",pop[maxpp].x,pop[maxpp].fitness);
printf("Clock:%2d:%2d:%4.2f\n",tt/60,tt%60,ttt-tt*60.0);
}
/*###############*/
float decode(unsigned char *pp)
{int j,k,l;
float tt;
tt=dd[pp[0]*lchrom+pp[lchrom-1]];
for(j=0;j<lchrom-1;j++)
{tt=tt+dd[pp[j]*lchrom+pp[j+1]];}
l=0;
for(k=0;k<lchrom-1;k++)
for(j=k+1;j<lchrom;j++)
{if(pp[j]==pp[k])l++;}
return tt+4*l*maxdd;
}
/*%%%%%%%%%%%%%%%%%%*/
void crtinit()
{int driver,mode;
struct palettetype p;
driver=DETECT;
mode=0;
initgraph(&driver,&mode,"");
cleardevice();
}
/*$$$$$$$$$$$$$$$$$$$$*/
int select()
{double rand1,partsum;
float r1;
int j;
partsum=0.0;
j=0;
rand1=random1()*sumfitness;
do{
partsum=partsum+oldpop[j].fitness;
j=j+1;
}while((partsum<rand1)&&(j<popsize));
return j-1;
}
/*$$$$$$$$$$$$$$$*/
int crossover(unsigned char *parent1,unsigned char *parent2,int k5)
{int k,j,mutate,i1,i2,j5;
int j1,j2,j3,s0,s1,s2;
unsigned char jj,ts1[maxstring],ts2[maxstring];
float f1,f2;
s0=0;s1=0;s2=0;
if(flip(pcross))
{jcross=random(lchrom-1);
j5=random(lchrom-1);
ncross=ncross+1;
if(jcross>j5){k=jcross;jcross=j5;j5=k;}
}
else jcross=lchrom;
if(jcross!=lchrom)
{s0=1;
k=0;
for(j=jcross;j<j5;j++)
{ts1[k]=parent1[j];
ts2[k]=parent2[j];
k++;
}
j3=k;
for(j=0;j<lchrom;j++)
{j2=0;
while((parent2[j]!=ts1[j2])&&(j2<k)){j2++;}
if(j2==k)
{ts1[j3]=parent2[j];
j3++;
}
}
j3=k;
for(j=0;j<lchrom;j++)
{j2=0;
while((parent1[j]!=ts2[j2])&&(j2<k)){j2++;}
if(j2==k)
{ts2[j3]=parent1[j];
j3++;
}
}
for(j=0;j<lchrom;j++)
{newpop[k5].chrom[j]=ts1[j];
newpop[k5+1].chrom[j]=ts2[j];
}
}
else
{for(j=0;j<lchrom;j++)
{newpop[k5].chrom[j]=parent1[j];
newpop[k5+1].chrom[j]=parent2[j];
}
mutate=flip(pmutation);
if(mutate)
{s1=1;
nmutation=nmutation+1;
for(j3=0;j3<200;j3++)
{j1=random(lchrom);
j=random(lchrom);
jj=newpop[k5].chrom[j];
newpop[k5].chrom[j]=newpop[k5].chrom[j1];
newpop[k5].chrom[j1]=jj;
}
}
mutate=flip(pmutation);
if(mutate)
{s2=1;
nmutation=nmutation+1;
for(j3=0;j3<100;j3++)
{j1=random(lchrom);
j=random(lchrom);
jj=newpop[k5+1].chrom[j];
newpop[k5+1].chrom[j]=newpop[k5+1].chrom[j1];
newpop[k5+1].chrom[j1]=jj;
}
}
}
j2=random(2*lchrom/3);
for(j=j2;j<j2+lchrom/3-1;j++)
for(k=0;k<lchrom;k++)
{if(k==j)continue;
if(k>j){i2=k;i1=j;}
else{i1=k;i2=j;}
f1=dd[lchrom*newpop[k5].chrom[i1]+newpop[k5].chrom[i2]];
f1=f1+dd[lchrom*newpop[k5].chrom[(i1+1)%lchrom]+
newpop[k5].chrom[(i2+1)%lchrom]];
f2=dd[lchrom*newpop[k5].chrom[i1]+
newpop[k5].chrom[(i1+1)%lchrom]];
f2=f2+dd[lchrom*newpop[k5].chrom[i2]+
newpop[k5].chrom[(i2+1)%lchrom]];
if(f1<f2){inversion(i1,i2,newpop[k5].chrom);}
}
j2=random(2*lchrom/3);
for(j=j2;j<j2+lchrom/3-1;j++)
for(k=0;k<lchrom;k++)
{if(k==j)continue;
if(k>j){i2=k;i1=j;}
else{i1=k;i2=j;}
f1=dd[lchrom*newpop[k5+1].chrom[i1]+newpop[k5+1].chrom[i2]];
f1=f1+dd[lchrom*newpop[k5+1].chrom[(i1+1)%lchrom]+
newpop[k5+1].chrom[(i2+1)%lchrom]];
f2=dd[lchrom*newpop[k5+1].chrom[i1]+
newpop[k5+1].chrom[(i1+1)%lchrom]];
f2=f2+dd[lchrom*newpop[k5+1].chrom[i2]+
newpop[k5+1].chrom[(i2+1)%lchrom]];
if(f1<f2){inversion(i1,i2,newpop[k5+1].chrom);}
}
return 1;
}
/*$$$$$$$$$$$$$$$*/
void inversion(unsigned int k,unsigned int j,unsigned char *ss)
{unsigned int l1,i;
unsigned char tt;
l1=(j-k)/2;
for(i=0;i<l1;i++)
{tt=ss[k+i+1];
ss[k+i+1]=ss[j-i];
ss[j-i]=tt;
}
}
/*%%%%%%%%%%%%%%%*/
void randomize1()
{int i;
randomize();
for(i=0;i<lchrom;i++)
oldrand[i]=random(30001)/30000.0;
jrand=0;
}
/*%%%%%%%%%%%*/
float random1()
{jrand=jrand+1;
if(jrand>=lchrom)
{jrand=0;
randomize1();
}
return oldrand[jrand];
}
/*%%%%%%%%%%*/
int flip(float probability)
{float ppp;
ppp=random(20001)/20000.0;
if(ppp<=probability)return 1;
return 0;
}
改进后用来求解VBR问题的delphi程序
unit uEA;
interface
uses
uUtilsEA, uIEA, uITSP, Classes, GaPara, windows, SysUtils, fEA_TSP;
type
TIndividual = class(TInterfacedObject, IIndividual)
private
// The internally stored fitness value
fFitness: TFloat;
fWeConstrain: integer;
fBackConstrain: integer;
fTimeConstrain: integer;
procedure SetFitness(const Value: TFloat);
function GetFitness: TFloat;
function GetWeConstrain: integer;
procedure SetWeConstrain(const Value: integer);
procedure SetBackConstrain(const Value: integer);
function GetBackConstrain: integer;
function GetTimeConstrain: integer;
procedure SetTimeConstrain(const Value: integer);
public
property Fitness : TFloat read GetFitness write SetFitness;
property WeConstrain :integer read GetWeConstrain write SetWeConstrain;
property BackConstrain :integer read GetBackConstrain write SetBackConstrain;
property TimeConstrain :integer read GetTimeConstrain write SetTimeConstrain;
end;
TTSPIndividual = class(TIndividual, ITSPIndividual)
private
// The route we travel
fRouteArray : ArrayInt;
fWeConstrain: integer;
fBackConstrain: integer;
fTimeConstrain: integer;
function GetRouteArray(I: Integer): Integer;
procedure SetRouteArray(I: Integer; const Value: Integer);
procedure SetSteps(const Value: Integer);
function GetSteps: Integer;
function GetWeConstrain: integer;
procedure SetWeConstrain(const Value: integer);
procedure SetBackConstrain(const Value: integer);
procedure SetTimeConstrain(const Value: integer);
function GetBackConstrain: integer;
function GetTimeConstrain: integer;
public
// Constructor, called with initial route size
constructor Create(Size : TInt); reintroduce;
destructor Destroy; override;
property RouteArray[I : Integer] : Integer read GetRouteArray write SetRouteArray;
// The number of steps on the route
property Steps : Integer read GetSteps write SetSteps;
property Fitness : TFloat read GetFitness write SetFitness;
property WeConstrain :integer read GetWeConstrain write SetWeConstrain;
property BackConstrain :integer read GetWeConstrain write SetBackConstrain;
property TimeConstrain :integer read GetTimeConstrain write SetTimeConstrain;
end;
TTSPCreator = class(TInterfacedObject, ITSPCreator)
private
// The Control component we are associated with
fController: ITSPController;
function GetController: ITSPController;
procedure SetController(const Value: ITSPController);
public
// Function to create a random individual
function CreateIndividual : IIndividual;
function CreateFeasibleIndividual: IIndividual;
property Controller : ITSPController read GetController write SetController;
end;
TKillerPercentage = class(TInterfacedObject, IKillerPercentage)
private
fPer: TFloat;
procedure SetPercentage(const Value: TFloat);
function GetPercentage: TFloat;
public
function Kill(Pop : IPopulation): Integer;
// Percentage of population to be killed
property Percentage: TFloat read GetPercentage write SetPercentage;
end;
TParentSelectorTournament = class(TInterfacedObject, IParentSelector)
public
function SelectParent(Population: IPopulation): IIndividual;
end;
TTSPBreederCrossover = class(TInterfacedObject, IBreeder)
public
function BreedOffspring(PSelector: IParentSelector; Pop: IPopulation): IIndividual;
end;
TTSPMutator = class(TInterfacedObject, ITSPMutator)
private
fTrans: TFloat;
fInv: TFloat;
procedure SetInv(const Value: TFloat);
procedure SetTrans(const Value: TFloat);
function GetInv: TFloat;
function GetTrans: TFloat;
public
procedure Mutate(Individual: IIndividual);
published
// Probability of doing a transposition
property Transposition: TFloat read GetTrans write SetTrans;
// Probability of doing an inversion
property Inversion: TFloat read GetInv write SetInv;
end;
TTSPExaminer = class(TInterfacedObject, ITSPExaminer)
private
// The Control component we are associated with
fController: ITSPController;
function GetController: ITSPController;
procedure SetController(const Value: ITSPController);
public
// Returns the fitness of an individual as a real number where 0 => best
function GetFitness(Individual : IIndividual) : TFloat;
property Controller : ITSPController read GetController write SetController;
end;
TPopulation = class(TInterfacedObject, IPopulation)
private
// The population
fPop : TInterfaceList;
// Worker for breeding
fBreeder: IBreeder;
// Worker for killing
fKiller: IKiller;
// Worker for parent selection
fParentSelector: IParentSelector;
// Worker for mutation
fMutator: IMutator;
// Worker for initial creation
fCreator: ICreator;
// Worker for fitness calculation
fExaminer: IExaminer;
// On Change event
FOnChange: TNotifyEvent;
procedure Change;
// Getters and Setters
function GetIndividual(I: Integer): IIndividual;
function GetCount: Integer;
function GetBreeder: IBreeder;
function GetCreator: ICreator;
function GetExaminer: IExaminer;
function GetKiller: IKiller;
function GetMutator: IMutator;
function GetOnChange: TNotifyEvent;
function GetParentSelector: IParentSelector;
procedure SetBreeder(const Value: IBreeder);
procedure SetCreator(const Value: ICreator);
procedure SetExaminer(const Value: IExaminer);
procedure SetKiller(const Value: IKiller);
procedure SetMutator(const Value: IMutator);
procedure SetOnChange(const Value: TNotifyEvent);
procedure SetParentSelector(const Value: IParentSelector);
// not interfaced
procedure DanQuickSort(SortList: TInterfaceList; L, R: Integer; SCompare: TInterfaceCompare);
procedure Sort(Compare: TInterfaceCompare);
protected
// Comparison function for Sort()
function CompareIndividuals(I1, I2: IIndividual): Integer;
// Sort the population
procedure SortPopulation;
public
// The constructor
constructor Create;
// The destructor
destructor Destroy; override;
// Adds an individual to the population
procedure Add(New : IIndividual);
// Deletes an individual from the population
procedure Delete(I : Integer);
// Runs a single generation
procedure Generation;
// Initialise the population
procedure Initialise(Size : Integer);
// Clear ourselves out
procedure Clear;
// Get the fitness of an individual
function FitnessOf(I : Integer) : TFloat;
// Access to the population members
property Pop[I : Integer] : IIndividual read GetIndividual; default;
// The size of the population
property Count : Integer read GetCount;
property ParentSelector : IParentSelector read GetParentSelector write SetParentSelector;
property Breeder : IBreeder read GetBreeder write SetBreeder;
property Killer : IKiller read GetKiller write SetKiller;
property Mutator : IMutator read GetMutator write SetMutator;
property Creator : ICreator read GetCreator write SetCreator;
property Examiner : IExaminer read GetExaminer write SetExaminer;
// An event
property OnChange : TNotifyEvent read GetOnChange write SetOnChange;
end;
TTSPController = class(TInterfacedObject, ITSPController)
private
fXmin, fXmax, fYmin, fYmax: TFloat;
{ The array of 'cities' }
fCities : array of TPoint2D;
{ The array of 'vehicles' }
fVehicles : array of TVehicle;
{ The array of 'vehicle number' }
fNoVehicles : ArrayInt;/////////////////////
{ The number of 'new cities' }
fCityCount: Integer;
{ The number of 'old cities' }
foldCityCount: Integer;
{ The number of 'travelers' }
fTravelCount:Integer; ///////////////////////
{ The number of 'depots' }
fDepotCount:Integer; ///////////////////////
{ Getters... }
function GetCity(I: Integer): TPoint2D;
function GetNoVehicle(I: Integer): TInt;
function GetCityCount: Integer;
function GetOldCityCount: Integer;
function GetTravelCount:Integer;
function GetDepotCount:Integer;
function GetXmax: TFloat;
function GetXmin: TFloat;
function GetYmax: TFloat;
function GetYmin: TFloat;
{ Setters... }
procedure SetCityCount(const Value: Integer);
procedure SetOldCityCount(const Value: Integer);
procedure SetTravelCount(const Value: Integer); /////////////
procedure SetDepotCount(const Value: Integer); /////////////
procedure SetXmax(const Value: TFloat);
procedure SetXmin(const Value: TFloat);
procedure SetYmax(const Value: TFloat);
procedure SetYmin(const Value: TFloat);
function TimeCostBetween(C1, C2: Integer): TFloat;
function GetTimeConstraint(Individual: IIndividual): TInt;
function DateSpanToMin(d1, d2: TDateTime): integer;
function GetVehicleInfo(routeInt: Tint): integer;
procedure writeTimeArray;
procedure writeCostArray;
public
{ The constructor }
constructor Create;
{ The destructor }
destructor Destroy; override;
{ Get the distance between two cities }
function DistanceBetween(C1, C2 : Integer) : TFloat;
{ Get the cost between two cities }
function CostBetween(C1, C2: Integer): TFloat;
function GetWeightConstraint( Individual: IIndividual): TInt;
function GetBackConstraint( Individual: IIndividual): TInt;
{ Places the cities at random points }
procedure RandomCities;
{ Area limits }
property Xmin: TFloat read GetXmin write SetXmin;
property Xmax: TFloat read GetXmax write SetXmax;
property Ymin: TFloat read GetYmin write SetYmin;
property Ymax: TFloat read GetYmax write SetYmax;
{ Properties... }
property CityCount : Integer read GetCityCount write SetCityCount;
property OldCityCount : Integer read GetOldCityCount write SetOldCityCount;
property TravelCount : Integer read GetTravelCount write SetTravelCount; ///////////
property DepotCount : Integer read GetDepotCount write SetDepotCount; ///////////
{ Access to the cities array }
property Cities[I : Integer] : TPoint2D read GetCity;
property NoVehicles[I : Integer] : TInt read GetNoVehicle; ///////////////
end;
implementation
uses
Math;
{ TIndividual }
function TIndividual.GetFitness: TFloat;
begin
result := fFitness;
end;
function TIndividual.GetWeConstrain: integer;
begin
result := fWeConstrain;
end;
function TIndividual.GetBackConstrain: integer;
begin
result := fBackConstrain;
end;
function TIndividual.GetTimeConstrain: integer;
begin
result := fTimeConstrain;
end;
procedure TIndividual.SetBackConstrain(const Value: integer);
begin
fBackConstrain := Value;
end;
procedure TIndividual.SetFitness(const Value: TFloat);
begin
fFitness := Value;
end;
procedure TIndividual.SetWeConstrain(const Value: integer);
begin
fWeConstrain := Value;
end;
procedure TIndividual.SetTimeConstrain(const Value: integer);
begin
fTimeConstrain := Value;
end;
{ TTSPIndividual }
constructor TTSPIndividual.Create(Size: TInt);
begin
Inherited Create;
SetLength(fRouteArray, Size);
// fSteps := Size;
end;
destructor TTSPIndividual.Destroy;
begin
SetLength(fRouteArray, 0);
inherited;
end;
function TTSPIndividual.GetRouteArray(I: Integer): Integer;
begin
result := fRouteArray[I];
end;
function TTSPIndividual.GetSteps: Integer;
begin
result := Length(fRouteArray);
end;
procedure TTSPIndividual.SetSteps(const Value: Integer);
begin
SetLength(fRouteArray, Value);
end;
procedure TTSPIndividual.SetRouteArray(I: Integer; const Value: Integer);
begin
fRouteArray[I] := Value;
end;
function TTSPIndividual.GetWeConstrain: integer;
begin
result := fWeConstrain;
end;
function TTSPIndividual.GetBackConstrain: integer;
begin
result := fBackConstrain;
end;
function TTSPIndividual.GetTimeConstrain: integer;
begin
result := fTimeConstrain;
end;
procedure TTSPIndividual.SetWeConstrain(const Value: integer);
begin
fWeConstrain := Value;
end;
procedure TTSPIndividual.SetBackConstrain(const Value: integer);
begin
fBackConstrain := Value;
end;
procedure TTSPIndividual.SetTimeConstrain(const Value: integer);
begin
fTimeConstrain := Value;
end;
{ TTSPCreator }
function TTSPCreator.CreateIndividual: IIndividual;
var
New: ITSPIndividual;
i, j, Top, Temp : Integer;
//trav:integer;
begin
// Get the number of cities
Top := fController.CityCount;
// Create the new individual
New := TTSPIndividual.Create(Top);
// Initialise it with a sequential route
for i := 0 to Top - 1 do
New.RouteArray[i] := i;
// Shuffle the route
for i := Top - 1 downto 1 do
begin
j := Random(i);
Temp := New.RouteArray[j];
New.RouteArray[j] := New.RouteArray[i];
New.RouteArray[i] := Temp;
end;
result := New;
end;
function TTSPCreator.CreateFeasibleIndividual: IIndividual;
var
New: ITSPIndividual;
i, j, Top, Temp : Tint;
Msg:TMsg;
begin
// Get the number of cities
Top := fController.CityCount;
// Create the new individual
New := TTSPIndividual.Create(Top);
// Initialise it with a sequential route
repeat
begin//////////////////////////////////
for i := 0 to Top - 1 do
New.RouteArray[i] := i;
// Shuffle the route
for i := Top - 1 downto 1 do
begin
j := Random(i);
Temp := New.RouteArray[j];
New.RouteArray[j] := New.RouteArray[i];
New.RouteArray[i] := Temp;
end;
//process message sequence//////////
while PeekMessage(Msg,0,0,0,1) do///
begin ///
if Msg.Message<>18 then ///
begin ///
TranslateMessage(Msg); ///
DispatchMessage(Msg); ///
end; ///
end; ///
////////////////////////////////////
end
until (fController.GetWeightConstraint(New)=0)and(fController.GetBackConstraint(New)=0);
result := New;
end;
function TTSPCreator.GetController: ITSPController;
begin
result := fController;
end;
procedure TTSPCreator.SetController(const Value: ITSPController);
begin
fController := Value;
end;
{ TKillerPercentage }
function TKillerPercentage.GetPercentage: TFloat;
begin
result := fPer;
end;
function TKillerPercentage.Kill(Pop: IPopulation): Integer;
var
KillCount, i : Integer;
begin
// Work out the number we have to kill
KillCount := Floor(Pop.Count * (fPer / 100));
// Delete the worst individuals - assuming the population is sorted
for i := 1 to KillCount do
Pop.Delete(Pop.Count - 1);
// Return the number killed
Result := KillCount;
end;
procedure TKillerPercentage.SetPercentage(const Value: TFloat);
begin
fPer := Value;
end;
{ TParentSelectorTournament }
function TParentSelectorTournament.SelectParent(
Population: IPopulation): IIndividual;
var
i1, i2 : Integer;
begin
// Select a random individual
i1 := Random(Population.Count);
// Select a *different* random individual
repeat
i2 := Random(Population.Count);
until i1 <> i2;
// Hold the tournament and return the fittest of the two
if Population.FitnessOf(i1) < Population.FitnessOf(i2) then
Result := Population[i1]
else
Result := Population[i2];
end;
{ TTSPBreederCrossover }
function TTSPBreederCrossover.BreedOffspring(PSelector: IParentSelector;
Pop: IPopulation): IIndividual;
var
Child, Mom, Dad, Parent1, Parent2 : ITSPIndividual;
i, j, p : Integer;
function AlreadyAssigned(City, x : Integer) : Boolean;
var
y : Integer;
Found : Boolean;
begin
Found := False;
for y := 0 to x - 1 do
begin
if Child.RouteArray[y] = City then
begin
Found := True;
Break;
end;
end;
Result := Found;
end;
begin
// Select a some parents...
Mom := PSelector.SelectParent(Pop) as ITSPIndividual;
Dad := PSelector.SelectParent(Pop) as ITSPIndividual;
// Create a child
Child := TTSPIndividual.Create(Mom.Steps);
// Copy the route from parents to child
for i := 0 to Child.Steps - 1 do
begin
// Choose a parent at random
p := Random(2);
if p = 0 then
begin
Parent1 := Mom;
Parent2 := Dad;
end else
begin
Parent1 := Dad;
Parent2 := Mom;
end;
if not AlreadyAssigned(Parent1.RouteArray[i], i) then
begin
// Use city from Parent 1 unless used already
Child.RouteArray[i] := Parent1.RouteArray[i];
end else
if not AlreadyAssigned(Parent2.RouteArray[i], i) then
begin
// Otherwise use city from Parent 2 unless used already
Child.RouteArray[i] := Parent2.RouteArray[i];
end else
begin
// If both assigned already then use a random city
repeat
j := Random(Child.Steps);
until not AlreadyAssigned(j, i);
Child.RouteArray[i] := j;
end;
end;
// Return the child
Result := Child;
end;
{ TTSPMutator }
function TTSPMutator.GetInv: TFloat;
begin
result := fInv;
end;
function TTSPMutator.GetTrans: TFloat;
begin
result := fTrans;
end;
procedure TTSPMutator.Mutate(Individual: IIndividual);
var
P: Double;
i, j, t : Integer; Start, Finish : Integer;
begin
with Individual as ITSPIndividual do
begin
// Should we do an inversion?
P := Random * 100;
if P < FTrans then
begin
// Do an inversion (i.e. swap two cities at random)
// Choose first city
i := Random(Steps);
// Choose a second city
repeat
j := Random(Steps);
until i <> j;
// Swap them over
t := RouteArray[i];
RouteArray[i] := RouteArray[j];
RouteArray[j] := t;
end;
// Should we do a transposition?
P := Random * 100;
if P < FInv then
begin
// Do a transposition (i.e. reverse a sub-route)
// Choose random start and finish points
Start := Random(Steps - 1);
Finish := Start + Random(Steps - Start);
// Reverse the sub-route
for i := 0 to Floor((Finish - Start) / 2) do
begin
t := RouteArray[Start + i];
RouteArray[Start + i] := RouteArray[Finish - i];
RouteArray[Finish - i] := t;
end;
end;
end;
end;
procedure TTSPMutator.SetInv(const Value: TFloat);
begin
fInv := Value;
end;
procedure TTSPMutator.SetTrans(const Value: TFloat);
begin
fTrans := Value;
end;
{ TTSPExaminer }
function TTSPExaminer.GetController: ITSPController;
begin
result := fController;
end;
function TTSPExaminer.GetFitness(Individual: IIndividual): TFloat;
var
i , weightConstraint, backConstraint : TInt;
Distance , penaltyW, penaltyB : TFloat;
Indi : ITSPIndividual;
begin
Indi := Individual as ITSPIndividual;
Distance := 0;
penaltyW:=FormGaPara.EditWeightConstrain.Value;
penaltyB:=FormGaPara.EditBackConstrain.Value;
for i := 0 to Indi.Steps - 2 do
begin
Distance := Distance + fController.DistanceBetween(Indi.RouteArray[i], Indi.RouteArray[i + 1]);
end;
Distance := Distance + fController.DistanceBetween(Indi.RouteArray[Indi.Steps - 1], Indi.RouteArray[0]);
WeightConstraint:=fController.GetWeightConstraint(Indi);
backConstraint:=fController.GetBackConstraint(Indi);
Indi.WeConstrain:=WeightConstraint;
Indi.BackConstrain:=backConstraint;
Result := Distance+penaltyW*weightconstraint+penaltyB*backConstraint;
end;
procedure TTSPExaminer.SetController(const Value: ITSPController);
begin
fController := Value;
end;
{ TPopulation }
constructor TPopulation.Create;
begin
inherited;
fPop := TInterfaceList.Create;
end;
destructor TPopulation.Destroy;
begin
fPop.Free;
inherited;
end;
procedure TPopulation.Add(New: IIndividual);
begin
fPop.Add(New);
end;
procedure TPopulation.Clear;
begin
fPop.Clear;
end;
function TPopulation.CompareIndividuals(I1, I2: IIndividual): Integer;
var
A, B, D : TFloat;
begin
// Get the difference between the two individuals (real number)
A := I1.Fitness;
B := I2.Fitness;
D := A - B;
// Quickest way to convert that to an integer is...
if D > 0 then
Result := 1
else if D < 0 then
Result := -1
else
Result := 0;
end;
procedure TPopulation.Delete(I: Integer);
begin
fPop.Delete(I);
end;
function TPopulation.FitnessOf(I: Integer): TFloat;
begin
result := Pop[I].Fitness;
end;
procedure TPopulation.Change;
begin
if Assigned(fOnChange) then
FOnChange(Self);
end;
procedure TPopulation.Generation;
var
Replace, i : Integer;
New : IIndividual;
begin
// Kill some of the population
Replace := fKiller.Kill(Self);
for i := 1 to Replace do
begin
// Breed a new individual
New := fBreeder.BreedOffspring(fParentSelector, Self);
// Perform some mutation on the individual
FMutator.Mutate(New);
// Get the fitness of the new individual
New.Fitness := fExaminer.GetFitness(New);
// Add it to the population
Add(New);
end;
// Sort the population into fitness order where first <==> best
SortPopulation;
Change;
end;
function TPopulation.GetBreeder: IBreeder;
begin
result := fBreeder;
end;
function TPopulation.GetCount: Integer;
begin
result := fPop.Count;
end;
function TPopulation.GetCreator: ICreator;
begin
result := fCreator;
end;
function TPopulation.GetExaminer: IExaminer;
begin
result := fExaminer;
end;
function TPopulation.GetIndividual(I: Integer): IIndividual;
begin
result := (fPop[I] as IIndividual);
end;
function TPopulation.GetKiller: IKiller;
begin
result := fKiller;
end;
function TPopulation.GetMutator: IMutator;
begin
result := fMutator;
end;
function TPopulation.GetOnChange: TNotifyEvent;
begin
result := fOnChange;
end;
function TPopulation.GetParentSelector: IParentSelector;
begin
result := fParentSelector;
end;
procedure TPopulation.Initialise(Size: Integer);
var
i,feasibleCount: Integer;
New: IIndividual;
begin
feasibleCount:=round(size*(FormGaPara.EditFeasible.Value)/100);
//feasibleCount:=1;
// Clear out the old stuff
Clear;
// Set the capacity first to save about 12 nanoseconds ;o)
fPop.Capacity := Size;
// Create the appropriate number of individuals
for i := 1 to feasibleCount do
begin
// Create the individual
New := fCreator.CreateFeasibleIndividual;
// Get the fitness of the new individual
New.Fitness := fExaminer.GetFitness(New);
// Add to the population
Add(New);
end;
for i := feasibleCount+1 to Size do
begin
// Create the individual
New := fCreator.CreateIndividual; ////////
// Get the fitness of the new individual
New.Fitness := fExaminer.GetFitness(New);
// Add to the population
Add(New);
end;
SortPopulation;
Change;
end;
procedure TPopulation.SetBreeder(const Value: IBreeder);
begin
fBreeder := Value;
end;
procedure TPopulation.SetCreator(const Value: ICreator);
begin
fCreator := Value;
end;
procedure TPopulation.SetExaminer(const Value: IExaminer);
begin
fExaminer := Value;
end;
procedure TPopulation.SetKiller(const Value: IKiller);
begin
fKiller := Value;
end;
procedure TPopulation.SetMutator(const Value: IMutator);
begin
fMutator := Value;
end;
procedure TPopulation.SetOnChange(const Value: TNotifyEvent);
begin
fOnChange := Value;
end;
procedure TPopulation.SetParentSelector(const Value: IParentSelector);
begin
fParentSelector := Value;
end;
procedure TPopulation.DanQuickSort(SortList: TInterfaceList; L, R: Integer;
SCompare: TInterfaceCompare);
var
I, J: Integer;
P: IIndividual;
begin
repeat
I := L;
J := R;
P := SortList.Items[(L + R) div 2] as IIndividual;
repeat
while SCompare(SortList.Items[I] as IIndividual, P) < 0 do
Inc(I);
while SCompare(SortList.Items[J] as IIndividual, P) > 0 do
Dec(J);
if I <= J then
begin
SortList.Exchange(I, J);
Inc(I);
Dec(J);
end;
until I > J;
if L < J then
DanQuickSort(SortList, L, J, SCompare);
L := I;
until I >= R;
end;
procedure TPopulation.Sort(Compare: TInterfaceCompare);
begin
if Assigned(fPop) and (Count > 0) then
DanQuickSort(fPop, 0, Count - 1, Compare);
end;
procedure TPopulation.SortPopulation;
begin
Sort(self.CompareIndividuals);
end;
{ TTSPController }
constructor TTSPController.Create;
begin
inherited;
end;
destructor TTSPController.Destroy;
begin
SetLength(FCities, 0);
SetLength(FNoVehicles, 0);
SetLength(FVehicles, 0);
inherited;
end;
{ Standard euclidian distance between two 2D vectors... }
function TTSPController.DistanceBetween( C1, C2: Integer): TFloat;
var
temp:TFloat;
i,j,intTemp,intTemp2:TInt;
begin
intTemp:=0;
temp:=FormGaPara.EditWrongConstrain.Value;
{if (Cities[C2].id>=1)and(Cities[C2].id<=fOldCityCount)and(Cities[C1].id<>0) then
begin
fCities[C2].serviceDepot:= fCities[C1].serviceDepot;
end; //}
//8
if (Cities[C1].id>=1)and(Cities[C1].id<=fOldCityCount)and(Cities[C2].id>=1)and(Cities[C2].id<=fOldCityCount) then
begin
temp:=CostArray[C1,C2];
end;
//1
if Cities[C1].id=0 then
begin
for i:=0 to fDepotCount-1 do
begin
intTemp:=intTemp+fNoVehicles[i];
if Cities[C2].id =fOldCityCount + intTemp +1 then
temp:=0;
end;
intTemp:=0;
end;
//2
if Cities[C2].id=0 then
begin
for i:=1 to fDepotCount do
begin
intTemp:=intTemp+fNoVehicles[i];
if Cities[C1].id =fOldCityCount + intTemp then
temp:=0;
end;
intTemp:=0;
end;
//5
for i:=0 to fDepotCount-1 do
begin
intTemp:=intTemp+fNoVehicles[i];
{ if (Cities[C1].id=fOldCityCount + intTemp +1)and(Cities[C2].id=Cities[C1].id+1) then
temp:=10; /////////////////////////// }
if (Cities[C1].id>=fOldCityCount + intTemp +1)and(Cities[C1].id<=fOldCityCount + intTemp+fNoVehicles[i+1])
and(Cities[C2].id>=fOldCityCount + intTemp +1)and(Cities[C2].id<=fOldCityCount + intTemp+fNoVehicles[i+1])
then
temp:=0;//}
end;
intTemp:=0;
//7
if (Cities[C1].id=Cities[C2].id)and(Cities[C1].id > fOldCityCount) then
begin
temp:=0;
end;
//3
if (Cities[C1].id > fOldCityCount)and(Cities[C2].id>=1)and(Cities[C2].id<=fOldCityCount) then
begin
//temp := Sqrt(sqr(Cities[C1].X - Cities[C2].X)+sqr(Cities[C1].Y - Cities[C2].Y));
temp:=CostArray[C1,C2];
end;
//4
if (Cities[C1].id<=fOldCityCount)and(Cities[C1].id>=1)and(Cities[C2].id > fOldCityCount) then
begin
//if Cities[C1].serviceDepot=Cities[C2].serviceDepot then //back to the start point
temp:=CostArray[C1,C2];
end;
//6
intTemp:=0;
for i:=1 to fDepotCount do
begin
intTemp:=intTemp+fNoVehicles[i];
if Cities[C1].id= fOldCityCount + intTemp then
begin
intTemp2:=0;
for j:=0 to fDepotCount-1 do
begin
intTemp2:=intTemp2+fNoVehicles[j];
if Cities[C2].id=fOldCityCount + intTemp2 +1 then
if abs(Cities[C2].id-Cities[C1].id) <> fNoVehicles[i]-1 then
temp:=0;
end; //}
end;
end;
intTemp:=0;
result:=temp;
end;
function TTSPController.CostBetween(C1, C2: Integer): TFloat; //matrix cij
var
distance:TFloat;
begin
distance := Sqrt(sqr(Cities[C1].X - Cities[C2].X)+ sqr(Cities[C1].Y - Cities[C2].Y));
//result:=distance+TimeCostBetween(C1,C2);
result:=distance;
end;
function TTSPController.TimeCostBetween(C1, C2: Integer): TFloat;
var
cost:TFloat;
i,j,penaltyW,penaltyD:TFloat;
startTime:TDateTime;
begin
startTime:=strToDateTime(FormGa.EditStartTime.Text);
penaltyW:=FormGaPara.EditWaitConstrain.Value;
penaltyD:=FormGaPara.EditDelayConstrain.Value;
if Cities[C2].id>fOldCityCount then
fCities[C2].totalTime:=0
else
fCities[C2].totalTime:=Cities[C1].totalTime+Cities[C1].serviceTime+timeArray[C1,C2];
fCities[C2].waitTime:= max(0,DateSpanToMin(startTime,Cities[C2].early)-Cities[C2].totalTime);
fCities[C2].delayTime:=max(0,Cities[C2].totalTime-DateSpanToMin(startTime,Cities[C2].late));
if Cities[C2].late<>0 then //consider time or not
begin
if Cities[C2].early<>0 then //window or deadline
cost:=penaltyW*fCities[C2].waitTime +penaltyD*fCities[C2].delayTime
else
cost:=penaltyD*fCities[C2].delayTime;
end
else
cost:=0;
result:=cost;
end;
function TTSPController.DateSpanToMin(d1,d2:TDateTime):integer;
var
span:TDateTime;
Year, Month, Day, Hour, Min, Sec, MSec: Word;
begin
span:=abs(d2-d1);
DecodeDate(span, Year, Month, Day);
DecodeTime(span, Hour, Min, Sec, MSec);
result:=Min;
end;
//return the position in the vehicles array
function TTSPController.GetVehicleInfo( routeInt:Tint):integer;
begin
result:=routeInt-fOldCityCount-1;
end;
function TTSPController.GetWeightConstraint( Individual: IIndividual): TInt;
var
Indi: ITSPIndividual;
totalCapacity,maxCapacity: TFloat;
i,j:TInt;
tempArray:array of TInt;
tempResult:TInt;
begin
Indi := Individual as ITSPIndividual;
SetLength(tempArray, fCityCount+1);
tempResult:=0;
/////////////////////////////////////////////////////////
for i:=0 to fCityCount-1 do
begin
if Indi.RouteArray[i]=fOldCityCount+1 then
break;
end;
for j:=0 to fCityCount-i-1 do
begin
tempArray[j]:= Indi.RouteArray[i+j];
end;
for j:=fCityCount-i to fCityCount-1 do
begin
tempArray[j]:= Indi.RouteArray[j-fCityCount+i];
end;
tempArray[fCityCount]:= tempArray[0];
//////////////////////////////////////////////////////////
//totalCapacity:=fCities[tempArray[0]].supply; //supply
maxCapacity:=fVehicles[GetVehicleInfo(tempArray[0])].volume;
totalCapacity:=maxCapacity;
for i:=0 to fCityCount do
begin
if (FCities[tempArray[i]].id<=fOldCityCount)and(FCities[tempArray[i]].id>0) then
begin
totalCapacity:=totalCapacity+FCities[tempArray[i]].supply-FCities[tempArray[i]].demand;
if (totalCapacity>maxCapacity)or(totalCapacity<0) then
begin
tempResult:=tempResult+1;
//break;
end;
end;
if FCities[tempArray[i]].id>fOldCityCount then
begin
//totalCapacity:=fCities[tempArray[i]].supply; //supply
maxCapacity:=fVehicles[GetVehicleInfo(tempArray[i])].volume;
totalCapacity:=maxCapacity;
end;
end;
SetLength(tempArray,0);
result:=tempResult;
end;
function TTSPController.GetBackConstraint( Individual: IIndividual): TInt;
var
Indi: ITSPIndividual;
i,j:TInt;
tempArray:array of TInt;
tempResult:TInt;
begin
Indi := Individual as ITSPIndividual;
SetLength(tempArray, fCityCount+1);
tempResult:=0;
for i:=0 to fCityCount-1 do
begin
if Indi.RouteArray[i]=fOldCityCount+1 then
break;
end;
for j:=0 to fCityCount-i-1 do
begin
tempArray[j]:= Indi.RouteArray[i+j];
end;
for j:=fCityCount-i to fCityCount-1 do
begin
tempArray[j]:= Indi.RouteArray[j-fCityCount+i];
end;
tempArray[fCityCount]:=tempArray[0];
{tempArray[0]:=11;tempArray[1]:=5;tempArray[2]:=8;tempArray[3]:=7;
tempArray[4]:=9;tempArray[5]:=6;tempArray[6]:=12;tempArray[7]:=10;
tempArray[8]:=2;tempArray[9]:=4;tempArray[10]:=3;tempArray[11]:=1;
tempArray[12]:=0;tempArray[13]:=11;tempArray[14]:=3;tempArray[15]:=1;
tempArray[16]:=4;tempArray[17]:=11;//10,2,2}
for i:=0 to fCityCount-1 do
begin
if (Cities[tempArray[i+1]].id<=fOldCityCount) then
begin
fCities[tempArray[i+1]].serviceDepot:= fCities[tempArray[i]].serviceDepot;
end;
if (Cities[tempArray[i]].id<=fOldCityCount)and(Cities[tempArray[i]].id>=1)and(Cities[tempArray[i+1]].id > fOldCityCount) then
begin
if Cities[tempArray[i]].serviceDepot<>Cities[tempArray[i+1]].serviceDepot then //back to the start point
begin
tempResult:=tempResult+1;
// break;
end;
end;
end;
SetLength(tempArray,0);
result:=tempResult;
end;
function TTSPController.GetTimeConstraint( Individual: IIndividual): TInt;
var
Indi: ITSPIndividual;
i,j:TInt;
totalTimeCost:TFloat;
tempArray:array of TInt;
tempResult:TInt;
begin
Indi := Individual as ITSPIndividual;
SetLength(tempArray, fCityCount+1);
tempResult:=0;
for i:=0 to fCityCount-1 do
begin
if Indi.RouteArray[i]=fOldCityCount+1 then
break;
end;
for j:=0 to fCityCount-i-1 do
begin
tempArray[j]:= Indi.RouteArray[i+j];
end;
for j:=fCityCount-i to fCityCount-1 do
begin
tempArray[j]:= Indi.RouteArray[j-fCityCount+i];
end;
tempArray[fCityCount]:=tempArray[0];
totalTimeCost:=0;
for i:=0 to fCityCount-1 do
begin
totalTimeCost:=totalTimeCost+timeCostBetween(tempArray[i],tempArray[i+1]);
end;
if totalTimeCost<>0 then tempResult:=1;
SetLength(tempArray,0);
end;
function TTSPController.GetCity(I: Integer): TPoint2D;
begin
result := fCities[I];
end;
function TTSPController.GetNoVehicle(I: Integer): TInt;
begin
result := fNoVehicles[I];
end;
function TTSPController.GetCityCount: Integer;
begin
result := fCityCount;
end;
function TTSPController.GetOldCityCount: Integer;
begin
result := fOldCityCount;
end;
function TTSPController.GetTravelCount: Integer;
begin
result := fTravelCount;
end;
function TTSPController.GetDepotCount: Integer;
begin
result := fDepotCount;
end;
function TTSPController.GetXmax: TFloat;
begin
result := fXmax;
end;
function TTSPController.GetXmin: TFloat;
begin
result := fXmin;
end;
function TTSPController.GetYmax: TFloat;
begin
result := fYmax;
end;
function TTSPController.GetYmin: TFloat;
begin
result := fYmin;
end;
procedure TTSPController.RandomCities; //from database
var
i,j,k,m,intTemp,totalVehicleCount: Integer;
tempVehicle:TVehicle;
begin
//////////////////////////////////////////////////////////
fNoVehicles[0]:=0;
totalVehicleCount:=0;
for i:=1 to fDepotCount do //from depots database
begin
fNoVehicles[i]:=fTravelCount +1;
totalVehicleCount:=totalVehicleCount+ fNoVehicles[i]; //real and virtual vehicles
end;
SetLength(fVehicles,totalVehicleCount);
intTemp:=0;
for i:=1 to fDepotCount do
begin
for j:=intTemp to intTemp+fNoVehicles[i]-2 do
begin
fVehicles[j].index:=j+1;
fVehicles[j].id:='real vehicle';
fVehicles[j].volume:=50;
end;
with fVehicles[intTemp+fNoVehicles[i]-1] do
begin
index:=intTemp+fNoVehicles[i];
id:='virtual vehicle';
volume:=0;
end;
intTemp:=intTemp+ fNoVehicles[i];
end;
///////////////////////////////////////////////////////////
intTemp:=0;
for i:=1 to fDepotCount do //depot 1--value
begin
intTemp:=intTemp + fNoVehicles[i];
end;
for i := 0 to FOldCityCount do //from database
begin
FCities[i].id:= i;
FCities[i].X := Xmin+0.5+(Xmax-Xmin-1.0)*Random;
FCities[i].Y := Ymin+0.5+(Ymax-Ymin-1.0)*Random;
FCities[i].early:=0;
FCities[i].late:=0; //TDateTime
FCities[i].serviceTime:=0;
FCities[i].totalTime:=0;
FCities[i].waitTime:=0;
FCities[i].delayTime:=0;
end;
for i:=FOldCityCount+1 to FCityCount-1 do
begin
FCities[i].id:= i;
if fDepotCount=1 then
begin
FCities[i].X := Xmin+0.5+(Xmax-Xmin-1.0)*RandomRange(2,4)/5;
FCities[i].Y := Ymin+0.5+(Ymax-Ymin-1.0)*RandomRange(2,4)/5;
end
else
begin
FCities[i].X := Xmin+0.5+(Xmax-Xmin-1.0)*Random;
FCities[i].Y := Ymin+0.5+(Ymax-Ymin-1.0)*Random;
end;
FCities[i].early:=0;
FCities[i].late:=0; //TDateTime
FCities[i].serviceTime:=0;
FCities[i].totalTime:=0;
FCities[i].waitTime:=0;
FCities[i].delayTime:=0;
end;
for i := 0 to FOldCityCount do
begin
FCities[i].serviceDepot:=i;
end;
m:=FOldCityCount+1;
for k:=1 to fDepotCount do
begin
for j:=0 to fNoVehicles[k]-1 do
begin
FCities[m].serviceDepot:= fOldCityCount+k;
m:=m+1;
end;
end;
//supply and demand //////////////////////////from database
FCities[0].demand:=0;
FCities[0].supply:=0;
for i:=1 to FOldCityCount do
begin
FCities[i].demand:=10;
FCities[i].supply:=0;
end;
for i:=FOldCityCount+1 to FCityCount-1 do
begin
FCities[i].demand:=0;
FCities[i].supply:=50;
end;
////////////////////////////////////////////////////////////
intTemp:=0;
for i:=0 to fDepotCount-1 do
begin
intTemp:=intTemp+fNoVehicles[i];
for j:=2 to fNoVehicles[i+1] do
begin
FCities[fOldCityCount + intTemp +j].X :=FCities[fOldCityCount + intTemp +1].X;
FCities[fOldCityCount + intTemp +j].Y :=FCities[fOldCityCount + intTemp +1].Y;
end;
end;
writeTimeArray;
writeCostArray;
end;
procedure TTSPController.writeTimeArray; //database
var
i,j:integer;
begin
SetLength(timeArray,fCityCount,fCityCount);
for i:=0 to fCityCount-1 do
begin
for j:=0 to fCityCount-1 do
begin
if i=j then timeArray[i,j]:=0
else timeArray[i,j]:=10;
end;
end;
end;
procedure TTSPController.writeCostArray; //database
var
i,j:integer;
begin
SetLength(costArray,fCityCount,fCityCount);
for i:=0 to fCityCount-1 do
begin
for j:=0 to fCityCount-1 do
begin
if i=j then costArray[i,j]:=0
else costArray[i,j]:=costBetween(i,j);
end;
end;
end;
procedure TTSPController.SetCityCount(const Value: Integer);
begin
SetLength(fCities, Value);
fCityCount := Value;
RandomCities;
end;
procedure TTSPController.SetOldCityCount(const Value: Integer);
begin
fOldCityCount := Value;
end;
procedure TTSPController.SetTravelCount(const Value: Integer); ///////////
begin
fTravelCount := Value;
end;
procedure TTSPController.SetDepotCount(const Value: Integer); ///////////
begin
SetLength(fNoVehicles, Value+1); ///////////////
fDepotCount := Value;
end;
procedure TTSPController.SetXmax(const Value: TFloat);
begin
fXmax := Value;
end;
procedure TTSPController.SetXmin(const Value: TFloat);
begin
fXmin := Value;
end;
procedure TTSPController.SetYmax(const Value: TFloat);
begin
fYmax := Value;
end;
procedure TTSPController.SetYmin(const Value: TFloat);
begin
fYmin := Value;
end;
end.
{unsigned char j1;
unsigned int k5,i1,i2,j,i,k,j2,j3,j4,p5[maxstring];
float f1,f2;
j=0;
for(k=0;k<lchrom;k++)
oldpop[j].chrom[k]=k;
for(k=0;k<lchrom;k++)
p5[k]=oldpop[j].chrom[k];
randomize();
for(;j<popsize;j++)
{j2=random(lchrom);
for(k=0;k<j2+20;k++)
{j3=random(lchrom);
j4=random(lchrom);
j1=p5[j3];
p5[j3]=p5[j4];
p5[j4]=j1;
}
for(k=0;k<lchrom;k++)
oldpop[j].chrom[k]=p5[k];
}
for(k=0;k<lchrom;k++)
for(j=0;j<lchrom;j++)
dd[k*lchrom+j]=hypot(x[k]-x[j],y[k]-y[j]);
for(j=0;j<popsize;j++)
{oldpop[j].x=(float)decode(oldpop[j].chrom);
oldpop[j].fitness=objfunc(oldpop[j].x);
oldpop[j].parent1=0;
oldpop[j].parent2=0;
oldpop[j].xsite=0;
}
}
/*&&&&&&&&&&&&&&&&&*/
void initialize()
{int k,j,minx,miny,maxx,maxy;
initdata();
minx=0;
miny=0;
maxx=0;maxy=0;
for(k=0;k<lchrom;k++)
{x[k]=rand();
if(x[k]>maxx)maxx=x[k];
if(x[k]<minx)minx=x[k];
y[k]=rand();
if(y[k]>maxy)maxy=y[k];
if(y[k]<miny)miny=y[k];
}
if((maxx-minx)>(maxy-miny))
{maxxy=maxx-minx;}
else {maxxy=maxy-miny;}
maxdd=0.0;
for(k=0;k<lchrom;k++)
for(j=0;j<lchrom;j++)
{dd[k*lchrom+j]=hypot(x[k]-x[j],y[k]-y[j]);
if(maxdd<dd[k*lchrom+j])maxdd=dd[k*lchrom+j];
}
refpd=dd[lchrom-1];
for(k=0;k<lchrom;k++)
refpd=refpd+dd[k*lchrom+k+2];
for(j=0;j<lchrom;j++)
dd[j*lchrom+j]=4.0*maxdd;
ff=(0.765*maxxy*pow(lchrom,0.5));
minpp=0;
min=dd[lchrom-1];
for(j=0;j<lchrom-1;j++)
{if(dd[lchrom*j+lchrom-1]<min)
{min=dd[lchrom*j+lchrom-1];
minpp=j;
}
}
initpop();
statistics(oldpop);
initreport();
}
/*&&&&&&&&&&&&&&&&&&*/
void report(int l,struct pp *pop)
{int k,ix,iy,jx,jy;
unsigned int tt;
float ttt;
cleardevice();
gotoxy(1,1);
printf("city:%4d para_size:%4d maxgen:%4d ref_tour:%f\n"
,lchrom,popsize,maxgen,refpd);
printf("ncross:%4d Nmutation:%4d Rungen:%4d AVG=%8.4f MIN=%8.4f\n\n"
,ncross,nmutation,l,avg,min);
printf("Ref.cominpath:%6.4f Minpath length:%10.4f Ref_co_tour:%f\n"
,pop[maxpp].x/maxxy,pop[maxpp].x,ff);
printf("Co_minpath:%6.4f Maxfit:%10.8f"
,100.0*pop[maxpp].x/ff,pop[maxpp].fitness);
ttt=clock()/18.2;
tt=ttt/60;
printf("Run clock:%2d:%2d:%4d.2f\n",tt/60,tt%60,ttt-tt*60.0);
setcolor(1%15+1);
for(k=0;k<lchrom-1;k++)
{ix=x[pop[maxpp].chrom[k]];
iy=y[pop[maxpp].chrom[k]]+110;
jx=x[pop[maxpp].chrom[k+1]];
jy=y[pop[maxpp].chrom[k+1]]+110;
line(ix,iy,jx,jy);
putpixel(ix,iy,RED);
}
ix=x[pop[maxpp].chrom[0]];
iy=y[pop[maxpp].chrom[0]]+110;
jx=x[pop[maxpp].chrom[lchrom-1]];
jy=y[pop[maxpp].chrom[lchrom-1]]+110;
line(ix,iy,jx,jy);
putpixel(jx,jy,RED);
setcolor(11);
outtextxy(ix,iy,"*");
setcolor(12);
for(k=0;k<1%200;k++)
{ix=k+280;
iy=366-fm[k]/3;
jx=ix+1;
jy=366-fm[k+1]/3;
line(ix,iy,jx,jy);
putpixel(ix,iy,RED);
}
printf("GEN:%3d",l);
printf("Minpath:%f Maxfit:%f",pop[maxpp].x,pop[maxpp].fitness);
printf("Clock:%2d:%2d:%4.2f\n",tt/60,tt%60,ttt-tt*60.0);
}
/*###############*/
float decode(unsigned char *pp)
{int j,k,l;
float tt;
tt=dd[pp[0]*lchrom+pp[lchrom-1]];
for(j=0;j<lchrom-1;j++)
{tt=tt+dd[pp[j]*lchrom+pp[j+1]];}
l=0;
for(k=0;k<lchrom-1;k++)
for(j=k+1;j<lchrom;j++)
{if(pp[j]==pp[k])l++;}
return tt+4*l*maxdd;
}
/*%%%%%%%%%%%%%%%%%%*/
void crtinit()
{int driver,mode;
struct palettetype p;
driver=DETECT;
mode=0;
initgraph(&driver,&mode,"");
cleardevice();
}
/*$$$$$$$$$$$$$$$$$$$$*/
int select()
{double rand1,partsum;
float r1;
int j;
partsum=0.0;
j=0;
rand1=random1()*sumfitness;
do{
partsum=partsum+oldpop[j].fitness;
j=j+1;
}while((partsum<rand1)&&(j<popsize));
return j-1;
}
/*$$$$$$$$$$$$$$$*/
int crossover(unsigned char *parent1,unsigned char *parent2,int k5)
{int k,j,mutate,i1,i2,j5;
int j1,j2,j3,s0,s1,s2;
unsigned char jj,ts1[maxstring],ts2[maxstring];
float f1,f2;
s0=0;s1=0;s2=0;
if(flip(pcross))
{jcross=random(lchrom-1);
j5=random(lchrom-1);
ncross=ncross+1;
if(jcross>j5){k=jcross;jcross=j5;j5=k;}
}
else jcross=lchrom;
if(jcross!=lchrom)
{s0=1;
k=0;
for(j=jcross;j<j5;j++)
{ts1[k]=parent1[j];
ts2[k]=parent2[j];
k++;
}
j3=k;
for(j=0;j<lchrom;j++)
{j2=0;
while((parent2[j]!=ts1[j2])&&(j2<k)){j2++;}
if(j2==k)
{ts1[j3]=parent2[j];
j3++;
}
}
j3=k;
for(j=0;j<lchrom;j++)
{j2=0;
while((parent1[j]!=ts2[j2])&&(j2<k)){j2++;}
if(j2==k)
{ts2[j3]=parent1[j];
j3++;
}
}
for(j=0;j<lchrom;j++)
{newpop[k5].chrom[j]=ts1[j];
newpop[k5+1].chrom[j]=ts2[j];
}
}
else
{for(j=0;j<lchrom;j++)
{newpop[k5].chrom[j]=parent1[j];
newpop[k5+1].chrom[j]=parent2[j];
}
mutate=flip(pmutation);
if(mutate)
{s1=1;
nmutation=nmutation+1;
for(j3=0;j3<200;j3++)
{j1=random(lchrom);
j=random(lchrom);
jj=newpop[k5].chrom[j];
newpop[k5].chrom[j]=newpop[k5].chrom[j1];
newpop[k5].chrom[j1]=jj;
}
}
mutate=flip(pmutation);
if(mutate)
{s2=1;
nmutation=nmutation+1;
for(j3=0;j3<100;j3++)
{j1=random(lchrom);
j=random(lchrom);
jj=newpop[k5+1].chrom[j];
newpop[k5+1].chrom[j]=newpop[k5+1].chrom[j1];
newpop[k5+1].chrom[j1]=jj;
}
}
}
j2=random(2*lchrom/3);
for(j=j2;j<j2+lchrom/3-1;j++)
for(k=0;k<lchrom;k++)
{if(k==j)continue;
if(k>j){i2=k;i1=j;}
else{i1=k;i2=j;}
f1=dd[lchrom*newpop[k5].chrom[i1]+newpop[k5].chrom[i2]];
f1=f1+dd[lchrom*newpop[k5].chrom[(i1+1)%lchrom]+
newpop[k5].chrom[(i2+1)%lchrom]];
f2=dd[lchrom*newpop[k5].chrom[i1]+
newpop[k5].chrom[(i1+1)%lchrom]];
f2=f2+dd[lchrom*newpop[k5].chrom[i2]+
newpop[k5].chrom[(i2+1)%lchrom]];
if(f1<f2){inversion(i1,i2,newpop[k5].chrom);}
}
j2=random(2*lchrom/3);
for(j=j2;j<j2+lchrom/3-1;j++)
for(k=0;k<lchrom;k++)
{if(k==j)continue;
if(k>j){i2=k;i1=j;}
else{i1=k;i2=j;}
f1=dd[lchrom*newpop[k5+1].chrom[i1]+newpop[k5+1].chrom[i2]];
f1=f1+dd[lchrom*newpop[k5+1].chrom[(i1+1)%lchrom]+
newpop[k5+1].chrom[(i2+1)%lchrom]];
f2=dd[lchrom*newpop[k5+1].chrom[i1]+
newpop[k5+1].chrom[(i1+1)%lchrom]];
f2=f2+dd[lchrom*newpop[k5+1].chrom[i2]+
newpop[k5+1].chrom[(i2+1)%lchrom]];
if(f1<f2){inversion(i1,i2,newpop[k5+1].chrom);}
}
return 1;
}
/*$$$$$$$$$$$$$$$*/
void inversion(unsigned int k,unsigned int j,unsigned char *ss)
{unsigned int l1,i;
unsigned char tt;
l1=(j-k)/2;
for(i=0;i<l1;i++)
{tt=ss[k+i+1];
ss[k+i+1]=ss[j-i];
ss[j-i]=tt;
}
}
/*%%%%%%%%%%%%%%%*/
void randomize1()
{int i;
randomize();
for(i=0;i<lchrom;i++)
oldrand[i]=random(30001)/30000.0;
jrand=0;
}
/*%%%%%%%%%%%*/
float random1()
{jrand=jrand+1;
if(jrand>=lchrom)
{jrand=0;
randomize1();
}
return oldrand[jrand];
}
/*%%%%%%%%%%*/
int flip(float probability)
{float ppp;
ppp=random(20001)/20000.0;
if(ppp<=probability)return 1;
return 0;
}
改进后用来求解VBR问题的delphi程序
unit uEA;
interface
uses
uUtilsEA, uIEA, uITSP, Classes, GaPara, windows, SysUtils, fEA_TSP;
type
TIndividual = class(TInterfacedObject, IIndividual)
private
// The internally stored fitness value
fFitness: TFloat;
fWeConstrain: integer;
fBackConstrain: integer;
fTimeConstrain: integer;
procedure SetFitness(const Value: TFloat);
function GetFitness: TFloat;
function GetWeConstrain: integer;
procedure SetWeConstrain(const Value: integer);
procedure SetBackConstrain(const Value: integer);
function GetBackConstrain: integer;
function GetTimeConstrain: integer;
procedure SetTimeConstrain(const Value: integer);
public
property Fitness : TFloat read GetFitness write SetFitness;
property WeConstrain :integer read GetWeConstrain write SetWeConstrain;
property BackConstrain :integer read GetBackConstrain write SetBackConstrain;
property TimeConstrain :integer read GetTimeConstrain write SetTimeConstrain;
end;
TTSPIndividual = class(TIndividual, ITSPIndividual)
private
// The route we travel
fRouteArray : ArrayInt;
fWeConstrain: integer;
fBackConstrain: integer;
fTimeConstrain: integer;
function GetRouteArray(I: Integer): Integer;
procedure SetRouteArray(I: Integer; const Value: Integer);
procedure SetSteps(const Value: Integer);
function GetSteps: Integer;
function GetWeConstrain: integer;
procedure SetWeConstrain(const Value: integer);
procedure SetBackConstrain(const Value: integer);
procedure SetTimeConstrain(const Value: integer);
function GetBackConstrain: integer;
function GetTimeConstrain: integer;
public
// Constructor, called with initial route size
constructor Create(Size : TInt); reintroduce;
destructor Destroy; override;
property RouteArray[I : Integer] : Integer read GetRouteArray write SetRouteArray;
// The number of steps on the route
property Steps : Integer read GetSteps write SetSteps;
property Fitness : TFloat read GetFitness write SetFitness;
property WeConstrain :integer read GetWeConstrain write SetWeConstrain;
property BackConstrain :integer read GetWeConstrain write SetBackConstrain;
property TimeConstrain :integer read GetTimeConstrain write SetTimeConstrain;
end;
TTSPCreator = class(TInterfacedObject, ITSPCreator)
private
// The Control component we are associated with
fController: ITSPController;
function GetController: ITSPController;
procedure SetController(const Value: ITSPController);
public
// Function to create a random individual
function CreateIndividual : IIndividual;
function CreateFeasibleIndividual: IIndividual;
property Controller : ITSPController read GetController write SetController;
end;
TKillerPercentage = class(TInterfacedObject, IKillerPercentage)
private
fPer: TFloat;
procedure SetPercentage(const Value: TFloat);
function GetPercentage: TFloat;
public
function Kill(Pop : IPopulation): Integer;
// Percentage of population to be killed
property Percentage: TFloat read GetPercentage write SetPercentage;
end;
TParentSelectorTournament = class(TInterfacedObject, IParentSelector)
public
function SelectParent(Population: IPopulation): IIndividual;
end;
TTSPBreederCrossover = class(TInterfacedObject, IBreeder)
public
function BreedOffspring(PSelector: IParentSelector; Pop: IPopulation): IIndividual;
end;
TTSPMutator = class(TInterfacedObject, ITSPMutator)
private
fTrans: TFloat;
fInv: TFloat;
procedure SetInv(const Value: TFloat);
procedure SetTrans(const Value: TFloat);
function GetInv: TFloat;
function GetTrans: TFloat;
public
procedure Mutate(Individual: IIndividual);
published
// Probability of doing a transposition
property Transposition: TFloat read GetTrans write SetTrans;
// Probability of doing an inversion
property Inversion: TFloat read GetInv write SetInv;
end;
TTSPExaminer = class(TInterfacedObject, ITSPExaminer)
private
// The Control component we are associated with
fController: ITSPController;
function GetController: ITSPController;
procedure SetController(const Value: ITSPController);
public
// Returns the fitness of an individual as a real number where 0 => best
function GetFitness(Individual : IIndividual) : TFloat;
property Controller : ITSPController read GetController write SetController;
end;
TPopulation = class(TInterfacedObject, IPopulation)
private
// The population
fPop : TInterfaceList;
// Worker for breeding
fBreeder: IBreeder;
// Worker for killing
fKiller: IKiller;
// Worker for parent selection
fParentSelector: IParentSelector;
// Worker for mutation
fMutator: IMutator;
// Worker for initial creation
fCreator: ICreator;
// Worker for fitness calculation
fExaminer: IExaminer;
// On Change event
FOnChange: TNotifyEvent;
procedure Change;
// Getters and Setters
function GetIndividual(I: Integer): IIndividual;
function GetCount: Integer;
function GetBreeder: IBreeder;
function GetCreator: ICreator;
function GetExaminer: IExaminer;
function GetKiller: IKiller;
function GetMutator: IMutator;
function GetOnChange: TNotifyEvent;
function GetParentSelector: IParentSelector;
procedure SetBreeder(const Value: IBreeder);
procedure SetCreator(const Value: ICreator);
procedure SetExaminer(const Value: IExaminer);
procedure SetKiller(const Value: IKiller);
procedure SetMutator(const Value: IMutator);
procedure SetOnChange(const Value: TNotifyEvent);
procedure SetParentSelector(const Value: IParentSelector);
// not interfaced
procedure DanQuickSort(SortList: TInterfaceList; L, R: Integer; SCompare: TInterfaceCompare);
procedure Sort(Compare: TInterfaceCompare);
protected
// Comparison function for Sort()
function CompareIndividuals(I1, I2: IIndividual): Integer;
// Sort the population
procedure SortPopulation;
public
// The constructor
constructor Create;
// The destructor
destructor Destroy; override;
// Adds an individual to the population
procedure Add(New : IIndividual);
// Deletes an individual from the population
procedure Delete(I : Integer);
// Runs a single generation
procedure Generation;
// Initialise the population
procedure Initialise(Size : Integer);
// Clear ourselves out
procedure Clear;
// Get the fitness of an individual
function FitnessOf(I : Integer) : TFloat;
// Access to the population members
property Pop[I : Integer] : IIndividual read GetIndividual; default;
// The size of the population
property Count : Integer read GetCount;
property ParentSelector : IParentSelector read GetParentSelector write SetParentSelector;
property Breeder : IBreeder read GetBreeder write SetBreeder;
property Killer : IKiller read GetKiller write SetKiller;
property Mutator : IMutator read GetMutator write SetMutator;
property Creator : ICreator read GetCreator write SetCreator;
property Examiner : IExaminer read GetExaminer write SetExaminer;
// An event
property OnChange : TNotifyEvent read GetOnChange write SetOnChange;
end;
TTSPController = class(TInterfacedObject, ITSPController)
private
fXmin, fXmax, fYmin, fYmax: TFloat;
{ The array of 'cities' }
fCities : array of TPoint2D;
{ The array of 'vehicles' }
fVehicles : array of TVehicle;
{ The array of 'vehicle number' }
fNoVehicles : ArrayInt;/////////////////////
{ The number of 'new cities' }
fCityCount: Integer;
{ The number of 'old cities' }
foldCityCount: Integer;
{ The number of 'travelers' }
fTravelCount:Integer; ///////////////////////
{ The number of 'depots' }
fDepotCount:Integer; ///////////////////////
{ Getters... }
function GetCity(I: Integer): TPoint2D;
function GetNoVehicle(I: Integer): TInt;
function GetCityCount: Integer;
function GetOldCityCount: Integer;
function GetTravelCount:Integer;
function GetDepotCount:Integer;
function GetXmax: TFloat;
function GetXmin: TFloat;
function GetYmax: TFloat;
function GetYmin: TFloat;
{ Setters... }
procedure SetCityCount(const Value: Integer);
procedure SetOldCityCount(const Value: Integer);
procedure SetTravelCount(const Value: Integer); /////////////
procedure SetDepotCount(const Value: Integer); /////////////
procedure SetXmax(const Value: TFloat);
procedure SetXmin(const Value: TFloat);
procedure SetYmax(const Value: TFloat);
procedure SetYmin(const Value: TFloat);
function TimeCostBetween(C1, C2: Integer): TFloat;
function GetTimeConstraint(Individual: IIndividual): TInt;
function DateSpanToMin(d1, d2: TDateTime): integer;
function GetVehicleInfo(routeInt: Tint): integer;
procedure writeTimeArray;
procedure writeCostArray;
public
{ The constructor }
constructor Create;
{ The destructor }
destructor Destroy; override;
{ Get the distance between two cities }
function DistanceBetween(C1, C2 : Integer) : TFloat;
{ Get the cost between two cities }
function CostBetween(C1, C2: Integer): TFloat;
function GetWeightConstraint( Individual: IIndividual): TInt;
function GetBackConstraint( Individual: IIndividual): TInt;
{ Places the cities at random points }
procedure RandomCities;
{ Area limits }
property Xmin: TFloat read GetXmin write SetXmin;
property Xmax: TFloat read GetXmax write SetXmax;
property Ymin: TFloat read GetYmin write SetYmin;
property Ymax: TFloat read GetYmax write SetYmax;
{ Properties... }
property CityCount : Integer read GetCityCount write SetCityCount;
property OldCityCount : Integer read GetOldCityCount write SetOldCityCount;
property TravelCount : Integer read GetTravelCount write SetTravelCount; ///////////
property DepotCount : Integer read GetDepotCount write SetDepotCount; ///////////
{ Access to the cities array }
property Cities[I : Integer] : TPoint2D read GetCity;
property NoVehicles[I : Integer] : TInt read GetNoVehicle; ///////////////
end;
implementation
uses
Math;
{ TIndividual }
function TIndividual.GetFitness: TFloat;
begin
result := fFitness;
end;
function TIndividual.GetWeConstrain: integer;
begin
result := fWeConstrain;
end;
function TIndividual.GetBackConstrain: integer;
begin
result := fBackConstrain;
end;
function TIndividual.GetTimeConstrain: integer;
begin
result := fTimeConstrain;
end;
procedure TIndividual.SetBackConstrain(const Value: integer);
begin
fBackConstrain := Value;
end;
procedure TIndividual.SetFitness(const Value: TFloat);
begin
fFitness := Value;
end;
procedure TIndividual.SetWeConstrain(const Value: integer);
begin
fWeConstrain := Value;
end;
procedure TIndividual.SetTimeConstrain(const Value: integer);
begin
fTimeConstrain := Value;
end;
{ TTSPIndividual }
constructor TTSPIndividual.Create(Size: TInt);
begin
Inherited Create;
SetLength(fRouteArray, Size);
// fSteps := Size;
end;
destructor TTSPIndividual.Destroy;
begin
SetLength(fRouteArray, 0);
inherited;
end;
function TTSPIndividual.GetRouteArray(I: Integer): Integer;
begin
result := fRouteArray[I];
end;
function TTSPIndividual.GetSteps: Integer;
begin
result := Length(fRouteArray);
end;
procedure TTSPIndividual.SetSteps(const Value: Integer);
begin
SetLength(fRouteArray, Value);
end;
procedure TTSPIndividual.SetRouteArray(I: Integer; const Value: Integer);
begin
fRouteArray[I] := Value;
end;
function TTSPIndividual.GetWeConstrain: integer;
begin
result := fWeConstrain;
end;
function TTSPIndividual.GetBackConstrain: integer;
begin
result := fBackConstrain;
end;
function TTSPIndividual.GetTimeConstrain: integer;
begin
result := fTimeConstrain;
end;
procedure TTSPIndividual.SetWeConstrain(const Value: integer);
begin
fWeConstrain := Value;
end;
procedure TTSPIndividual.SetBackConstrain(const Value: integer);
begin
fBackConstrain := Value;
end;
procedure TTSPIndividual.SetTimeConstrain(const Value: integer);
begin
fTimeConstrain := Value;
end;
{ TTSPCreator }
function TTSPCreator.CreateIndividual: IIndividual;
var
New: ITSPIndividual;
i, j, Top, Temp : Integer;
//trav:integer;
begin
// Get the number of cities
Top := fController.CityCount;
// Create the new individual
New := TTSPIndividual.Create(Top);
// Initialise it with a sequential route
for i := 0 to Top - 1 do
New.RouteArray[i] := i;
// Shuffle the route
for i := Top - 1 downto 1 do
begin
j := Random(i);
Temp := New.RouteArray[j];
New.RouteArray[j] := New.RouteArray[i];
New.RouteArray[i] := Temp;
end;
result := New;
end;
function TTSPCreator.CreateFeasibleIndividual: IIndividual;
var
New: ITSPIndividual;
i, j, Top, Temp : Tint;
Msg:TMsg;
begin
// Get the number of cities
Top := fController.CityCount;
// Create the new individual
New := TTSPIndividual.Create(Top);
// Initialise it with a sequential route
repeat
begin//////////////////////////////////
for i := 0 to Top - 1 do
New.RouteArray[i] := i;
// Shuffle the route
for i := Top - 1 downto 1 do
begin
j := Random(i);
Temp := New.RouteArray[j];
New.RouteArray[j] := New.RouteArray[i];
New.RouteArray[i] := Temp;
end;
//process message sequence//////////
while PeekMessage(Msg,0,0,0,1) do///
begin ///
if Msg.Message<>18 then ///
begin ///
TranslateMessage(Msg); ///
DispatchMessage(Msg); ///
end; ///
end; ///
////////////////////////////////////
end
until (fController.GetWeightConstraint(New)=0)and(fController.GetBackConstraint(New)=0);
result := New;
end;
function TTSPCreator.GetController: ITSPController;
begin
result := fController;
end;
procedure TTSPCreator.SetController(const Value: ITSPController);
begin
fController := Value;
end;
{ TKillerPercentage }
function TKillerPercentage.GetPercentage: TFloat;
begin
result := fPer;
end;
function TKillerPercentage.Kill(Pop: IPopulation): Integer;
var
KillCount, i : Integer;
begin
// Work out the number we have to kill
KillCount := Floor(Pop.Count * (fPer / 100));
// Delete the worst individuals - assuming the population is sorted
for i := 1 to KillCount do
Pop.Delete(Pop.Count - 1);
// Return the number killed
Result := KillCount;
end;
procedure TKillerPercentage.SetPercentage(const Value: TFloat);
begin
fPer := Value;
end;
{ TParentSelectorTournament }
function TParentSelectorTournament.SelectParent(
Population: IPopulation): IIndividual;
var
i1, i2 : Integer;
begin
// Select a random individual
i1 := Random(Population.Count);
// Select a *different* random individual
repeat
i2 := Random(Population.Count);
until i1 <> i2;
// Hold the tournament and return the fittest of the two
if Population.FitnessOf(i1) < Population.FitnessOf(i2) then
Result := Population[i1]
else
Result := Population[i2];
end;
{ TTSPBreederCrossover }
function TTSPBreederCrossover.BreedOffspring(PSelector: IParentSelector;
Pop: IPopulation): IIndividual;
var
Child, Mom, Dad, Parent1, Parent2 : ITSPIndividual;
i, j, p : Integer;
function AlreadyAssigned(City, x : Integer) : Boolean;
var
y : Integer;
Found : Boolean;
begin
Found := False;
for y := 0 to x - 1 do
begin
if Child.RouteArray[y] = City then
begin
Found := True;
Break;
end;
end;
Result := Found;
end;
begin
// Select a some parents...
Mom := PSelector.SelectParent(Pop) as ITSPIndividual;
Dad := PSelector.SelectParent(Pop) as ITSPIndividual;
// Create a child
Child := TTSPIndividual.Create(Mom.Steps);
// Copy the route from parents to child
for i := 0 to Child.Steps - 1 do
begin
// Choose a parent at random
p := Random(2);
if p = 0 then
begin
Parent1 := Mom;
Parent2 := Dad;
end else
begin
Parent1 := Dad;
Parent2 := Mom;
end;
if not AlreadyAssigned(Parent1.RouteArray[i], i) then
begin
// Use city from Parent 1 unless used already
Child.RouteArray[i] := Parent1.RouteArray[i];
end else
if not AlreadyAssigned(Parent2.RouteArray[i], i) then
begin
// Otherwise use city from Parent 2 unless used already
Child.RouteArray[i] := Parent2.RouteArray[i];
end else
begin
// If both assigned already then use a random city
repeat
j := Random(Child.Steps);
until not AlreadyAssigned(j, i);
Child.RouteArray[i] := j;
end;
end;
// Return the child
Result := Child;
end;
{ TTSPMutator }
function TTSPMutator.GetInv: TFloat;
begin
result := fInv;
end;
function TTSPMutator.GetTrans: TFloat;
begin
result := fTrans;
end;
procedure TTSPMutator.Mutate(Individual: IIndividual);
var
P: Double;
i, j, t : Integer; Start, Finish : Integer;
begin
with Individual as ITSPIndividual do
begin
// Should we do an inversion?
P := Random * 100;
if P < FTrans then
begin
// Do an inversion (i.e. swap two cities at random)
// Choose first city
i := Random(Steps);
// Choose a second city
repeat
j := Random(Steps);
until i <> j;
// Swap them over
t := RouteArray[i];
RouteArray[i] := RouteArray[j];
RouteArray[j] := t;
end;
// Should we do a transposition?
P := Random * 100;
if P < FInv then
begin
// Do a transposition (i.e. reverse a sub-route)
// Choose random start and finish points
Start := Random(Steps - 1);
Finish := Start + Random(Steps - Start);
// Reverse the sub-route
for i := 0 to Floor((Finish - Start) / 2) do
begin
t := RouteArray[Start + i];
RouteArray[Start + i] := RouteArray[Finish - i];
RouteArray[Finish - i] := t;
end;
end;
end;
end;
procedure TTSPMutator.SetInv(const Value: TFloat);
begin
fInv := Value;
end;
procedure TTSPMutator.SetTrans(const Value: TFloat);
begin
fTrans := Value;
end;
{ TTSPExaminer }
function TTSPExaminer.GetController: ITSPController;
begin
result := fController;
end;
function TTSPExaminer.GetFitness(Individual: IIndividual): TFloat;
var
i , weightConstraint, backConstraint : TInt;
Distance , penaltyW, penaltyB : TFloat;
Indi : ITSPIndividual;
begin
Indi := Individual as ITSPIndividual;
Distance := 0;
penaltyW:=FormGaPara.EditWeightConstrain.Value;
penaltyB:=FormGaPara.EditBackConstrain.Value;
for i := 0 to Indi.Steps - 2 do
begin
Distance := Distance + fController.DistanceBetween(Indi.RouteArray[i], Indi.RouteArray[i + 1]);
end;
Distance := Distance + fController.DistanceBetween(Indi.RouteArray[Indi.Steps - 1], Indi.RouteArray[0]);
WeightConstraint:=fController.GetWeightConstraint(Indi);
backConstraint:=fController.GetBackConstraint(Indi);
Indi.WeConstrain:=WeightConstraint;
Indi.BackConstrain:=backConstraint;
Result := Distance+penaltyW*weightconstraint+penaltyB*backConstraint;
end;
procedure TTSPExaminer.SetController(const Value: ITSPController);
begin
fController := Value;
end;
{ TPopulation }
constructor TPopulation.Create;
begin
inherited;
fPop := TInterfaceList.Create;
end;
destructor TPopulation.Destroy;
begin
fPop.Free;
inherited;
end;
procedure TPopulation.Add(New: IIndividual);
begin
fPop.Add(New);
end;
procedure TPopulation.Clear;
begin
fPop.Clear;
end;
function TPopulation.CompareIndividuals(I1, I2: IIndividual): Integer;
var
A, B, D : TFloat;
begin
// Get the difference between the two individuals (real number)
A := I1.Fitness;
B := I2.Fitness;
D := A - B;
// Quickest way to convert that to an integer is...
if D > 0 then
Result := 1
else if D < 0 then
Result := -1
else
Result := 0;
end;
procedure TPopulation.Delete(I: Integer);
begin
fPop.Delete(I);
end;
function TPopulation.FitnessOf(I: Integer): TFloat;
begin
result := Pop[I].Fitness;
end;
procedure TPopulation.Change;
begin
if Assigned(fOnChange) then
FOnChange(Self);
end;
procedure TPopulation.Generation;
var
Replace, i : Integer;
New : IIndividual;
begin
// Kill some of the population
Replace := fKiller.Kill(Self);
for i := 1 to Replace do
begin
// Breed a new individual
New := fBreeder.BreedOffspring(fParentSelector, Self);
// Perform some mutation on the individual
FMutator.Mutate(New);
// Get the fitness of the new individual
New.Fitness := fExaminer.GetFitness(New);
// Add it to the population
Add(New);
end;
// Sort the population into fitness order where first <==> best
SortPopulation;
Change;
end;
function TPopulation.GetBreeder: IBreeder;
begin
result := fBreeder;
end;
function TPopulation.GetCount: Integer;
begin
result := fPop.Count;
end;
function TPopulation.GetCreator: ICreator;
begin
result := fCreator;
end;
function TPopulation.GetExaminer: IExaminer;
begin
result := fExaminer;
end;
function TPopulation.GetIndividual(I: Integer): IIndividual;
begin
result := (fPop[I] as IIndividual);
end;
function TPopulation.GetKiller: IKiller;
begin
result := fKiller;
end;
function TPopulation.GetMutator: IMutator;
begin
result := fMutator;
end;
function TPopulation.GetOnChange: TNotifyEvent;
begin
result := fOnChange;
end;
function TPopulation.GetParentSelector: IParentSelector;
begin
result := fParentSelector;
end;
procedure TPopulation.Initialise(Size: Integer);
var
i,feasibleCount: Integer;
New: IIndividual;
begin
feasibleCount:=round(size*(FormGaPara.EditFeasible.Value)/100);
//feasibleCount:=1;
// Clear out the old stuff
Clear;
// Set the capacity first to save about 12 nanoseconds ;o)
fPop.Capacity := Size;
// Create the appropriate number of individuals
for i := 1 to feasibleCount do
begin
// Create the individual
New := fCreator.CreateFeasibleIndividual;
// Get the fitness of the new individual
New.Fitness := fExaminer.GetFitness(New);
// Add to the population
Add(New);
end;
for i := feasibleCount+1 to Size do
begin
// Create the individual
New := fCreator.CreateIndividual; ////////
// Get the fitness of the new individual
New.Fitness := fExaminer.GetFitness(New);
// Add to the population
Add(New);
end;
SortPopulation;
Change;
end;
procedure TPopulation.SetBreeder(const Value: IBreeder);
begin
fBreeder := Value;
end;
procedure TPopulation.SetCreator(const Value: ICreator);
begin
fCreator := Value;
end;
procedure TPopulation.SetExaminer(const Value: IExaminer);
begin
fExaminer := Value;
end;
procedure TPopulation.SetKiller(const Value: IKiller);
begin
fKiller := Value;
end;
procedure TPopulation.SetMutator(const Value: IMutator);
begin
fMutator := Value;
end;
procedure TPopulation.SetOnChange(const Value: TNotifyEvent);
begin
fOnChange := Value;
end;
procedure TPopulation.SetParentSelector(const Value: IParentSelector);
begin
fParentSelector := Value;
end;
procedure TPopulation.DanQuickSort(SortList: TInterfaceList; L, R: Integer;
SCompare: TInterfaceCompare);
var
I, J: Integer;
P: IIndividual;
begin
repeat
I := L;
J := R;
P := SortList.Items[(L + R) div 2] as IIndividual;
repeat
while SCompare(SortList.Items[I] as IIndividual, P) < 0 do
Inc(I);
while SCompare(SortList.Items[J] as IIndividual, P) > 0 do
Dec(J);
if I <= J then
begin
SortList.Exchange(I, J);
Inc(I);
Dec(J);
end;
until I > J;
if L < J then
DanQuickSort(SortList, L, J, SCompare);
L := I;
until I >= R;
end;
procedure TPopulation.Sort(Compare: TInterfaceCompare);
begin
if Assigned(fPop) and (Count > 0) then
DanQuickSort(fPop, 0, Count - 1, Compare);
end;
procedure TPopulation.SortPopulation;
begin
Sort(self.CompareIndividuals);
end;
{ TTSPController }
constructor TTSPController.Create;
begin
inherited;
end;
destructor TTSPController.Destroy;
begin
SetLength(FCities, 0);
SetLength(FNoVehicles, 0);
SetLength(FVehicles, 0);
inherited;
end;
{ Standard euclidian distance between two 2D vectors... }
function TTSPController.DistanceBetween( C1, C2: Integer): TFloat;
var
temp:TFloat;
i,j,intTemp,intTemp2:TInt;
begin
intTemp:=0;
temp:=FormGaPara.EditWrongConstrain.Value;
{if (Cities[C2].id>=1)and(Cities[C2].id<=fOldCityCount)and(Cities[C1].id<>0) then
begin
fCities[C2].serviceDepot:= fCities[C1].serviceDepot;
end; //}
//8
if (Cities[C1].id>=1)and(Cities[C1].id<=fOldCityCount)and(Cities[C2].id>=1)and(Cities[C2].id<=fOldCityCount) then
begin
temp:=CostArray[C1,C2];
end;
//1
if Cities[C1].id=0 then
begin
for i:=0 to fDepotCount-1 do
begin
intTemp:=intTemp+fNoVehicles[i];
if Cities[C2].id =fOldCityCount + intTemp +1 then
temp:=0;
end;
intTemp:=0;
end;
//2
if Cities[C2].id=0 then
begin
for i:=1 to fDepotCount do
begin
intTemp:=intTemp+fNoVehicles[i];
if Cities[C1].id =fOldCityCount + intTemp then
temp:=0;
end;
intTemp:=0;
end;
//5
for i:=0 to fDepotCount-1 do
begin
intTemp:=intTemp+fNoVehicles[i];
{ if (Cities[C1].id=fOldCityCount + intTemp +1)and(Cities[C2].id=Cities[C1].id+1) then
temp:=10; /////////////////////////// }
if (Cities[C1].id>=fOldCityCount + intTemp +1)and(Cities[C1].id<=fOldCityCount + intTemp+fNoVehicles[i+1])
and(Cities[C2].id>=fOldCityCount + intTemp +1)and(Cities[C2].id<=fOldCityCount + intTemp+fNoVehicles[i+1])
then
temp:=0;//}
end;
intTemp:=0;
//7
if (Cities[C1].id=Cities[C2].id)and(Cities[C1].id > fOldCityCount) then
begin
temp:=0;
end;
//3
if (Cities[C1].id > fOldCityCount)and(Cities[C2].id>=1)and(Cities[C2].id<=fOldCityCount) then
begin
//temp := Sqrt(sqr(Cities[C1].X - Cities[C2].X)+sqr(Cities[C1].Y - Cities[C2].Y));
temp:=CostArray[C1,C2];
end;
//4
if (Cities[C1].id<=fOldCityCount)and(Cities[C1].id>=1)and(Cities[C2].id > fOldCityCount) then
begin
//if Cities[C1].serviceDepot=Cities[C2].serviceDepot then //back to the start point
temp:=CostArray[C1,C2];
end;
//6
intTemp:=0;
for i:=1 to fDepotCount do
begin
intTemp:=intTemp+fNoVehicles[i];
if Cities[C1].id= fOldCityCount + intTemp then
begin
intTemp2:=0;
for j:=0 to fDepotCount-1 do
begin
intTemp2:=intTemp2+fNoVehicles[j];
if Cities[C2].id=fOldCityCount + intTemp2 +1 then
if abs(Cities[C2].id-Cities[C1].id) <> fNoVehicles[i]-1 then
temp:=0;
end; //}
end;
end;
intTemp:=0;
result:=temp;
end;
function TTSPController.CostBetween(C1, C2: Integer): TFloat; //matrix cij
var
distance:TFloat;
begin
distance := Sqrt(sqr(Cities[C1].X - Cities[C2].X)+ sqr(Cities[C1].Y - Cities[C2].Y));
//result:=distance+TimeCostBetween(C1,C2);
result:=distance;
end;
function TTSPController.TimeCostBetween(C1, C2: Integer): TFloat;
var
cost:TFloat;
i,j,penaltyW,penaltyD:TFloat;
startTime:TDateTime;
begin
startTime:=strToDateTime(FormGa.EditStartTime.Text);
penaltyW:=FormGaPara.EditWaitConstrain.Value;
penaltyD:=FormGaPara.EditDelayConstrain.Value;
if Cities[C2].id>fOldCityCount then
fCities[C2].totalTime:=0
else
fCities[C2].totalTime:=Cities[C1].totalTime+Cities[C1].serviceTime+timeArray[C1,C2];
fCities[C2].waitTime:= max(0,DateSpanToMin(startTime,Cities[C2].early)-Cities[C2].totalTime);
fCities[C2].delayTime:=max(0,Cities[C2].totalTime-DateSpanToMin(startTime,Cities[C2].late));
if Cities[C2].late<>0 then //consider time or not
begin
if Cities[C2].early<>0 then //window or deadline
cost:=penaltyW*fCities[C2].waitTime +penaltyD*fCities[C2].delayTime
else
cost:=penaltyD*fCities[C2].delayTime;
end
else
cost:=0;
result:=cost;
end;
function TTSPController.DateSpanToMin(d1,d2:TDateTime):integer;
var
span:TDateTime;
Year, Month, Day, Hour, Min, Sec, MSec: Word;
begin
span:=abs(d2-d1);
DecodeDate(span, Year, Month, Day);
DecodeTime(span, Hour, Min, Sec, MSec);
result:=Min;
end;
//return the position in the vehicles array
function TTSPController.GetVehicleInfo( routeInt:Tint):integer;
begin
result:=routeInt-fOldCityCount-1;
end;
function TTSPController.GetWeightConstraint( Individual: IIndividual): TInt;
var
Indi: ITSPIndividual;
totalCapacity,maxCapacity: TFloat;
i,j:TInt;
tempArray:array of TInt;
tempResult:TInt;
begin
Indi := Individual as ITSPIndividual;
SetLength(tempArray, fCityCount+1);
tempResult:=0;
/////////////////////////////////////////////////////////
for i:=0 to fCityCount-1 do
begin
if Indi.RouteArray[i]=fOldCityCount+1 then
break;
end;
for j:=0 to fCityCount-i-1 do
begin
tempArray[j]:= Indi.RouteArray[i+j];
end;
for j:=fCityCount-i to fCityCount-1 do
begin
tempArray[j]:= Indi.RouteArray[j-fCityCount+i];
end;
tempArray[fCityCount]:= tempArray[0];
//////////////////////////////////////////////////////////
//totalCapacity:=fCities[tempArray[0]].supply; //supply
maxCapacity:=fVehicles[GetVehicleInfo(tempArray[0])].volume;
totalCapacity:=maxCapacity;
for i:=0 to fCityCount do
begin
if (FCities[tempArray[i]].id<=fOldCityCount)and(FCities[tempArray[i]].id>0) then
begin
totalCapacity:=totalCapacity+FCities[tempArray[i]].supply-FCities[tempArray[i]].demand;
if (totalCapacity>maxCapacity)or(totalCapacity<0) then
begin
tempResult:=tempResult+1;
//break;
end;
end;
if FCities[tempArray[i]].id>fOldCityCount then
begin
//totalCapacity:=fCities[tempArray[i]].supply; //supply
maxCapacity:=fVehicles[GetVehicleInfo(tempArray[i])].volume;
totalCapacity:=maxCapacity;
end;
end;
SetLength(tempArray,0);
result:=tempResult;
end;
function TTSPController.GetBackConstraint( Individual: IIndividual): TInt;
var
Indi: ITSPIndividual;
i,j:TInt;
tempArray:array of TInt;
tempResult:TInt;
begin
Indi := Individual as ITSPIndividual;
SetLength(tempArray, fCityCount+1);
tempResult:=0;
for i:=0 to fCityCount-1 do
begin
if Indi.RouteArray[i]=fOldCityCount+1 then
break;
end;
for j:=0 to fCityCount-i-1 do
begin
tempArray[j]:= Indi.RouteArray[i+j];
end;
for j:=fCityCount-i to fCityCount-1 do
begin
tempArray[j]:= Indi.RouteArray[j-fCityCount+i];
end;
tempArray[fCityCount]:=tempArray[0];
{tempArray[0]:=11;tempArray[1]:=5;tempArray[2]:=8;tempArray[3]:=7;
tempArray[4]:=9;tempArray[5]:=6;tempArray[6]:=12;tempArray[7]:=10;
tempArray[8]:=2;tempArray[9]:=4;tempArray[10]:=3;tempArray[11]:=1;
tempArray[12]:=0;tempArray[13]:=11;tempArray[14]:=3;tempArray[15]:=1;
tempArray[16]:=4;tempArray[17]:=11;//10,2,2}
for i:=0 to fCityCount-1 do
begin
if (Cities[tempArray[i+1]].id<=fOldCityCount) then
begin
fCities[tempArray[i+1]].serviceDepot:= fCities[tempArray[i]].serviceDepot;
end;
if (Cities[tempArray[i]].id<=fOldCityCount)and(Cities[tempArray[i]].id>=1)and(Cities[tempArray[i+1]].id > fOldCityCount) then
begin
if Cities[tempArray[i]].serviceDepot<>Cities[tempArray[i+1]].serviceDepot then //back to the start point
begin
tempResult:=tempResult+1;
// break;
end;
end;
end;
SetLength(tempArray,0);
result:=tempResult;
end;
function TTSPController.GetTimeConstraint( Individual: IIndividual): TInt;
var
Indi: ITSPIndividual;
i,j:TInt;
totalTimeCost:TFloat;
tempArray:array of TInt;
tempResult:TInt;
begin
Indi := Individual as ITSPIndividual;
SetLength(tempArray, fCityCount+1);
tempResult:=0;
for i:=0 to fCityCount-1 do
begin
if Indi.RouteArray[i]=fOldCityCount+1 then
break;
end;
for j:=0 to fCityCount-i-1 do
begin
tempArray[j]:= Indi.RouteArray[i+j];
end;
for j:=fCityCount-i to fCityCount-1 do
begin
tempArray[j]:= Indi.RouteArray[j-fCityCount+i];
end;
tempArray[fCityCount]:=tempArray[0];
totalTimeCost:=0;
for i:=0 to fCityCount-1 do
begin
totalTimeCost:=totalTimeCost+timeCostBetween(tempArray[i],tempArray[i+1]);
end;
if totalTimeCost<>0 then tempResult:=1;
SetLength(tempArray,0);
end;
function TTSPController.GetCity(I: Integer): TPoint2D;
begin
result := fCities[I];
end;
function TTSPController.GetNoVehicle(I: Integer): TInt;
begin
result := fNoVehicles[I];
end;
function TTSPController.GetCityCount: Integer;
begin
result := fCityCount;
end;
function TTSPController.GetOldCityCount: Integer;
begin
result := fOldCityCount;
end;
function TTSPController.GetTravelCount: Integer;
begin
result := fTravelCount;
end;
function TTSPController.GetDepotCount: Integer;
begin
result := fDepotCount;
end;
function TTSPController.GetXmax: TFloat;
begin
result := fXmax;
end;
function TTSPController.GetXmin: TFloat;
begin
result := fXmin;
end;
function TTSPController.GetYmax: TFloat;
begin
result := fYmax;
end;
function TTSPController.GetYmin: TFloat;
begin
result := fYmin;
end;
procedure TTSPController.RandomCities; //from database
var
i,j,k,m,intTemp,totalVehicleCount: Integer;
tempVehicle:TVehicle;
begin
//////////////////////////////////////////////////////////
fNoVehicles[0]:=0;
totalVehicleCount:=0;
for i:=1 to fDepotCount do //from depots database
begin
fNoVehicles[i]:=fTravelCount +1;
totalVehicleCount:=totalVehicleCount+ fNoVehicles[i]; //real and virtual vehicles
end;
SetLength(fVehicles,totalVehicleCount);
intTemp:=0;
for i:=1 to fDepotCount do
begin
for j:=intTemp to intTemp+fNoVehicles[i]-2 do
begin
fVehicles[j].index:=j+1;
fVehicles[j].id:='real vehicle';
fVehicles[j].volume:=50;
end;
with fVehicles[intTemp+fNoVehicles[i]-1] do
begin
index:=intTemp+fNoVehicles[i];
id:='virtual vehicle';
volume:=0;
end;
intTemp:=intTemp+ fNoVehicles[i];
end;
///////////////////////////////////////////////////////////
intTemp:=0;
for i:=1 to fDepotCount do //depot 1--value
begin
intTemp:=intTemp + fNoVehicles[i];
end;
for i := 0 to FOldCityCount do //from database
begin
FCities[i].id:= i;
FCities[i].X := Xmin+0.5+(Xmax-Xmin-1.0)*Random;
FCities[i].Y := Ymin+0.5+(Ymax-Ymin-1.0)*Random;
FCities[i].early:=0;
FCities[i].late:=0; //TDateTime
FCities[i].serviceTime:=0;
FCities[i].totalTime:=0;
FCities[i].waitTime:=0;
FCities[i].delayTime:=0;
end;
for i:=FOldCityCount+1 to FCityCount-1 do
begin
FCities[i].id:= i;
if fDepotCount=1 then
begin
FCities[i].X := Xmin+0.5+(Xmax-Xmin-1.0)*RandomRange(2,4)/5;
FCities[i].Y := Ymin+0.5+(Ymax-Ymin-1.0)*RandomRange(2,4)/5;
end
else
begin
FCities[i].X := Xmin+0.5+(Xmax-Xmin-1.0)*Random;
FCities[i].Y := Ymin+0.5+(Ymax-Ymin-1.0)*Random;
end;
FCities[i].early:=0;
FCities[i].late:=0; //TDateTime
FCities[i].serviceTime:=0;
FCities[i].totalTime:=0;
FCities[i].waitTime:=0;
FCities[i].delayTime:=0;
end;
for i := 0 to FOldCityCount do
begin
FCities[i].serviceDepot:=i;
end;
m:=FOldCityCount+1;
for k:=1 to fDepotCount do
begin
for j:=0 to fNoVehicles[k]-1 do
begin
FCities[m].serviceDepot:= fOldCityCount+k;
m:=m+1;
end;
end;
//supply and demand //////////////////////////from database
FCities[0].demand:=0;
FCities[0].supply:=0;
for i:=1 to FOldCityCount do
begin
FCities[i].demand:=10;
FCities[i].supply:=0;
end;
for i:=FOldCityCount+1 to FCityCount-1 do
begin
FCities[i].demand:=0;
FCities[i].supply:=50;
end;
////////////////////////////////////////////////////////////
intTemp:=0;
for i:=0 to fDepotCount-1 do
begin
intTemp:=intTemp+fNoVehicles[i];
for j:=2 to fNoVehicles[i+1] do
begin
FCities[fOldCityCount + intTemp +j].X :=FCities[fOldCityCount + intTemp +1].X;
FCities[fOldCityCount + intTemp +j].Y :=FCities[fOldCityCount + intTemp +1].Y;
end;
end;
writeTimeArray;
writeCostArray;
end;
procedure TTSPController.writeTimeArray; //database
var
i,j:integer;
begin
SetLength(timeArray,fCityCount,fCityCount);
for i:=0 to fCityCount-1 do
begin
for j:=0 to fCityCount-1 do
begin
if i=j then timeArray[i,j]:=0
else timeArray[i,j]:=10;
end;
end;
end;
procedure TTSPController.writeCostArray; //database
var
i,j:integer;
begin
SetLength(costArray,fCityCount,fCityCount);
for i:=0 to fCityCount-1 do
begin
for j:=0 to fCityCount-1 do
begin
if i=j then costArray[i,j]:=0
else costArray[i,j]:=costBetween(i,j);
end;
end;
end;
procedure TTSPController.SetCityCount(const Value: Integer);
begin
SetLength(fCities, Value);
fCityCount := Value;
RandomCities;
end;
procedure TTSPController.SetOldCityCount(const Value: Integer);
begin
fOldCityCount := Value;
end;
procedure TTSPController.SetTravelCount(const Value: Integer); ///////////
begin
fTravelCount := Value;
end;
procedure TTSPController.SetDepotCount(const Value: Integer); ///////////
begin
SetLength(fNoVehicles, Value+1); ///////////////
fDepotCount := Value;
end;
procedure TTSPController.SetXmax(const Value: TFloat);
begin
fXmax := Value;
end;
procedure TTSPController.SetXmin(const Value: TFloat);
begin
fXmin := Value;
end;
procedure TTSPController.SetYmax(const Value: TFloat);
begin
fYmax := Value;
end;
procedure TTSPController.SetYmin(const Value: TFloat);
begin
fYmin := Value;
end;
end.
全部作者的其他最新日志
- • 结晶元胞代码
- • QCADesigner仿真
