The Little Schemer 第七章

さて、 The Little Schemer の第七章は "Friends and Relations" 。
この章の内容を一言で言うと、「小さなツールを作っておくと論理がよく見えるようになる」。要するにボトムアッププログラミングの有効性についてだ。
それから、主題には出てこないけれどもひそかに出現しているのが「関数を定義する際に、中にある関数は定義されていなくても良い」というLispの特長。

(defun pick-first (list)
  (cond
    ((nil? list) nil)
    (t (first list))))

とか定義したあとに、

(defun nil? (a)
  (null a))
(defun first (l)
  (car l))

などと実装することができる。(例がテキトー過ぎる)
これ結構ストレスフリーですよ。さくさく書ける。


以下プログラム羅列。

;; 第二章で定義したもの。使うので再定義。
(defun member? (a lat)
  (cond
   ((null lat) nil)
   (t (or (equal (car lat) a)
	  (member? a (cdr lat))))))

;; set? 定義
(defun set? (lat)
  (cond
   ((null lat) t)
   (t (cond
       ((member? (car lat) (cdr lat)) nil)
       (t (set? (cdr lat)))))))
;; 簡略化して書き直し
(defun set? (lat)
  (cond
   ((null lat) t)
   ((member? (car lat) (cdr lat))
    nil)
   (t (set? (cdr lat)))))

;; member? を使って作ったmakeset。
;; 出力が逆向きになってしまうので良くない
(defun makeset (lat)
  (cond
   ((null lat) nil)
   ((member? (car lat) (cdr lat))
    (makeset (cdr lat)))
   (t (cons (car lat)
	    (makeset (cdr lat))))))
;; multirember を使って作ったmakeset。
;; 出力順が正しくなる
(defun makeset (lat)
  (cond
   ((null lat) nil)
   (t (cons (car lat)
	    (makeset
	     (multirember (car lat)
			  (cdr lat)))))))
;; multirember 再掲
(defun multirember (a lat)
  (cond
   ((null lat) nil)
   ((equalp (car lat) a)
    (multirember a (cdr lat)))
   (t (cons (car lat)
	    (multirember a (cdr lat))))))

;; set1 の全ての要素が set2 に含まれるかどうか
(defun subset? (set1 set2)
  (cond
   ((null set1) t)
   (t (and (member? (car set1) set2)
	   (subset? (cdr set1) set2)))))

;; set1 と set2 に共通な要素をリストにする
(defun intersect (set1 set2)
  (cond
   ((null set1) nil)
   ((member? (car set1) set2)
    (cons (car set1)
	  (intersect (cdr set1) set2)))
   (t (intersect (cdr set1) set2))))

;; set1 と set2 の要素を重複なく一つのリストにまとめる
(defun union (set1 set2)
  (cond
   ((null set1) set2)
   ((member? (car set1) set2)
    (union (cdr set1) set2))
   (t (cons (car set1)
	    (union (cdr set1) set2)))))

(defun xxx (set1 set2)
  (cond
   ((null set1) nil)
   ((member? (car set1) set2)
    (xxx (cdr set1) set2))
   (t (cons (car set1)
	    (xxx (cdr set1) set2)))))

(defun intersectall (l-set)
  (cond
   ((null (cdr l-set)) (car l-set))
   (t (intersect (car l-set)
		 (intersectall (cdr l-set))))))

(defun a-pair (x)
  (cond
   ((null x) nil)
   ((null (car x)) nil)
   ((null (cdr x)) nil)
   ((null (cddr x)) t)
   (t nil)))

(defun first (p)
  (car p))
(defun second (p)
  (car (cdr p)))
(defun build (s1 s2)
  (cons s1 (cons s2 nil)))
(defun third (l)
  (car (cdr (cdr l))))

(defun firsts (l)
  (cond
   ((null l) nil)
   ((cons (car (car l)) (firsts (cdr l))))))
(defun fun? (rel)
  (set? (firsts rel)))

;; rel を逆転させるrevrelは、
(defun revrel (rel)
  (cond
   ((null rel) nil)
   (t (cons (build (second (car rel))
		   (first (car rel)))
	    (revrel (cdr rel))))))

;; revpair を作ったらもっと簡単になるよ。
(defun revpair (pair)
  (build (second pair) (first pair)))
(defun revrel (rel)
  (cond
   ((null rel) nil)
   (t (cons (revpair (car rel))
	    (revrel (cdr rel))))))

(defun fullfun? (fun)
  (set? (seconds fun)))
(defun seconds (rel)
  (cond
   ((null rel) nil)
   (t (cons (second (car rel))
	    (seconds (cdr rel))))))