Cod sursa(job #134082)

Utilizator vrvpVlad Veigang vrvp Data 10 februarie 2008 17:23:12
Problema Cc Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 4.3 kb
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]<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
                  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.