Cod sursa(job #41616)

Utilizator andrei_infoMirestean Andrei andrei_info Data 28 martie 2007 13:48:02
Problema Critice Scor 90
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.51 kb
//critice infoarena
const nmax =1000;

type edge = record
                x,y:integer;
                end;
    sir = array[1..nmax] of boolean;

var flux, c : array[1..nmax,1..nmax] of integer;
    e: array[1..10*nmax] of edge;
    bfs,bft : sir;
    tata,lista:array[1..nmax] of integer;
    list: array[1..nmax*10] of integer;
    n,m:integer;
    buf : array[1..32768] of byte;
    f:text;
    cc:char;

function getnn:integer;
var rez:integer;
begin
rez:=0;
while (ord(cc) >=48) and (ord(cc) <= 57) do
        begin
        rez:=rez*10 + ord(cc) - 48;
        read(f,cc);
        end;
getnn:=rez;
while (((ord(cc)  < 48) or ( ord(cc) > 57))) and ( ord(cc) <> 26)  do
       read(f,cc);
end;


procedure citire;
var i,x,y,z:integer;
begin
assign(f,'critice.in'); reset(f); settextbuf(f,buf);  read(f,cc);
//readln(f,n,m);
n:=getnn; m:=getnn;
for i:=1 to m do
        begin
        //readln(f,x,y,z);
        x:=getnn; y:=getnn; z:=getnn;
        e[i].x:=x; e[i].y:=y;
        c[x,y]:=z; c[y,x]:=z;
        end;
closE(f);
end;


function bf:boolean;
var i,j,k:integer;
begin
k:=1;
for i:=1 to n do tata[i]:=-1;
lista[1]:=1;
tata[1]:=0;
i:=1;
while i<= k do
        begin
        for j:=1 to n do
                if ( tata[j] = -1 ) and ( flux[lista[i],j] < c[lista[i],j]) then
                        begin
                        tata[j]:=lista[i];
                        inc(k);
                        lista[k]:=j;
                        if j = n then begin i:=k; break; end;
                        end;
        inc(i);
        end;
bf:=tata[n]<>-1;
end;

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


procedure fflux;
var i,max : integer;
begin
max:=maxint;
i:=n;
while (i <> 1) and (tata[i] <> -1) do
        begin
        max:=min(max,c[tata[i],i]-flux[tata[i],i]);
        i:=tata[i];
        end;
i:=n;
while (i <> 1) and (tata[i] <> -1) do
        begin
        flux[tata[i],i]:=flux[tata[i],i]+max;
        flux[i,tata[i]]:=flux[i,tata[i]]-max;
        i:=tata[i];
        end;
end;

procedure bff(nod:integer; var bool: sir);
var i,j,k:integer;
begin
k:=1; i:=1;
lista[1]:=nod;
bool[nod]:=true;
tata[1]:=0;
while i<= k do
        begin
        for j:=1 to n do
                if ( not bool[j] ) and ( flux[lista[i],j] < c[lista[i],j]) then
                        begin
                        bool[j]:=true;
                        inc(k);
                        lista[k]:=j;
                        end;
        inc(i);
        end;
end;

procedure bff2(nod:integer; var bool: sir);
var i,j,k:integer;
begin
k:=1; i:=1;
lista[1]:=nod;
bool[nod]:=true;
tata[1]:=0;
while i<= k do
        begin
        for j:=1 to n do
                if ( not bool[j] ) and ( flux[j,lista[i]] < c[j,lista[i]]) then
                        begin
                        bool[j]:=true;
                        inc(k);
                        lista[k]:=j;
                        end;
        inc(i);
        end;
end;


procedure calc;
var i,k:integer;
begin
while bf do
        fflux;
bff(1,bfs);
bff2(n,bft);
k:=0;
for i:=1 to m do
        begin
        if ( (bfs[e[i].x] and bft[e[i].y]) or (bfs[e[i].y] and bft[e[i].x]) ) then
                begin
                inc(k);
                list[k]:=i;
                end;
        end;
assign(output,'critice.out'); rewrite(output);
writeln(k);
for i:=1 to k do
        writeln(list[i]);
close(output);
end;

begin
citire;
calc;
end.