V8SORT - Sắp xếp

Tác giả: flashmt

Ngôn ngữ: Pascal

const fi='';
      fo='';
      max=5050;
      maxc=1000000000;
      f:array[0..7] of longint=(1,1,2,6,24,120,720,5040);
type ar=array[1..7] of longint;
var a:array[1..7,1..7] of longint;
    d:array[1..max] of longint;
    dau,c:array[1..max] of byte;
    b,y:ar;
    n,x,t,min,i,j,m:longint;

function conv(var b:ar):longint;
var t,r,i,j:longint;
begin
     r:=1;
     fillchar(c,sizeof(c),0);
     for i:=1 to m do
     begin
          t:=-1;
          for j:=1 to b[i] do
              if c[j]=0 then inc(t);
          r:=r+t*f[m-i];
          c[b[i]]:=1;
     end;
     conv:=r;
end;

procedure reconv(var b:ar;x:longint);
var t,i,j:longint;
begin
     dec(x);
     fillchar(c,sizeof(c),0);
     for i:=1 to m-1 do
     begin
          t:=x div f[m-i]+1;
          x:=x mod f[m-i];
          j:=0;
          while t>0 do
          begin
               inc(j);
               if c[j]=0 then dec(t);
          end;
          b[i]:=j;
          c[j]:=1;
     end;
     for i:=1 to m do
         if c[i]=0 then
         begin
              b[m]:=i;
              break;
         end;
end;

begin
     assign(input,fi); reset(input);
     assign(output,fo); rewrite(output);
     m:=0;
     while not eoln do
     begin
          inc(m);
          read(b[m]);
     end;
     x:=conv(b);
     for i:=1 to m do
         for j:=1 to m do
             read(a[i,j]);
     n:=f[m];
     for i:=1 to n do d[i]:=maxc;
     d[x]:=0; dau[x]:=1;
     repeat
           reconv(b,x);
           for i:=1 to m-1 do
               for j:=i+1 to m do
               begin
                    y:=b;
                    y[i]:=b[j]; y[j]:=b[i];
                    t:=conv(y);
                    if (dau[t]=0) and (d[x]+a[i,j]<d[t]) then
                       d[t]:=d[x]+a[i,j];
               end;
           min:=maxc-1;
           for i:=1 to n do
               if (dau[i]=0) and (d[i]<min) then
               begin
                    min:=d[i];
                    t:=i;
               end;
           x:=t; dau[t]:=1;
     until dau[1]>0;
     writeln(d[1]);
     close(input); close(output);
end.

Download