Cod sursa(job #17691)

Utilizator andrei_infoMirestean Andrei andrei_info Data 16 februarie 2007 18:02:05
Problema Cc Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.51 kb
const nmax = 100;

var cap,cost : array[0..2*nmax+1,0..2*nmax+1] of integer;
    d,tata:array[0..2*nmax+1] of integer;
    n,dest,sursa:integer;
    rez:longint;

procedure init;
var i,j:integer;
begin

for i:=0 to dest do
        for j:=0 to dest do
                begin
                cap[i,j]:=-1;
                cost[i,j]:=maxint;
                end;
for i:=1 to n do
        begin
        cap[sursa][i]:=1;
        cost[sursa][i]:=0;
        cost[i][sursa]:=0;
        end;
for i:=n+1 to 2*n do
        begin
        cap[i][dest]:=1;
        cost[i][dest]:=0;
        cost[dest][i]:=0;
        end;
end;

procedure citire;
var i,j,x:integer;
begin
assign(input,'cc.in'); reset(input);
readln(n); sursa:=0; dest:=2*n+1;
init;
for i:=1 to n do
        begin
        for j:=1 to n do
                begin
                read(x);
                cap[i,n+j]:=1;
                cost[i,n+j]:=x;
                cost[n+j,i]:=-x;
                end;
        end;
close(input);
end;

procedure drum_minim;
var i,j:integer;
    ok:boolean;
begin
  for i:= sursa to dest do
        begin
        d[i]:=maxint;
        tata[i]:=0;
        end;
  d[sursa]:=0;
  repeat
  ok:=false;
  for i:=sursa to dest do
        if d[i]<> maxint then
                for j:=sursa to dest do
                        if cap[i,j] =1 then
                                if d[i] + cost[i][j] < d[j] then
                                        begin
                                        d[j]:=d[i]+cost[i][j];
                                        tata[j]:=i;
                                        ok:=true;
                                        end;
  until not ok;
end;

procedure drum;
var i,j:integer;
begin
i:=dest;
while i<>0 do
        begin
        j:=tata[i];
        cap[j,i]:=0;
        cap[i,j]:=1;
        i:=j;
        end;
end;

function gata:boolean;
var flux,i: integer;
begin
        flux:=0;
        for i:=n+1 to 2*n do
                if cap[i,dest] = 0 then
                        flux:=flux+1;
gata:=flux=n;
end;

procedure scrie;
var i,j,cc:integer;
begin

for i:=1 to n do
        begin
        cc:=0;
        for j:=n+1 to 2*n do
                if (cap[i,j] = 0) and ( cost[i,j] <> maxint) then
                        cc:=cost[i,j];
        rez:=rez+cc;
        end;
assign(output,'cc.out'); rewrite(output);
writeln(rez);
closE(output);
end;

begin
citire;

repeat
drum_minim;
drum;
until gata;
scrie;

end.