駒を動かすということは、駒のマスと空白のマスの置換ということだ。
Egisonのmatch-allのmultisetは、要素の全ての組み合わせ（置換）を考えるから、
これをフィルタリングすれば、駒の動きを表現できるのではないか、と思った。
①先手の空白への駒の流入
各マスが
- 空白のとき
^,xで空白以外を指定する - 近傍駒のとき
普通に動く - 動かない駒のとき
,xで固定する
・駒の動きは、2ヶ所の置換だから、3ヶ所以上の置換は省く。
・盤上に同じ駒があると、同じ駒同士の置換が発生して、同じパターンができてしまうから、
最後にuniqueをかます。bugがあったので考え中
②持駒を打つ
全ての持駒と全ての空白の直積をとって、それらをswapする。
③敵の駒を取る
まず、敵の駒と空白持駒をswapする。
そして①をおこなう。
④後手
boardをreverseして、駒を大文字⇔小文字にする。これで先後が入れ替わった。
あとは①②③をおこなって、再度先後を入れ替える。
これで合法手が出力できるわけだ。
;; (load-file "doubutsu05.egi") ;; ライオン Lion ;; きりん Giraffe ;; ぞう Elephant ;; ひよこ Chick ;; にわとり cHicken (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)))) ;; ① (filter (n-check? board3) (mth 9 board3)) ;; --------------------------------------------------- ;; 持駒を打つ (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 {})))]) {}))) ;; ③ (filter (n-check? (hull 5 board3)) (mth 5 (hull 5 board3))) ;; --------------------------------------------------- ;; 後手 (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}) ))) ;; ④ (map b-reverse (filter (n-check? (b-reverse board3)) (mth 9 (b-reverse board3)))) ;; ⑤ (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)) ) ))))) ;; ⑥ (map b-reverse (filter (n-check? (hull 5 (b-reverse board3))) (mth 5 (hull 5 (b-reverse board3))))) ;; ---------------------------------------------------- (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 {"\n"} bob {"\n"} boc {"\n"} bod {"\n"} boe {"\n"} 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.")})) ;; (io (main-loop board 1))
> (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で解決できました- ひよこの成り
- キャッチの判定
- トライの判定
- 千日手の判定
- 対CPU
