2001 - BIẾN ĐỔI TRÊN LƯỚI SỐCONST INP ='BAI72.INP'; OUT ='BAI72...

Bài 72/2001 - Biến đổi trên lưới số

const Inp ='bai72.inp';

Out ='bai72.out' ;

maxn=100;

Var dem, n, i, j, d:integer; f:text;

a:array[0..maxn+1,0..maxn+1] of Boolean;

Procedure Init;

Var t:integer;

Begin

Fillchar(a, Sizeof(a), true);

Assign(f, inp); reset(f);

dem:=0;

Readln(f, n);

for i:= 1 to n do

for j:=1 to n do

begin

read(f, t);

If t=1 then a[i,j]:=true else begin a[i,j]:=false;inc(dem); end;

If j=n then readln(f);

end;

Close(f);

End;

Procedure Solve1;

for i:=1 to n do

for j:=1 to n do

begin

If not a[i,j] then

begin

a[i,j]:= not (a[i,j-1] xor a[i,j+1] xor a[i-1,j] xor a[i+1,j]);

If a[i,j] then begin dec(dem);writeln(f,i,' ',j) end

end;

end;

Procedure Solve2;

If not a[i,j] then

If i >1 then

begin

a[i-1,j]:=false;

inc(dem);

writeln(f, i-1, ' ', j);

end

else

If i <n then

begin

a[i+1,j]:=false;

inc(dem);

writeln(f, i+1, ' ', j);

end

else

If j >1 then

begin

a[i,j-1]:=false;

inc(dem);

writeln(f, i, ' ', j-1);

end

else

begin a[i,j+1]:=false; inc(dem); writeln(f, i, ' ', j+1) end;

exit;

end;

BEGIN

Init;

Assign(f,out); rewrite(f);

While dem >0 do

begin

writeln(dem); d:=dem; solve1;

If (d=dem) and (dem >0) then solve2;

end; Close(f);

END.

(Lời giải của bạn Nguyễn Chí Thức - khối PTCTT - ĐHSP - Hà Nội)