HIWAY - Hai đường đi

Tác giả: flashmt

Ngôn ngữ: Pascal

const fi='';
      fo='';
      maxn=111;
      maxc=1000000000;
var n,s,f,res1,res2:longint;
    a:array[1..maxn,1..maxn] of longint;
    d,tr,r1,r2:array[0..maxn] of longint;
    free:array[1..maxn] of boolean;
    dau:array[1..maxn,1..maxn] of boolean;

procedure rf;
var i,x,y,t,m:longint;
begin
     assign(input,fi); reset(input);
     read(n,m,s,f);
     for x:=1 to n do
         for y:=1 to n do
             dau[x,y]:=false;
     for i:=1 to m do
     begin
          readln(x,y,t);
          if not dau[x,y] or (a[x,y]>t) then
          begin
               a[x,y]:=t; a[y,x]:=t;
               dau[x,y]:=true; dau[y,x]:=true;
          end;
     end;
     close(input);
end;

procedure dijk;
var i,j,x,min:longint;
begin
     for i:=1 to n do
     begin
          free[i]:=true;
          d[i]:=maxc;
          tr[i]:=i;
     end;
     x:=s; d[x]:=0; free[x]:=false;
     repeat
           for i:=1 to n do
               if free[i] and dau[x,i] and (d[i]>d[x]+a[x,i]) then
               begin
                    d[i]:=d[x]+a[x,i];
                    tr[i]:=x;
               end;
           j:=0; min:=maxc-1;
           for i:=1 to n do
               if free[i] and (d[i]<min) then
               begin
                    min:=d[i];
                    j:=i;
               end;
           x:=j; free[x]:=false;
     until not free[f];
     repeat
           j:=tr[x];
           dau[j,x]:=false; a[x,j]:=-a[x,j];
           x:=j;
     until x=s;
     res1:=d[f];
end;

procedure ford;
var i,x,y:longint; kt:boolean;
begin
     for i:=1 to n do
     begin
          d[i]:=maxc;
          tr[i]:=i;
     end;
     d[s]:=0;
     for i:=1 to n-1 do
     begin
          kt:=false;
          for y:=1 to n do
              for x:=1 to n do
                  if dau[y,x] and (d[x]>d[y]+a[y,x]) then
                  begin
                       d[x]:=d[y]+a[y,x];
                       tr[x]:=y;
                       kt:=true;
                  end;
          if not kt then break;
     end;
     x:=f;
     repeat
           y:=tr[x];
           dau[y,x]:=false;
           x:=y;
     until x=s;
     res2:=d[f];
end;

procedure pr;
var i,x,y:longint;
begin
     dijk;
     ford;
     for x:=1 to n-1 do
         for y:=x+1 to n do
             if dau[x,y] and dau[y,x] then
             begin
                  dau[x,y]:=false;
                  dau[y,x]:=false;
             end;
     r1[0]:=1; r2[0]:=1;
     r1[1]:=f; r2[1]:=f;
     x:=f;
     repeat
           for i:=1 to n do
               if dau[x,i] then break;
           inc(r1[0]);
           r1[r1[0]]:=i;
           dau[x,i]:=false;
           x:=i;
     until x=s;
     x:=f;
     repeat
           for i:=1 to n do
               if dau[x,i] then break;
           inc(r2[0]);
           r2[r2[0]]:=i;
           dau[x,i]:=false;
           x:=i;
     until x=s;
end;

procedure wf;
var i:longint;
begin
     assign(output,fo); rewrite(output);
     writeln(res1+res2);
     write(r1[0],' ');
     for i:=r1[0] downto 1 do write(r1[i],' ');
     writeln;
     write(r2[0],' ');
     for i:=r2[0] downto 1 do write(r2[i],' ');
     close(output);
end;

begin
     rf;
     pr;
     wf;
end.

Download