The Little Schemer 五章

The Little Schemer 五章の内容は、

• ツリー構造のcar・cdr下り
• 関数の簡略化

の二つ。
一つ目は、car部がatomでない場合のリストの下り方について。目新しいのは、carがlistかatomかで条件分けする必要があるってことくらい。
二つ目は、条件が複雑になった場合の簡略化法。「正しい論理を作ってから簡略化しよう」というのがスローガン。

ちょっと変だなと思ったのは、これ。

(defun eqlist? (l1 l2)
  (cond
   ((and (null? l1) (null? l2))
    t)
   ((and (null? l1) (atom? (car l2)))
    nil)
   ((null? l1) nil)
   ((and (atom (car l1))
	 (null l2))
    nil)
   ((and (atom (car l1))
	 (atom (car l2)))
    (and (eqan? (car l1)
		(car l2))
	 (eqan? (cdr l1)
		(cdr l2))))
   ((atom? (car l1)) nil)
   ((null l2) f)
   ((atom (car l2)) nil)
   (t
    (and (eqlist? (car l1)
		  (car l2))
	 (eqlist? (cdr l1)
		  (cdr l2))))))

Is it okay to ask (atom (car l2)) in the second question?

Yes, because we know that the second list cannot be empty. Otherwise the first question would have been true.

つまりl1,l2がatomである場合については考えてないんだな。
cdr下りしてるときならいざ知らず、car下りするなら終着条件はatomにしたほうが分かりやすいように思う。
という思想で簡略化したeqlist?は

(defun my-eqlist? (l1 l2)
  (cond
   ((and (null l1) (null l2)) t)
   ((or (null l1) (null l2)) nil)
   ((and (atom l1) (atom l2))
    (equal l1 l2))
   ((or (atom l1) (atom l2)) nil)
   (t (and (my-eqlist? (car l1) (car l2))
	   (my-eqlist? (cdr l1) (cdr l2))))))

でもこれ、もはやeqlist?じゃなくてeq-S-exp?かなぁ。

以下プログラム羅列。

(defun rember* (a l)
  (cond
   ((null l) nil)
   ((atom (car l))
    (cond
     ((equalp (car l) a)
      (rember* a (cdr l)))
     (t (cons (car l)
       (rember* a (cdr l))))))
   (t (cons (rember* a (car l))
     (rember* a (cdr l))))))


(defun insertR* (new old l)
  (cond
   ((null l) nil)
   ((atom (car l))
    (cond
     ((equalp (car l) old)
      (cons (car l)
     (cons new
    (insertR* new old
       (cdr l)))))
     (t (cons (car l)
       (insertR* new old (cdr l))))))
   (t (cons (insertR* new old (car l))
     (insertR* new old (cdr l))))))

(defun add1 (n)
  (+ 1 n))
; o+ は組み込みの + で代用

(defun occur* (a l)
  (cond
   ((null l) 0)
   ((atom (car l))
    (cond
     ((equalp (car l) a)
      (add1 (occur* a (cdr l))))
     (t (occur* a (cdr l)))))
   (t (+ (occur* a (car l))
  (occur* a (cdr l))))))

(defun subst* (new old l)
  (cond
   ((null l) nil)
   ((atom (car l))
    (cond
     ((equalp (car l) old)
      (cons new (subst* new old (cdr l))))
     (t (cons (car l)
       (subst* new old (cdr l))))))
   (t (cons (subst* new old (car l))
     (subst* new old (cdr l))))))

(defun insertL* (new old l)
  (cond
   ((null l) nil)
   ((atom (car l))
    (cond
     ((equalp (car l) old)
      (cons new
     (cons old
    (insertL* new old (cdr l)))))
     (t (cons (car l)
       (insertL* new old (cdr l))))))
   (t (cons (insertL* new old (car l))
     (insertL* new old (cdr l))))))

(defun member* (a l)
  (cond
   ((null l) nil)
   ((atom (car l))
    (cond
     ((equalp (car l) a) t)
     (t (member* a (cdr l)))))
   (t (or (member* a (car l))
   (member* a (cdr l))))))

(defun member2* (a l)
  (cond
   ((null l) nil)
   ((atom (car l))
    (or (equal (car l) a)
 (member2* a (cdr l))))
   (t (or (member* a (car l))
   (member2* a (cdr l))))))

(defun leftmost (l)
  (cond
   ((atom (car l))
    (car l))
   (t (leftmost (car l)))))

(defun eqan? (a1 a2)
  (cond
   ((and (numberp a1) (numberp a2))
    (= a1 a2))
   ((or (numberp a1) (numberp a2))
    nil)
   (t (equal a1 a2))))

(defun my-eqlist? (l1 l2)
  (cond
   ((and (null l1) (null l2)) t)
   ((or (null l1) (null l2)) nil)
   ((and (atom l1) (atom l2))
    (equal l1 l2))
   ((or (atom l1) (atom l2)) nil)
   (t (and (my-eqlist? (car l1) (car l2))
	   (my-eqlist? (cdr l1) (cdr l2))))))

(defun equal? (s1 s2)
  (cond
   ((and (atom s1) (atom s2))
    (equal s1 s2))
   ((or (atom s1) (atom s2))
    nil)
   (t (eqlist? s1 s2))))

(defun eqlist? (l1 l2)
  (cond
   ((and (null l1) (null l2)) t)
   ((or (null l1) (null l2)) nil)
   (t (and (equal? (car l1) (car l2))
	   (eqlist? (cdr l1) (cdr l2))))))

(defun rember (s l)
  (cond
   ((null l) nil)
   ((atom (car l))
    (cond
     ((equal? (car l) s)
      (cdr l))
     (t (cons (car l)
	      (rember s (cdr l))))))
   (t (cond
       ((equal? (car l) s) (cdr l))
       (t (cons (car l)
		(rember s (cdr l))))))))

;; 上の二つの条件をまとめると、
(defun rember (s l)
  (cond
   ((null l) nil)
   (else (cond
	  ((equal? (car l) s)
	   (cdr l))
	  (t (cons (car l)
		   (rember s (cdr l))))))))

;; 内側のcondで聞いている内容は、外のcondでも聞ける
(defun rember (s l)
  (cond
   ((null l) nil)
   ((equal? (car l) s)
    (cdr l))
   (t (cons (car l)
	    (rember s (cdr l))))))