从我正在阅读的书中的示例代码尝试一个简单的贝叶斯概率推理网络,似乎存在涉及更新节点概率的问题。更新节点POPULARITY
没有问题,但是一旦它因某种原因尝试更新ELEGANCE
,就会出现相关错误。我尝试在allegro中输入调试器,它将nil nil
作为它正在尝试更新的弧的prior-prob
和current-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)))))
感谢您提供的任何帮助!
答案 0 :(得分:4)
您遇到问题的原因是图表节点名称中至少有两个不一致:
service
,有时则使用services
。appearance
,有时则appearence
(我停止照顾这两个名字)。
如果您需要经常更改此程序,请考虑编写一个检查图表一致性的函数。另请注意,宏sp
的定义中存在错误(未使用)。引号(')可能应该是反引号(`)(这是从其他材料进行复制粘贴时的典型错误。)
最后,如果你想继续在Common Lisp中编程,请考虑学习如何使用调试器,因为通过适当使用调试器几乎可以立即找到错误的原因。
答案 1 :(得分:2)
检查是否存在符号属性
在缺少属性的情况下改进代码的一种方法是编写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
时)并且有更多信息。