Cod sursa(job #17935)

Utilizator andrei_infoMirestean Andrei andrei_info Data 17 februarie 2007 14:46:53
Problema Taramul Nicaieri Scor 95
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.84 kb
//infoarena taramul nicaieri - flux
const nmax= 100;
var fl: 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 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
        fl[sursa,i]:=mout[i];
for i:=n+1 to 2*n do
        fl[i,dest]:=min[i-n];
for i:=1 to n do
        for j:=n+1 to 2*n do
                if i <> j-n then
                        fl[i,j]:=1
                else fl[i,j]:=-1;
end;

function bf:boolean;
var i,j,k: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
        for j:=sursa to dest do
                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;
        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:integer;
begin
while bf do
        flux;

assign(output,'harta.out'); rewrite(output);
writeln(m);
for i:=1 to n do
        for j:=n+1 to 2*n do
                if fl[i,j]= 0 then
                        writeln(i,' ',j-n);
close(output);
end;

begin
citire;
init;
calc;
end.