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.