http://acm.pku.edu.cn/JudgeOnline/problem?id=1138
Код:
type
tymap = array [ 1 .. 16 , 1 .. 16 ] of byte ;
tyblo = array [ 1 .. 4 , 1 .. 2 ] of byte ;
const
pos : array [ 1 .. 7 , 1 .. 5 ] of byte = (
( 1 , 0 , 0 , 0 , 0 ) ,
( 2 , 3 , 0 , 0 , 0 ) ,
( 4 , 5 , 0 , 0 , 0 ) ,
( 6 , 7 , 8 , 9 , 0 ) ,
( 10 , 11 , 12 , 13 , 0 ) ,
( 14 , 15 , 16 , 17 , 0 ) ,
( 18 , 19 , 0 , 0 , 0 )
) ;
b : array [ 1 .. 19 ] of tyblo = (
( ( 1 , 1 ) , ( 1 , 2 ) , ( 2 , 1 ) , ( 2 , 2 ) ) , // 1
( ( 1 , 1 ) , ( 1 , 2 ) , ( 2 , 2 ) , ( 2 , 3 ) ) , // 2
( ( 1 , 2 ) , ( 2 , 1 ) , ( 2 , 2 ) , ( 3 , 1 ) ) ,
( ( 1 , 2 ) , ( 1 , 3 ) , ( 2 , 1 ) , ( 2 , 2 ) ) , // 3
( ( 1 , 1 ) , ( 2 , 1 ) , ( 2 , 2 ) , ( 3 , 2 ) ) ,
( ( 1 , 1 ) , ( 2 , 1 ) , ( 2 , 2 ) , ( 2 , 3 ) ) , // 4
( ( 1 , 1 ) , ( 1 , 2 ) , ( 2 , 1 ) , ( 3 , 1 ) ) ,
( ( 1 , 1 ) , ( 1 , 2 ) , ( 1 , 3 ) , ( 2 , 3 ) ) ,
( ( 1 , 2 ) , ( 2 , 2 ) , ( 3 , 1 ) , ( 3 , 2 ) ) ,
( ( 1 , 3 ) , ( 2 , 1 ) , ( 2 , 2 ) , ( 2 , 3 ) ) , // 5
( ( 1 , 1 ) , ( 2 , 1 ) , ( 3 , 1 ) , ( 3 , 2 ) ) ,
( ( 1 , 1 ) , ( 1 , 2 ) , ( 1 , 3 ) , ( 2 , 1 ) ) ,
( ( 1 , 1 ) , ( 1 , 2 ) , ( 2 , 2 ) , ( 2 , 3 ) ) ,
( ( 1 , 2 ) , ( 2 , 1 ) , ( 2 , 2 ) , ( 2 , 3 ) ) , // 6
( ( 1 , 1 ) , ( 2 , 1 ) , ( 2 , 2 ) , ( 3 , 1 ) ) ,
( ( 1 , 1 ) , ( 1 , 2 ) , ( 1 , 3 ) , ( 2 , 2 ) ) ,
( ( 1 , 2 ) , ( 2 , 1 ) , ( 2 , 2 ) , ( 3 , 2 ) ) ,
( ( 1 , 1 ) , ( 1 , 2 ) , ( 1 , 3 ) , ( 1 , 4 ) ) , // 7
( ( 1 , 1 ) , ( 2 , 1 ) , ( 3 , 1 ) , ( 4 , 1 ) )
);
var
c ,
tot ,
w , h : longint ;
f : array [ 1 .. 16 , 1 .. 16 ] of boolean ;
r ,
num ,
a ,
map : tymap ;
s : array [ 1 .. 1000 ] of tymap ;
use : array [ 1 .. 50 ] of boolean ;
procedure init ;
var
ch : char ;
i , j : longint ;
begin
fillchar ( map , sizeof ( map ) , 0 ) ;
fillchar ( a , sizeof ( a ) , 0 ) ;
fillchar ( num , sizeof ( num ) , 0 ) ;
fillchar ( use , sizeof ( use ) , 0 ) ;
for i := 1 to h do begin
for j := 1 to w do begin
read ( ch ) ;
case ch of
'.' : map [ i , j ] := 2 ;
'x' : map [ i , j ] := 1 ;
'o' : map [ i , j ] := 0 ;
end ;
end ;
readln ;
end ;
tot := 0 ;
end ;
function equal ( n1 , n2 : longint ) : boolean ;
var
i , j : longint ;
begin
equal := false;
for i := 1 to h do
for j := 1 to w do
if s [ n1 ] [ i ] [ j ] <> s [ n2 ] [ i ] [ j ] then exit ;
equal := true ;
end ;
procedure save ;
var
i : longint ;
begin
inc ( tot ) ;
s [ tot ] := a ;
for i := 1 to tot - 1 do
if equal ( i , tot ) then
begin
dec ( tot ) ;
exit ;
end ;
end ;
function over : boolean ;
var
i , j : longint ;
begin
over := false ;
for i := 1 to h do
for j := 1 to w do
if ( a [ i ] [ j ] = 0 ) and ( map [ i ] [ j ] = 1 ) then exit ;
over := true ;
end ;
procedure get ( ship , rank : longint ) ;
var
i , j : longint ;
function ok : boolean ;
var
xx , yy ,
p : longint ;
begin
ok := false ;
for p := 1 to 4 do begin
xx := i + b [ pos [ ship ] [ rank ] ] [ p ] [ 1 ] - 1 ;
yy := j + b [ pos [ ship ] [ rank ] ] [ p ] [ 2 ] - 1 ;
if ( xx > h ) or ( yy > w ) or ( a [ xx ] [ yy ] > 0 ) or ( map [ xx , yy ] = 0 ) then exit ;
end ;
ok := true ;
end ;
procedure putinto ;
var
p : longint ;
begin
for p := 1 to 4 do begin
a [ i + b [ pos [ ship ] [ rank ] ] [ p ] [ 1 ] - 1 ] [ j + b [ pos [ ship ] [ rank ] ] [ p ] [ 2 ] - 1 ] := 1 ;
end ;
end ;
procedure takeout ;
var
p : longint ;
begin
for p := 1 to 4 do begin
a [ i + b [ pos [ ship ] [ rank ] ] [ p ] [ 1 ] - 1 ] [ j + b [ pos [ ship ] [ rank ] ] [ p ] [ 2 ] - 1 ] := 0 ;
end ;
end ;
begin
if ship > 7 then begin
if over then begin
save ;
end ;
exit ;
end ;
if pos [ ship ] [ rank ] = 0 then begin
exit ;
end ;
for i := 1 to h do
for j := 1 to w do
if ok then begin
putinto ;
get ( ship + 1 , 1 ) ;
takeout ;
if tot >= 33 then exit ;
end ;
get ( ship , rank + 1 ) ;
end ;
procedure count ;
var
i , j , k : longint ;
begin
fillchar ( num , sizeof ( num ) , 0 ) ;
for k := 1 to tot do
if not use [ k ] then begin
for i := 1 to h do
for j := 1 to w do
if map [ i , j ] = 2 then
if s [ k ] [ i ] [ j ] = 0 then begin
inc ( num [ i , j ] ) ;
r [ i , j ] := k ;
end ;
end ;
end ;
function canguess : boolean ;
var
find : boolean ;
n ,
i , j : longint ;
begin
n := tot ;
find := true ;
fillchar ( f , sizeof ( f ) , 0 ) ;
while find do
begin
if n = 1 then break ;
count ;
find := false ;
for i := 1 to h do begin
for j := 1 to w do
if ( not f [ i , j ] ) and ( num [ i , j ] = 1 ) and ( not use [ r [ i , j ] ] ) then begin
find := true ;
use [ r [ i ] [ j ] ] := true ;
f [ i , j ] := true ;
dec ( n ) ;
break ;
end ;
if find then break ;
end ;
end ;
if n = 1 then canguess := true
else canguess := false ;
end ;
begin
c := 0 ;
readln ( h , w ) ;
while h + w <> 0 do begin
init ;
inc ( c ) ;
get ( 1 , 1 ) ;
writeln ( 'Game #' , c ) ;
if tot >= 33 then writeln ( 'no.' )
else
if canguess then writeln ( 'yes.' )
else writeln ( 'no.' ) ;
readln ;
readln ( h , w ) ;
writeln ;
end ;
end.