（TSP问题的交叉算子）TSP问题(Traveling Sa

（TSP问题的交叉算子）TSP问题(Traveling Salesman Problem)描述如下：给定n个城市，构成一个完全图，任何两城市之间都有一个代价（例如路程、旅费等），现要构造遍历所有城市的环路，每个城市恰好经过一次，求使总代价达到最小的一条环路。 遗传算法是求解该问题的一个很有效的近似算法。在该算法中，一个个体为一条环路，其编码方法之一是1到n这n个数字的一个排列，每个数字为一个城市的编号。例如当n=5时，“3 4 2 1 5”表示该方案实施的路线为3->4->2->1->5->3。遗传算法的核心是通过两个个体的交叉操作，产生两个新的个体。下面的程序给出了最简单的一种交叉算法。具体过程如下：
(1)选定中间一段作为互换段，该段的起止下标为t1，t2，随机生成t1，t2后，互换两段。
(2)互换后，在每个新的排列中可能有重复数字，因而不能作为新个体的编码，一般再做两步处理：(2.1) 将两个互换段中，共同的数字标记为0，表示已处理完。
(2.2) 将两个互换段中其余数字标记为1，按顺序将互换段外重复的数字进行替换。
例如：n=12，两个个体分别是：
a1: 1 3 5 4 * 2 6 7 9 * 10 12 8 11
a2: 3 2 1 12 * 6 7 10 11 * 8 5 4 9
t1=5，t2=8。上述每一行中，两个星号间的部分为互换段。假定数组的下标从1开始，互换后有：
a1: 1 3 5 4 * 6 7 10 11 * 10 12 8 11
a2: 3 2 1 12 * 2 6 7 9 * 8 5 4 9
然后，将数字6,7对应的项标记为0，星号内数字2,9,10,11对应的项标记为1，并且按顺序对应关系为: 10<->2 ，11<->9。于是，将a1[9]=10替换为a1[9]=2，将a2[2]=2替换为a2[2]=10，类似再做第2组替换。这样处理后，就得到了两个新个体：
a1: 1 3 5 4 6 7 10 11 2 12 8 9
a2: 3 10 1 12 2 6 7 9 8 5 4 11
（3）输出两个新个体的编码。
程序：

program ex502;
type
  arr1 = array[1..20] of integer;
var
  a1, a2, kz1, kz2 : arr1;
  n, k, t1, t2 : integer;
function rand1(k : integer) : integer;
var
  t : integer;
begin
  t := 0;
  while (t < 2) or (t > k) do
    t := random(k + 1) - 2;
  rand1 := t;
end;
procedure read1(var a : arr1; m : integer);
{读入数组元素a[1]至a[m]，a[0]=0，略。}
procedure wrt1(var a : arr1; m : integer);
{输出数组元素a[1]至a[m]，略。}
procedure cross(var a1, a2 : arr1; t1, t2, n : integer);
var
  i, j, t, kj : integer;
begin
  for i:=t1 to t2 do
  begin
    t := a1[i];
    1;
  end;
  for i:=1 to n do
    if (i < t1) or (i > t2) then
    begin
      kz1[i] := -1;
      kz2[i] := -1;
    end
    else
    begin
      2;
    end;
  for i:=t1 to t2 do
    for j:=t1 to t2 do
      if(a1[i] = a2[j]) then
      begin
        3;
        break;
      end;
  for i:=t1 to t2 do
    if(kz1[i] = 1) then
    begin
      for j:=t1 to t2 do
        if(kz2[j] = 1) then
        begin
          kj := j;
          break;
        end;
      for j:=1 to n do
        if 4 then
        begin
          a1[j] := a2[kj];
          break;
        end;
      for j:=1 to n do
        if 5 then
        begin
          a2[j] := a1[i];
          break;
        end;
      kz1[i] := 0;
      kz2[kj] := 0;
    end;
end;
begin
  writeln('input (n>5):');
  readln(n);
  writeln('input array 1:');
  read1(a1, n);
  writeln('input array 2:');
  read1(a2, n);
  t1 := rand1(n - 1);
  repeat
    t2 := rand1(n - 1);
  until(t1 <> t2);
  if(t1 > t2) then
  begin
    k := t1;
    t1 := t2;
    t2 := k;
  end;
  6;
  wrt1(a1, n);
  wrt1(a2, n);
end