マルバツゲーム in Scheme DouKaku?

マルバツゲームは３×３の格子に交互に○と×を書き込み、先に縦・横・斜めに記号をそろえたほうが勝ちというおなじみのゲームです。

「毎ターン乱数を使って手を決めるランダムプレイヤー同士を対戦させる」というのが今回のお題です。１万回対戦させ、勝ち・負け・引き分けの数を表示してください。そして先手が有利であることを確かめてください。

良い手を思考するプレイヤーについては別のお題にしようと思っています。プレイヤーを簡単に差し換えることができる設計を目指してください。

ちょっと力業でしょうか。

(use srfi-1)
(use srfi-27)
(use util.list)

(random-source-randomize! default-random-source)

;; board: (0 1 0 0 0 0 0 0 0)
;; board -> board
(define (player-random board self)
  (define (okeru)
    (length (filter zero? board)))

  (let loop ((board board)
         (next  (random-integer (okeru))))
    (if (null? board)
    ()
    (cons (if (= next 0)
          self
          (car board))
          (loop (cdr board)
            (if (= (car board) 0)
            (- next 1)
            next
            ))))))

(define (play p1 p2)
  (define (finish? board)
    (or (> (judge board) 0)
    (not (find zero? board))))

  (let loop ((board (make-list 9 0))
         (phase 1))
    (if (finish? board)
    board
    (if (= phase 1)
        (loop (p1 board 1) 2)
        (loop (p2 board 2) 1)))))

(define (judge board)
  (define line-points-list
    '((0 1 2)
      (3 4 5)
      (6 7 8)
      (0 3 6)
      (1 4 7)
      (2 5 8)
      (0 4 8)
      (2 4 6)))

  (define (judge-4-player n)
    (find (lambda (line-points)
        (every (lambda (j)
             (= (ref board j) n))
           line-points))
      line-points-list))

  (cond ((judge-4-player 1) 1)
    ((judge-4-player 2) 2)
    (else 0)))

(define (marubatsu p1 p2)
  (define (one-play)
    (judge (play p1 p2)))

  (define hash (make-hash-table))
  (dotimes (counter 10000)
    (hash-table-update! hash (one-play) (cut + 1 <>) 0))

  (write (hash-table->alist hash)))

・状態遷移を相互再帰で書く
・Gaucheで最近になって文書化されたshuffleを使う
・盤面のベクタを副作用で上書きするのが普通だけど、副作用が嫌なので棋譜のリストを持ってみました。

結果
 player1 won: 5787
 player2 won: 2909
 draw: 1304

(use srfi-1)
(use gauche.sequence)

(define (win? l)
  (any (cut lset<= = <> l)
       '((0 1 2) (3 4 5) (6 7 8) (0 3 6) (1 4 7) (2 5 8) (0 4 8) (2 4 6))))

(let new-game ((win 0)
               (lose 0)
               (draw 0))
  (if (<= 10000 (+ win lose draw))
    (format #t " player1 won: ~a\n player2 won: ~a\n draw: ~a\n" win lose draw)
    (letrec ((p1-turn (lambda (p1 p2)
                        (if (win? p2)
                          (new-game win (+ 1 lose) draw)
                          (let ((vacant (lset-difference = '(0 1 2 3 4 5 6 7 8) (append p1 p2))))
                            (if (null? vacant)
                              (new-game win lose (+ 1 draw))
                              (p2-turn (cons (car (shuffle vacant)) p1) p2))))))
             (p2-turn (lambda (p1 p2)
                        (if (win? p1)
                          (new-game (+ 1 win) lose draw)
                          (let ((vacant (lset-difference = '(0 1 2 3 4 5 6 7 8) (append p1 p2))))
                            (if (null? vacant)
                              (new-game win lose (+ 1 draw))
                              (p1-turn p1 (cons (car (shuffle vacant)) p2))))))))
      (p1-turn '() '()))))

オマケです。せっかく書いたので。問題の趣旨にあってないし、ゴルフとしても中途半端です。
結果
player1 won: 5907
player2 won: 2872
draw: 1221

(use srfi-1)
(use gauche.sequence)

(define (win? l)
  (any (cut lset<= = <> l)
       '((0 1 2) (3 4 5) (6 7 8) (0 3 6) (1 4 7) (2 5 8) (0 4 8) (2 4 6))))

(let omake ((win 0)
            (lose 0)
            (draw 0))
  (if (<= 10000 (+ win lose draw))
    (format #t " player1 won: ~a\n player2 won: ~a\n draw: ~a\n" win lose draw)
    (receive (p1 p2) (split-at (shuffle '(0 1 2 3 4 5 6 7 8)) 5)
      (or (and-let* ((i (list-index win? (list (cddr p1) (cdr p2) (cdr p1) p2 p1))))
            (if (even? i)
              (omake (+ 1 win) lose draw)
              (omake win (+ 1 lose) draw)))
          (omake win lose (+ 1 draw))))))

DouKaku?

マルバツゲーム

Posted feedbacks - Scheme

Index

Feed

Other

Link

Pathtraq