V8SORT - Sắp xếp
Tác giả: ll931110
Ngôn ngữ: Pascal
{$MODE DELPHI}
Program V8SORT;
Const
input = '';
output = '';
maxn = 7;
maxc = 100000000;
maxv = 2500000;
Type
arr = array[1..maxn] of integer;
Var
F: array[1..maxv] of integer;
heap,pos: array[1..2500000] of integer;
free: array[1..maxv] of boolean;
c: array[1..maxn,1..maxn] of integer;
n,nHeap: integer;
a,k,p: arr;
Procedure init;
Var
fi: text;
i,j: integer;
Begin
Assign(fi, input);
Reset(fi);
n:= 0;
While not SeekEoln(fi) do
Begin
inc(n);
Read(fi, a[n]);
End;
Readln(fi);
For i:= 1 to n do
Begin
For j:= 1 to n do read(fi, c[i,j]);
Readln(fi);
End;
Close(fi);
End;
Procedure swap(var x,y: integer);
Var
t: integer;
Begin
t:= x;
x:= y;
y:= t;
End;
Procedure update(v: integer);
Var
parent,child: integer;
Begin
child:= pos[v];
If child = 0 then
Begin
inc(nHeap);
child:= nHeap;
End;
parent:= child div 2;
While (parent > 0) and (F[heap[parent]] > F[v]) do
Begin
heap[child]:= heap[parent];
pos[heap[child]]:= child;
child:= parent;
parent:= child div 2;
End;
heap[child]:= v;
pos[v]:= child;
End;
Function pop: integer;
Var
r,c,v: integer;
Begin
pop:= heap[1];
v:= heap[nHeap];
dec(nHeap);
r:= 1;
While r * 2 <= nHeap do
Begin
c:= r * 2;
If (c < nHeap) and (F[heap[c + 1]] < F[heap[c]]) then inc(c);
If F[v] <= F[heap[c]] then break;
heap[r]:= heap[c];
pos[heap[r]]:= r;
r:= c;
End;
heap[r]:= v;
pos[v]:= r;
End;
Function calc(d: arr): integer;
Var
i,tmp: integer;
Begin
tmp:= d[1];
For i:= 2 to n do tmp:= tmp * (n + 1) + d[i];
calc:= tmp;
End;
Procedure solve;
Var
fo: text;
i,j,u,s,tmp,res: integer;
Begin
Fillchar(free, sizeof(free), true);
For i:= 1 to maxv do F[i]:= maxc;
Fillchar(pos, sizeof(pos), 0);
nHeap:= 0;
For i:= 1 to n do p[i]:= i;
res:= calc(p);
F[res]:= 0;
update(res);
free[res]:= false;
For i:= 1 to n - 1 do
For j:= i + 1 to n do
if a[i] > a[j] then
Begin
swap(a[i], a[j]);
swap(p[i], p[j]);
End;
res:= calc(p);
Repeat
u:= pop;
If u = res then break;
tmp:= u;
free[u]:= false;
For i:= n downto 1 do
Begin
k[i]:= tmp mod (n + 1);
tmp:= tmp div (n + 1);
End;
For i:= 1 to n do
For j:= 1 to n do
Begin
swap(k[i], k[j]);
s:= calc(k);
If free[s] and
(F[s] > F[u] + c[i,j]) then
Begin
F[s]:= F[u] + c[i,j];
update(s);
End;
swap(k[i], k[j]);
End;
Until nHeap = 0;
Assign(fo, output);
Rewrite(fo);
Writeln(fo, F[res]);
Close(fo);
End;
Begin
init;
solve;
End.