Cod sursa(job #1199092)

Utilizator mihaitamoglanmihai moglan mihaitamoglan Data 18 iunie 2014 09:13:04
Problema Jocul Flip Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.89 kb
type matrice=array [1..17,1..17]of longint;
     tablou=array [1..17]of longint;
var t:matrice;
    aux:tablou;
    i,j,k,m,n,s1,s2,s:integer;
    f,g:text;
begin
assign(f,'flip.in');
assign(g,'flip.out');
reset(f);
rewrite(g);
read(f,n,m);
for i:=1 to n do
 for j:=1 to m do
 read(f,t[i,j]);
i:=1;
repeat
 s1:=0;s2:=0;
 for j:=1 to m do
  begin
  aux[j]:=t[i,j]*(-1);
  s1:=s1+t[i,j];
  s2:=s2+aux[j];
  end;
 if s1<s2 then begin
                for j:=1 to m do
                 t[i,j]:=aux[j];
                end;
 i:=i+1;
until i>n;
for i:=1 to m do
 aux[i]:=0;
i:=1;
k:=0;
repeat
 s1:=0;s2:=0;
 for j:=1 to n do
  begin
  aux[j]:=t[j,i]*(-1);
  s1:=s1+t[j,i];
  s2:=s2+aux[j];
  end;
 if s1<s2 then begin
                for j:=1 to n do
                 t[j,i]:=aux[j];
                k:=k+1;
                end;
          i:=i+1;
  until i>m;
   while k>0 do
   begin
   k:=0;
   i:=1;
    repeat
      s1:=0;s2:=0;
      for j:=1 to m do
       begin
        aux[j]:=t[i,j]*(-1);
        s1:=s1+t[i,j];
         s2:=s2+aux[j];
      end;
     if s1<s2 then begin
                for j:=1 to m do
                 t[i,j]:=aux[j];
                k:=k+1;
                end;
     i:=i+1;
    until i>n;
  if k>0 then begin
            for i:=1 to m do
             aux[i]:=0;
             i:=1;
             k:=0;
             repeat
              s1:=0;s2:=0;
               for j:=1 to n do
                 begin
                 aux[j]:=t[j,i]*(-1);
                 s1:=s1+t[j,i];
                 s2:=s2+aux[j];
                 end;
           if s1<s2 then begin
                for j:=1 to m do
                 t[j,i]:=aux[j];
                k:=k+1;
                end;
               i:=i+1;
             until i>m;
 end;
end;
for i:=1 to n do
  for j:=1 to m do
  s:=s+t[i,j];
write(g,s);
close(f);
close(g);
end.