Cod sursa(job #134646)

Utilizator ProtomanAndrei Purice Protoman Data 11 februarie 2008 23:30:38
Problema Sate Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.17 kb
type point=^nod;
     nod=record
         sp,dr:longint;
         ua:point;
     end;

var f1,f2:text;
    i,x,y,d,n,m,st,fn,h:longint;
    p:point;
    s:array[0..30010] of integer;
    l:array[0..30010] of point;

procedure clad(t,f,c:longint);
begin
        new(p);
        p^.sp:=f;
        p^.dr:=c;
        p^.ua:=l[t];
        l[t]:=p;
end;

procedure ctdrum(xa,dr:longint);
begin
        s[xa]:=1;
        if xa=fn then
        begin
                writeln(f2,dr);
                close(f1);
                close(f2);
                halt;
        end;
        while l[xa]<>nil do
        begin
                if s[l[xa]^.sp]=0 then
                begin
                        h:=dr+l[xa]^.dr;
                        ctdrum(l[xa]^.sp,h);
                end;
                l[xa]:=l[xa]^.ua;
        end;
end;

begin
        assign(f1,'sate.in');
        reset(f1);
        assign(f2,'sate.out');
        rewrite(f2);
        readln(f1,n,m,st,fn);
        for i:=1 to m do
        begin
                readln(f1,x,y,d);
                clad(x,y,d);
                clad(y,x,-d);
        end;
        ctdrum(st,0);
end.