人、婚姻与机器——人工智能建议的冒险，第2部分

• 下载 Backward_chaining_algorithm.zip - 902 B
• 下载 Making_the_system_interactive.zip - 1,013 B
• 下载 Making_the_system_interactive-with_validation.zip - 1.44 KB
• 下载 WiserSocrates.zip - 1.89 KB

第1部分 | 第3部分

在本系列文章的第1部分中，我们学习了专家系统的基本概念。在本文中，我们将使用这些概念来开发一个基于专家系统的人工顾问。

苏格拉底——人工顾问

这个专家系统的目标是根据以下因素对一个人的婚姻成功进行客观评估：

1. 收入兼容性
2. 年龄因素
3. 就业状况
4. 婚姻罚金税负
5. 同居伴侣经济
6. 健康保险覆盖
7. 社会保障福利
8. 家庭动态
9. 迈尔斯-布里格斯性格类型兼容性（MBTI）

领域专业知识

编写专家系统的首要任务是找到一个领域专家。但出于本文的目的，我将使用以下网站作为主题专家。（对于一个严肃的专家系统，你需要一个人类领域专家）。

• http://articles.moneycentral.msn.com/CollegeAndFamily/SuddenlySingle/WhenItPaysToStaySingle.aspx?page=2
• http://www.bankrate.com/brm/news/pf/20051017a1.asp
• http://money.usnews.com/money/personal-finance/articles/2008/07/02/marriages-financial-pros-and-cons
• http://marriagecalculator.acf.hhs.gov/marriage/assumptions.php
• http://www.personalitydesk.com/story/compatibility-and-your-myers-briggs-personality-type

这些领域专业知识需要转换成推理机可以进行推理的格式。

知识工程“苏格拉底”

如前所述，专家系统推理中最常用的两种策略是：“前向链”和“逆向链”。前者也称为数据驱动，后者称为目标驱动。在逆向链中，推理机选择一个目标，然后尝试找到事实来肯定或否定这个目标。在此过程中，可以建立新的目标，称为子目标。由于CLIPS不直接支持逆向链，我将使用以下逆向链算法。

逆向链算法

1. 将目标（结果）与其所依赖的条件（前件）之间的关联表达为事实，并将此事实命名为领域规则（domain-rule）。
2. 领域规则的结果是要解决的目标。
3. 如果领域规则有前件，那么每个前件都成为一个子目标。
4. 每个子目标都通过基于名为答案（answer）的事实进行肯定或否定来解决。
5. 如果一个子目标被肯定，那么这个前件就从领域规则的前件中移除。
6. 重复步骤3和4，直到没有前件为止。
7. 当一个领域规则没有前件时，触发该规则以创建新的事实，称为结论（conclusion）。
8. 结论包含目标以及称为“置信度（confidence-factor）”的确定性评级。
9. 如果两个目标解析为相同的结论，则使用函数((100* (cf1 + cf2))-(cf1 * cf2))/100组合它们的确定性（置信度）。

让我们看看这在CLIPS中是如何实现的。但首先通过按“CTRL W”或输入命令来启用激活和事实跟踪：

(watch facts)

(watch activations)

然后通过键入(clear)清除CLIPS环境。

实现算法

算法步骤1-2实现

定义一个事实模板，捕获目标与其条件之间的链接。在CLIPS窗口中键入或复制/粘贴此代码：
（注意：在CLIPS窗口中每次键入或复制/粘贴操作后按回车键）

(deftemplate domain-rule
    (multislot if (default none))
    (multislot then (default none)))

这个事实模板现在可以表达以下语句：
“如果两个人年龄差超过30岁，那么专家系统基于‘年龄因素’的结婚置信度为20%”，由这个“领域规则”表示。在CLIPS中输入它：

(assert 
    (domain-rule 
        (if age-difference is-more-than 30 )
        (then based-on age-factor the-expert-system-favours-getting-married-with-certainty 20.0 %)))

