Работа с графом.Найти кратчайший маршрут между двумя вершинами.

program individ_5;
 
type
   refnode = ^node;
   refarc = ^arc;
   node = record
      id: integer;
      next: refnode;
      arclist: refarc;
   end;
   arc = record
      st_t: integer;
      fin_t: integer;
      adj: refnode;
      next: refarc;
   end;
   farray = array[1..10000] of boolean;
 
var
   g, v1, v2: refnode;
   n, m1, m2, sum, sum1, min: integer;
   visited: farray;
   s, ssum: string;
 
function search(i: integer; q: refnode): refnode;
begin
   while (q^.id <> i) and (q <> nil)  do
      q := q^.next;
   search := q;
end;
 
procedure CreateGraph(var g: refnode; var n, m1, m2: integer);
var
   f: text;
   a: refarc;
   i, m, err, v1, v2, t1, t2: integer;
   z, z1, q, head: refnode;
   s: string;
begin
   assign(f, 'input08.txt');
   reset(f);
   if seekeof(f) then writeln('Файл пуст')
   else begin
      readln(f, s);
      Val(s, n, err);
      if err = 0 then begin
         new(head);
         head^.id := 1;
         head^.next := nil;
         head^.arclist := nil;
         g := head;
         for i := 2 to n do 
         begin
            new(q);
            q^.id := i;
            q^.next := nil;
            q^.arclist := nil;
            g^.next := q;
            g := q;
         end;
         g := head;
         readln(f, m1, m2);
         readln(f, m);
         for i := 1 to m do 
         begin
            readln(f, v1, t1, v2, t2);
            z := search(v1, head);
            z1 := search(v2, head);
            new(a);
            a^.st_t := t1;
            a^.fin_t := t2;
            a^.next := z^.arclist;
            z^.arclist := a;
            z^.arclist^.adj := z1;
         end;
         
         g := head;
      end;
   end;
   close(f);
end;
 
procedure brows(g: refnode);
var
   a: refarc;
   nn, na: integer;
begin
   nn := 0;
   na := 0;
   while g <> nil do 
   begin
      writeln('Вершина ', g^.id);
      writeln('Список дуг');
      a := g^.arclist;
      if a = nil then writeln('пуст');
      while a <> nil do 
      begin
         writeln('Дуга к вершине ', (a^.adj)^.id, ' начальное время ', a^.st_t, ' конечное время ', a^.fin_t);
         inc(na);
         a := a^.next;
      end;
      inc(nn);
      g := g^.next;
   end;
   writeln('В графе ', nn, ' вершин ', na, ' дуг');
end;
 
procedure bb(v1, v2: refnode; var s, ssum: string; var sum: integer; var sum1: integer; var min: integer);
var
   a: refarc;
   s1: string;
   i: integer;
begin
   if v1 <> v2 then begin
      a := v1^.arclist;
      while a <> nil do 
      begin
         write(a^.adj^.id<>m1);
         if (a^.st_t >= sum) and (a^.adj^.id<>m1) then begin
            sum1 := sum;
            sum := a^.fin_t;
            str(a^.adj^.id, s1);
            s := s + s1 + '-';
            bb(a^.adj, v2, s, ssum, sum, sum1, min);
            delete(s, length(s), 1);
            i := length(s);
            while s[i] <> '-' do 
            begin
               delete(s, length(s), 1);
               dec(i);
            end;
            sum := sum1;
         end;
         a := a^.next;
      end;
   end
   else if sum < min then begin
      min := sum; 
      ssum := s; 
      delete(ssum, length(s), 1);
   end;
end;
 
begin
   creategraph(g, n, m1, m2);
   brows(g);
   v1 := search(m1, g);
   v2 := search(m2, g);
   visited[m1] := true;
   sum1 := 0;
   min := maxint;
   str(m1, s);
   s := s + '-';
   bb(v1, v2, s, ssum, sum, sum1, min);
  // if min=maxint then writeln('-1')
  // else 
   writeln(min,' ' ,ssum);
end.

const
  maxn = 100;
  maxt = 10000;
  inf = maxint div 2;
type
  station = record
      ns:integer;
      time:longint;
  end;
  bus = record
        n:integer;
        st:array[1..maxn]of station;
        end;
 
