Cod sursa(job #287348)

Utilizator belgun_adrianBelgun Dimitri Adrian belgun_adrian Data 24 martie 2009 19:28:53
Problema Critice Scor 70
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.05 kb
// Arhiva Educationala - Flux Maxim

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

type
        adresa = ^nod;
        nod    = record inf: integer; adr : adresa; end;

var
        n, m, i, j, x, y, z, nsol : longint;
        fmin , flux : longint;
        q : adresa;
        v : array[1..1024] of adresa;
        c, f : array[1..1024,1..1024] of longint;
        xx,yy,sol: array[1..10000] of integer;
        fio : text;
        cd, viz, tat : array[1..1024] of integer;

function BF : boolean;
var
        p, u : integer;
        q : adresa;
begin
fillchar (viz, n*sizeof(integer), 0);
fillchar (tat, n*sizeof(integer), 0);

p := 1; u := 1; cd[1] := 1; viz[1] := 1;
while (p <= u) do
      begin
      q := v[cd[p]];
      if (cd[p] <> n) then
         while (q<>nil) do
            begin
            if (viz[q^.inf] = 0) and (f[cd[p],q^.inf] <> c[cd[p], q^.inf]) then
               begin
               viz [q^.inf] := 1;
               inc(u); cd[u] := q^.inf;
               tat[q^.inf] := cd[p];
               end;
            q := q^.adr;
            end;
      inc (p);
      end;
if viz[n] = 1 then
        BF := true
else
        BF := false;
end;

begin
assign  (fio, 'critice.in');
reset   (fio);
readln  (fio, n, m);
for i := 1 to m do
    begin
    readln (fio, x, y, z);
    c[x,y] := z;
    c[y,x] := z;
    xx[i]  := x;
    yy[i]  := y;
    new (q); q^.inf := x; q^.adr := v[y]; v[y] := q;
    new (q); q^.inf := y; q^.adr := v[x]; v[x] := q;
    end;
close   (fio);


while (BF) do
        begin
        q:= v[n];
        while (q <> nil) do
              begin
              if (viz[q^.inf] = 1) and (f[q^.inf, n] <> c[q^.inf, n]) then
                 begin
                 tat [n] := q^.inf;

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

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

                     end;


                 flux := flux + fmin;
                 end;
              q := q^.adr;
              end;
        end;

for i:=1 to m do
    if (c[xx[i],yy[i]] = f[xx[i],yy[i]]) or (c[yy[i],xx[i]] = f[yy[i],xx[i]]) then
        begin
        inc(c[xx[i],yy[i]]);
        inc(c[yy[i],xx[i]]);

        if (BF) then
            begin
            inc(nsol);
            sol[nsol] := i;
            end;

        dec(c[xx[i],yy[i]]);
        dec(c[yy[i],xx[i]]);
        end;


assign  (fio, 'critice.out');
rewrite (fio);
writeln (fio, nsol);
for i := 1 to nsol do
    writeln (fio, sol[i]);
close   (fio);
end.