Cod sursa(job #282264)

Utilizator THE_GAMEAndrei Alexandru THE_GAME Data 17 martie 2009 11:03:33
Problema Cc Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 4.79 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.