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.

Download