Cod sursa(job #286471)

Utilizator belgun_adrianBelgun Dimitri Adrian belgun_adrian Data 23 martie 2009 20:35:43
Problema Taramul Nicaieri Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.44 kb
// Arhiva Educationala - Flux Maxim

function  min (x,y: longint) : longint;
begin
if (x <= y) then min := x else min := y;
end;

var
        n, m, i, j, x, y, z : longint;
        fmin , flux : longint;
        c, f : array[0..255,0..255] of longint;
        fio : text;
        cd, viz, tat : array[0..255] of integer;

function BF : boolean;
var
        p, u : integer;
begin
fillchar (viz, (2*n+1)*sizeof(integer), 0);
fillchar (tat, (2*n+1)*sizeof(integer), 0);
fillchar (cd,  (2*n+1)*sizeof(integer), 0);

p := 1; u := 1; cd[1] := 0; viz[0] := 1;
while (p <= u) do
      begin
      if (cd[p] <> n*2+1) then
         for i:=1 to n*2 + 1 do
            begin
            if (viz[i] = 0) and (f[cd[p],i] <> c[cd[p],i]) then
               begin
               viz [i] := 1;
               inc(u); cd[u] := i;
               tat[i] := cd[p];
               end;
            end;
      inc (p);
      end;
if viz[n] = 1 then
        BF := true
else
        BF := false;
end;

begin
assign  (fio, 'harta.in');
reset   (fio);
readln  (fio, n);
for i := 1 to n do
    begin
    readln (fio, x, y);
    c[0,i] := x;
    c[i+n,n*2+1] := y;
    end;
for i:=1 to n do
    begin
    for j:=n+1 to n+i-1 do c[i,j] :=1;
    for j:=n+i+1 to n*2 do c[i,j] :=1;
    end;
close   (fio);


while (BF) do
        begin
        for i:=n+1 to n*2 do
              begin
              if (viz[i] = 1) and (f[i, 2*n+1] <> c[i, 2*n+1]) then
                 begin
                 tat [2*n+1] := i;

                 fmin := 200000;
                 x := 2*n+1;
                 while (x<>0) do
                       begin
                       fmin := min (fmin, c[tat[x], x] - f[tat[x], x]);
                       x := tat[x];
                       end;

                 if (fmin<> 0) then
                     begin
                     x := 2*n+1;
                     while (x<>0) do
                           begin
                           inc (f[tat[x],x], fmin);
                           dec (f[x,tat[x]], fmin);
                           x := tat[x];
                           end;

                     end;


                 flux := flux + fmin;
                 end;
              end;
        end;

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