【CLドリル】8 リスト処理 (その4)

頭が悪い。かんたんなことに時間がかかる。。。

• まず、8.3.3をやるなかで、S式に含まれるSymbolを収集する関数をつくりたい。
  
• 単純にやると次のよう。
  

  
  (defun collect-rec (sexp &optional result)
    (cond
     ((null sexp) result)
     ((symbolp sexp) (cons sexp result))
     (t (append (collect-rec (car sexp) result)
               (collect-rec (cdr sexp) result)))))
  

  
  
• 次に、このとき重複がないようにしたい。
  
• これを上の拡張でやろうとするがうまくいかない。悩む。
  
• すると、これはこの「構造」では書けないことがわかる。例えば、
  

  
  (defun collect-rec (sexp &optional result)
    (cond
     ((null sexp) result)
     ((symbolp sexp)
      (if (member sexp result)
          result
          (cons sexp result)))
     (t (append (collect-rec (car sexp) result)
               (collect-rec (cdr sexp) result)))))
  

  
  としたときに、memberがみているresultというのはそれぞれの枝の状態で分離しているからだ。
  
• なので、まずS式をトラバースしてsymbolをみつけるたびに処理する関数をかいて、
  

  
  (defun do-symbols-in-sexp (fun sexp)
    (cond
     ((null sexp) nil)
     ((symbolp sexp)
      (funcall fun sexp))
     (t (progn (do-symbols-in-sexp fun (car sexp))
               (do-symbols-in-sexp fun (cdr sexp))))))
  

  
  そこで、関数の「外」に集積することにした。
  

  
  (setq result nil)
  (do-symbols-in-sexp #'(lambda (x)
                          (if (not (member x result)) (push x result))) '((x j) (a d) ((x y b) . (c a))))
  result ; => (C B Y X D A)
  

  
  こういうことが、すんなりできないのがくやしいなぁ。で、演算子を除外するなら、
  

  
  (do-symbols-in-sexp #'(lambda (x)
                          (if (and (not (member x '(not and or =>)))
                                   (not (member x result)))
                              (push x result)))
    '((not j) (a and) ((=> y b) . (c a)))) 
  result ;  => (C B Y A J)
  

  
  あとは命題論理のインタプリタと恒真判定を総当たりで。
  

  
  (defun validate-wff (form)
    (let ((symbols nil))
      (do-symbols-in-sexp #'(lambda (x)
                          (if (and (not (member x '(not and or =>)))
                                   (not (member x symbols)))
                              (push x symbols))) form)
      (dolist (ttable (make-truth-tables (length symbols)) t)
        (if (not (eval-wff form (pairlis symbols ttable)))
            (return (pairlis symbols ttable))))))
  
  (defun eval-wff (form table)
    (cond
     ((symbolp form) (cdr (assoc form table)))
     ((consp form)
      (case (car form)
        ('not
         (null (eval-wff (second form) table)))
        ('and
         (and (eval-wff (second form) table)
              (eval-wff (third form) table)))
        ('or
         (or (eval-wff (second form) table)
             (eval-wff (third form) table)))
        ('=>
         (eval-wff `(or (not ,(second form)) ,(third form)) table))))))
  
  (defun make-truth-tables (n)
    (do ((i 0 (1+ i))
         (num (make-list n) (addt num))
         (result))
        ((> i (1- (expt 2 n))) result)
      (push num result)))
  
  (defun addt (num)
    (cond
     ((eq nil (car num))
      (cons t (cdr num)))
     ((eq t (car num))
      (cons nil (addt (cdr num))))))
  

  
  
• 解答をみてみると、、、う、andで分岐して再帰していく、というアイデアがきれい。。。
  
  
• 8.3.5 命題論理 (3)
  
  
  
  • 8.3.4で自分がつくった方が、もともと対応していたからそのまま。
    
  • 8.3.4の解答をベースにすると大域脱出でいける。
    
  
  
• 8.4.1 一般化変数(2)と8.4.2インタプリタ(3)はさくさくと。
  
• しかし、やはりSymbolっていうのはでっかいObjectだなぁ。
  

おお、やっと8章がおわった！
途中、大域脱出したい誘惑に駆られた、が、ふんばった。
次回は、9 宣言。ここは主題自体がごついところなのでちょっと警戒。
こつこつ。