V8SORT - Sắp xếp
Tác giả: ladpro98
Ngôn ngữ: Pascal
{$MODE OBJFPC}
program v8sort;
uses math;
type e=record
v,p:longint;
end;
const maxn=10;
maxl=5555;
oo=trunc(1e9);
fi='';
var c:array[1..maxn,1..maxn] of longint;
a,s,f:array[0..maxn] of longint;
check:array[1..maxn] of boolean;
d,h,pos:array[0..maxl] of longint;
b:array[1..maxn] of e;
n,dd,nh:longint;
procedure input;
var inp:text;
i,j:longint;
begin
assign(inp,fi);
reset(inp);
while not seekeoln(inp) do
begin
inc(n);
read(inp,b[n].v);
b[n].p:=n;
end;
for i:=1 to n do
begin
for j:=1 to n do
read(inp,c[i,j]);
readln(inp);
end;
close(inp);
end;
procedure init;
var i,j:longint;
t:e;
begin
f[1]:=1;
for i:=2 to n do f[i]:=i*f[i-1];
for i:=1 to n do
for j:=i+1 to n do
if b[i].v>b[j].v then
begin
t:=b[i];
b[i]:=b[j];
b[j]:=t;
end;
dd:=1;
for i:=1 to n do
begin
s[b[i].p]:=dd;
inc(dd);
end;
for i:=1 to f[n] do d[i]:=oo;
end;
function toNum:longint;
var i,j,t,sum:longint;
begin
for i:=1 to n do check[i]:=false;
sum:=0;
for i:=1 to n do
begin
t:=0;
for j:=1 to a[i]-1 do
if not check[j] then inc(t);
inc(sum,t*f[n-i]);
check[a[i]]:=true;
end;
exit(sum+1);
end;
procedure toMask(p:longint);
var i,j,t,k:longint;
begin
for i:=1 to n do check[i]:=false;
for i:=1 to n do
begin
for j:=n-1 downto 0 do
begin
t:=0;
for k:=1 to j do
if not check[k] then inc(t);
if (not check[j+1]) and (t*f[n-i]<p) then break;
end;
s[i]:=j+1;
check[j+1]:=true;
dec(p,t*f[n-i]);
end;
end;
procedure update(v:longint);
var p,c:longint;
begin
c:=pos[v];
if c=0 then begin
inc(nh);
c:=nh;
end;
repeat
p:=c shr 1;
if (p=0) or (d[h[p]]<=d[v]) then break;
h[c]:=h[p];
pos[h[c]]:=c;
c:=p;
until false;
h[c]:=v;
pos[v]:=c;
end;
function extract:longint;
var v,p,c:longint;
begin
result:=h[1];
v:=h[nh];
dec(nh);
p:=1;
repeat
c:=p shl 1;
if (c<nh) and (d[h[c+1]]<d[h[c]]) then inc(c);
if (c>nh) or (d[h[c]]>=d[v]) then break;
h[p]:=h[c];
pos[h[p]]:=p;
p:=c;
until false;
h[p]:=v;
pos[v]:=p;
end;
procedure dijkstra;
var i,j,u,t,v:longint;
begin
a:=s;
d[toNum]:=0;
update(toNum);
repeat
u:=extract;
toMask(u);
for i:=1 to n-1 do
for j:=i+1 to n do
begin
a:=s;
t:=a[i];
a[i]:=a[j];
a[j]:=t;
v:=toNum;
if d[v]>d[u]+c[i,j] then begin
d[v]:=d[u]+c[i,j];
update(v);
end;
end;
until nh=0;
end;
procedure output;
var i:longint;
begin
for i:=1 to n do a[i]:=i;
write(d[toNum]);
end;
begin
input;
init;
Dijkstra;
output;
end.