Cod sursa(job #67550)

Utilizator mlazariLazari Mihai mlazari Data 25 iunie 2007 11:25:51
Problema Sate Scor 0
Compilator fpc Status done
Runda preONI 2007, Runda Finala, Clasa a 9-a si gimnaziu Marime 2.29 kb
Program Sate;
const NuStiu=-1;
type Stiva=^Sat;
     Sat=record
           nrSat : integer;
           dist : longint;
           next : Stiva;
         end;
var N,X,Y : integer;
    M,raspuns : longint;
    S : array[1..30000] of Stiva;

procedure Init;
var i : integer;
begin
  for i:=1 to N do
   begin
     new(S[i]);
     S[i]:=nil;
   end;
  raspuns:=NuStiu;
end;

procedure Adauga(s1,s2 : integer; d : longint);
var nou : Stiva;
begin
  if s1<>s2 then
   begin
     new(nou);
     nou^.nrSat:=s2;
     nou^.dist:=d;
     nou^.next:=S[s1];
     S[s1]:=nou;
     new(nou);
     nou^.nrSat:=s1;
     nou^.dist:=d;
     nou^.next:=S[s2];
     S[s2]:=nou;
     if ((s1=X) and (s2=Y)) or ((s1=Y) and (s2=x)) then raspuns:=d;
   end;
end;

procedure Citeste;
var Intrare : text;
    i,s1,s2 : integer;
    d : longint;
begin
  assign(Intrare,'sate.in');
  reset(Intrare);
  readln(Intrare,N,M,X,Y);
  Init;
  for i:=1 to m do
   begin
     readln(Intrare,s1,s2,d);
     Adauga(s1,s2,d);
   end;
  close(Intrare);
end;

function DeAceeasiParte(r1,r2,mj : integer) : boolean;
begin
  if r1<mj then DeAceeasiParte:=(r2<mj)
   else DeAceeasiParte:=(r2>mj);
end;

procedure Actualizeaza(sat : integer);
var aux,aux2 : stiva;
begin
  aux:=S[sat];
  while aux<>nil do
   begin
     aux2:=S[aux^.nrSat];
     while aux2<>nil do
      begin
        if DeAceeasiParte(sat,aux2^.nrSat,aux^.nrSat) then
         Adauga(sat,aux2^.nrSat,abs(aux^.dist-aux2^.dist))
         else Adauga(sat,aux2^.nrSat,aux^.dist+aux2^.dist);
        aux2:=aux2^.next;
      end;
     aux:=aux^.next;
   end;
end;

procedure Calculeaza;
var i : integer;
begin
  while raspuns=NuStiu do
   begin
     for i:=1 to n do
      begin
        Actualizeaza(i);
        if Raspuns<>NuStiu then break;
      end;
   end;
end;

procedure Scrie;
var Iesire : text;
begin
  assign(Iesire,'sate.out');
  rewrite(Iesire);
  write(Iesire,raspuns);
  close(Iesire);
end;

procedure DistrugeStivele;
var i : integer;
    aux : Stiva;
begin
  for i:=1 to n do
   begin
     aux:=S[i];
     while aux<>nil do
      begin
        S[i]:=S[i]^.next;
        dispose(aux);
        aux:=S[i];
      end;
   end;
end;

begin
  Citeste;
  Calculeaza;
  Scrie;
  DistrugeStivele;
end.