GONDOR - GONDOR

Tác giả: ll931110

Ngôn ngữ: Pascal

{$N+} {$MODE DELPHI}
Program GONDOR;
  Const
    input  = '';
    output = '';
    maxn = 100;
    maxd = 1000000;
  Type
    rec = record
      x,y: integer;
    end;
  Var
    heap,pos,s: array[1..maxn] of integer;
    c: array[1..maxn] of rec;
    des: array[1..maxn,1..maxn] of integer;
    d: array[1..maxn] of double;
    free: array[1..maxn] of boolean;
    n,nHeap: integer;

Procedure init;
Var
  f: text;
  i,j: integer;
Begin
  Assign(f, input);
    Reset(f);

  Readln(f, n);
  For i:= 1 to n do
    Begin
      Read(f, c[i].x, c[i].y);
      Read(f, s[i]);
      For j:= 1 to n - 1 do read(f, des[i,j]);
    End;

  Close(f);
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 (d[heap[parent]] > d[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 (d[heap[c + 1]] < d[heap[c]]) then inc(c);

      If d[v] <= d[heap[c]] then break;
      heap[r]:= heap[c];
      pos[heap[r]]:= r;

      r:= c;
    End;

  heap[r]:= v;
  pos[v]:= r;
End;

Procedure solve;
Var
  i,k,u,v: integer;
  tmp: double;
Begin
  Fillchar(free, sizeof(free), true);
  free[1]:= false;

  For i:= 1 to n do d[i]:= maxd;
  d[1]:= 0;

  nHeap:= 0;
  update(1);

  Repeat
    u:= pop;
    free[u]:= false;
    k:= 0;

    For i:= 1 to n - 1 do
      Begin
        v:= des[u,i];
        If free[v] then
          Begin
            inc(k);
            tmp:= sqr(c[u].x - c[v].x) + sqr(c[u].y - c[v].y);
            tmp:= sqrt(tmp);

            If d[v] > d[u] + tmp then
              Begin
                d[v]:= d[u] + tmp;
                update(v);
              End;
          End;
        If k = s[u] then break;
      End;
  Until nHeap = 0;
End;

Procedure printresult;
Var
  f: text;
  i: integer;
Begin
  Assign(f, output);
    Rewrite(f);
    For i:= 1 to n do writeln(f, d[i]:0:10);
  Close(f);
End;

Begin
  init;
  solve;
  printresult;
End.

Download