Cod sursa(job #42180)
Utilizator | Data | 28 martie 2007 22:10:01 | |
---|---|---|---|
Problema | Cc | Scor | 100 |
Compilator | fpc | Status | done |
Runda | Arhiva de probleme | Marime | 7.58 kb |
program cc;
var f,g:text;
a,c:array[1..101,1..101] of longint;
b:array[1..101,1..101] of longint;
nl0,nc0,ml,mc:array[1..101] of longint;
n,i,j,nrc:longint;
ok:boolean;
procedure iofile;
var i,j:longint;
begin
assign(f,'cc.in');
reset(f);
assign(g,'cc.out');
rewrite(g);
readln(f,n);
for i:=1 to n do
for j:=1 to n do
read(f,c[i,j]);
a:=c;
close(f);
end;
procedure pas2;
var min,i,j:longint;
begin
for i:=1 to n do
begin
min:=maxlongint;
for j:=1 to n do
if a[i,j]<min then min:=a[i,j];
for j:=1 to n do
a[i,j]:=a[i,j]-min;
end;
for j:=1 to n do
begin
min:=maxlongint;
for i:=1 to n do
if a[i,j]<min then min:=a[i,j];
for i:=1 to n do
a[i,j]:=a[i,j]-min;
end;
end;
procedure pas3;
var ok:boolean;
nr0,p,q:integer;
min,mn:longint;
begin
fillchar(b,sizeof(b),0);
repeat
min:=maxlongint;
p:=0;
for i:=1 to n do
if nl0[i]<>0 then
if nl0[i]<min then
begin
min:=nl0[i];
p:=i;
end;
if min<>maxlongint then
begin
q:=0;
mn:=maxlongint;
for i:=1 to n do
if a[p,i]=0 then
if nc0[i]<>0 then
if nc0[i]<mn then
begin
mn:=nc0[i];
q:=i;
end;
for i:=1 to n do
if a[p,i]=0 then if b[p,i]=0 then
begin
b[p,i]:=1;
dec(nl0[p]);
dec(nc0[i]);
end;
for i:=1 to n do
if a[i,q]=0 then if b[i,q]=0 then
begin
b[i,q]:=1;
dec(nc0[q]);
dec(nl0[i]);
end;
b[p,q]:=2;
end;
until min=maxlongint;
end;
procedure pas4;
var i,j,nr0:longint;
ok:boolean;
begin
fillchar(ml,sizeof(ml),0);
fillchar(mc,sizeof(mc),0);
for i:=1 to n do
begin
nr0:=0;
for j:=1 to n do
if b[i,j]=2 then
begin
inc(nr0);
break;
end;
if nr0=0 then ml[i]:=1;
end;
repeat
ok:=false;
for j:=1 to n do
begin
nr0:=0;
for i:=1 to n do
if ml[i]=1 then
if b[i,j]=1then
begin
inc(nr0);
break;
end;
if nr0<>0 then
if mc[j]=0 then
begin
mc[j]:=1;
ok:=true;
end;
end;
for i:=1 to n do
begin
nr0:=0;
for j:=1 to n do
if mc[j]=1 then
if b[i,j]=2 then
begin
inc(nr0);
break;
end;
if nr0<>0 then
if ml[i]=0 then
begin
ml[i]:=1;
ok:=true;
end;
end;
until ok=false;
end;
procedure pas5;
var min,i,j:longint;
begin
min:=maxlongint;
for i:=1 to n do
for j:=1 to n do
if (ml[i]=1)and(mc[j]=0) then
{if a[i,j]<>0 then }
if a[i,j]<min then
min:=a[i,j];
for i:=1 to n do
for j:=1 to n do
if (ml[i]=1)and(mc[j]=0) then
begin
{if a[i,j]<>0 then}
a[i,j]:=a[i,j]-min end else
begin
if (ml[i]=0)and(mc[j]=1) then
a[i,j]:=a[i,j]+min;
end;
end;
begin
iofile;
pas2;
repeat
fillchar(nc0,sizeof(nc0),0);
fillchar(nl0,sizeof(nl0),0);
for i:=1 to n do
for j:=1 to n do
if a[i,j]=0 then
begin
inc(nl0[i]);
inc(nc0[j]);
end;
ok:=false;
pas3;
nrc:=0;
for i:=1 to n do
for j:=1 to n do
if b[i,j]=2 then inc(nrc);
if nrc<n then
begin
pas4;
pas5;
ok:=true;
end;
until ok=false;
nrc:=0;
for i:=1 to n do
for j:=1 to n do
if b[i,j]=2 then
nrc:=nrc+c[i,j];
writeln(g,nrc);
close(g);
end.