Cod sursa(job #554274)

Utilizator killerkaliKovacs Levente killerkali Data 14 martie 2011 18:42:18
Problema Flux maxim Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 2.47 kb
uses crt;
type rekord=record
      c,b:longint;
      end;
    vektor=array[1..5000] of integer;
    matrix=array[1..1000,1..1000] of rekord;
    vektor1=array[1..5000] of boolean;
var g,f:text;
    db,csu,n,m,i,t,p,kcs1,kcs,k,min,j,s,szam,szam1:integer;
    cs,os,os1:vektor;
    jart:vektor1;
    x:matrix;
    benne:boolean;
procedure szelleseg(var kcs:integer; var cs,os:vektor; var jart:vektor1);
 var i:integer;
 begin
  min:=1;
  csu:=1;
  cs[min]:=kcs;
  jart[kcs]:=true;
  repeat
   for i:= 1 to n do
    begin
     if ((x[kcs,i].c-x[kcs,i].b<>0)or(x[i,kcs].b<>0)) and (jart[i]=false)
      then
       begin
       inc(min);
       cs[min]:=i;
       jart[i]:=true;
       os[i]:=cs[csu];
       benne:=true;
       end;
    end;
   inc(csu);
   kcs:=cs[csu];
  until (min<csu) or (cs[min]=n);
 end;
begin
clrscr;
assign(f,'maxflow.in');
reset(f);
readln(f,n,m);
for i:= 1 to m do
 begin
  readln(f,t,p,k);
  x[t,p].c:=k;
 end;
for i:= 1 to n do
 begin
 for j:= 1 to n do
  write(x[i,j].c,' ');
 writeln;
 end;
repeat
benne:=false;
for i:= 1 to n do
 jart[i]:=false;
for i:= 1 to n do
 begin
 os[i]:=0;
 cs[i]:=0;
 end;
kcs:=1;
szelleseg(kcs,cs,os,jart);
if (cs[min]=n) and benne
  then
   begin
   benne:=true;
   kcs1:=n;
   db:=1;
   os1[db]:=kcs1;
   while os[kcs1]<>0 do
    begin
     inc(db);
     os1[db]:=os[kcs1];
     kcs1:=os[kcs1];
    end;
   min:=1000;
   for j:= db downto 2 do
    begin
     szam:=os1[j];
     szam1:=os1[j-1];
     write(x[szam,szam1].c);
     if x[szam,szam1].c<>0
      then
       begin
       if x[szam,szam1].c<min
        then
         min:=x[szam,szam1].c;
        end
      else
       if x[szam1,szam].c<min
        then
         min:=x[szam1,szam].c;
    end;
   for j:= db downto 2 do
    begin
     szam:=os1[j];
     szam1:=os1[j-1];
     if x[szam,szam1].c<>0
      then
       x[szam,szam1].b:=min
      else
       x[szam1,szam].b:=min;
     end;
   {for j:= 1 to db-1 do
       if (x[os1[j],os1[j+1]].c)<min
        then
         min:=x[os1[j],os1[j+1]].c;
    for j:= 1 to db-1 do
     begin
      if x[os1[j],os1[j+1]].c<>0
       then
         x[os1[j],os1[j+1]].b:=min
       else
        x[os1[j+1],os1[j]].b:=min;
     end;     }
  end
   else
    benne:=false
until not benne;
s:=0;
for i:= 1 to n do
 s:=s+x[i,n].b;
assign(g,'maxflow.out');
rewrite(g);
write(g,s);
{writeln;
for i:= 1 to n do
 write(os[i],' ');}
close(g);
end.