[COLOR=#000000][FONT=Arial]PROGRAM Domin;
Uses crt;
Const tf=’mine.inp’;
mx=127;
Type mang=array[0..151,0..151] of shortint;
Var a,b:mang;
m,n,min,max:integer;
f:text;
thoat:boolean;[/FONT][/COLOR]
[COLOR=#000000][FONT=Arial]Procedure doc;
Var i,j:integer;
Begin
Assign(f,tf);
Reset(f);
Readln(f,m,n);
For i:=1 to m do
for j:=1 to n do
read(f,a[i,j]);
Close(f);
End;
Procedure xem;
Var i,j:integer;
Begin
Writeln(m, ‘ ‘,n);
For i:=1 to m do
begin
for j:=1 to n do
if a[i,j]=1 then write(‘* ‘)
else
if a[i,j]=0 then write(‘. ‘);
writeln;
end;
End;
Procedure xem1;
Var i,j:integer;
Begin
Writeln(m, ‘ ‘,n);
For i:=1 to m do
begin
for j:=1 to n do
write(b[i,j],’ ‘);
writeln;
end;
End;
Function dem(i,j:byte):byte;
Var s:integer;
Begin
s:=0;
if (a[i-1,j]=1) then inc(s);
if (a[i,j-1]=1) then inc(s);
if (a[i+1,j]=1) then inc(s);
if (a[i,j+1]=1) then inc(s);
if (a[i-1,j-1]=1) then inc(s);
if (a[i-1,j+1]=1) then inc(s);
if (a[i+1,j+1]=1) then inc(s);
if (a[i+1,j-1]=1) then inc(s);
dem:=s;
End;
Procedure minso;
Var i,j:integer;
Begin
For i:=1 to m do
for j:=1 to n do
b[i,j]:=dem(i,j)
End;
Procedure giam(i,j:integer);
Begin
dec(b[i-1,j]); dec(b[i+1,j]);dec(b[i,j-1]);dec(b[i,j+1]);
dec(b[i-1,j-1]);dec(b[i-1,j+1]);dec(b[i+1,j-1]);dec(b[i+1,j+1]);
if (b[i-1,j]<0)or(b[i+1,j]<0)or(b[i,j-1]<0)or(b[i,j+1]<0)or(b[i-1,j-1]<0) or(b[i-1,j+1]<0) or(b[i+1,j-1]<0) or(b[i+1,j+1]<0) then thoat:=true; End; Procedure tang(i,j:integer); Begin inc(b[i-1,j]); inc(b[i+1,j]);inc(b[i,j-1]);inc(b[i,j+1]); inc(b[i-1,j-1]);inc(b[i-1,j+1]);inc(b[i+1,j-1]);inc(b[i+1,j+1]); End; Procedure loang(i:integer); Var j,t:integer; Begin if i>m then t:=m
else
if i>n then t:=n
else t:=i-1;
For j:=2 to t do
Begin
if (i>n) or (i>m) then
begin
if i>m then
begin
if (b[j-1,i-1]>1) then begin thoat:=true; exit; end;
if b[j-1,i-1]=0 then a[j,i]:=0
else
if b[j-1,i-1]=1 then begin a[j,i]:=1; giam(j,i); end
else begin thoat:=true; exit; end
end
else
begin
if (b[i-1,j-1]>1) then begin thoat:=true; exit; end;
if b[i-1,j-1]=0 then a[i,j]:=0
else
if b[i-1,j-1]=1 then begin a[i,j]:=1; giam(i,j); end
else begin thoat:=true; exit; end
end
end
else
begin
if (b[j-1,i-1]>1) or (b[i-1,j-1]>1) then begin thoat:=true; exit; end;
if b[j-1,i-1]=0 then a[j,i]:=0
else begin a[j,i]:=1; giam(j,i); end;
if b[i-1,j-1]=0 then a[i,j]:=0
else begin a[i,j]:=1; giam(i,j); end
end;
End;
if i<=min then begin if b[i-1,i-1]>1 then begin thoat:=true; exit; end;
if b[i-1,i-1]=0 then a[i,i]:=0
else begin a[i,i]:=1; giam(i,i);end;
end;
End;
Procedure lui(i:integer);
Var j,t:integer;
Begin
if i>m then t:=m
else
if i>n then t:=n
else t:=i;
For j:=2 to t do
Begin
if (i>m) or (i>n) then
begin
if i>m then
begin
if a[j,i]=1 then begin tang(j,i); a[j,i]:=0; end
end
else
begin
if a[i,j]=1 then begin tang(i,j); a[i,j]:=0; end
end;
end
else
begin
if a[j,i]=1 then begin tang(j,i); a[j,i]:=0; end;
if a[i,j]=1 then begin tang(i,j); a[i,j]:=0; end
end;
End;
End;
Function Kt(k:integer):boolean;
var i,j,m1,n1:integer;
Begin
If k>m then m1:=m
else m1:=k;
if k>n then m1:=n
else n1:=k;
For i:=1 to m1 do
for j:=1 to n1 do
if (b[i,j]<0) then begin kt:=false; exit; end; kt:=true; End; Function du:boolean; var i,j:integer; Begin {xem1;readln;} For i:=1 to m do for j:=1 to n{m-1} do if b[i,j]<>0 then
begin
du:=false;
exit;
end;
du:=true;
End;
Procedure inkq;
begin
xem;
{readln;}
end;
Procedure somin(i:integer);
Begin
if i={min}max+1 then
if not thoat then
if du then inkq ;
if (i<={min}max) and not thoat {and kt(i-1)} then if i>min then
Begin
if m>n then
begin
a[i,1]:=0;
thoat:=false; {xem1;}
loang(i); {xem;xem1;readln;}
somin(i+1);
lui(i);
a[i,1]:=1;
thoat:=false;
giam(i,1); {xem1;}
loang(i); {xem;xem1;readln;}
somin(i+1);
lui(i);
tang(i,1);
end
else
begin
{xem;readln;xem1;readln;}
a[1,i]:=0;
thoat:=false; {xem1;}
loang(i); {xem;xem1;readln;}
somin(i+1);
lui(i);
a[1,i]:=1;
thoat:=false;
giam(1,i); {xem1;}
loang(i); {xem;xem1;readln;}
somin(i+1);
lui(i);
tang(1,i);
end
End
else
Begin
if i=1 then
begin
a[1,1]:=0; {xem;xem1;readln;}
thoat:=false;
somin(i+1);
a[1,1]:=1;
thoat:=false;
giam(1,1); {xem;xem1;readln;}
somin(i+1);
tang(1,1);
end
else
begin
{write(i,’ ‘);}
a[1,i]:=0;a[i,1]:=0;
thoat:=false;
loang(i); {xem;xem1;readln;}
somin(i+1);
lui(i);
a[1,i]:=0;a[i,1]:=1;
thoat:=false;
giam(i,1);
loang(i); {xem;xem1;readln;}
somin(i+1);
lui(i);
tang(i,1);
a[1,i]:=1;a[i,1]:=1;
thoat:=false;
giam(1,i);giam(i,1);
loang(i); {xem;xem1;readln;}
somin(i+1);
lui(i);
tang(1,i);tang(i,1);
a[1,i]:=1;a[i,1]:=0;
thoat:=false;
giam(1,i);
loang(i); {xem;xem1;readln;}
somin(i+1);
lui(i);
tang(1,i);
end;
End;
End;
Procedure test;
Var i,j:integer;
Begin
Doc;
Xem;
for i:=0 to n+1 do
begin
a[0,i]:=0; b[0,i]:=mx;
a[m+1,i]:=0; b[m+1,i]:=mx;
end;
for i:= 0 to m+1 do
begin
a[i,0]:=0; b[i,0]:=mx;
a[i,n+1]:=0; b[i,n+1]:=mx;
end;
minso;
writeln;
xem1;
For i:=0 to m+1 do
for j:=0 to n+1 do
a[i,j]:=0;
If n>m then begin min:=m; max:=n; end
else begin min:=n; max:=m; end;
thoat:=false;
somin(1);
End;
BEGIN
ClrScr;
test;
readln;
END.[/FONT][/COLOR]
