Listing: CETATEA.PAS
{$M 65000,0,655360} 
 const NMax=5000; 
 type nod1=^tip_nod1; 
 tip_nod1=
record  
 v,c,f:Word; 
 urm:nod1 
 end; 
 nod2=^tip_nod2; 
 tip_nod2=record 
 v:Word; 
 inv:nod1; 
 urm:nod2 
 end; 
 var i,j,k,n,c:Word; 
 cap,cmin:Longint; 
 ic1:array[1..NMax] of nod1; 
 ic2:array[1..NMax] of nod2; 
 f:Text; 
 p:nod1; 
 q:nod2; 
 v:array[1..NMax] of Boolean; 
 
 procedure citire; 
 begin 
 Assign(f,'medias.in'); Reset(f); 
 Readln(f,n); 
 for i:=1 to n do 
 begin 
 ic1[i]:=nil; ic2[i]:=nil 
 end; 
 while not Seekeof(f) do 
 begin 
 Readln(f,i,j,k); 
 New(p); 
 p^.v:=j; p^.c:=k; p^.f:=0; 
 if ic1[i]=
nil  
  
then  
 begin ic1[i]:=p; ic1[i]^.urm:=nil 
end  
 else begin p^.urm:=ic1[i]; ic1[i]:=p end; 
 New(q); 
 q^.v:=i; q^.inv:=p; 
 if ic2[j]=nil 
 then begin ic2[j]:=q; ic2[j]^.urm:=nil end 
 else begin q^.urm:=ic2[j]; ic2[j]:=q end 
 end; 
 Close(f) 
 end; 
 
 procedure gaseste_si_prelucreaza_drum; 
 type coada=^tip_coada; 
 tip_coada=record 
 v:Word; 
 leg:nod1; 
 direct:Boolean; 
 urm,ant:coada 
 end; 
 var ic,sc,dd,start:coada; 
 min:Word; 
 
  procedure succesori; 
  begin 
 p:=ic1[ic^.v]; 
 while p<>nil do 
 begin 
 if not v[p^.v] and (p^.f<>p^.c) 
 then 
 begin 
 v[p^.v]:=true; 
 New(dd); 
 dd^.v:=p^.v; dd^.leg:=p; 
 dd^.direct:=true; dd^.urm:=nil; 
 dd^.ant:=ic; 
 sc^.urm:=dd; sc:=dd; 
 if dd^.v=1 then Exit 
 end; 
 p:=p^.urm 
 end; 
 q:=ic2[ic^.v]; 
 while q<>nil do 
 begin 
 if not v[q^.v] and (q^.inv^.f<>0) 
 then 
 begin 
 v[q^.v]:=true; 
 New(dd); 
 dd^.v:=q^.v; dd^.leg:=q^.inv; 
 dd^.direct:=false; 
 dd^.urm:=nil; dd^.ant:=ic; 
 sc^.urm:=dd; sc:=dd; 
 if dd^.v=1 then Exit 
 end; 
 q:=q^.urm 
 end 
  end; 
 
 begin { gaseste_si_prelucreaza_drum } 
 New(ic); 
 ic^.v:=n; 
 v[n]:=true; 
 ic^.urm:=nil; 
 start:=ic; 
 sc:=ic; 
 while (ic<>nil) and not v[1] do 
 begin succesori; ic:=ic^.urm end; 
 if not v[1] then Exit; 
 { prelucreaza drum } 
 { gasesc minimul de pe drum } 
 min:=65001; 
 dd:=sc; 
 while dd<>start do 
 begin 
 if dd^.direct 
 then 
 if min>dd^.leg^.c-dd^.leg^.f 
 then min:=dd^.leg^.c-dd^.leg^.f 
 else 
 else 
 if min>dd^.leg^.f 
 then min:=dd^.leg^.f; 
 dd:=dd^.ant 
 end; 
 cmin:=cmin+longint(min); 
 { scad minimul de pe drum } 
 dd:=sc; 
 while dd<>start do 
 begin 
 if dd^.direct 
 then dd^.leg^.f:=dd^.leg^.f+min 
 else dd^.leg^.f:=dd^.leg^.f-min; 
 dd:=dd^.ant 
 end; 
 while start<>nil do 
 begin 
 dd:=start; 
 start:=start^.urm; 
 Dispose(dd) 
 end 
 end; 
 procedure prelucrare; 
 begin 
 cmin:=0; 
 repeat 
 Fillchar(v,Sizeof(v),false); 
 gaseste_si_prelucreaza_drum 
 until not v[1] 
 end; 
 
 procedure afisare; 
 begin 
 Assign(f,'medias.out'); 
 Rewrite(f); 
 Writeln(f,cmin); 
 for i:=1 to n do 
 if v[i] 
 then 
 begin 
 p:=ic1[i]; 
 while p<>nil do 
 begin 
 if not v[p^.v] 
 then Writeln(f,i,' ',p^.v,' ',p^.c); 
 p:=p^.urm 
 end 
 end; 
 Close(f) 
 end; 
 
 Begin 
 Citire; 
 Prelucrare; 
 Afisare 
 End. 

[cuprins]