program p_zdktausch2; (* 2+3-Kantentausch(erster Schritt), Thomas Klein 1999 *)
 (* 3-Kantentausch basierend auf einer Prozedur aus                   
    M. M. Syslo: Discrete Optimization Algorithms, Prentice-Hall, 1983 *)     
uses graph,tsp;

function ktausch(i,j:stadtnr;w:weg):weg;
 (* Zweikantentausch mit Schnitten nach i,j *)
 var k,k1,l1:stadtnr;
     hilf:char;
 begin
  for k:=1 to ((j-i+stadtanzahl) mod stadtanzahl) div 2 do begin
   k1:=1+(i+k-1+stadtanzahl) mod stadtanzahl;
   l1:=1+(j-k+stadtanzahl) mod stadtanzahl;
   hilf:=w[k1]; w[k1]:=w[l1]; w[l1]:=hilf;
  end;
  w[stadtanzahl+1]:=w[1];
  ktausch:=w;
 end;

procedure ktausch2(var mweg:weg;var m:entfernung);
 (* Postoptimierung mit Zweikantentausch/erster verbessernder Schritt *)
 var i,j:stadtnr;
     l:entfernung;
     w:weg;
     tausch:boolean;
 begin
  m:=weglaenge(mweg);
  repeat
   tausch:=false;
   for i:=1 to stadtanzahl do
    for j:=1 to stadtanzahl do begin
     w:=ktausch(i,j,mweg);
     l:=weglaenge(w);
     if l<m then begin m:=l; mweg:=w; tausch:=true; end;
    end;
  until not tausch;
 end;

procedure dktausch(var w:weg);
 (* Postoptimierung mit Dreikantentausch, fuer symm. Matrix *)
 type tauschrec=record
                  x1,x2,y1,y2,z1,z2:stadtnr;
                  verbesserung:entfernung;
                  art:boolean; (* true: asymm., false: symm. *)
                 end;
 var besttausch,tausch:tauschrec;
     i,j,k,index:stadtnr;
     zeiger:array[1..maxstadt] of stadtnr;
 procedure tauschtest(var tausch:tauschrec);
  var l,max:entfernung;
  begin
   with tausch do begin
    verbesserung:=0;
    l:=entftab[x1,x2]+entftab[y1,y2]+entftab[z1,z2];
    max:=l-entftab[y1,x1]-entftab[z1,x2]-entftab[z2,y2];
    if max>verbesserung then begin
     verbesserung:=max; art:=true;
    end;
    max:=l-entftab[x1,y2]-entftab[z1,x2]-entftab[y1,z2];
    if max>verbesserung then begin
     verbesserung:=max; art:=false;
    end;
   end;
  end;
 procedure umkehren(anfang,ende:stadtnr);
  var voraus,letzte,naechste:stadtnr;
  begin
   if anfang<>ende then begin
    letzte:=anfang; naechste:=zeiger[letzte];
    repeat
     voraus:=zeiger[naechste]; zeiger[naechste]:=letzte;
     letzte:=naechste; naechste:=voraus;
    until letzte=ende;
   end;
  end;

 begin
  for i:=1 to stadtanzahl-1 do zeiger[ord(w[i])]:=ord(w[i+1]);
  zeiger[ord(w[stadtanzahl])]:=ord(w[1]);
  repeat
   besttausch.verbesserung:=0; tausch.x1:=1;
   for i:=1 to stadtanzahl do begin
    tausch.x2:=zeiger[tausch.x1]; tausch.y1:=tausch.x2;
    for j:=2 to stadtanzahl-3 do begin
     tausch.y2:=zeiger[tausch.y1]; tausch.z1:=zeiger[tausch.y2];
     for k:=j+2 to stadtanzahl-1 do begin
      tausch.z2:=zeiger[tausch.z1];
      tauschtest(tausch);
      if tausch.verbesserung>besttausch.verbesserung then besttausch:=tausch;
      tausch.z1:=tausch.z2;
     end;
     tausch.y1:=tausch.y2;
    end;
    tausch.x1:=tausch.x2;
   end;
   if besttausch.verbesserung>0 then
    with besttausch do begin
     if art then begin
      umkehren(z2,x1); zeiger[y1]:=x1; zeiger[z2]:=y2;
     end else begin
      zeiger[x1]:=y2; zeiger[y1]:=z2;
     end;
     zeiger[z1]:=x2;
    end;
  until besttausch.verbesserung=0;
  index:=1; w:='';
  for i:=1 to stadtanzahl do begin
   w:=w+chr(index); index:=zeiger[index];
  end;
  w:=w+chr(1);
 end;

procedure zdktausch2(var w:weg);
 (* Postoptimierung mit Zwei- und Dreikantentausch 2 *)
 var m,l:entfernung;
 begin
  m:=maxentfernung;
  repeat
   l:=m; ktausch2(w,m);
   if m<l then begin l:=m; dktausch(w); m:=weglaenge(w); end;
  until m>=l;
 end;

begin
 if tspinit('TSP: 2+3-Kantentausch 2(erster Schritt)','Berechnen') then
  while tspmenue([113]) do begin
   start; zdktausch2(aktuell); stop;
   wegkarte(aktuell,true,brown,yellow);
   laenge_aus(aktuell); zeit_aus(true);
  end;
 closegraph;
end.