`NIL 不是 Lisp 中预期的 REAL 类型

`NIL is not of the expected type REAL in Lisp

根据我正在阅读的一本书中的示例代码对简单的贝叶斯概率推理网络进行实验,似乎存在涉及更新节点概率的问题。更新节点 POPULARITY 没有问题,但是一旦它尝试更新 ELEGANCE 出于某种原因,就会出现相关错误。我已经尝试在 allegro 中输入调试器,它将 nil nil 作为它试图更新的弧的 prior-probcurrent-prob 的 CAR。不过,我不明白为什么,因为这不是第一个节点的问题。这是代码:

;;Network representation

(defun odds (prob)
  (/ prob (- 1.0 prob)))

(defun prob (odds)
  (/ odds (1+ odds)))

(defmacro define-node (name prior-prob current-prob arcs)
  `(progn
     (setf (get ',name 'prior-prob) ,prior-prob)
     (setf (get ',name 'prior-odds) (odds ,prior-prob))
     (setf (get ',name 'current-prob) ,current-prob)
     (setf (get ',name 'current-odds) (odds ,current-prob))
     (setf (get ',name 'arcs) ',arcs)))

(defun current-prob (n) (get n 'current-prob))
(defun prior-prob (n) (get n 'prior-prob))
(defun current-odds (n) (get n 'current-odds))
(defun prior-odds (n) (get n 'prior-odds))
(defun sufficiency (arc) (cadr arc))
(defun necessity (arc) (car (cddr arc)))

;Primary evidential variables

(define-node decor 0.5 0.9 ())
(define-node table-setting 0.5 0.8 ())
(define-node surface-cleanliness 0.8 0.8 ())
(define-node air 0.6 0.6 ())
(define-node sounds 0.5 0.5 ())
(define-node clientele 0.5 0.9 ())
(define-node menu 0.5 0.5 ())
(define-node prices 0.5 0.9 ())
(define-node services 0.3 0.9 ())

;Lumped evidential variables

(define-node popularity 0.5 0.6 (indep
                                 (arc sounds 1.5 1.0)
                                 (arc clientele 1.0 0.24)))
(define-node elegance 0.5 0.5   (indep
                                 (arc decor 3.0 0.5)
                                 (arc table-setting 1.0 0.74)
                                 (arc sounds 1.5 0.74)
                                 (arc clientele 1.0 0.5)
                                 (arc menu 1.24 0.74)
                                 (arc prices 1.24 0.74)
                                 (arc service 1.0 0.5)))
(define-node artistry 0.5 0.9   (indep
                                 (arc decor 1.0 0.5)
                                 (arc table-setting 1.0 0.5)
                                 (arc menu 1.5 0.74)
                                 (arc service 1.0 0.5)))
(define-node cleanliness 0.7 0.7 (indep
                                  (arc surface-cleanliness 1.5 0.2)
                                  (arc air 1.5 0.5)))

(define-node taste 0.6 0.6 (indep 
                            (arc popularity 1.5 0.7)
                            (arc elegance 1.5 0.8)))
(define-node texture 0.6 0.6 (indep
                              (arc popularity 1.5 0.7)
                              (arc elegance 1.5 0.8)))
(define-node appearance 0.5 0.5 (indep
                                 (arc artistry 3.0 0.4)))
(define-node quantity 0.5 0.5 (indep
                               (arc popularity 1.5 0.5)))
(define-node correctness 0.5 0.5 (indep
                                  (arc elegance 1.0 0.7)))
(define-node nutrition 0.6 0.6 (indep 
                                (arc popularity 1.1 0.7)
                                (arc elegance 1.8 0.8)))
(define-node hygiene 0.8 0.8 (indep 
                              (arc cleanliness 1.0 0.1)))

(define-node overall-food-quality 0.5 0.5
  (indep
   (and 
    (arc taste 3.0 0.3)
    (arc texture 1.0 0.5))
   (and
    (arc appearence 1.0 0.3)
    (arc correctness 1.3 0.8))
   (arc quantity 1.2 0.8)
   (arc nutrition 1.0 0.3)
   (arc hygiene 1.5 0.2)))

;Update-prob computes P(H|E') for a single arc 
(defun update-prob (h arc)
  (cond 
   ((> (current-prob (car arc))
       (prior-prob (car arc)))
    (report-progress 'supportive h arc)
    (+ (prior-prob h)
       (* (/ (- (prob (* (sufficiency arc)
                         (prior-odds h)))
                (prior-prob h))
             (- 1.0 (prior-prob (car arc))))
          (- (current-prob (car arc))
             (prior-prob (car arc))))))
   (t (report-progress 'inhibitive h arc)
      (+ (prob (* (necessity arc) (prior-odds h)))
         (* (/ (- (prior-prob h)
                  (prob (* (necessity arc)
                           (prior-odds h))))
               (prior-prob (car arc)))
            (current-prob (car arc)))))))

;Report-porgres describes the progress of the updating
(defun report-progress (supp-inhib h arc)
  (cond
   ((null reporting) nil)
   (t
    (format t "~%~a probability updating for node ~a" supp-inhib h)
    (format t " along arc:~%~s with prior odds ~s." arc (prior-odds h))
    (format t "~%Prior and current probabilities of E are ~s and ~s."
      (prior-prob (car arc)) (current-prob (car arc))))))

(proclaim '(special *node*))

(defun effective-arc-lambda (arc)
  (/ (odds (update-prob *node* arc))
     (prior-odds *node*)))

(defun combine-indep-lambdas (arc-exp)
  (apply #'*
         (mapcar #'eval-arc-exp
           (cdr arc-exp))))

(defun combine-conjunctive-lambdas (arc-exp)
  (apply #'min
         (mapcar #'eval-arc-exp
           (cdr arc-exp))))

(defun combine-disjunctive-lambdas (arc-exp)
  (apply #'max
         (mapcar #'eval-arc-exp
           (cdr arc-exp))))

(defun update-nodes (nodes)
  (cond ((null nodes) nil)
        (t (update-node (car nodes))
           (update-nodes (cdr nodes)))))

;;Evaluates arc expression, finding odds updating factor
(defun eval-arc-exp (arc-exp)
  (cond ((eq (car arc-exp) 'arc)
         (effective-arc-lambda (cdr arc-exp)))
        ((eq (car arc-exp) 'indep)
         (combine-indep-lambdas arc-exp))
        ((eq (car arc-exp) 'and)
         (combine-conjunctive-lambdas arc-exp))
        ((eq (car arc-exp) 'or)
         (combine-disjunctive-lambdas arc-exp))
        (t (print '(illegal arc expression)) (print arc-exp))))

;;Update nde computes the new probability for a given node
(defun update-node (h)
  (setq *node* h)
  (setf (get h 'current-odds)
    (* (prior-odds h)
       (eval-arc-exp (get h 'arcs))))
  (setf (get h 'current-prob) (prob (current-odds h)))
  (format t "~%Current probability of a node ~a is ~s.~%" h (current-prob h)))

(defun test ()
  (update-nodes '(popularity elegance artistry cleanliness
                             taste texture appearance quantity
                             correctness nutrition hygiene
                             overall-food-quality)))
(defmacro sp (name current-prob)
  '(progn
     (setf (get (car l) 'current-prob) (cadr l))
     (setf (get (car l) 'current-odds) (odds (cadr l)))))

感谢您提供的任何帮助!

你的问题的原因是图的节点名称至少有两处不一致:

  1. 有时您使用 service,有时您使用 services
  2. 有时您使用 appearance,有时您使用 appearence

(我不再关注这两个名字了)

如果您需要经常更改此程序,请考虑编写一个函数来检查图形的一致性。另请注意,宏sp(未使用)的定义存在错误。引号 (') 可能应该是反引号 (`)(这是从其他 material 执行 copy-paste 时的典型错误)。

