括弧の山と戦ってみた：Ruby で書いたオセロのプログラムを Lisp に書き直す

1.この記事で学べること・学べないこと

　学べること
- 初心者 Lisper が書くちゃっちいコードっていうのはどういうものか分かる。
- 取り敢えずは動くコードをいじって，Lisp の練習台にできる。

　学べないこと
- Lisp の美しいコード技法。
- オセロゲームの優れた設計。

2.書いたもの

othelo.lisp

(defparameter *board-size* 8)
(defparameter *stone-chars* '(none white black))

(defun put-initial-stones (board)
  (let* ((i0 (- (truncate *board-size* 2) 1)) (i1 (+ i0 1)))
    (setf (aref (aref board i0) i0) 'white)
    (setf (aref (aref board i0) i1) 'black)
    (setf (aref (aref board i1) i0) 'black)
    (setf (aref (aref board i1) i1) 'white))
  board)

(defun make-board ()
  (let ((board (make-array *board-size* :initial-element 'none)))
    (loop for i below *board-size*
          do (setf (aref board i) 
                   (make-array *board-size* :initial-element 'none)))
    (put-initial-stones board)))

(defparameter *board* (make-board))

(defun describe-board ()
  (princ "  1 2 3 4 5 6 7 8")
  (fresh-line)
  (loop for x below *board-size*
        do (progn (princ (+ x 1))
                  (princ " ")
                  (loop for y below *board-size*
                        do (progn (case (aref (aref *board* x) y) 
                                    ((none)    (princ #\.)) 
                                    ((white)   (princ #\o)) 
                                    ((black)   (princ #\x)) 
                                    (otherwise (princ #\.)))
                                  (princ " ")))
                  (fresh-line))))

(defun put-stone (players-color x y)
  (let ((u (- x 1)) (v (- y 1)))
    (setf (aref (aref *board* u) v) players-color)
    (reverse-stones players-color u v)))

(defun reverse-stones (color u v)
  (mapc (lambda (dir)
          (mapc (lambda (positions)
                  (let ((_u (car positions)) (_v (car (cdr positions))))
                    (setf (aref (aref *board* _u) _v) color)))
                (reversible-positions color u v dir)))
          '(nw n_ ne e_ se s_ sw w_)))

(defun reversible-positions (players-color u v direction)
  (let ((temp '()) (positions_list '()))
    (catch 'end
        (mapc (lambda (positions)
                (let* ((_u (car positions))
                       (_v (cdr positions))
                       (color (aref (aref *board* _u) _v)))
                  (cond ((eq color 'none) 
                         (throw 'end t))
                        ((not (eq color players-color))
                         (setf temp (cons (list _u _v) temp)))
                        ((eq color players-color)
                         (setf positions_list temp)
                         (throw 'end t)))))
              (generator u v direction)))
    (remove nil positions_list)))

(defun generator (u v direction)
  (labels ((do-nothing (i) i)
           (dec (i) (- i 1))
           (inc (i) (+ i 1))
           (in-board? (i) (and (<= i *board-size*) (< 0 i))))
    (let ((fu #'do-nothing) (fv #'do-nothing) (_u u) (_v v))
      (case direction
        ((nw) (progn (setf fu #'dec) (setf fv #'dec)))
        ((n_) (setf fv #'dec))
        ((ne) (progn (setf fu #'inc) (setf fv #'dec)))
        ((e_) (setf fu #'inc))
        ((se) (progn (setf fu #'inc) (setf fv #'inc)))
        ((s_) (setf fv #'inc))
        ((sw) (progn (setf fu #'dec) (setf fv #'inc)))
        ((w_) (setf fu #'dec)))
      (loop while (and (in-board? _u) (in-board? _v))
            collect (progn (setf _u (funcall fu _u))
                           (setf _v (funcall fv _v))
                           (cons _u _v))))))

[1]> (load "othelo.lisp")
;; Loading file othelo.lisp ...
;; Loaded file othelo.lisp
T
[2]> (describe-board)
  1 2 3 4 5 6 7 8
1 . . . . . . . . 
2 . . . . . . . . 
3 . . . . . . . . 
4 . . . o x . . . 
5 . . . x o . . . 
6 . . . . . . . . 
7 . . . . . . . . 
8 . . . . . . . . 
NIL
[3]> (put-stone 'black 6 5)

NIL 
NIL 
NIL 
NIL 
NIL 
NIL 
NIL 
((4 4)) 
(NW N_ NE E_ SE S_ SW W_)
[4]> (describe-board)
  1 2 3 4 5 6 7 8
1 . . . . . . . . 
2 . . . . . . . . 
3 . . . . . . . . 
4 . . . o x . . . 
5 . . . x x . . . 
6 . . . . x . . . 
7 . . . . . . . . 
8 . . . . . . . . 
NIL
[5]> (put-stone 'white 6 6)

((4 4)) 
NIL 
NIL 
NIL 
NIL 
NIL 
NIL 
NIL 
(NW N_ NE E_ SE S_ SW W_)
[6]> (describe-board)
  1 2 3 4 5 6 7 8
1 . . . . . . . . 
2 . . . . . . . . 
3 . . . . . . . . 
4 . . . o x . . . 
5 . . . x o . . . 
6 . . . . x o . . 
7 . . . . . . . . 
8 . . . . . . . . 
NIL

　とあるサイトでオセロのプログラムの問題があったんだけど...の記事で書いたコードをそのまま Lisp に置き換えてみた。

　いや，もう... ものすごく疲れた。

　Lisp なんて勉強し始めたばかりだし，わからないことだらけだったから。

3.つまづいたところ・気づいたところ

　初心者 Lisper として，つまづいてしまったところ・気づいたところをまとめておく。
　後々役に立つかもしれない。

3.1.Lisp のリストについて

index (4) for #(NONE NONE NONE BLACK WHITE NONE NONE NONE) is not of type `(INTEGER 0 (,ARRAY-DIMENSION-LIMIT))

　というエラーにものすごく悩まされた。これ，どういうことかというと，

[1]> (+ (car '(1 2)) (cdr '(1 2)))

*** - +: (2) is not a number
The following restarts are available:
USE-VALUE      :R1      Input a value to be used instead.
ABORT          :R2      Abort main loop

　clisp で実行してみたのだが，これが失敗するのと同じことだった。
　Lisp をちょっと勉強した方ならお分かりの通り，リストはコンスセルから成る。
　だから，(cons 1 cons 2 nil)) と '(1 2) は，同じものを表している。

　つまり，このリストは2つのコンスセルから成り，3つの要素から成るということ。

　これをすっかり忘れてしまっていたので，(cdr '(1 2)) が 2 を返すのだと思い込んでしまった。実際には，(2) すなわち (cons 2 nil) を返すのにもかかわらずだ。これに気づくのに本当に長い時間がかかった。

3.2.Lisp の表現力

　かなりエラーを出しまくりながらの作業にはなったが，もとのRubyコードとは多分それほど変わらない理屈で動いていると思う。Rubyでやれることは大体，Lispでもできるみたい。オブジェクト指向についてもLispではサポートしているらしいのだけど，まだそこまで勉強できていない。何かいい記事がないものだろうか...