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.

Download