Cod sursa(job #17941)

Utilizator andrei_infoMirestean Andrei andrei_info Data 17 februarie 2007 15:08:43
Problema Taramul Nicaieri Scor 95
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.51 kb
//infoarena taramul nicaieri - flux
const nmax= 100;
var fl,graf: array[0..2*nmax+1, 0..2*nmax+1] of integer;
    tata,lista:array[0..2*nmax+1] of integer;
    min,mout :  array[1..nmax] of integer;
    n,m,sursa,dest:longint;

procedure addlist(nod,x:integer);
begin
inc(graf[nod,0]); graf[nod,graf[nod,0]]:=x;
end;

procedure citire;
var i:integer;
begin
assign(input,'harta.in'); reset(input);
readln(n);
for i:=1 to n do
        begin
        readln(mout[i],min[i]);
        m:=m+mout[i];
        end;
close(input);
sursa:=0; dest:=2*n+1;
end;

procedure init;
var i,j:integer;
begin

for i:=1 to n do
        begin
        fl[sursa,i]:=mout[i];
        addlist(sursa,i);
        addlist(i,sursa);
        end;
for i:=n+1 to 2*n do
        begin
        fl[i,dest]:=min[i-n];
        addlist(i,dest);
        addlist(dest,i);
        end;
for i:=1 to n do
        for j:=n+1 to 2*n do
                if i <> j-n then
                        begin
                        fl[i,j]:=1;
                        addlist(i,j);
                        addlist(j,i);
                        end
                else fl[i,j]:=-1;
end;

function bf:boolean;
var i,j,k,z:integer;
begin
for i:=sursa to dest do
        tata[i]:=-1;
lista[1]:=0; k:=1; i:=1;
tata[0]:=0;
while i <= k do
        begin
        z:=1;
        while z<= graf[lista[i],0] do
                begin
                j:=graf[lista[i],z];
                if (fl[lista[i],j] > 0) and ( tata[j] = -1) then
                        begin
                        tata[j]:=lista[i];
                        k:=k+1;
                        lista[k]:=j;
                        if j = dest then begin i:=k; break; end;
                        end;
                z:=z+1;
                end;
        i:=i+1;
        end;
bf:=tata[dest]<>-1;
end;

procedure flux;
var i,j:integer;
begin
i:=dest;
while i <> 0 do
        begin
        j:=tata[i];
        fl[j,i]:=fl[j,i]-1;
        fl[i,j]:=fl[i,j]+1;
        i:=j;
        end;
end;

procedure calc;
var i,j,z:integer;
begin
while bf do
        flux;

assign(output,'harta.out'); rewrite(output);
writeln(m);
for i:=1 to n do
        begin
        z:=1;
        while z<= graf[i,0] do
                begin
                j:=graf[i,z];
                if (fl[i,j]= 0) and (j > n) then
                        writeln(i,' ',j-n);
                inc(z);
                end;
        end;
close(output);
end;

begin
citire;
init;
calc;
end.