駒を動かすということは、駒のマスと空白のマスの置換ということだ。

Egisonのmatch-allのmultisetは、要素の全ての組み合わせ（置換）を考えるから、

これをフィルタリングすれば、駒の動きを表現できるのではないか、と思った。

①先手の空白への駒の流入

各マスが

空白のとき ^,xで空白以外を指定する

近傍駒のとき 普通に動く

動かない駒のとき ,xで固定する

・駒の動きは、2ヶ所の置換だから、3ヶ所以上の置換は省く。

・盤上に同じ駒があると、同じ駒同士の置換が発生して、同じパターンができてしまうから、

最後にuniqueをかます。 bugがあったので考え中

②持駒を打つ

全ての持駒と全ての空白の直積をとって、それらをswapする。

③敵の駒を取る

まず、敵の駒と空白持駒をswapする。

そして①をおこなう。

④後手

boardをreverseして、駒を大文字⇔小文字にする。これで先後が入れ替わった。

あとは①②③をおこなって、再度先後を入れ替える。

これで合法手が出力できるわけだ。





( define $board { "g" "l" "e" "0" "c" "1" "2" "C" "3" "E" "L" "G" "4" "5" "6" "7" "8" "9" "10" "11" "12" "13" "14" "15" "16" "17" } ) ( define $isnumber? ( lambda $x ( any ( eq ? $ x ) { "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" "11" "12" "13" "14" "15" "16" "17" } ))) ( define $pat-move ( lambda [$p $ks] ( lambda [$p2 $x] ( if ( and ( eq ? p p2 ) ( isnumber? x )) ( pattern-function [$pt1 $pt2] <cons ( & pt1 ^,x ) pt2> ) ( if ( any ( eq ? $ x ) ks_p ) ( pattern-function [$pt1 $pt2] <cons pt1 pt2> ) ( pattern-function [$pt1 $pt2] <cons ( & pt1 ,x ) pt2> ) ))))) ( define $move1 {| [1 {}] [2 { "L" "G" "H" }] [3 {}] [4 { "L" "G" "H" }] [5 { "L" "E" }] [6 {}] [7 {}] [8 {}] [9 {}] [10 {}] [11 {}] [12 {}] |} ) ( define $move2 {| [1 { "L" "G" "H" }] [2 {}] [3 { "L" "G" "H" }] [4 { "L" "E" }] [5 { "L" "G" "H" }] [6 { "L" "E" }] [7 {}] [8 {}] [9 {}] [10 {}] [11 {}] [12 {}] |} ) ( define $move3 {| [1 {}] [2 { "L" "G" "H" }] [3 {}] [4 {}] [5 { "L" "E" }] [6 { "E" "G" "H" }] [7 {}] [8 {}] [9 {}] [10 {}] [11 {}] [12 {}] |} ) ( define $move4 {| [1 { "L" "G" "C" "H" }] [2 { "L" "E" }] [3 {}] [4 {}] [5 { "L" "G" "H" }] [6 {}] [7 { "L" "G" "H" }] [8 { "L" "E" }] [9 {}] [10 {}] [11 {}] [12 {}] |} ) ( define $move5 {| [1 { "L" "E" "H" }] [2 { "L" "G" "C" "H" }] [3 { "L" "E" "H" }] [4 { "L" "G" "H" }] [5 {}] [6 { "L" "G" "H" }] [7 { "L" "E" }] [8 { "L" "G" "H" }] [9 { "L" "E" }] [10 {}] [11 {}] [12 {}] |} ) ( define $move6 {| [1 {}] [2 { "L" "E" }] [3 { "L" "G" "C" "H" }] [4 {}] [5 { "L" "G" "H" }] [6 {}] [7 {}] [8 { "L" "E" }] [9 { "L" "G" "H" }] [10 {}] [11 {}] [12 {}] |} ) ( define $move7 {| [1 {}] [2 {}] [3 {}] [4 { "L" "G" "C" "H" }] [5 { "L" "E" }] [6 {}] [7 {}] [8 { "L" "G" "H" }] [9 {}] [10 { "L" "G" "H" }] [11 { "L" "E" }] [12 {}] |} ) ( define $move8 {| [1 {}] [2 {}] [3 {}] [4 { "L" "E" "H" }] [5 { "L" "G" "C" "H" }] [6 { "L" "E" }] [7 { "L" "G" "H" }] [8 {}] [9 { "L" "G" "H" }] [10 { "L" "E" }] [11 { "L" "G" "H" }] [12 { "L" "E" }] |} ) ( define $move9 {| [1 {}] [2 {}] [3 {}] [4 {}] [5 { "L" "E" }] [6 { "L" "G" "C" "H" }] [7 {}] [8 { "L" "G" "H" }] [9 {}] [10 {}] [11 { "L" "E" }] [12 { "L" "G" "H" }] |} ) ( define $move10 {| [1 {}] [2 {}] [3 {}] [4 {}] [5 {}] [6 {}] [7 { "L" "G" "C" "H" }] [8 { "L" "E" "H" }] [9 {}] [10 {}] [11 { "L" "E" "H" }] [12 {}] |} ) ( define $move11 {| [1 {}] [2 {}] [3 {}] [4 {}] [5 {}] [6 {}] [7 { "L" "G" "H" }] [8 { "L" "G" "C" "H" }] [9 { "L" "E" "H" }] [10 { "L" "G" "H" }] [11 {}] [12 { "L" "G" "H" }] |} ) ( define $move12 {| [1 {}] [2 {}] [3 {}] [4 {}] [5 {}] [6 {}] [7 {}] [8 { "L" "E" "H" }] [9 { "L" "G" "C" "H" }] [10 {}] [11 { "L" "G" "H" }] [12 {}] |} ) ( define $mth ( lambda [$p $board] ( let {[$k1 ( nth 1 board ) ] [$k2 ( nth 2 board ) ] [$k3 ( nth 3 board ) ] [$k4 ( nth 4 board ) ] [$k5 ( nth 5 board ) ] [$k6 ( nth 6 board ) ] [$k7 ( nth 7 board ) ] [$k8 ( nth 8 board ) ] [$k9 ( nth 9 board ) ] [$k10 ( nth 10 board ) ] [$k11 ( nth 11 board ) ] [$k12 ( nth 12 board ) ] [$g1 ( nth 13 board ) ] [$g2 ( nth 14 board ) ] [$g3 ( nth 15 board ) ] [$g4 ( nth 16 board ) ] [$g5 ( nth 17 board ) ] [$g6 ( nth 18 board ) ] [$g7 ( nth 19 board ) ] [$s1 ( nth 20 board ) ] [$s2 ( nth 21 board ) ] [$s3 ( nth 22 board ) ] [$s4 ( nth 23 board ) ] [$s5 ( nth 24 board ) ] [$s6 ( nth 25 board ) ] [$s7 ( nth 26 board ) ] [$pat-1 ( pat-move p move1 ) ] [$pat-2 ( pat-move p move2 ) ] [$pat-3 ( pat-move p move3 ) ] [$pat-4 ( pat-move p move4 ) ] [$pat-5 ( pat-move p move5 ) ] [$pat-6 ( pat-move p move6 ) ] [$pat-7 ( pat-move p move7 ) ] [$pat-8 ( pat-move p move8 ) ] [$pat-9 ( pat-move p move9 ) ] [$pat-10 ( pat-move p move10 ) ] [$pat-11 ( pat-move p move11 ) ] [$pat-12 ( pat-move p move12 ) ] } ( if ( and ( not ( empty? board )) ( isnumber? ( nth p board ))) ( match-all ( take 12 board ) ( multiset string ) [ (( pat-1 1 k1 ) $x1 (( pat-2 2 k2 ) $x2 (( pat-3 3 k3 ) $x3 (( pat-4 4 k4 ) $x4 (( pat-5 5 k5 ) $x5 (( pat-6 6 k6 ) $x6 (( pat-7 7 k7 ) $x7 (( pat-8 8 k8 ) $x8 (( pat-9 9 k9 ) $x9 (( pat-10 10 k10 ) $x10 (( pat-11 11 k11 ) $x11 (( pat-12 12 k12 ) $x12 <nil> ) ))))))))))) {x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 g1 g2 g3 g4 g5 g6 g7 s1 s2 s3 s4 s5 s6 s7}] ) {} )))) ( define $n-check ' ? ( lambda [$xs $ys $cnt] ( if ( and ( empty? xs ) ( lte? 3 cnt )) #f ( if ( empty? xs ) #t ( if ( eq ? ( car xs ) ( car ys )) ( n-check ' ? ( cdr xs ) ( cdr ys ) cnt ) ( n-check ' ? ( cdr xs ) ( cdr ys ) ( + 1 cnt ))))))) ( define $n-check? ( lambda $board ( lambda $ys ( n-check ' ? board ys 0 )))) ( define $up ( lambda $s ( if ( isnumber? s ) s ( match s string {[, "l" "L" ] [, "g" "G" ] [, "e" "E" ] [, "c" "C" ] [, "h" "C" ]} )))) ( define $swap ( lambda $xs ( lambda [$i $j] ( let {[$f ( lambda [$idx $x] ( match idx integer {[,i ( nth j xs ) ] [,j ( up ( nth i xs )) ] [_ x]} )) ]} ( map f ( zip nats xs )))))) ( define $direct-product ( lambda [$xs $ys] ( concat ( match-all xs ( list integer ) [<join _ <cons $x _>> ( match-all ys ( list integer ) [<join _ <cons $y _>> [x y]] ) ] )))) ( define $search-number ( lambda [$xs $cnt $out] ( if ( empty? xs ) ( reverse out ) ( if ( isnumber? ( car xs )) ( search-number ( cdr xs ) ( + 1 cnt ) ( cons cnt out )) ( search-number ( cdr xs ) ( + 1 cnt ) out ))))) ( define $xx ( lambda $board ( search-number ( take 12 board ) 1 {} ))) ( define $search-piece ( lambda [$xs $cnt $out] ( difference ( between 1 ( length xs )) ( search-number xs cnt out )))) ( define $yy ( lambda $board ( search-piece ( drop 19 board ) 1 {} ))) ( define $hit ( lambda $board ( if ( empty? ( yy board )) {} ( map (( swap board ) $ ) ( direct-product ( xx board ) ( map ( + $ 19 ) ( yy board ))))))) ( define $isenemy? ( lambda $x ( any ( eq ? $ x ) { "l" "e" "g" "c" "h" } ))) ( define $hull ( lambda [$p $board] ( if ( isenemy? ( nth p board )) (( swap board ) [p ( + 19 ( car ( search-number ( drop 19 board ) 1 {} ))) ] ) {} ))) ( define $up-low ( lambda $s ( if ( isnumber? s ) s ( match s string {[, "l" "L" ] [, "g" "G" ] [, "e" "E" ] [, "c" "C" ] [, "h" "H" ] [, "L" "l" ] [, "G" "g" ] [, "E" "e" ] [, "C" "c" ] [, "H" "h" ]} )))) ( define $b-reverse ( lambda $board ( let {[$boa ( reverse ( map up-low ( take 12 board ))) ] [$bob ( map up-low ( take 7 ( drop 12 board ))) ] [$boc ( map up-low ( drop 19 board )) ]} ( foldl append {} {boa boc bob} ) ))) ( define $xxx ( lambda $board ( search-number ( take 12 ( b-reverse board )) 1 {} ))) ( define $yyy ( lambda $board ( search-piece ( drop 19 ( b-reverse board )) 1 {} ))) ( define $hitgo ( lambda $board ( if ( empty? ( yyy board )) {} ( map b-reverse ( map (( swap ( b-reverse board )) $ ) ( direct-product ( xxx board ) ( map ( + $ 19 ) ( yyy board )) ) ))))) ( define $sb ( lambda [$board $sengo $x] ( if ( eq ? 1 sengo ) ( unique/m string ( filter ( n-check? board ) ( mth x board ))) ( unique/m string ( map b-reverse ( filter ( n-check? ( b-reverse board )) ( mth x ( b-reverse board )))) )))) ( define $sb2 ( lambda [$board $sengo $x] ( if ( eq ? 1 sengo ) ( unique/m string ( filter ( n-check? ( hull x board )) ( mth x ( hull x board )))) ( unique/m string ( map b-reverse ( filter ( n-check? ( hull x ( b-reverse board ))) ( mth x ( hull x ( b-reverse board ))))) )))) ( define $hit-sengo ( lambda [$board $sengo] ( if ( eq ? 1 sengo ) ( hit board ) ( hitgo board )))) ( define $legal ( lambda [$board $sengo] ( foldl append {} { ( sb board sengo 1 ) ( sb board sengo 2 ) ( sb board sengo 3 ) ( sb board sengo 4 ) ( sb board sengo 5 ) ( sb board sengo 6 ) ( sb board sengo 7 ) ( sb board sengo 8 ) ( sb board sengo 9 ) ( sb board sengo 10 ) ( sb board sengo 11 ) ( sb board sengo 12 ) ( sb2 board sengo 1 ) ( sb2 board sengo 2 ) ( sb2 board sengo 3 ) ( sb2 board sengo 4 ) ( sb2 board sengo 5 ) ( sb2 board sengo 6 ) ( sb2 board sengo 7 ) ( sb2 board sengo 8 ) ( sb2 board sengo 9 ) ( sb2 board sengo 10 ) ( sb2 board sengo 11 ) ( sb2 board sengo 12 ) ( hit-sengo board sengo ) } ) )) ( define $molding ( lambda $board ( let {[$boa ( take 3 board ) ] [$bob ( take 3 ( drop 3 board )) ] [$boc ( take 3 ( drop 6 board )) ] [$bod ( take 3 ( drop 9 board )) ] [$boe ( take 7 ( drop 12 board )) ] [$bof ( drop 19 board ) ]} ( S.append "," ( S.intercalate "," ( foldl append {} {boa { "

" } bob { "

" } boc { "

" } bod { "

" } boe { "

" } bof} ))) ))) ( define $main-loop ( lambda [$board $sengo] ( do { ( print ( molding board )) ( print ( if ( eq ? 1 sengo ) "sente" "gote" )) ( let {[$nboards ( legal board sengo ) ]} ( do { ( each print ( map show nboards )) ( write "input num: (0:quit) " ) ( flush ) [$input ( read-line ) ] ( print "" ) ( if ( eq ? "0" input ) end ( main-loop ( nth ( read input ) nboards ) ( - 3 sengo ))) } )) } ))) ( define $end ( do { ( print "end." ) } ))

> ( load-file "doubutsu05.egi" ) > ( io ( main-loop board 1 )) ,g,l,e, , 0 ,c, 1 , , 2 ,C, 3 , ,E,L,G, , 4 , 5 , 6 , 7 , 8 , 9 , 10 , , 11 , 12 , 13 , 14 , 15 , 16 , 17 sente { "g" "l" "e" "0" "c" "1" "L" "C" "3" "E" "2" "G" "4" "5" "6" "7" "8" "9" "10" "11" "12" "13" "14" "15" "16" "17" } { "g" "l" "e" "0" "c" "1" "2" "C" "L" "E" "3" "G" "4" "5" "6" "7" "8" "9" "10" "11" "12" "13" "14" "15" "16" "17" } { "g" "l" "e" "0" "c" "1" "2" "C" "G" "E" "L" "3" "4" "5" "6" "7" "8" "9" "10" "11" "12" "13" "14" "15" "16" "17" } { "g" "l" "e" "0" "C" "1" "2" "11" "3" "E" "L" "G" "4" "5" "6" "7" "8" "9" "10" "C" "12" "13" "14" "15" "16" "17" } input num: ( 0 :quit ) 4 ,g,l,e, , 0 ,C, 1 , , 2 , 11 , 3 , ,E,L,G, , 4 , 5 , 6 , 7 , 8 , 9 , 10 , ,C, 12 , 13 , 14 , 15 , 16 , 17 gote { "g" "1" "e" "0" "C" "l" "2" "11" "3" "E" "L" "G" "4" "5" "6" "7" "8" "9" "10" "C" "12" "13" "14" "15" "16" "17" } { "g" "0" "e" "l" "C" "1" "2" "11" "3" "E" "L" "G" "4" "5" "6" "7" "8" "9" "10" "C" "12" "13" "14" "15" "16" "17" } { "0" "l" "e" "g" "C" "1" "2" "11" "3" "E" "L" "G" "4" "5" "6" "7" "8" "9" "10" "C" "12" "13" "14" "15" "16" "17" } { "g" "l" "4" "0" "e" "1" "2" "11" "3" "E" "L" "G" "c" "5" "6" "7" "8" "9" "10" "C" "12" "13" "14" "15" "16" "17" } { "g" "4" "e" "0" "l" "1" "2" "11" "3" "E" "L" "G" "c" "5" "6" "7" "8" "9" "10" "C" "12" "13" "14" "15" "16" "17" } input num: ( 0 :quit ) 3 , 0 ,l,e, ,g,C, 1 , , 2 , 11 , 3 , ,E,L,G, , 4 , 5 , 6 , 7 , 8 , 9 , 10 , ,C, 12 , 13 , 14 , 15 , 16 , 17 sente { "0" "l" "e" "g" "C" "1" "L" "11" "3" "E" "2" "G" "4" "5" "6" "7" "8" "9" "10" "C" "12" "13" "14" "15" "16" "17" } { "0" "l" "e" "g" "C" "1" "2" "E" "3" "11" "L" "G" "4" "5" "6" "7" "8" "9" "10" "C" "12" "13" "14" "15" "16" "17" } { "0" "l" "e" "g" "C" "1" "2" "L" "3" "E" "11" "G" "4" "5" "6" "7" "8" "9" "10" "C" "12" "13" "14" "15" "16" "17" } { "0" "l" "e" "g" "C" "1" "2" "11" "L" "E" "3" "G" "4" "5" "6" "7" "8" "9" "10" "C" "12" "13" "14" "15" "16" "17" } { "0" "l" "e" "g" "C" "1" "2" "11" "G" "E" "L" "3" "4" "5" "6" "7" "8" "9" "10" "C" "12" "13" "14" "15" "16" "17" } { "0" "C" "e" "g" "12" "1" "2" "11" "3" "E" "L" "G" "4" "5" "6" "7" "8" "9" "10" "C" "L" "13" "14" "15" "16" "17" } { "C" "l" "e" "g" "C" "1" "2" "11" "3" "E" "L" "G" "4" "5" "6" "7" "8" "9" "10" "0" "12" "13" "14" "15" "16" "17" } { "0" "l" "e" "g" "C" "C" "2" "11" "3" "E" "L" "G" "4" "5" "6" "7" "8" "9" "10" "1" "12" "13" "14" "15" "16" "17" } { "0" "l" "e" "g" "C" "1" "C" "11" "3" "E" "L" "G" "4" "5" "6" "7" "8" "9" "10" "2" "12" "13" "14" "15" "16" "17" } { "0" "l" "e" "g" "C" "1" "2" "C" "3" "E" "L" "G" "4" "5" "6" "7" "8" "9" "10" "11" "12" "13" "14" "15" "16" "17" } { "0" "l" "e" "g" "C" "1" "2" "11" "C" "E" "L" "G" "4" "5" "6" "7" "8" "9" "10" "3" "12" "13" "14" "15" "16" "17" } input num: ( 0 :quit ) 6 , 0 ,C,e, ,g, 12 , 1 , , 2 , 11 , 3 , ,E,L,G, , 4 , 5 , 6 , 7 , 8 , 9 , 10 , ,C,L, 13 , 14 , 15 , 16 , 17 gote { "0" "C" "e" "2" "12" "1" "g" "11" "3" "E" "L" "G" "4" "5" "6" "7" "8" "9" "10" "C" "L" "13" "14" "15" "16" "17" } { "0" "C" "e" "12" "g" "1" "2" "11" "3" "E" "L" "G" "4" "5" "6" "7" "8" "9" "10" "C" "L" "13" "14" "15" "16" "17" } { "0" "C" "12" "g" "e" "1" "2" "11" "3" "E" "L" "G" "4" "5" "6" "7" "8" "9" "10" "C" "L" "13" "14" "15" "16" "17" } { "g" "C" "e" "0" "12" "1" "2" "11" "3" "E" "L" "G" "4" "5" "6" "7" "8" "9" "10" "C" "L" "13" "14" "15" "16" "17" } { "0" "e" "4" "g" "12" "1" "2" "11" "3" "E" "L" "G" "c" "5" "6" "7" "8" "9" "10" "C" "L" "13" "14" "15" "16" "17" } input num: ( 0 :quit )



できてない事

同じ候補手を出力してしまう (unique/m stringで解決できました

(unique/m stringで解決できました ひよこの成り

キャッチの判定

トライの判定

千日手の判定

対CPU