最后,如果您想继续使用 Common Lisp 编程,请强烈考虑学习使用调试器,因为通过适当使用调试器几乎可以立即找到错误原因。

检查符号属性是否存在

在缺少属性的情况下改进代码的一种方法是编写 get 替换,这会提供更多信息。不幸的是,如果 属性 不存在,get 不会给出指示:

CL-USER 54 > (get 'decor 'prior-prob-a)
NIL

属性 不存在还是值 nil?我们不知道使用 get.

我们需要检查 属性 是否确实存在。这可以通过标准的 Common Lisp 函数 get-properties.

来完成
(defun safer-get (symbol property)
  (multiple-value-bind (property0 value tail)
      (get-properties (symbol-plist symbol)
                      (list property))
    (declare (ignore property0))
    (assert tail ()
      "Property ~a not found for node ~a." property symbol)
    value))

示例:

属性 prior-prob 存在于符号 decor:

CL-USER 49 > (safer-get 'decor 'prior-prob)
0.5

属性 prior-prob-a 不存在符号 decor:

CL-USER 47 > (safer-get 'decor 'prior-prob-a)

Error: Property PRIOR-PROB-A not found for node DECOR.
  1 (continue) Retry assertion.
  2 (abort) Return to level 0.
  3 Return to top loop level 0.

这样您就可以得到 属性 它是哪个以及哪个交易品种的信息。所以错误消息出现得更早(不是后来使用 NIL 时)并且有更多信息。