Haskellerが勘違いして『Scheme初心者へのアドバイス』を書いてみた

Scheme初心者へのアドバイスを書いてみる - ヤドカリデンキ商会（第一倉庫）にインスパイアされて書いてみた．
ネタだからね真に受けないでね．
お題はServer error

トップダウンに考える

部品からいきなり作ってはいけません．その部品にひきずられてしまいます．トップダウンに考えます．
トップレベルの駆動手続 run を考えましょう．run は情報をもらって，結果を出力というのでよいでしょう．入力情報は対戦回数，結果は対戦結果の集計になるかな．

(define (run n)
  'undefined)

とりあえずインタフェースはこれでよし．で，n 回で対戦 game を繰り返すから，くりかえし回数，対戦結果の集計の初期値，そして対戦手続があればよさそう．

(define (run n)
  (iter/count game '(0 0 0) n)))

(define (iter/count f a c)
  'undefined)

(define (game a c)
  'undefined)

繰り返しのための高階手続 iter/count

まず繰り返し iter/count の引数は，

f : 直前まで集計結果と回数カウントをもらって1回分を集計結果に蓄積する手続
a : 集計初期値
c : 残りの繰り返し回数

の3つ．もし，

残りの繰り返し回数が0なら，直前までの集計結果をそのまま返す．
そうでなければ，(f a c)の結果によって，集計結果を更新し，残り回数を減らして繰り返す．

(define (iter/count f a c)
  (if (= c 0)
      a
      (iter/count f (f a c) (- c 1))))

これは汎用的で十分再利用性があると思います．

対戦 game

対戦は手のリストで表現，ランダムに置く対戦は，*moves* すなわち '(0 1 2 3 4 5 6 7 8) の置換で表現できそう．というわけで対戦の勝敗を判断 judge する手続があれば以下のように書けます．

(define (game a _)
  (match a
    ((w l d) 
     (match (judge (shuffle *moves*))
       ('Win  (list (+ w 1) l d))
       ('Lose (list w (+ l 1) d))
       (_     (list w l (+ d 1)))))))

game は実質1引数ですが，iter/count で使うので2引数にしてある．shuffle を使うには (use gauche.sequence)を指定します．アドバイザはHaskellerだからパターンマッチを多用する(^o^)．(use util.match) を指定しよう．

手の番号は 3×3 のマスめの上の行左のマスめから 0，1，2，... のように付番してあるものと仮定しておこう．直線にならぶパターンは'(0 1 2)，'(3 4 5) など全部で8種類ある．直線にならぶパターン *win-patterns* はわかっているものとして，判定を行う手続を定義しよう．

(define (judge ms)
  (define (iter p q w l vvs)
    'undefined)
  (iter *win-patterns* *win-patterns* 'Win 'Lose ms))

直線になるパターンから置いたところを削除していく，先にパターンのどれかが空になった方が勝ち．2人の間で手が交互になることを引数の入れ替りで表現します．

(define (judge ms)
  (define (iter p q w l vvs)
    (match vvs
      (() 'Draw)
      ((v . vs) (let1 p- (map (cut delete v <>) p)
                  (if (any null? p-)
		      w
		      (iter q p- l w vs))))))
  (iter *win-patterns* *win-patterns* 'Win 'Lose ms))

あとは *moves* と *win-patterns* を定義すればよい．この程度ならハードコーディンで十分．（とかいって手抜きの言い訳）

(define *moves* '(0 1 2 3 4 5 6 7 8))
(define *win-patterns* 
  '((0 1 2) (3 4 5) (6 7 8)
    (0 3 6) (1 4 7) (2 5 8)
    (0 4 8) (2 4 6)))

全体のコード

結果表示は手抜きです．また，REPL内で run を走らせたときいつでも同じ乱数源だと結果に変化がない（これはこれで良い性質ではある）と実験には適さない．そこで run の実行ごとに乱数源を乱すようにしてある．

(use srfi-1)
(use srfi-27)
(use gauche.sequence)
(use util.match)

(define (run n)
  (random-source-randomize! default-random-source)
  (iter/count game '(0 0 0) n))

(define (iter/count f a c)
  (if (= c 0)
      a
      (iter/count f (f a c) (- c 1))))

(define (game a _)
  (match a
    ((w l d) 
     (match (judge (shuffle *moves*))
       ('Win  (list (+ w 1) l d))
       ('Lose (list w (+ l 1) d))
       (_     (list w l (+ d 1)))))))

(define (judge ms)
  (define (iter p q w l vvs)
    (match vvs
      (() 'Draw)
      ((v . vs) (let1 p- (map (cut delete v <>) p)
                  (if (any null? p-)
		      w
		      (iter q p- l w vs))))))
  (iter *win-patterns* *win-patterns* 'Win 'Lose ms))

(define *moves* '(0 1 2 3 4 5 6 7 8))
(define *win-patterns*
  '((0 1 2) (3 4 5) (6 7 8)
    (0 3 6) (1 4 7) (2 5 8)
    (0 4 8) (2 4 6)))