読者です 読者をやめる 読者になる 読者になる

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

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)))