Listing DRUM.PAS
Program
typesir=array[1..200] of Word;
ssir=array[1..30000] of record v,t:Byte end;
vara:array[1..200] of ^sir;
r:array[1..200,0..300] of Byte;
act,xx:^ssir;
s:array[1..200] of Boolean;
d,db,df:array[1..200] of Word;
t:array[1..200] of Byte;
i,j,k,kk,q,min,m,n,p,bo,fo,st,w:Word;
f,g:Text;
procedure citeste;
begin
Assign(f,'MASINA.IN'); Reset(f);
Readln(f,n,m); Readln(f,st,p); Readln(f,bo,fo);
for i:=1 to n do
begin
New(a[i]);
for j:=1 to n do a[i]^[j]:=15000
end;
for i:=1 to n do a[i]^[i]:=0;
for k:=1 to m do
begin
Readln(f,i,j,a[i]^[j]);
a[j]^[i]:=a[i]^[j]
end;
Close(f)
end;
procedureDijkstra;
begin
for i:=1 to n do
begin
d[i]:=a[w]^[i];
t[i]:=w
end;
Fillchar(s,Sizeof(s),false);
t[w]:=0; s[w]:=true;
repeat
min:=15000; k:=0;
for i:=1 to n do
if not s[i] and (d[i]<min)
then
begin
min:=d[i];
k:=i
end;
if k<>0
then
begin
s[k]:=true;
for i:=1 to n do
if not s[i] and (d[i]>d[k]+a[k]^[i])
then
begin
d[i]:=d[k]+a[k]^[i];
t[i]:=k
end
end
until k=0
end;
procedure parcurge;
begin
New(act); New(xx);
Fillchar(r,Sizeof(r),255);
r[st,0]:=0;
k:=1; act^[1].v:=st; act^[1].t:=0;
repeat
q:=0;
for w:=1 to k do
for i:=1 to n do
if (act^[w].t+a[act^[w].v]^[i]<=p) and
(r[i,act^[w].t+a[act^[w].v]^[i]]=255)
then
begin
r[i,act^[w].t+a[act^[w].v]^[i]]:=
act^[w].v;
q:=q+1;
xx^[q].v:=i;
xx^[q].t:=act^[w].t+a[act^[w].v]^[i]
end;
k:=q; act^:=xx^
until q=0
end;
procedurerezolva;
begin
w:=bo; Dijkstra;
db:=d; w:=fo; dijkstra;
df:=d; parcurge
end;
procedure scrieoras(i,k:Byte);
begin
if i<>0
then
begin
scrieoras(r[i,k],k-a[i]^[r[i,k]]);
Write(g,i,' ')
end
end;
procedure solutie(i,k:Byte);
begin
Writeln(g,k);
scrieoras(i,k)
end;
procedure scrie;
begin
Assign(g,'MASINA.OUT');
Rewrite(g);
k:=p;
while k>0 do
begin
for i:=1 to n do
if (r[i,k]<>255) and (db[i]+k<=p)
and (df[i]+k<=p)
then
begin
solutie(i,k); Close(g); Halt
end;
k:=k-1
end;
Writeln('NU')
end;
Begin
citeste;
rezolva;
scrie
End.