Cod sursa(job #554341)

Utilizator boardkingLazar Zsolt boardking Data 14 martie 2011 19:31:37
Problema Flux maxim Scor 30
Compilator fpc Status done
Runda Arhiva educationala Marime 2.4 kb
uses crt;
type elem=record
      maxi:integer;
      id:integer;
     end;
     matrix=array[1..1000,1..1000] of elem;
     vek=array[1..1000] of integer;
var mx:matrix;
    v,o,os,jart,u:vek;
    a,h,min,akt,j,k,r,b,c,i,n,m:integer;
    g,f:text;
    jo:boolean;

procedure sz(a:integer);
var p:integer;
begin
akt:=1;
k:=1;
v[k]:=1;
r:=0;

jart[1]:=1;
while (akt<=k) and (jart[n]<>1) do
begin
  for i:= 1 to n do
    begin
      if mx[v[akt],i].maxi<>0
       then
        begin
          if (mx[v[akt],i].maxi-mx[v[akt],i].id<>0) and (jart[i]=0) then
             begin v[k+1]:=i;
                   inc(k);
                   jart[i]:=1;
                   os[i]:=v[akt];
             end;
         end
       else
       if mx[i,v[akt]].maxi<>0
        then
         begin
           if (mx[v[akt],i].id<>0) and (jart[i]=0)
            then
               begin
                   inc(k);
                   v[k]:=i;
                   jart[i]:=1;
                   os[i]:=v[akt]*(-1);
               end;
          end;
    end;
    inc(akt);
   end;
if jart[n]=1 then r:=1;
end;

begin
clrscr;
assign(g,'maxflow.in');
reset(g);
readln(g,n,m);
for i:= 1 to m do
begin
readln(g,a,b,c);
mx[a,b].maxi:=c;
end;
jo:=true;
 while jo do
  begin
   v:=o;
   jart:=o;
   os:=o;
   sz(1);
     if r=1 then
       begin
         i:=n;
         j:=1;
         u:=o;
       while i<>1 do
          begin
          if os[i]>0 then
          begin
           u[j]:=i;
           i:=os[i];
           inc(j);
          end
          else
          begin
           u[j]:=i*(-1);
           i:=abs(os[i]);
           inc(j);
          end;
          end;
u[j]:=1;
min:=mx[u[2],u[1]].maxi-mx[u[2],u[1]].id;
for i:= 2 to j-1 do
begin
if u[i]>0 then
    begin
    if (mx[abs(u[i+1]),abs(u[i])].maxi) - (mx[abs(u[i+1]),abs(u[i])].id)<min
     then min:=(mx[abs(u[i+1]),abs(u[i])].maxi) - (mx[abs(u[i+1]),abs(u[i])].id);
     end
   else if (mx[abs(u[i+1]),abs(u[i])].id) < min
     then min:=(mx[abs(u[i+1]),abs(u[i])].id);
end;
for i:= 1 to j-1 do
begin
if u[i]>0 then mx[abs(u[i+1]),abs(u[i])].id:=min+mx[abs(u[i+1]),abs(u[i])].id
else mx[abs(u[i+1]),abs(u[i])].id:= mx[abs(u[i+1]),abs(u[i])].id-min;

end;
end
       else jo:=false;

end;
for i:= 1 to n do
h:=h+mx[i,n].id;
assign(f,'maxflow.out');
rewrite(f);
writeln(f,h);
close(g);
close(f);
end.