您现在将在事实窗口中看到一个事实“f-1 (domain-rule (if age-difference...”。

算法步骤3、4、5、6实现

我们现在必须肯定或否定目标“年龄因素，确定性20%”，其前件是“年龄差”超过30。为了捕获可以肯定或否定前件的事实，我们定义一个名为“answer”的事实模板。在CLIPS中输入：

(deftemplate answer
    (slot known-factor (default none))
    (slot value (default none)))

接下来，我们定义一个规则，当前件的领域规则与“answer”事实匹配时触发。在CLIPS中输入此规则：

(defrule remove-ask-if-in-domain-rules-with-more-than
    ?r <- (domain-rule (if ?first-ask-if is-more-than ?min $?rest-of-ifs-true)) 
    (answer (known-factor ?f&:(eq ?f ?first-ask-if)) (value ?a&:(> ?a ?min)) )
 => 
    (if (eq (nth$ 1 ?rest-of-ifs-true) and) 
    then (modify ?r (if (rest$ ?rest-of-ifs-true)))
    else (modify ?r (if ?rest-of-ifs-true))))

这是如何读取此规则的LHS（前件）：

• 将“domain-rule”事实赋给变量?r。
• 将“if”槽中的第一个符号赋给变量?first-ask-if。
• 下一个符号应匹配“is-more-than”
• 将“is-more-than”后面的符号赋给变量?min
• 将剩余的符号赋给多字段变量?rest-of-ifs-true
• 和
• answer事实的“known-factor”槽（赋给变量?f）必须与变量?first-ask-if 完全匹配，并且“value”槽（赋给变量?a）必须大于?min。

这是如何读取此规则的RHS（结果）：

• 如果?rest-of-ifs-true 中的第一个符号是“and”则
• 修改规则?r 的“if”槽，并将其值设置为?rest-of-ifs-true中跳过第一个符号后的剩余符号。
  （我们需要这样做来处理具有多个前件的领域规则）
• 否则，如果?rest-of-ifs-true 中的第一个符号不是“and”，则
• 修改规则?r 的“if”槽，并将其值设置为?rest-of-ifs-true。

为了看到这个规则被触发，让我们创建一个肯定前件的事实（age-difference > 30）。
我们稍后将看到如何通过向用户提出一系列问题来自动推断这个事实。

(assert 
    (answer (known-factor age-difference) (value 31)))

理解跟踪

请注意以下跟踪：

• ==> f-2 (answer (known-factor age-difference) (value 31))
• ==> Activation 0 remove-ask-if-in-domain-rules-with-more-than: f-1,f-2

这意味着事实f-2现在在工作内存中，并且规则“remove-ask-if-in-domain-rules-with-more-than”现在在议程中，因为其LHS匹配事实f-1和f-2。

接下来按“CTRL T”或键入(run 1)，跟踪现在显示：

• <== f-1 (domain-rule (if age-difference is-more-than 30) (then based-on age-factor the-expert-system-favours-getting-married-with- certainty 20.0 %))
• ==> f-3 (domain-rule (if) (then based-on age-factor the-expert-system-favours-getting-married-with- certainty 20.0 %))

这意味着领域规则f-1已被修改，其前件“age-difference is-more-than 30”已从“if”槽中移除。

算法步骤7、8实现

这个修改后的事实现在应该触发另一个规则，通过推断前件（“if”槽）中的所有事实都被工作内存中的事实肯定来解决目标。创建一个表示结论的事实模板：

(deftemplate conclusion
    (slot name (default none))
    (slot confidence-factor (type FLOAT) (default 0.0)))

然后在CLIPS中定义此规则：

(defrule fire-domain-rule
    ?r <- (domain-rule (if $?a&:(=(length$ ?a) 0)) 
    (then based-on ?factor&:(> (str-length ?factor) 0) the-expert-system-favours-getting-married-with-certainty ?cf % $?rest-of-factors))
  =>
    (if (eq (nth$ 1 ?rest-of-factors) and) 
    then (modify ?r (then (rest$ ?rest-of-factors)))) 
    (assert (conclusion (name ?factor) (confidence-factor ?cf))) )

这是如何读取此规则的LHS（前件）：

• 将domain-rule事实赋给变量?r。
• 将“if”槽中的所有符号赋给变量?a，并确保它是空的（通过检查其长度）。
• 将“then”槽中出现在“based-on”和“the-expert-system-favours-getting-married-with-certainty” 符号之间的符号赋给变量?factor ，并确保其长度非零。
• 将“the-expert-system-favours-getting-married-with-certainty” 之后但在“%” 符号之前的符号赋给变量?cf.
• 将剩余的符号赋给多字段变量$?rest-of-factors

这是如何读取此规则的RHS（结果）：

• 如果变量?rest-of-factors中的第一个符号是“and”，则
• 修改规则?r 的“then”槽，并将其值设置为变量?rest-of-factors中跳过第一个符号后的剩余符号。
  （我们需要这样做来处理具有多个结果的领域规则）
• 否则，如果?rest-of-factors 中的第一个符号不是“and”，则
• 在工作内存中创建一个名为“conclusion”的新事实，并将其“name”槽设置为变量?factor ，将“confidence-factor”槽设置为变量?cf.

理解跟踪

您现在看到以下跟踪：

• ==> Activation 0 fire-domain-rule: f-3

按CTRL T触发此规则。显示以下跟踪：

• ==> f-4 (conclusion (name age-factor) (confidence-factor 20.0) (evaluated no))

这意味着目标“age-factor”已解决，并断言了置信度为20的结论。

算法步骤9实现（组合确定性）

如果两个目标解析为相同的结论怎么办？假设一个40岁以上的人也解析为结论“age-factor”，置信度为45%。为了表达它，编写以下“domain-rule”：

(assert
    (domain-rule 
    (if your-age is-more-than 40 )
    (then based-on age-factor the-expert-system-favours-getting-married-with-certainty 45.0 %)))

然后输入这个“answer”事实来触发“fire-domain-rule”。

(assert 
    (answer (known-factor your-age) (value 47)))

现在键入(run)或按CTRL R。

这将在工作内存中创建另一个名为“age-factor”，值为45的“conclusion”事实。

现在让我们编写一个规则来组合同名的结论：

(defrule combine-confidence-factors
    ?rem1 <- (conclusion (name ?n) (confidence-factor ?f1))
    ?rem2 <- (conclusion (name ?n) (confidence-factor ?f2))
    (test (neq ?rem1 ?rem2))
  =>
    (retract ?rem1)
    (modify ?rem2 (confidence-factor (/ (- (* 100 (+ ?f1 ?f2)) (* ?f1 ?f2)) 100))))

这是如何读取此规则的LHS（前件）：

• 将一个结论事实赋给变量?rem1。
• 将“name”槽的值赋给变量“n”，将“confidence-factor”的值赋给?f1。
• 将另一个结论事实赋给变量?rem2，并确保其“name”槽与变量?n匹配，将其“confidence-factor”赋给?f2。
• 确保?rem1和?rem2不引用同一事实。

这是如何读取此规则的RHS（结果）：

• 从工作内存中移除事实?rem1。
• 将?rem2的“confidence-factor” 槽修改为函数((100* (?f1 + ?f2))-(?f1 * ?f2))/100返回的值。

理解跟踪

输入规则后，显示以下跟踪：

• ==> Activation 0 combine-confidence-factors: f-4,f-8
• ==> Activation 0 combine-confidence-factors: f-8,f-4

这意味着规则“combine-confidence-factors”的LHS匹配事实f4和f-8。

按CTRL T，最终结论显示为：

(conclusion (name age-factor) (confidence-factor 56.0)) 基于此函数
((100* (20 + 45))-(20 * 45))/100 = 56.0

完整的算法

要在一个文件中查看并执行此算法，请按照以下步骤操作：

• 解压下载 Backward_chaining_algorithm.zip 。
• 使用“ALT F B”键在CLIPS中加载“Backward chaining algorithm.bat”。
• 键入(run)或按CTRL R。

使系统交互化

现在我们已经有了基本的逆向链算法，让我们看看如何使我们的系统具有交互性，并向用户提问，而不是硬编码答案。我们还将看到如何从基本问题的答案中推断出额外的答案。

定义问题模板

我们首先定义一个名为“question”的无序事实。键入以下内容：
（注意：请确保您首先加载并运行了“Backward chaining algorithm.bat”）

(deftemplate question
    (slot factor (default none)) 
    (slot question-to-ask (default none))
    (slot has-pre-condition (type SYMBOL) (default no))) 

“question”事实具有以下属性/槽/字段：

• factor – 事实的唯一可读标识符，约束为不允许为空。
• question-to-ask – 问题的文本，约束为非空。
• has-pre-condition – 指示此问题是否仅在另一个问题已回答后才应提出。默认为否。

推断“age-difference”答案

为此，我们首先想知道用户的年龄。我们通过在CLIPS中创建/断言以下事实来做到这一点：

(assert 
    (question 
    (factor your-age) 
    (question-to-ask "What is your age?") ))

然后我们还想知道用户希望结婚的人的年龄：

(assert 
    (question 
    (factor your-partner-age) 
    (question-to-ask "What is the age of the person you wish to marry?") )) 

接下来，我们创建一个规则，从这些事实中推断出“age-difference”：

(defrule calculate-age-difference
    (answer (known-factor your-age) ( value ?your-age))
    (answer (known-factor your-partner-age) ( value ?your-part-age))
  =>
    (assert (answer (known-factor age-difference) (value (abs (- ?your-age ?your-part-age)) ))))

现在我们需要将问题转换为与用户的交互式对话。为此，我们定义以下规则：

(defrule ask-question
    ?q <- (question (question-to-ask ?question)
    (factor ?factor)
    (has-pre-condition no))
    (not (answer (known-factor ?factor)))
  =>
    (printout t ?question crlf)
    (assert (answer (known-factor ?factor) (value (read)))))

这条规则的含义是，如果工作内存中有一个尚未回答且没有前置条件的问题，则向用户提问。此规则的结果（RHS）会向用户提示“?question”，然后创建一个（断言）“answer”事实，其“known-factor”槽设置为“?factor”，而“value”设置为用户响应（'(read)' I/O函数的返回值）。

理解跟踪

在CLIPS中输入规则后，显示以下跟踪：

• ==> Activation 0 ask-question: f-11,*

请注意，问题事实f-10没有激活此规则，因为它在内存中有一个匹配的答案事实（f-4），这意味着它已经回答。
现在通过键入(run)来触发规则。
系统将提示您一个问题，您回答68。
这反过来又触发了“calculate-age-difference”规则，在工作内存中创建了一个新的答案事实。

• ==> f-12 (answer (known-factor your-partner-age) (value 68))
• ==> Activation 0 calculate-age-difference: f-4,f-12
• ==> f-13 (answer (known-factor age-difference) (value 21))

带前置条件的问题

现在我们有了触发用户提示的规则，接下来让我们看看如何实现问题依赖性。
假设我们有一个问题，只有当您在工作内存（或事实数据库）中有一个特定的答案时才应提出。例如：仅当其工作状态为“employed”时才查找用户的年收入。为了做到这一点，我们首先需要定义一个将其前置条件槽设置为“yes”的问题。在CLIPS中输入此代码：

(assert 
    (question 
    (factor your-annual-income) 
    (question-to-ask "What is your annual income in USD?") 
    (has-pre-condition yes)))

这将在事实数据库中创建一个新的事实“f-14”，但不会触发“ask-question”规则，因为其前置条件槽设置为yes，如以下跟踪所示：

• ==> f-14 (question (factor your-annual-income) (question-to-ask "What is your annual income in USD?")(has-pre-condition yes))

前置条件是只有当该人的“就业状态”为“employed”时才应提出问题。为了表达这一点，我们定义了另一个名为“question-rule”的事实模板。

(deftemplate question-rule
    (multislot if (default none))
    (slot then-ask-question (default none)))

并使用此事实模板以类似自然语言的语法来陈述问题依赖性：

(assert 
    (question-rule (if your-work-status is employed) (then-ask-question your-annual-income)))

这将在事实数据库中创建一个新的“question-rule”事实“f-15”，如以下跟踪所示：

• ==> f-15 (question-rule (if your-work-status is employed) (then-ask-question your-annual-income))

实现问题依赖规则

在这里，我们再次使用逆向链算法。我们使用“question-rule”而不是“domain-rule”，并使用“question”事实而不是“answer”事实。让我们看看它是如何通过定义以下规则来实现的：

(defrule remove-ask-if-in-question-rules
    ?r <- (question-rule (if ?first-ask-if is ?val $?rest-of-ifs-true))
    (answer (value ?val) (known-factor ?f&:(eq ?f ?first-ask-if)))
  =>
    (if (eq (nth$ 1 ?rest-of-ifs-true) and) 
    then (modify ?r (if (rest$ ?rest-of-ifs-true)))
    else (modify ?r (if ?rest-of-ifs-true))))

当所有子目标（前件）都解决后，以下规则将把问题事实的“has-pre-condition”槽设置为“no”。

(defrule set-pre-condition-when-no-antecedents
    ?r <- (question-rule (if $?a&:(=(length$ ?a) 0)) (then-ask-question ?f))
    ?q <- (question (factor ?f)(has-pre-condition yes) )
    (not (answer (known-factor ?f)))
  =>
    (modify ?q (has-pre-condition no)))

要查看此规则的作用，请输入以下问题事实：

(assert 
    (question 
    (factor your-work-status) 
    (question-to-ask "What is your work status?") )) 

理解跟踪

这将激活“ask-question”规则，如以下跟踪所示：

• ==> f-16 (question (factor your-work-status) (question-to-ask "What is your work status?") (has-pre-condition no))
• ==> Activation 0 ask-question: f-16,*

现在让我们一步一步运行这个程序。按“CRTL T”或键入“(run 1)”。
这将执行问答规则前件中的代码，导致出现问题提示：“你的工作状态是什么？”输入employed作为响应并按回车键。
这会触发以下事件：

1. 断言了一个新的答案事实（f-17），其中包含响应“employed”。
2. 由于其前件匹配事实f-15和f-17，因此激活了remove-ask-if-in-question-rules 。

如以下跟踪所示：

• => f-17 (answer (known-factor your-work-status) (value employed))
• ==> Activation 0 remove-ask-if-in-question-rules: f-15,f-17

请注意，“0 remove-ask-if-in-question-rules: f-15,f-17”现在位于议程的顶部。
再次按“CTRL T”。这会触发以下事件：

1. 事实（f-15 question-rule）被撤回。
2. 一个新的事实（f-18 question-rule），f-15的克隆，被断言，其“if”属性设置为空列表。
3. 规则“set-pre-condition-when-no-antecedents”被激活，因为其LHS匹配事实18和14。

如以下跟踪所示：

• <== f-15 (question-rule (if your-work-status is employed) (then-ask-question your-annual-income))
• ==> f-18 (question-rule (if) (then-ask-question your-annual-income))
• ==> Activation 0 set-pre-condition-when-no-antecedents: f-18,f-14,*

请注意，“set-pre-condition-when-no-antecedents: f-18,f-14,*”现在位于议程的顶部。再次按“CTRL T”。这会触发以下事件：

1. 事实（f-14 question）被撤回。
2. 一个新的事实（f-19 question），f-14的克隆，被断言，其“has-pre-condition”属性设置为“no”。
3. 规则“ask-question”被激活，因为其LHS匹配事实19及其他事实。

如以下跟踪所示：

• <== f-14 (question (factor your-annual-income) (question-to-ask "What is your annual income in USD?") (has-pre-condition yes))
• ==> f-19 (question (factor your-annual-income) (question-to-ask "What is your annual income in USD?") (has-pre-condition no))
• ==> Activation 0 ask-question: f-19,*

请注意，“0 ask-question: f-19,*”现在位于议程的顶部。
再次按下“CTRL T”。这将执行问答规则前件中的代码，导致出现问题提示：“你的年收入是多少美元？”输入20000 并按回车键。
这会触发以下事件：

1. 断言了一个新的答案事实（f-25），其中包含您的年收入。

如以下跟踪所示：

• => f-20 (answer (known-factor your-annual-income) (value 20000))

完整的算法

要在一个文件中查看并执行此算法，请按照以下步骤操作：

• 解压下载 Making_the_system_interactive.zip 。
• 使用“ALT F B”键在CLIPS中加载“Making the system interactive.bat”。
• 键入(run)或按CTRL R。

使系统交互并带有验证

表达用户输入约束

如果您想将问题的响应限制在预定义选项集或某个范围内，该怎么办？例如，您希望“your-work-status”的响应仅限于以下选项：学生、受雇或退休。

此外，您希望将“your-annual-income”限制在20K到100K的范围内。为了实现这一点，我们修改问题模板并添加额外的多槽。
在CLIPS中输入(clear)，然后输入此事实模板：

(deftemplate question
    (slot factor (default none)) 
    (slot question-to-ask (default none))
    (slot has-pre-condition (type SYMBOL) (default no)) 
    (multislot choices (default yes no))
    (multislot range (type INTEGER))) 

“question”事实现在有两个额外的槽位：

• choices – 可能的答案列表，默认为yes和no。
• range – 需要整数响应的答案范围，受整数类型约束。

您现在可以在问题事实中表达约束。在CLIPS中输入以下事实：

(assert 
    (question 
    (factor your-age) 
    (question-to-ask "What is your age?") 
    (range 18 120)))

(assert 
    (question 
    (factor your-work-status) 
    (question-to-ask "What is your work status?") 
    (choices student employed retired) ))

您现在的事实数据库中将有两个事实。

根据约束验证用户输入

既然我们已经捕获了输入约束，接下来要做的是编写一些CLIPS函数来强制执行这些约束。
首先，我们编写这个检查范围的函数。它接受范围和用户响应作为参数，如果响应在范围内则返回1，否则返回0。在CLIPS中编写方式如下：

(deffunction check-range ( ?min ?max ?answer )
    (if (not (numberp ?answer)) then (return 0) ) 
    (if ( and (>= ?answer ?min) (<= ?answer ?max) ) 
    then (return 1) 
    else (return 0)) )

请注意，此方法还使用CLIPS谓词函数“numberp”验证数字响应。通过在CLIPS窗口中执行此方法来尝试它。

(check-range 20 40 1)

(check-range 20 40 two)
(check-range 20 40 21) 

第一次和第二次调用将返回0，第三次调用将返回1。

接下来，我们编写一个函数，它会不断向用户提示相同的问题，直到答案符合约束条件。在CLIPS中键入或复制/粘贴此函数：

(deffunction ask 
    (?question ?choices ?range)
    (if (eq (length$ ?range) 0) 
    then (printout t ?question ?choices ":") 
    else (printout t ?question "range-" $?range ":")
    )
    (bind ?answer (read) )
    (if (eq (length$ ?range) 0)
     then (while (not (member$ ?answer ?choices)) do
        (printout t "Invalid option! Please specify one of these options" ?choices ":" ) 
        (bind ?answer (read))
        (if (lexemep ?answer) then (bind ?answer (lowcase ?answer))))
    else (while (eq (check-range (nth$ 1 ?range ) (nth$ 2 ?range ) ?answer) 0 ) do
        (printout t "Invalid input! Please specify a value within the range" $?range ":")
        (bind ?answer (read))
        (if (lexemep ?answer) then (bind ?answer (lowcase ?answer))))
        )
    (printout t crlf) 
    ?answer
)

函数的工作原理如下：

1. 它接受问题及其答案约束作为参数。
2. 然后它通过检查多槽“?range”的长度来检查约束是“范围”还是“选项”集，并向用户提示一个适当的问题以及约束。
3. 它将用户响应（(read) I/O函数的返回值）赋给“?answer”变量。
4. 如果约束是一组“选项”，它将检查“?answer”是否使用CLIPS函数“member$”匹配多字段变量“?choices”中的任何元素。
5. 如果不匹配，它会重新提示用户并一直这样做，直到用户重新打开的答案与“?choices”多字段中的任何一个元素匹配。
6. 如果约束不是“选项”集，即它是一个“范围”，那么它使用“check-range”方法检查答案是否在范围内。
7. 它使用CLIPS多字段函数“$nth”访问?range变量中的第一个和第二个元素，然后将它们传递给“check-range”方法。
8. 如果用户响应“?answer”不在范围内，它会重新提示用户并一直这样做，直到用户响应在多字段“?range”的第一个和第二个元素之间。

并通过从CLIPS中调用它来尝试（首先尝试一些无效的响应）

(ask "What is your employment status?" (create$ retired employed student) (create$))

然后尝试这个：

(ask "What is your age?" (create$) (create$ 18 120))

“create$”函数将任意数量的字段连接起来以创建多字段值。
接下来，我们修改“ask-question”规则，使用“ask”函数而不是直接请求/响应。
（注意：由于我们已清除CLIPS环境，请首先重新定义“answer”事实模板）

(deftemplate answer
    (slot known-factor (default none))
    (slot value (default none)))

然后在CLIPS中输入此函数：

(defrule ask-question
    ?q <- (question (question-to-ask ?question)
    (factor ?factor)
    (range $?range)
    (choices $?choices)
    (has-pre-condition no))
    (not (answer (known-factor ?factor)))
  =>
    (assert (answer (known-factor ?factor)
    (value (ask ?question ?choices ?range)))))

这条规则的含义是，如果工作内存中有一个尚未回答且没有前置条件的问题，则创建一个（断言）“answer”事实，其“known-factor”槽设置为“?factor”，而“value”设置为“ask”函数的返回值。
因此，这条规则现在将被激活，因为它有两个匹配的事实，如以下跟踪所示：

• ==> Activation 0 ask-question: f-1,*
• ==> Activation 0 ask-question: f-2,*

键入(run)以触发规则。
一旦提示，请使用无效答案进行响应，以查看约束强制执行。一旦输入有效响应，您将看到以下答案事实：

• f-3 (answer (known-factor your-work-status) (value student))
• f-4 (answer (known-factor your-age) (value 44))

完整的算法

要在一个文件中查看并执行此算法，请按照以下步骤操作：

• 解压下载 Making_the_system_interactive-with_validation.zip 。
• 使用“ALT F B”键在CLIPS中加载“Making the system interactive-with validation.bat”。
• 键入(run)或按CTRL R。

让“苏格拉底”更明智

到目前为止，这些规则让“苏格拉底”考虑了“年龄”因素。现在我们将添加规则，以纳入“收入兼容性”和“婚姻罚金税负”。
再次将“Making the system interactive-with validation.bat”加载到CLIPS中（暂时不要运行它）。
然后在CLIPS中添加以下规则：

(assert 
    (domain-rule (if income-difference is-more-than 100000 )
    (then based-on income-compatibility the-expert-system-favours-getting-married-with-certainty 15.0 %)) )


(assert
    (domain-rule (if income-difference is-more-than 1000 but-less-than 10000 )
    (then based-on income-compatibility the-expert-system-favours-getting-married-with-certainty 55.0 % 
    and based-on marriage-penalty-tax-liability the-expert-system-favours-getting-married-with-certainty 25.0 %)))

您现在应该在事实窗口中看到16个事实。

扩展逆向链算法

请注意，此规则中的条件要求我们检查表示为“income-difference is-more-than 1000 but-less-than 10000”的范围。我们的“remove-ask-if-in-domain-rules-with-more-than”无法处理此问题。因此，我们需要一个额外的规则来处理此条件。

(defrule remove-ask-if-in-domain-rules-with-more-than-but-less-than
    ?r <- (domain-rule (if ?first-ask-if is-more-than ?min but-less-than ?max $?rest-of-ifs-true)) 
    (answer (known-factor ?f&:(eq ?f ?first-ask-if)) (value ?a&:(and (> ?a ?min) (< ?a ?max)(numberp ?a))) )
  =>
    (if (eq (nth$ 1 ?rest-of-ifs-true) and) 
    then (modify ?r (if (rest$ ?rest-of-ifs-true)))
    else (modify ?r (if ?rest-of-ifs-true))))

但这会给冲突解决器带来一个小问题——此规则和“remove-ask-if-in-domain-rules-with-more-than”规则可能会匹配相同的事实。

增加显着性

为了确保此规则优先，我们修改“remove-ask-if-in-domain-rules-with-more-than”规则，并将其显着性更改为-100。显着性允许您为规则分配优先级（或权重）。

(defrule remove-ask-if-in-domain-rules-with-more-than
    (declare (salience -100)) 
    ?r <- (domain-rule (if ?first-ask-if is-more-than ?min $?rest-of-ifs-true)) 
    (answer (known-factor ?f&:(eq ?f ?first-ask-if)) (value ?a&:(> ?a ?min)) )
  => 
    (if (eq (nth$ 1 ?rest-of-ifs-true) and) 
    then (modify ?r (if (rest$ ?rest-of-ifs-true)))
    else (modify ?r (if ?rest-of-ifs-true))))

添加更多问题

现在，让我们添加一个“question”事实，以获取用户希望结婚的人的年收入。

(assert
    (question (factor your-partner-annual-income) 
    (question-to-ask "What is your annual income in USD of the person you wish marry?") 
    (range 20000 1000000)
    (has-pre-condition yes)))

但我们只想在他/她受雇时才提出这个问题，因此这个问题和依赖规则：

(assert 
    (question (factor your-partner-work-status) 
    (question-to-ask "What is the work status of the person you wish marry ?") 
    (choices student employed retired) ))

(assert 
    (question-rule 
    (if your-partner-work-status is employed) 
    (then-ask-question your-partner-annual-income)))

现在您将在议程中看到三项内容：

• ==> Activation 0 ask-question: f-18,*
• ==> Activation 0 ask-question: f-14,*
• ==> Activation 0 ask-question: f-11,*

为了推断收入差异，我们将添加以下规则：

(defrule calculate-income-difference
    (answer (known-factor your-annual-income) ( value ?your-inc))
    (answer (known-factor your-partner-annual-income) ( value ?your-part-inc))
  =>
    (assert (answer (known-factor income-difference) (value (abs (- ?your-inc ?your-part-inc)) ))) )

运行更明智的“苏格拉底”

键入(run)或按CRTL R。
对两个工作状态问题都回答“employed”。
输入您的收入为80000，您希望结婚的人的收入为82000。
输入您希望结婚的人的年龄为68岁。

要查看最终结论事实，请在CLIPS中键入此查询：

(find-all-facts ((?c conclusion)) TRUE)

您将看到结论：(<Fact-9> <Fact-31> <Fact-32>)。对每个结论键入(ppfact)。

(ppfact 9)
(ppfact 31)
(ppfact 32) 

查看以下结论：

• (conclusion (name age-factor) (confidence-factor 56.0))
• (conclusion (name income-compatibility) (confidence-factor 55.0))
• (conclusion (name marriage-penalty-tax-liability) (confidence-factor 25.0))

打印并格式化结果

要显示格式化的结论，请编写此规则：

(defrule print-conclusions
    (declare (salience -5000))
    ?c<- (conclusion (confidence-factor ?cf) (name ?n))
 =>
    (printout t "Factor " (upcase ?n) ", confidence rating:" ?cf " %" crlf)) 

请注意以下激活：

• ==> Activation -5000 print-conclusions: f-9
• ==> Activation -5000 print-conclusions: f-31
• ==> Activation -5000 print-conclusions: f-32

键入(run)以查看格式化的结论：

• 因素 婚姻罚金税负, 置信度:25.0 %
• 因素 收入兼容性, 置信度:55.0 %
• 因素 年龄因素, 置信度:56.0 %

完整的算法

要在一个文件中查看并执行此算法，请按照以下步骤操作：

• 解压下载 WiserSocrates.zip。
• 使用“ALT F B”键在CLIPS中加载“WiserSocrates.bat”。
• 键入(run)或按CTRL R。

第三部分

现在我们已经学习了如何在CLIPS中编程专家系统，是时候看看如何将其集成到应用程序中了。在本系列的最后一篇文章中，我将向您展示如何将CLIPS应用程序嵌入到C++、C#和Java等编程语言中。

人、婚姻与机器——人工智能建议的冒险，第3部分

.