[an error occurred while processing this directive]
Listing SOSELE.PAS
{$M 16384,0,655360}
Program Roads;
type stare=record
cost:Integer;
nod:Byte;
dist:Integer
end;
muchie=record
sursa,tinta,lung,taxa:Byte
end;
sir=array[1..10000] of muchie;
var cap,K,n,nm:Integer;
f:Text;
distmin:array[1..100] of Integer;
L:array[0..5000] of stare;
M:^sir;
procedure Citire;
var i,a,b,c,d:Integer;
begin
New(m);
Assign(f,'roads.in'); Reset(f);
Readln(f,K,n,nm);
for i:=1 to nm do
with M^[i] do
Readln(f,sursa,tinta,lung,taxa);
Close(f)
end;
procedure adaug(s:stare);
var i,j:Integer;
begin
i:=cap;
while L[i-1].cost<=s.cost do
begin
if L[i-1].nod=s.nod
then
begin
if L[i-1].dist<=s.dist
then Exit
else
if (L[i-1].cost<s.cost) and
(s.dist<L[i-1].dist)
then
begin
L[i-1]:=s; Exit
end
else
end;
Dec(i)
end;
if i=cap
then
begin
L[i]:=s;
Inc(cap);
Exit
end;
for j:=cap downto i+1 do L[j]:=L[j-1];
L[i]:=s;
Inc(cap)
end;
procedure scot(var s:stare);
begin Dec(cap); s:=L[cap] end;
procedure ordonare;
{ Ordonarea muchiilor dupa sursa }
var i:Integer;
gata:Boolean;
aux:muchie;
begin
repeat
gata:=true;
for i:=1 to nm-1 do
if M^[i].sursa>M^[i+1].sursa
then
begin
aux:=M^[i];
M^[i]:=M^[i+1];
M^[i+1]:=aux;
gata:=false
end
until gata;
end;
procedure Rezolvare;
var i,j:Integer;
s,snou:stare;
start:array[1..100] of Integer;
begin
distmin[1]:=0;
for i:=2 to n do distmin[i]:=maxint;
ordonare;
j:=1;
for i:=1 to n do
begin
while (M^[j].sursa<i) and (j<=nm) do
Inc(j);
if j=nm+1 then Dec(j);
start[i]:=j
end;
L[0].cost:=maxint;
L[0].nod:=255;
cap:=1; { initializare lista }
s.cost:=0;
s.nod:=1;
s.dist:=0;
adaug(s);
while cap>1 do
{ cat timp lista este nevida }
begin
scot(s);
if (distmin[s.nod]=0) or
(s.dist<distmin[s.nod])
then
begin
distmin[s.nod]:=s.dist;
i:=start[s.nod];
while M^[i].sursa=s.nod do
begin
if s.cost+M^[i].taxa<=K
then
begin
snou.cost:=s.cost+M^[i].taxa;
snou.nod:=M^[i].tinta;
snou.dist:=s.dist+M^[i].lung;
adaug(snou)
end;
Inc(i)
end
end
end
end;
procedure Scriere;
begin
Assign(f,'roads.out'); Rewrite(f);
if distmin[n]<maxint
then Writeln(f,distmin[n])
else Writeln(f,'-1');
Close(f)
end;
Begin
Citire;
Rezolvare;
Scriere
End.