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] |