Cod sursa(job #287388)

Utilizator belgun_adrianBelgun Dimitri Adrian belgun_adrian Data 24 martie 2009 20:09:29
Problema Critice Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 4.22 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, p,u: longint;
        fmin , flux : longint;
        ok1,ok2: boolean;
        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,v1,v2, 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;



p := 1; u := 1; cd[1] := 1; v1[1] := 1;
while (p <= u) do
      begin
      q := v[cd[p]];
         while (q<>nil) do
            begin
            if (v1[q^.inf] = 0) and (abs(f[cd[p],q^.inf]) <> c[cd[p], q^.inf]) then
               begin
               v1 [q^.inf] := 1;
               inc(u); cd[u] := q^.inf;
               end;
            q := q^.adr;
            end;
      inc (p);
      end;


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


for i := 1 to m do
    if ((v1[xx[i]] and v2[yy[i]] = 1) or (v2[xx[i]] and v1[yy[i]] = 1)) and
       ((c[xx[i],yy[i]] = abs(f[xx[i],yy[i]])) or (c[yy[i],xx[i]] = abs(f[yy[i],xx[i]])))
    then
        begin
        inc(nsol);
        sol[nsol] := i;
        end;



{ Varianta neoptimizata. - 70pct
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.