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.