Clips 人员识别专家系统源码——注释解析

;;;此文只是仿照clips例子改写的一个人员识别的程序，只供学习使用，并无实际意义。


;;;***************************
;;;* DEFTEMPLATE DEFINITIONS *
;;;***************************

(deftemplate rule ;代表定义模板(define template)的意思。这个关键词能帮助你写出具有明确定义模式的规则。相当于结构体
(multislot if) ;定义成员if为多槽则可以包含零个或多个字段
(multislot then)) ;定义成员then为多槽则可以包含零个或多个字段

;;;**************************
;;;* INFERENCE ENGINE RULES *
;;;**************************

(defrule propagate-goal "推导的规则" ;定义推导的规则
(goal is ?goal) ;第一个事实：goal 是 某个变量
(rule (if ?variable $?) ;第二个事实: $? 该符号指代零个或多个字段
(then ?goal ? ?value)) ;?是单个字段通配符
=>
(assert (goal is ?variable))
(printout t " propagate-goal => goal is " ?variable crlf)
) ;加入事实 goal is 某变量


(defrule goal-satified ""
(declare (salience 30))
?f <- (goal is ?goal)
(variable ?goal ?value)
(answer ? ?text ?goal)
=>
(printout t " goal-satified <= goal is " ?goal crlf)
(retract ?f)
(format t "%s%s%n" ?text ?value))

(defrule remove-rule-no-match "撤销掉不匹配的规则事实"
(declare (salience 20))
(variable ?variable ?value)
?f <- (rule (if ?variable ? ~?value $?)) ;$? 该符号指代零个或多个字段
=>
(printout t " remove-rule-no-match <= " $?f crlf)
(retract ?f))

(defrule modify-rule-match "更改匹配到的规则事实"
(declare (salience 20)) ;declare salience命令提供对增添到议程中的规则的外部控制。在使用该特性的时候要注意不要太过于自由以免你的程序被人为控制太多。
(variable ?variable ?value)
?f <- (rule (if ?variable ? ?value and $?rest)) ;如果满足了一个条件，则在条件列表里去掉这个条件，例如原来的条件是 color is red and temp is 10,当color is red 满足后，条件列表变为：temp is 10
=>
(printout t " modify-rule-match >> " $?rest crlf)
(modify ?f (if ?rest))) ;可以利用修改(modify)行为修改指定的自定义模板中的槽来撤销并增加一个新事实


(defrule rule-satisfied "如果某规则最后满足了，则删除这个规则，增加一个规则满足后的属性"
(declare (salience 20)) ;定义规则的优先级，值越大优先级越高
(variable ?variable ?value)
?f <- (rule (if ?variable ? ?value) ;获得规则符合的地址
(then ?goal ? ?goal-value))
=>
(retract ?f) ;删除这个符合条件的规则
(assert (variable ?goal ?goal-value))) ;增加一个满足规则的属性变量



(defrule ask-question-legalvalues ""
(declare (salience 10))
(legalanswers ? $?answers)
?f1 <- (goal is ?variable)
?f2 <- (question ?variable ? ?text)
=>
(retract ?f1)
(format t "%s " ?text) ;打印问题内容
(printout t ?answers " ") ;打印答案提示 yes no
(bind ?reply (read)) ;读取键盘回答
(if (member (lowcase ?reply) ?answers) ;判断是否是小写的 yes no
then (assert (variable ?variable ?reply)) ;设置事实为yes or no
(retract ?f2) ;删除问题事实
else (assert (goal is ?variable)) ;输入的不是yes no ,则重新添加这个事实，再次触发询问
(printout t "重新添加这个事实，再次触发询问." crlf)
)
)



;;;***************************
;;;* DEFFACTS KNOWLEDGE BASE *
;;;***************************

