Scheme初心者へのアドバイスを書いてみる

id:tsuyoshikawaさんが初めてSchemeのコードを書いた（ここにあるコード）と聞いて「初めてでここまで書けるのはすげー」と思いました。ということで、このコードについて私ができる範囲でアドバイスしてみます。私自身はSchemeプログラマのレベル10でレベル3〜4程度のへっぽこSchemerなのですが。

閉じカッコの位置について

コーディング・スタイルは典型的な「自転車置き場の議論」なのでそれほど気にする必要はないと思いますが、一応、触れておきます。

tsuyoshikawaさんは

(define (size-of lis)
  (if (null? lis)
      0
      (+ 1 (size-of (cdr lis)))
      )
  )

のように書いているのですが、実際には

(define (size-of lis)
  (if (null? lis)
      0
      (+ 1 (size-of (cdr lis)))))

のように閉じカッコは最後にまとめて書くことが多いです。Lisperのコードブロックの認識は、実はPythonistaに近いんじゃないかなと思っています。Schemeのコーディングスタイルについてはここを参考に。

標準関数について

tsuyoshikawaさんが自作している関数は、実際には標準で用意されているものが多かったりします。練習の意味で自作しているのだと思うのですが、同様の関数が用意されているかどうかを調べてみました。

【R5RSで規定されている関数】
R5RSはSchemeの言語仕様です。最新の仕様はR6RSですが、まだ対応しているものはそれほど多くないようなので、とりあえずSchemeの標準が知りたかったらR5RSに当たるのがよいと思います。

• リストにある要素が含まれるか：memberもしくはmemq
• リストのサイズを測る：length
• n番目の要素を取り出す：list-ref
• リストにリストを付け加える：append
• 2番目の要素を取り出す：cadr

といったものはR5RSに準拠した処理系では標準で利用できます。

【SRFI-1で規定されている関数】
Schemeには、言語仕様と切り離された形でSRFIというライブラリ仕様群があります。その一つであるSRFI-1にはリスト操作関連の関数がまとめられています。SRFI-1の中に「二つのリストの積集合を返す」機能を持つ「lset-intersection」という関数がありました。ただ、この関数を試しに使ってみたところ、速度的なペナルティがかなりありました。今回の例では、自作する方がいいみたいです。このあたりの判断は難しいなと思いました。

末尾再帰について

先ほどの

(define (size-of lis)
  (if (null? lis)
      0
      (+ 1 (size-of (cdr lis)))))

なのですが、Schemerならたいてい

(define (size-of lis)
  (define (size-of-iter a count)
    (if (null? a)
      count
      (size-of-iter (cdr a) (+ 1 count))))
  (size-of-iter lis 0))

のように本能的に書き換えます（このコード自体はSICP日本語版の23ページにそのまま載っています）。このように再帰する部分が関数の呼び出しそのものになっている形を末尾再帰といいます。Schemeの言語仕様では、処理系は末尾再帰をgotoと等価になるよう最適化しなければならないと定められています。つまり、末尾再帰の形にするとスタック消費や速度の面で有利なので、Schemeの再帰では末尾再帰を多用します。

ifのネストについて

(define (flatten lis)
  (if (null? lis)
      '()
      (if (pair? lis)
          (my-append (flatten (car lis)) (flatten (cdr lis)))
          (list lis)
          )
      )
  )

は自分なら

