Đề thi Biến đổi 0 - 1

Bài 85/2001 - Biến đổi 0 - 1
(Dành cho học sinh THPT)
Thuật toán: Bài này sử dụng thuật toán duyệt nhưng có một vài chú ý sau:
- Với 1 ô ta chỉ tác động nhiều nhất một lần.
- Thứ tự tác động là không quan trọng.
- Với một ô có nhiều nhất 5 ô ảnh hưởng được tới nó, vì vậy nếu với một ô ta biết 4 ô ảnh hưởng của nó có được tác động hay không thì ô còn lại ta sẽ biết là có nên tác động hay không tác động.
Từ các chú ý trên ta sẽ duyệt một dòng 1 (hoặc một cột 1) được tác động như thế nào khi đó các ô ở dòng 1 (hoặc cột 1) sẽ chỉ còn 1 ô ảnh hưởng tới nó. Ta sẽ biết được rằng các ô dòng 2 (hoặc cột 2) cũng sẽ được tác động như thế nào, cứ như vậy cho các dòng tiếp theo.
Bài sẽ phải duyệt 2N nếu duyệt theo dòng 1 (2M nếu duyệt theo cột 1) vì vậy để giảm độ phức tạp của bài bạn nên chọn duyệt theo chiều nào tuỳ thuộc vào M,N.
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R+,S+,T-,V+,X+}
{$M 16384,0,655360}
uses crt;
const max =100;
 fi ='biendoi.inp';
 fo ='biendoi.out';
 tx : array[0..4]of integer=(0,0,-1,0,1);
 ty: array[0..4]of integer=(0,-1,0,1,0);
type mg = array[1..max,1..max]of byte;
var a,b,td,lkq,c:mg;
 m,n,dem,best:integer;
procedure docf;
var f :text;
 i,j :byte;
 begin
 assign(f,fi);
 reset(f);
 readln(f,m,n);
 for i:=1 to m do
 for j:=1 to n do read(f,a[i,j]);
 for i:=1 to m do
 for j:=1 to n do read(f,b[i,j]);
 close(f);
 end;
procedure tacdong(i,j:byte);
var u,v,k :integer;
 begin
 for k:=0 to 4 do
 begin
 u:=i+tx[k];
 v:=j+ty[k];
 if (u>0)and(v>0)and(u<=m)and(v<=n) then a[u,v]:=1-a[u,v];
 end;
 inc(dem);
 end;
procedure process;
var i,j,k :byte;
 w : mg;
 begin
 c:=a;dem:=0;w:=td;
 for i:=1 to n do
 if td[1,i]=1 then tacdong(1,i);
 for i:=2 to m do
 for j:=1 to n do
 if a[i-1,j]b[i-1,j] then
 begin
 tacdong(i,j);
 td[i,j]:=1;
 end;
 for k:=1 to n do
 if a[m,k]b[m,k] then begin a:=c;td:=w;exit;end;
 if dem<best then
 begin
 best:=dem;
 lkq:=td;
 end;
 a:=c;td:=w;
 end;
procedure try(i:byte);
var j :byte;
 begin
 for j:=0 to 1 do
 begin
 td[1,i]:=j;
 if i=n then process
 else try(i+1);
 end;
 end;
procedure ghif;
var f :text;
 i,j :integer;
 begin
 assign(f,fo);
 rewrite(f);
 if bestmaxint then
 begin
 writeln(f,best);
 for i:=1 to m do
 for j:=1 to n do
 if lkq[i,j]=1 then writeln(f,i,#32,j);
 end
 else writeln(f,'No solution');
 close(f);
 end;
begin
 clrscr;
 best:=maxint;
 docf;
 try(1);
 ghif;
end.
(Lời giải của Đinh Quang Huy)