Cod sursa(job #42180)

Utilizator vanila0406Ionescu Victor vanila0406 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.