Cod sursa(job #12901)

Utilizator Data 5 februarie 2007 10:50:41 Jocul Flip 20 fpc done Arhiva de probleme 2.54 kb
``````var fi,fo:text;
n,m,i,j:integer;
v,aux:array[1..17,1..17] of longint;
l1,l2,max,peak:longint;
a,b:array[0..35000,1..15] of byte;

function suma:longint;
var i,j:integer;
sum:longint;
begin
sum:=0;
for i:=1 to n do
for j:=1 to m do
sum:=sum+aux[i,j];
suma:=sum;
end;

procedure invcol(x:integer);
var i:integer;
begin
for i:=1 to n do
aux[i,x]:=-aux[i,x];
end;

procedure invlin(x:integer);
var j:integer;
begin
for j:=1 to m do
aux[x,j]:=-aux[x,j];
end;

procedure gosolve;
var i,j,k:longint;
begin
for i:=0 to l1 do
for j:=0 to l2 do
begin
aux:=v;
for k:=1 to n do
if a[i,k]=1 then invlin(k);
for k:=1 to m do
if b[j,k]=1 then invcol(k);
peak:=suma;
if peak>max then max:=peak;
end;
end;

procedure b2I(x:longint);
var int,i,j:longint;
begin
for i:=0 to x do
begin
int:=i;
j:=1;
while int<>0 do
begin
a[i,j]:=int mod 2;
int:=int div 2;
inc(j);
end;
end;

end;

procedure b2II(x:longint);
var int,i,j:longint;
begin
for i:=0 to x do
begin
int:=i;
j:=1;
while int<>0 do
begin
b[i,j]:=int mod 2;
int:=int div 2;
inc(j);
end;
end;
end;

begin
assign(fi,'flip.in'); reset(fi);
assign(fo,'flip.out'); rewrite(fo);
for i:=1 to n do
for j:=1 to m do
case n of
1: l1:=1;
2: l1:=3;
3: l1:=7;
4: l1:=15;
5: l1:=31;
6: l1:=63;
7: l1:=127;
8: l1:=255;
9: l1:=511;
10: l1:=1023;
11: l1:=2047;
12: l1:=4095;
13: l1:=8191;
14: l1:=16383;
15: l1:=32767;
end;
b2I(l1);
case m of
1: l2:=1;
2: l2:=3;
3: l2:=7;
4: l2:=15;
5: l2:=31;
6: l2:=63;
7: l2:=127;
8: l2:=255;
9: l2:=511;
10: l2:=1023;
11: l2:=2047;
12: l2:=4095;
13: l2:=8191;
14: l2:=16383;
15: l2:=32767;
end;
b2II(l2);
{  for i:=0 to l1 do
begin
for j:=1 to n do
write(fo,a[i,j],' ');
writeln(fo);
end;
for i:=0 to l2 do
begin
for j:=1 to m do
write(fo,b[i,j],' ');
writeln(fo);
end;          }
gosolve;
writeln(fo,max);
close(fi);
close(fo);
end.
``````