Cod sursa(job #289313)

Utilizator flamecataCiobanu Alexandru-Catalin flamecata Data 26 martie 2009 17:46:48
Problema Critice Scor 100
Compilator fpc Status done
Runda aa Marime 4.7 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.