Cod sursa(job #20864)

Utilizator vanila0406Ionescu Victor vanila0406 Data 22 februarie 2007 15:43:40
Problema Amlei Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.06 kb
program flux;
var fin,g:text;
        a,c,f:array[1..100,1..100] of longint;
        n,min,i,j,s:longint;
        pred:array[1..1000] of longint;
        viz:array[1..1000] of boolean;
        ok:boolean;


procedure iofile;
var i,j,cap:longint;
begin
        assign(fin,'flux.in');
        reset(fin);
        assign(g,'flux.out');
        rewrite(g);
        readln(fin,n);
        fillchar(c,sizeof(c),0);
        fillchar(f,sizeof(f),0);
        while not eof(fin) do
                begin
                        readln(fin,i,j,cap);
                        c[i,j]:=cap;
                end;
        close(fin);
end;




procedure flux_rez;
var i,j:longint;
begin
        for i:=1 to n do
                for j:=1 to n do
                        begin
                                if (c[i,j]>f[i,j])or(c[i,j]=f[i,j])and(
                                c[i,j]<>0) then
                                        a[i,j]:=c[i,j]-f[i,j] else
                                if f[j,i]>0 then
                                        a[i,j]:=f[j,i];
                        end;
        for i:=1 to n do
                viz[i]:=false;
        viz[1]:=true;
        pred[1]:=0;
end;



procedure minim(n:longint);
begin
        if n<>1 then
                begin
                        if a[pred[n],n]<min then
                                min:=a[pred[n],n];
                        minim(pred[n]);
                end;
end;

procedure crestere(n:longint);
begin
        if n<>1 then
                begin
                        f[pred[n],n]:=f[pred[n],n]+min;
                        crestere(pred[n]);
                end;
end;

procedure graf_flux;
var p,u,i,k:longint;
        co:array[1..10000] of longint;
begin
        p:=1;
        u:=1;
        co[1]:=1;
        ok:=true;
        while (p<=u)and ok do
                begin
                        k:=co[p];
                        for i:=1 to n do
                                if (a[k,i]>0)and (not viz[i]) then
                                        begin
                                                inc(u);
                                                co[u]:=i;
                                                pred[i]:=k;
                                                viz[i]:=true;
                                                if i=n then
                                                        ok:=false;
                                        end;
                        inc(p);
                end;
        if not ok then
                begin
                        min:=maxlongint;
                        minim(n);
                        crestere(n);
                        s:=s+min;
                end;
end;



begin
        iofile;
        s:=0;
        repeat
        flux_rez;
        graf_flux;
        until ok;
        writeln(g,s);
        for i:=1 to n do
                for j:=1 to n do
                        if f[i,j]>0 then
                                writeln(g,i,' ',j,' ',f[i,j]);
        close(g);
end.