(define (flatten lst)
  (cond ((null? lst) '())
        ((symbol? lst) (list lst))
        (else (append (flatten (car lst)) (flatten (cdr lst))))))

と書くかな、と思いました。ifのネストが必要な場合ももちろんありますが、条件が並列に存在する場合はcondをよく使います。こんな風に書くと、(null? lst)がcdrで潜っていったときの終了条件で、(symbol? lst)がcarで潜っていったときの終了条件だということが一目でわかると思います。

ちなみに条件が一つだけの場合でもcondを使う人もいます。Schemeで複数の処理を順番に行うには普通はbeginを使いますが、condのelse節の中ではbeginを使わなくても複数の処理を記述できるためです。

（ここからは余談）

先ほど「再帰はなるべく末尾再帰にする」と書いたのですが、このflattenのような形の再帰は一時変数を導入するだけでは末尾再帰にはできません。末尾再帰にしたければ「継続渡しスタイル（CPS）」を使います。

(define (flatten lst) 
  (define (flatten/cps lst cont)
    (cond ((null? lst) (cont '()))
          ((symbol? lst) (cont (list lst)))
          (else
           (flatten/cps
            (car lst)
            (lambda (f)
              (flatten/cps
               (cdr lst)
               (lambda (r) (cont (append f r)))))))))
  (flatten/cps lst values))

lambdaを使って継続を明示的に自作して再帰の際に渡しています。これにより末尾再帰を実現できています。ただし、この場合はこのように無理矢理末尾再帰にしてもあまりうれしくありません。継続が大量にできてしまうので、結局、末尾再帰にしない場合と同じようにスタックを消費してしまいます スタックは消費しませんがlambdaの分、リソースを消費してしまいます。このあたりに興味があればなんでも継続を読むとおもしろいと思います。

ということでコード全体をオレオレリファクタリング

グローバルの即値をなるべく排除するよう整理してみました。基本的なロジックは変えてないです

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

;;乱数の初期化
(random-source-randomize! default-random-source)

;;二つのリストの積集合を返す
(define (intersection lst1 lst2)
  (define (iter lst1 lst2 result)
    (if (null? lst1) result
        (if (memq (car lst1) lst2)
            (iter (cdr lst1) lst2 (cons (car lst1) result))
            (iter (cdr lst1) lst2 result))))
  (iter lst1 lst2 '()))

;;ボードの生成
(define (make-board n)
  (iota (* n n) 1))

;;勝利パターンの生成
(define (make-win-patterns n)
  (define (verticalize m)
    (if (null? (car m)) '()
        (cons (map car m) (verticalize (map cdr m)))))
  (let ((horizontal-patterns (slices (make-board n) n)))
    (cons (iota n 1 (+ n 1))
          (cons (iota n n (- n 1))
                (append horizontal-patterns
                        (verticalize horizontal-patterns))))))

;;プレーヤのコンストラクタ
(define (make-player name)
  (cons name '()))

;;プレーヤのセレクタ
(define (name player)
  (car player))

(define (pieces player)
  (cdr player))

;;勝利判定
(define (win? pieces n win-patterns)
  (if (null? win-patterns) #f
      (if (eq? n
               (length (intersection pieces (car win-patterns))))
          #t
          (win? pieces n (cdr win-patterns)))))

;;盤から一つ番号を選ぶ
(define (choice player board)
  (let ((rnd (random-integer (length board))))
    (values
     (cons (name player) (cons (list-ref board rnd) (pieces player)))
     (append (take board rnd) (cdr (drop board rnd))))))
 
;;決着するまで回数を重ねる
(define (fight name1 name2 n)
  (define (loop player-a player-b board win-patterns)
    (if (null? board)
        (cond [(win? (pieces player-a) n win-patterns) (name player-a)]
              [(win? (pieces player-b) n win-patterns) (name player-b)]
              [else 'draw])
        (receive (pl bo) (choice player-a board)
          (if (win? (pieces pl) n win-patterns)
              (name player-a)
              (loop player-b pl bo win-patterns)))))
  (loop (make-player name1)
        (make-player name2)
        (make-board n)
        (make-win-patterns n)))

;;指定回数ゲーム実行
(define (run name1 name2 n max)
  (define (loop c1 c2 cd)
    (if (eq? (+ c1 c2 cd) max)
        (print name1 ":" c1 " " name2 ":" c2 " draw:" cd)
        (let ((result (fight name1 name2 n)))
          (cond ((eq? result name1) (loop (+ c1 1) c2 cd))
                ((eq? result name2) (loop c1 (+ c2 1) cd))
                (else (loop c1 c2 (+ cd 1)))))))
  (loop 0 0 0))

;;実行
(run 'P1 'P2 3 10000)