NKMINES - Trò chơi dò mìn
Tác giả: RR
Ngôn ngữ: Pascal
{$R+,Q+}
PROGRAM NKMINES;
CONST
FINP='';
FOUT='';
maxn=401;
VAR
c,a:array[0..maxn+1,0..maxn+1] of integer;
m,n,kt:integer;
procedure readInput;
var
f:text;
i,j:integer;
begin
assign(f,FINP); reset(f);
readln(f,m,n);
for i:=1 to m do
for j:=1 to n do
read(f,c[i,j]);
for i:=0 to n+1 do
begin
c[0,i]:=100;
c[m+1,i]:=100;
end;
for j:=0 to m+1 do
begin
c[j,0]:=100;
c[j,n+1]:=100;
end;
if m<n then kt:=n else kt:=m;
close(f);
end;
procedure writeOutput;
var
f:text;
i,j:integer;
begin
assign(f,FOUT); rewrite(f);
for i:=1 to m do
begin
for j:=1 to n do write(f,a[i,j],' ');
writeln(f);
end;
close(f);
halt;
end;
function dienSo(k:integer):boolean;
var
i,j:integer;
ok:boolean;
begin
ok:=true;
for i:=2 to k-2 do
if c[i-1,k-i-1]>0 then
if (i<=m) and (k-i-1<=n) then
begin
j:=k-i;
if c[i-1,j-1]>1 then ok:=false;
a[i,j]:=1;
dec(c[i-1,j-1]); if c[i-1,j-1]<0 then ok:=false;
dec(c[i-1,j]); if c[i-1,j]<0 then ok:=false;
dec(c[i-1,j+1]); if c[i-1,j+1]<0 then ok:=false;
dec(c[i,j-1]); if c[i,j-1]<0 then ok:=false;
dec(c[i,j+1]); if c[i,j+1]<0 then ok:=false;
dec(c[i+1,j-1]); if c[i+1,j-1]<0 then ok:=false;
dec(c[i+1,j]); if c[i+1,j]<0 then ok:=false;
dec(c[i+1,j+1]); if c[i+1,j+1]<0 then ok:=false;
end;
dienSo:=ok;
end;
procedure xoaSo(k:integer);
var
i,j:integer;
begin
for i:=2 to k-2 do
if a[i,k-i]=1 then
begin
j:=k-i;
a[i,j]:=0;
inc(c[i-1,j-1]); inc(c[i-1,j]); inc(c[i-1,j+1]);
inc(c[i,j-1]); inc(c[i,j+1]);
inc(c[i+1,j-1]); inc(c[i+1,j]); inc(c[i+1,j+1]);
end;
end;
function kiemtra:boolean;
var
i,j:integer;
begin
kiemtra:=false;
for i:=1 to m do
for j:=1 to n do
if c[i,j]<>0 then exit;
kiemtra:=true;
end;
procedure try(i:integer);
var
j1,j2:byte;
ok:boolean;
begin
for j2:=0 to 1 do
for j1:=0 to 1 do
if (i<=n) or (j1=0) then
if (i<=m) or (j2=0) then
begin
ok:=true;
a[1,i]:=j1;
if j1=1 then
begin
dec(c[1,i-1]); if c[1,i-1]<0 then ok:=false;
dec(c[1,i+1]); if c[1,i+1]<0 then ok:=false;
dec(c[2,i-1]); if c[2,i-1]<0 then ok:=false;
dec(c[2,i]); if c[2,i]<0 then ok:=false;
dec(c[2,i+1]); if c[2,i+1]<0 then ok:=false;
end;
a[i,1]:=j2;
if j2=1 then
begin
dec(c[i-1,1]); if c[i-1,1]<0 then ok:=false;
dec(c[i+1,1]); if c[i+1,1]<0 then ok:=false;
dec(c[i-1,2]); if c[i-1,2]<0 then ok:=false;
dec(c[i+1,2]); if c[i+1,2]<0 then ok:=false;
dec(c[i,2]); if c[i,2]<0 then ok:=false;
end;
if ok then ok:=dienSo(i+1);
if ok then
begin
if i<kt+kt-1 then try(i+1)
else if kiemtra then writeOutput;
end;
if j1=1 then
begin
inc(c[1,i-1]); inc(c[1,i+1]);
inc(c[2,i-1]); inc(c[2,i]); inc(c[2,i+1]);
end;
if j2=1 then
begin
inc(c[i-1,1]); inc(c[i+1,1]);
inc(c[i-1,2]); inc(c[i+1,2]); inc(c[i,2]);
end;
xoaSo(i+1);
end;
end;
procedure solve;
begin
a[1,1]:=0;
try(2);
fillchar(a,sizeof(a),0);
a[1,1]:=1;
dec(c[1,2]); dec(c[2,1]); dec(c[2,2]);
if c[1,2]<0 then exit;
if c[2,1]<0 then exit;
if c[2,2]<0 then exit;
try(2);
end;
BEGIN
readInput;
solve;
END.