var
   m,n,b,e,e1,i:integer;
   tr:array[1..maxt]of bus;
   time:array[0..maxn]of longint;
   ok:array[0..maxn]of boolean;
 
procedure readdata;
var
 i,j:integer;
begin
  assign(input,'input09.txt');
  reset(input);
  read(n,b,e,m);
 // b:=1;
  for i:=1 to m do
    begin
      tr[i].n:=2;
      for j:=1 to tr[i].n do
        read(tr[i].st[j].ns, tr[i].st[j].time);
    end;
  close(input);
end;
 
procedure writedata;
begin
  assign(output,'b.out');
  rewrite(output);
  writeln(time[e]);
  close(output);
  writeln(time[e]);
end;
 
procedure update(st:byte);
var
 i,j,k:byte;
begin
  ok[st]:=true;
  for i:=1 to m do
    for j:=1 to tr[i].n do
       if (tr[i].st[j].ns = st) and (tr[i].st[j].time >= time[st]) then
         for k:= j+1 to tr[i].n do
           if tr[i].st[k].time < time[tr[i].st[k].ns] then
              time[tr[i].st[k].ns] := tr[i].st[k].time;
 
end;
 
procedure solve;
var
 i,min:byte;
 f:boolean;
begin
  for i:=0 to n do
    begin
      time[i] := inf;
      ok[i] := false;
    end;
  time[b] := 0;
  f:=true;
  while not ok[e] and f do
     begin
       min :=0;
       for i:=1 to n do
         if not ok[i] then
            if time[i] < time[min] then min := i;
       if min < 1 then f:=false;
       update(min);
     end;
  if not ok[e] then time[e] := -1;
 
end;
 
begin
  readdata;
  solve;
  writedata;
end.

var 
a: array[1..100,1..4] of integer; 
num, time, res: array[1..100] of integer;
mas_kontr: array[1..100] of boolean;
n, d, v, r, i, min, t: integer;
begin
read(n,d,v,r);
for i:=1 to r do
read(a[i][1], a[i][2], a[i][3], a[i][4]);
for i:=1 to n do
time[i]:=2000000;
time[d]:=0;
while true do
begin
min:=0;
for i:=1 to n do
if (mas_kontr[i]=false) and (time[i]<>2000000) then
begin
if min=0 then min:=i
else
  if time[i]<time[min] then min:=i;
end;
if min=0 then break;
for i:=1 to r do
if a[i][1]=min then
begin
  if (mas_kontr[a[i][3]]=false) and (a[i][2]>=time[min]) and (time[i]>a[i][4]) then
  begin 
  time[i]:=a[i][4];
  num[i]:=min;
  end;  
end;
mas_kontr[min]:=true;
end;
if time[v]=2000000 then writeln(-1)
else
begin
writeln(time[v]);
t:=v;
n:=1;
while(t>0) do
begin
res[n]:=t;
t:=num[t];
inc(n);
end;
for i:=n-1 downto 1 do
write(res[i],' ');
writeln;
end;
end.

var 
a: array[1..100,1..4] of integer; 
num, time, res: array[1..100] of integer;
mas_kontr: array[1..100] of boolean;
n, d, v, r, i, min, t: integer;
begin
 assign(input, 'input.txt'); reset(input);
  assign(output, 'output.txt'); rewrite(output);
read(n,d,v,r);
for i:=1 to r do
read(a[i][1], a[i][2], a[i][3], a[i][4]);
for i:=1 to n do
time[i]:=2000000;
time[d]:=0;
while true do
begin
min:=0;
for i:=1 to n do
if (mas_kontr[i]=false) and (time[i]<>2000000) then
begin
if min=0 then min:=i
else
  if time[i]<time[min] then min:=i;
end;
if min=0 then break;
for i:=1 to r do
if a[i][1]=min then
begin
  if (mas_kontr[a[i][3]]=false) and (a[i][2]>=time[min]) and (time[a[i][3]]>a[i][4]) then
  begin 
  time[a[i][3]]:=a[i][4];
  num[a[i][3]]:=min;
  end;  
end;
mas_kontr[min]:=true;
end;
if time[v]=2000000 then writeln(-1)
else
begin
writeln(time[v]);
t:=v;
n:=1;
while(t>0) do
begin
res[n]:=t;
t:=num[t];
inc(n);
end;
for i:=n-1 downto 1 do
write(res[i],' ');
writeln;
end;
end.