(deffacts knowledge-base
(goal is type.human)
(legalanswers are yes no)
(rule (if "男性" is yes)
(then "性别" is "男性"))
(rule (if "男性" is no)
(then "性别" is "女性"))
(question "男性" is "他是男性吗?")

(rule (if "戴眼镜" is yes)
(then "戴眼镜" is yes))
(rule (if "戴眼镜" is no)
(then "戴眼镜" is no))
(question "戴眼镜" is "他戴眼镜吗?")

(rule (if "白头发" is yes)
(then "白头发" is yes))
(rule (if "白头发" is no)
(then "白头发" is no))
(question "白头发" is "他有白头发吗?")

(rule (if "大高个" is yes)
(then "大高个" is yes))
(rule (if "大高个" is no)
(then "大高个" is no))
(question "大高个" is "他是180大高个吗?")

(rule (if "体型胖" is yes)
(then "体型胖" is yes))
(rule (if "体型胖" is no)
(then "体型胖" is no))
(question "体型胖" is "他的体型胖吗?")

(rule (if "夫妇在一个单位" is yes)
(then "夫妇在一个单位" is yes))
(rule (if "夫妇在一个单位" is no)
(then "夫妇在一个单位" is no))
(question "夫妇在一个单位" is "夫妇在一个单位吗?")

(rule (if "喜欢球类" is yes)
(then "喜欢球类" is yes))
(rule (if "喜欢球类" is no)
(then "喜欢球类" is no))
(question "喜欢球类" is "喜欢球类吗?")

(rule (if "喜欢坦克大战" is yes)
(then "喜欢坦克大战" is yes))
(rule (if "喜欢坦克大战" is no)
(then "喜欢坦克大战" is no))
(question "喜欢坦克大战" is "喜欢坦克大战吗?")

(rule (if "炒股票" is yes)
(then "炒股票" is yes))
(rule (if "炒股票" is no)
(then "炒股票" is no))
(question "炒股票" is "他炒股票吗?")

(rule (if "性别" is "男性"
and "戴眼镜" is yes
and "白头发" is no
and "喜欢球类" is no
and "夫妇在一个单位" is no
and "喜欢坦克大战" is no)
(then type.human is "路人甲"))

(rule (if "性别" is "男性"
and "戴眼镜" is no
and "白头发" is no
and "大高个" is yes
and "喜欢球类" is yes
and "夫妇在一个单位" is yes)
(then type.human is "路人乙"))

(rule (if "性别" is "男性"
and "戴眼镜" is yes
and "白头发" is yes
and "夫妇在一个单位" is no
and "炒股票" is yes
and "体型胖" is yes)
(then type.human is "路人丙"))

(rule (if "性别" is "男性"
and "戴眼镜" is yes
and "大高个" is yes
and "体型胖" is yes
and "白头发" is no
and "夫妇在一个单位" is no)
(then type.human is "路人丁"))


(rule (if "性别" is "男性"
and "戴眼镜" is yes
and "大高个" is no
and "体型胖" is yes
and "白头发" is no
and "喜欢球类" is yes
and "夫妇在一个单位" is no)
(then type.human is "路人戊"))

(rule (if "性别" is "男性"
and "戴眼镜" is yes
and "大高个" is yes
and "体型胖" is yes
and "白头发" is no
and "夫妇在一个单位" is yes)
(then type.human is "路人己"))

(rule (if "性别" is "男性"
and "戴眼镜" is yes
and "大高个" is no
and "体型胖" is no
and "白头发" is no
and "夫妇在一个单位" is no
and "喜欢坦克大战" is yes
)
(then type.human is "路人庚"))

(rule (if "性别" is "男性"
and "戴眼镜" is no
and "白头发" is no
and "大高个" is no
and "体型胖" is no
and "夫妇在一个单位" is yes
and "喜欢球类" is yes
)
(then type.human is "路人辛"))

(rule (if "性别" is "男性"
and "戴眼镜" is no
and "大高个" is no
and "体型胖" is no
and "白头发" is no
and "夫妇在一个单位" is yes
and "喜欢球类" is no
)
(then type.human is "路人寅"))

(rule (if "性别" is "男性"
and "戴眼镜" is no
and "大高个" is no
and "体型胖" is no
and "白头发" is yes
and "夫妇在一个单位" is yes
and "喜欢球类" is no)
(then type.human is "路人癸"))

(rule (if "性别" is "女性"
and "戴眼镜" is yes
and "大高个" is no
and "体型胖" is yes
and "白头发" is yes
and "夫妇在一个单位" is yes
and "喜欢球类" is yes)
(then type.human is "路人某"))

(answer is "我猜此人是：" type.human)

)

;;;结构体定义举例;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(deftemplate person
(slot name)
(slot age)
(slot eye-color)
(slot hair-color))