Cod sursa(job #295729)

Utilizator petrePajarcu Alexandru-Petrisor petre Data 3 aprilie 2009 17:15:26
Problema Flux maxim Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.8 kb
var f,c:array[1..1000,1..1000] of longint;
graf:array[1..1000] of array of integer;
p,n,i,j,k,l,flux,m,min,x,y,cap:longint;
fol:array[1..1000] of byte;
ant:array[1..1000] of integer;
//parcurgere pt flux

function bf:boolean;
var i,j,k,po:longint;
x:array[1..1000] of longint;
begin
fillchar(fol,sizeof(fol),0);
fol[1]:=1;
x[1]:=1;
i:=0;
k:=1;
while i<k do
	begin
	inc(i);
	for j:=1 to graf[x[i]][0] do
		begin
		po:=graf[x[i]][j];
		if po=n then 
		else 
						
		if (f[x[i]][po]=c[x[i]][po]) or (fol[po]=1) then
											else
	begin
	inc(K);
	x[k]:=po;
        ant[po]:=x[i];
	fol[po]:=1;
	end;
	end;
	end;
if fol[n]=1 then bf:=true
	else bf:=false;
end;


begin
assign(input,'maxflow.in');
assign(output,'maxflow.out');
reset(input);
rewrite(output);
//citire

read(n,m);
for i:=1 to n do setlength(graf[i],1);
for i:=1 to m do
		begin
		read(x,y,cap);
			c[x][y]:=cap;
			c[y][x]:=cap;
		inc(graf[x][0]);
		inc(graf[y][0]);
		setlength(graf[x],graf[x][0]+1);
		setlength(graf[y],graf[y][0]+1);
		graf[x][graf[x][0]]:=y;
		graf[y][graf[y][0]]:=x;
		end;

// calculare flux

flux:=0;
while bf do
	for i:=1 to  graf[n][0] do
		begin
		x:=graf[n][i];
		if (c[x][n]=f[x][n])or(fol[x]=0) then
			else
			begin
			ant[n]:=x;p:=n;min:=maxlongint;
			while p<>1 do begin
                                        if c[ant[p]][p]-f[ant[p]][p]<min then min:=c[ant[p]][p]-f[ant[p]][p];
                                        p:=ant[p];
                                        end;
			if min=0 then
				else
				begin
				p:=n;
				while p<>1 do
					begin
					inc(f[ant[p]][p],min);
					dec(f[p][ant[p]],min);
                                        p:=ant[p];
					end;

		inc(flux,min);
		end;
	end;
	end;
write(flux);
close(input);
close(output);
end.