Cod sursa(job #295634)

Utilizator mlazariLazari Mihai mlazari Data 3 aprilie 2009 15:23:04
Problema Algoritmul lui Dijkstra Scor 40
Compilator fpc Status done
Runda Arhiva educationala Marime 2.36 kb
Program Dijkstra;
const inf=15000;
      maxn=50000;
type PNod=^Nod;
     Nod=record
       q : longint;
       l : integer;
       next : PNod;
     end;

var P : array[1..maxn] of PNod;
    D : array[1..maxn] of longint;
    S : array[1..maxn] of boolean;
    n,m : longint;

procedure ElibList(var C : Pnod);
var D : PNod;
begin
  D:=C;
  while D<>nil do begin
    C:=C^.next;
    dispose(D);
    D:=C;
  end;
end;

procedure ElibMem;
var i : longint;
begin
  for i:=1 to n do ElibList(P[i]);
end;

procedure Adauga(var C : PNod; q,l : longint);
var D,E : PNod;
begin
  new(D);
  D^.q:=q;
  D^.l:=l;
  D^.next:=nil;
  if C=nil then C:=D
  else begin
    if q<C^.q then begin
      D^.next:=C;
      C:=D;
    end
    else begin
      E:=C;
      while E^.next<>nil do begin
        if E^.next^.q>q then begin
          D^.next:=E^.next;
          E^.next:=D;
          break;
        end;
        E:=E^.next;
      end;
      if E^.next=nil then E^.next:=D;
    end;
  end;
end;

function dist(i,j : longint) : integer;
var C : PNod;
    d : integer;
begin
  d:=inf;
  C:=P[i];
  while C<>nil do begin
    if C^.q>j then break
    else
     if C^.q=j then
      if d>C^.l then d:=C^.l;
    C:=C^.next;
  end;
  dist:=d;
end;

procedure Citeste;
var Intrare : text;
    i,a,b : longint;
    c : integer;
begin
  assign(Intrare,'dijkstra.in');
  reset(Intrare);
  readln(Intrare,n,m);
  for i:=1 to n do begin
    P[i]:=nil;
    D[i]:=inf;
    S[i]:=false;
  end;
  for i:=1 to m do begin
    readln(Intrare,a,b,c);
    Adauga(P[a],b,c);
    if a=1 then begin
      if c<D[b] then D[b]:=c;
    end;
  end;
  close(Intrare);
end;

procedure Calculeaza;
var i,fs,k : longint;
begin
  S[1]:=true;
  D[1]:=0;
  for i:=1 to n-1 do begin
    fs:=0;
    repeat
      fs:=fs+1;
    until not S[fs];
    for k:=fs+1 to n do
     if not S[k] then
      if D[k]<D[fs] then fs:=k;
    S[fs]:=true;
    for k:=1 to n do
     if not S[k] then
      if D[fs]+dist(fs,k)<D[k] then D[k]:=D[fs]+dist(fs,k)
  end;
end;

procedure Scrie;
var Iesire : text;
    i : longint;
begin
  assign(Iesire,'dijkstra.out');
  rewrite(Iesire);
  for i:=2 to n do
   if D[i]<inf then write(Iesire,D[i],' ') else write(Iesire,0,' ');
  close(Iesire);
end;

begin
  Citeste;
  Calculeaza;
  Scrie;
  ElibMem;
end.