「Ansi Common Lisp」12章練習問題

1. ((A) (A) (A))のように表示される3種類のツリーを描け。さらにおのおののツリーを生成する式を書け。

* (setf a '((A) (A) (A)))
Warning:  Declaring A special.

((A) (A) (A))
* (setf b1 '((A) (A)))
Warning:  Declaring B1 special.

((A) (A))
* (setf b2 '(A))

(A)
* (cons b2 b1)

((A) (A) (A))
* (setf c1 '((A)))
Warning:  Declaring C1 special.

((A))
* (setf c2 '(A))
Warning:  Declaring C2 special.

(A)
* (setf c3 '(A))
Warning:  Declaring C3 special.

(A)
* (cons c3 (cons c2 c1))

((A) (A) (A))
*

部分リストを使えってことかな。

2. make-queue、enqueue、dequeueが図12.7のように定義されているとして、以下の各ステップの後のキューを箱表記で描け。

> (setf q (make-queue))
(NIL)
> (enqueue 'a q)
(A)
> (enqueue 'b q)
(A B)
> (dequeue q)
A

多分こんな感じでしょう。

3. キューのコピーを返すcopy-queueという関数を定義せよ。

(defun make-queue () (cons nil nil))

(defun enqueue (obj q)
  (if (null (car q))
      (setf (cdr q) (setf (car q) (list obj)))
	  (setf (cdr (cdr q)) (list obj)
	        (cdr q) (cdr (cdr q))))
  (car q))

(defun dequeue (q)
  (pop (car q)))

' ----------

(setf q (make-queue))
(enqueue 'a q)
(enqueue 'b q)
(format t "original q = ~A~%" q)

(setf q2 (copy-tree q))

(enqueue 'c q)

(format t "q = ~A~%" q)
(format t "q2 = ~A~%" q2)

っていうか、copy-queueを定義するまでもなく、copy-tree呼べばいいじゃんっていう荒業(?)
結果はこう。

* 
MAKE-QUEUE
* 
ENQUEUE
* 
DEQUEUE
* 
----------
* Warning:  Declaring Q special.

(NIL)
* 
(A)
* 
(A B)
* original q = ((A B) B)
NIL
* Warning:  Declaring Q2 special.

((A B) B)
* 
(A B C)
* q = ((A B C) C)
NIL
* q2 = ((A B) B)
NIL
*

qをコピーして作ったq2は、元のqと同じだし、qを変更してもq2には影響ないことが分かる。

4. オブジェクトとキューを引数として、オブジェクトをキューのリストの第1要素に挿入するような関数を定義せよ。

(defun make-queue () (cons nil nil))

(defun enqueue (obj q)
  (if (null (car q))
      (setf (cdr q) (setf (car q) (list obj)))
	  (setf (cdr (cdr q)) (list obj)
	        (cdr q) (cdr (cdr q))))
  (car q))

(defun dequeue (q)
  (pop (car q)))

(defun enqueue-head (obj q)
  (if (null (car q))
      (enqueue obj q)
	  (setf (car q) (cons obj (car q)))))

' ----------

(setf q (make-queue))
(enqueue-head 'a q)
(enqueue 'b q)
(enqueue-head 'c q)

(format t "q = ~A~%" q)

cdr部は操作する必要はないので、enqueueよりも楽みたいです。
結果はこう。

* Warning:  Declaring Q special.

(NIL)
* 
(A)
* 
(A B)
* 
(C A B)
* q = ((C A B) B)
NIL
*

5. オブジェクトとキューを引数として、オブジェクトと最初にeqlとなる要素をキューのリストの第一要素に(破壊的に)移動する関数を定義せよ。

(defun make-queue () (cons nil nil))

(defun enqueue (obj q)
  (if (null (car q))
      (setf (cdr q) (setf (car q) (list obj)))
	  (setf (cdr (cdr q)) (list obj)
	        (cdr q) (cdr (cdr q))))
  (car q))

(defun dequeue (q)
  (pop (car q)))

(defun move-obj-to-queue-head (obj q)
  (let ((obj-exists (position obj (car q))))
    (if (null obj-exists)
	  q
      (setf (car q) (cons obj
	                  (append
	                    (subseq (car q) 0 obj-exists)
                        (subseq (car q) (+ obj-exists 1)
 (length (car q)))))))))

' ----------

(setf q (make-queue))
(enqueue 'a q)
(enqueue 'b q)
(enqueue 'c q)

(format t "q = ~A~%" q)

(move-obj-to-queue-head 'b q)


(format t "q = ~A~%" q)

見つかったオブジェクトと、その前後のリストに分けて、くっつけなおしてるだけ。
結果はこう。

* Warning:  Declaring Q special.

(NIL)
* 
(A)
* 
(A B)
* 
(A B C)
* q = ((A B C) C)
NIL
* 
(B A C)
* q = ((B A C) C)
NIL
*

6. オブジェクトとリスト(これはcdr循環かもしれない)を引数として、オブジェクトがリストのメンバであれば真を返す関数を定義せよ。

とりあえず安直にmemberを使ってみる。

(setf *print-circle* t)

(setf x '(a))
(setf (cdr x) x)

(member 'a x)
(member 'b x)

が、見つかる場合は動くが、見つからない場合は延々とループしてしまう。。
ので、循環リストかどうかの判定を入れてあげる。

(setf *print-circle* t)

(setf x '(a))
(setf (cdr x) x)

(defun my-member (obj lst)
  (if (eql obj (car lst))
    t
	(if (eql lst (cdr lst))
	  ; 循環リスト
	  nil
	  (my-member obj (cdr lst)))))

(my-member 'a x)
(my-member 'b x)

結果はこう。

* 
T
* Warning:  Declaring X special.

(A)
* 
#1=(A . #1#)
* 
MY-MEMBER
* 
T
* 
NIL
*

7. 引数がcdr循環リストである場合に真を返す関数を定義せよ。

8. 引数がcar循環リストである場合に真を返す関数を定義せよ。

まとめて。

(setf *print-circle* t)

(setf x '(a))
(setf (cdr x) x)

(setf y '(a))
(setf (car y) y)

(defun is-cdr-circle-list (lst)
  (eql lst (cdr lst)))

(defun is-car-circle-list (lst)
  (eql lst (car lst)))

(is-cdr-circle-list x)
(is-cdr-circle-list y)
(is-car-circle-list x)
(is-car-circle-list y)