Man, Marriage and Machine – Adventures in Artificial Advice, part 2

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

Part 1 | Part 3

In part 1 of this article we learnt the fundamental concepts of Expert Systems. In this article we will use these concepts to develop an expert system based artificial advisor.

Socrates—the artificial advisor

The goal of this expert system is to provides an objective assessment of one’s nuptial success, based on the following factors:

1. Income compatibility
2. Age Factor
3. Employment status
4. Marriage penalty tax liability
5. Cohabitating couple economy
6. Health insurance coverage
7. Social security benefits
8. Family dynamics
9. Myers briggs personality type personality compatibility (MBTI)

Domain Expertise

The first and foremost thing to write an expert system is to find a domain expert. But for the purpose of this article I will use the following website as the SMEs. (For a serious expert system you will need a human domain expert).

• 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

This domain expertise needs to be converted into a format that the inference engine can reason over.

Knowledge engineering “Socrates”

As explained earlier the two most frequently employed strategies in expert systems reasoning are: “forward chaining” and “backward chaining”. The former is also called data-driven and the latter goal-driven. In backward chaining the inference engine selects a goal and then attempts to find facts to affirm or contradict this goal. In this process new goals can be established called sub-goals. Since CLIPS doesn’t directly support backward chaining, I will use the following backward chaining algorithm.

The backward chaining algorithm

1. Express associations between a goal (consequent) and the conditions it depends on (antecedents) as facts, and name this fact domain-rule.
2. The consequents of a domain-rule are the goals for be resolved.
3. If a domain-rule has an antecedent then each antecedent becomes a sub-goal.
4. Each sub goal is resolved by affirming or negated it based on the facts called answer.
5. If a sub-goal is affirmed then this antecedent is removed from the domain-rule's antecedents.
6. Repeat step 3 and 4 until there are no antecedents left.
7. When a domain-rule has no antecedent then fire the rule to create of a new fact called conclusion.
8. The conclusion consists of the goal along with certainty rating called “confidence-factor” .
9. If two goals resolve to same conclusion then combine their certainties (confidence-factors) using the function ((100* (cf1 + cf2))-(cf1 * cf2))/100

Let us see how this is implemented in CLIPS. But first enable activations and facts tracing by pressing “CTRL W” or typing the commands

(watch facts)

(watch activations)

And then clear the CLIPS environment by typing (clear)

Implementing the algorithm

Algorithm step 1-2 implementation

Define a fact template that captures the link between the goal and its conditions. Type or copy/pastes this code in the CLIPS window
(Note : After each type or copy/paste operation in the CLIPS window press enter)

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

This fact template can now express the following statement:
“if the age difference between two people is more than 30, then the experts system’s confidence-factor based on “age-factor” of getting married is 20%” As represented by this 'domain-rule'. Type it in 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 %)))

You will now see a fact “f-1 (domain-rule (if age-difference...” in the facts window.

Algorithm step 3, 4, 5, 6 implementation

We now have to affirm or negate the goal “Age-factor with certainty 20 %” with the antecedents “age difference” of more than 30.To capture such fact that can affirm or negate the antecedents we define a fact-template called “answer”. Type this in CLIPS

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

Next we define a rule that fires when an antecedent of a domain-rule matches an “answer” fact. Type this rule in 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))))

This is how you read the LHS (antecedent) of this rule

• Assign the “domain-rule” fact to a variable ?r.
• Assign the first symbol in the “if” slot to a variable ?first-ask-if.
• The next symbol should match “is-more-than”
• Assign the symbol following “is-more-than” to a variable ?min
• Assign the rest of the symbols to a multi-field variable ?rest-of-ifs-true
• and
• The answer fact’s “known-factor” slot (assigned to variable ?f) must exactly match the variable ?first-ask-if and the “value” slot (assigned to variable ?a) must be greater than ?min.

This is how you read the RHS (consequent) of this rule

• If the first symbol in the ?rest-of-ifs-true is “and” then
• Modify the “if” slot of the rule ?r and set its value to rest of the symbols in ?rest-of-ifs-true after skipping the first symbol.
  (we need this to handle domain-rules with multiple antecedents)
• Else if first symbol in the ?rest-of-ifs-true is not “and” then
• Modify the “if” slot of the rule ?r and set its value to ?rest-of-ifs-true.

To see this rule triggered let us create a fact that affirms the antecedent (age-difference > 30)
We will see later how this fact can be automatically inferred by asking the user a series of questions.

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

Understanding the trace

Notice the following trace

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

What this means that the fact f-2 in now in working memory and the rule “remove-ask-if-in-domain-rules-with-more-than” is now on the agenda, as its LHS matches facts f-1 and f-2.

Next press “CTRL T” or type (run 1) and the trace now shows

• <== 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 %))

This means that the domain-rule f-1 has been modified and its antecedent “age-difference is-more-than 30” removed from the “if” slot.

Algorithm step 7,8 implementation

This modified fact should now trigger another rule that resolves the goal by concluding that all facts in the antecedent (“if” slot ) are affirmed by the facts in the working memory. Create a fact-template that represents a conclusion

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

Then define this rule in 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))) )

This is how you read the LHS(antecedent) of this rule.

• Assign the domain-rule fact to a variable ?r.
• Assign all symbols in the “if” slot to a variable ?a and make sure it is empty ( by checking its length).
• Assign the symbol in the “then” slot that appears between the “based-on” and “the-expert-system-favours-getting-married-with-certainty” symbols to a variable ?factor and makes sure its length is non-zero.
• Assign the symbols that appears after “the-expert-system-favours-getting-married-with-certainty” but before the “%” symbol to a variable ?cf.
• Assign the rest of the symbols to a multi-field variable $?rest-of-factors

This is how you read the RHS (consequent) of this rule.

• If the first symbol in variable ?rest-of-factors is “and” then
• Modify the “then” slot of the rule ?r and set its value to rest of the symbols in variable ?rest-of-factors after skipping the first symbol.
  (we need this to handle domain-rules with multiple consequents)
• Else if first symbol in the ?rest-of-factors is not “and” then
• Create a new fact in the working memory called “conclusion” and set its “name” slot to the variable ?factor and the “confidence-factor” slot to variable ?cf.

Understanding the trace

You now see this trace

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

Press CTRL T to fire this rule. This trace show up

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

What it means is that the goal “age-factor” has been resolved and a conclusion asserted with a “confidence factor” of 20.

Algorithm step 9 implementation (combining certainty)

What if two goals resolve to the same conclusion. Say if a person aged more than 40 also resolves to conclusion “age-factor” with “confidence-factor” of 45%. To express it write the following “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 %)))

Then enter this “answer” fact to trigger the "fire-domain-rule"

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

Now type (run) or press CTRL R

This will create another “conclusion” facts in working memory with name “age-factor” and value 45.

Now let us write a rule to combine conclusions with same name

(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))))

This is how you read the LHS(antecedent) of this rule.

• Assign the a conclusion fact to a variable ?rem1.
• Assign the value of “name” slot to a variable “n and of “confidence-factor” to ?f1
• Assign the another conclusion fact to a variable ?rem2 and make sure its “name” slot matches the variable ?n and assigin its “confidence-factor” to ?f2.
• Make sure ?rem1 and ?rem2 don’t refer to the same fact.

This is how you read the RHS (consequent) of this rule.

• Remove fact ?rem1 from working memory
• Modify the “confidence-factor” slot of ?rem2 to the value returned by this function((100* (?f1 + ?f2))-(?f1 * ?f2))/100

Understanding the trace

After you type the rule the following trace shows up

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

This means that the rule “combine-confidence-factors” LHS matches facts f4 and f-8.

Press CTRL T and the final conclusion shows up:

(conclusion (name age-factor) (confidence-factor 56.0)) based on this function
((100* (20 + 45))-(20 * 45))/100 = 56.0

The complete algorithm

To see this algorithm in a single file and execute it follow these steps

• Unzip Download Backward_chaining_algorithm.zip .
• Load “Backward chaining algorithm.bat” in CLIPS using keys “ALT F B”.
• Type (run) or press CTRL R.

Making the system interactive

Now that we have the basic backward chaining algorithm in place, let see how we can makes our system interactive and ask user questions instead of hardcoding the answers. We will also see how additional answers can be inferred from answers to basic questions.

Define the question template

We will first define an unordered fact called “question”. Type the below
(Note: Make sure you first load and run the “Backward chaining algorithm.bat”)

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

The “question” fact has following attributes/slots/fields:

• factor – A unique human readable identifier for the fact, constrained by not allowing nulls.
• question-to-ask – The text of the question, constrained by not null.
• has-pre-condition – Indicates if this question should be asked only if another question has been answered first. Defaults to no.

Inferring the “age-difference” answer

To do that we first want to know is the age of the user. We do that by creating/asserting the following fact in CLIPS

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

Then we also want to know the age of the person the user wishes to marry

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

Next we create a rule that infers the “age-difference” from these facts

(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)) ))))

Now we need to convert the questions to an interactive dialog with the user. For that we define the following rule

(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)))))

What this rule means that if there is a question in the working memory that is not answered yet and has no pre-condition, then prompt the user with a question. The consequent of this rule (RHS) prompts the user with the “?question” and then creates (asserts) an “answer” fact with its “known-factor” slot set to “?factor” and “value” to the user response (return value of the '(read)' I/O function).

Understanding the trace

After typing the rule in CLIPS the following trace shows up

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

Notice question fact f-10 is doesn’t activate this rule as it has a matching answer fact in memory (f-4), meaning it is already answered.
Now fire the rule by typing (run).
You will be prompted with a question, to which you answer 68.
This in-turn fires the “calculate-age-difference” rule creating a new answer fact the working memory.

• ==> 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))

Question with pre conditions

Now that we have rules to trigger user prompts, let us now see how question dependencies are implemented.
Say we have a question that should be asked only if you have a certain answer in the working memory (or facts database). Like this one: Find the user's annual income only if his/her work status is 'employed'. In order to that we need to first define a question with its pre-condition slot set to ‘yes’. Type this code in CLIPS

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

This will create a new fact “f-14” in the facts database, but won’t trigger the “ask-question” rule as its pre-condition slot is set to yes, as see in this trace

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

The pre-condition is that the question should only be asked if the ‘employment status’ of the person is ‘employed’. To express that we define another fact template called “question-rule”.

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

and use this fact-template to state the question dependency in a natural language like syntax

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

This will create a new “question-rule” fact “f-15” in the facts database a seen in this trace

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

Implementing the question dependency rules

Here, we again use the backward chaining algorithm. Instead of using the “domain-rule” we use the “question-rule” and instead of “answer” facts we use “question” facts. Let us see how it is implemented by the defining the following rule

(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))))

When all sub-goals (antecedents) are resolved then the following rule will set the “has-pre-condition” slot of the question fact to “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)))

To see this rule in action enter the following question fact

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

Understanding the trace

This will activate the “ask-question” rule as seen in this trace

• ==> 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,*

Now let us run this program step-by-step. Press “CRTL T” or type “(run 1)”.
This executes the code in the antecedent of the ask-question rule, resulting in a question prompt: “What is your work status?” Type employed in response and hit enter.
This triggers the following events:

1. A new answer fact is asserted (f-17) that contains the response “employed”.
2. The remove-ask-if-in-question-rules is activated as its antecedents match facts f-15 and f-17

As seen in this trace

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

Notice “0 remove-ask-if-in-question-rules: f-15,f-17” is on the top of the agenda now.
Press “CTRL T” again. This triggers the following events

1. The fact ( f-15 question-rule) is retracted
2. A new fact (f-18 question-rule) a clone of f-15 is asserted with the “if” attribute set to an empty list.
3. The rule “set-pre-condition-when-no-antecedents” is activated as its LHS matches facts 18 and 14

As see in this trace

• <== 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,*

Notice “set-pre-condition-when-no-antecedents: f-18,f-14,*” is on the top of the agenda now. Press “CTRL T” again. This triggers the following events

1. The fact ( f-14 question) is retracted
2. A new fact (f-19 question) a clone of f-14 is asserted with the “has-pre-condition” attribute set to “no”.
3. The rule “ask-question” is activated as its LHS matches fact 19 and others.

As seen in this trace

• <== 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,*

Notice “0 ask-question: f-19,*” is on the top of the agenda now.
Press “CTRL T” again. This executes the code in the antecedent of the ask-question rule, resulting in a question prompt: “What is you annual income in USD?”. Type 20000 and hit enter.
This triggers the following events

1. A new answer fact is asserted (f-25) that contains your annual income.

As seen in this trace

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

The complete algorithm

To see this algorithm in a single file and execute it follow these steps

• Unzip Download Making_the_system_interactive.zip .
• Load “Making the system interactive.bat” in CLIPS using keys “ALT F B”.
• Type (run) or press CTRL R.

Making the system interactive with validation

Expressing user input constraints

What if you want to constraint the response of the questions to a predefined set of options or a range. For example you want the response to the “your-work-status” to be limited of the options: student, employed or retired.

Further you want to constrain the “your-annual-income” to a range: 20 to 100K. In order to do that let us modify the question template and add additional multi-slots.
Type (clear) in CLIPS and then this fact-template

(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))) 

The “question” fact now has two additional slots:

• choices – List of possible answers , it default to yes and no.
• range – Range of answers that require an integer response, constrained by integer type.

This is how you can now express constraints in the question facts. Enter the following facts in 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) ))

You will now have two facts in the facts database.

Validating user input based on constraints

Now that we captured the input constraints; the next thing to do is to write a few CLIPS function that enforces these constraints.
First we write this function that checks ranges. It accepts the range and user response as its arguments a return 1 if the response is within the range and a 0 otherwise. This is how you write it in 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)) )

Notice this method also validates a numeric response using the CLIPS predicate function “numberp”. Try this method out by executing it from the CLIPS window.

(check-range 20 40 1)

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

The first and second call will return 0 and the third call 1.

Next we write a function that keeps prompting the user with the same question until the answer is within the constraints. Type or copy/paste this function in 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
)

This is how the function works

1. It accepts the question and its answer constraints as its arguments.
2. It then checks if the constraint is a “range” or a set of “options” by checking the length of the multi-slot “?range” and the prompts the user with an appropriate question along with the constraints.
3. It the assigns the user response (return value of the (read) I/O function) to the “?answer” variable.
4. If the constraint is a set of “options” it then checks to see if the “?answer” matches any one of the elements of the multi-field variable “?choices” using the CLIPS function “member$”.
5. If it doesn’t match that it re-prompts the user and keeps doing it until the user reopens is matches any one of the elements in the “?choices” multi-field.
6. If the constraint is not a set of “options” meaning it is a “range”, then it checks to see if the answer is within the range using the method “check-range”.
7. It uses the CLIPS multi-field function “$nth” to access the first and second element in the ?range variable and then passes them to the “check-range” method.
8. If the user response “?answer” is not within the range it re-prompts the user and keeps doing it until the user response is within the first and the second element of the multi-field “?range”.

And try it out by calling if from CLIPS ( try some invalid responses first)

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

Then try this

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

The “create$” functions appends any number of fields together to create a multi-field value.
Next we modify the “ask-question” rule to use the “ask” function instead of a direct request/response.
(Note: Since we cleared the CLIPS environment, re-define the “answer” fact-template first)

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

Then type this function in 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)))))

What this rule means is that if there is a question in the working memory that is not answered yet and has no pre-condition, then create (assert) an “answer” fact with its “known-factor” slot set to “?factor” and “value” to the return value of the “ask” function.
As a result this rule will now be activated as it has two matching facts, as seen in this trace

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

Type (run) to fire the rule.
Once prompted respond with invalid answers to see the constrain enforcement in action. Once you enter valid responsed will see following answer facts:

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

The complete algorithm

To see this algorithm in a single file and execute it follow these steps

• Unzip Download Making_the_system_interactive-with_validation.zip .
• Load “Making the system interactive-with validation.bat” in CLIPS using keys “ALT F B”.
• Type (run) or press CTRL R.

Making “Socrates” wiser

So far the rules let “socrates” factor in “age”. Now we will add rules to include “income-compatibility” and “marriage-penalty-tax-liability”.
Load the “Making the system interactive-with validation.bat” into CLIPS again (don’t run it yet).
Then add the following rules in 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 %)))

You should now see 16 facts in the facts window.

Extending the backward chaining algorithm

Notice the condition in this rule requires us to check a range expressed as “income-difference is-more-than 1000 but-less-than 10000”. Our “remove-ask-if-in-domain-rules-with-more-than” cannot process this. So we need an additional rule to handle this condition.

(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))))

It will lead to a small problem with the conflict resolver though— This rule and the “remove-ask-if-in-domain-rules-with-more-than” rule can potentially match the same facts.

Adding Salience

To ensure that this rule takes precedence we modify the “remove-ask-if-in-domain-rules-with-more-than” rule and change its salience to -100. Salience allows you to assign priority (or weight) to a rule.

(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))))

Adding more questions

Now let us add a “question” fact to get the annual income of the person the user wishes to marry

(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)))

But we want to ask this question only if he/she is employed, hence this question and a dependency rule

(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)))

Now you will see three items in the agenda

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

To infer the income difference we will add following rule

(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)) ))) )

Running the wiser “Socrates”

Type (run) or press CRTL R.
Respond to both work status questions as “employed”.
Enter your income as 80000 and the person you wish to marry as 82000.
Enter the age of person you wish to marry as 68

To see see final conclusion facts type this query in clips

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

You will see the conclusions: (<Fact-9> <Fact-31> <Fact-32>). Type (ppfact) for each one of them

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

To see the following conclusions:

• (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))

Printing and formatting the results

To display a formatted conclusion write this rule

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

Note the following activations

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

Type (run) to see the formatted conclusions

• Factor MARRIAGE-PENALTY-TAX-LIABILITY, confidence rating:25.0 %
• Factor INCOME-COMPATIBILITY, confidence rating:55.0 %
• Factor AGE-FACTOR, confidence rating:56.0 %

The complete algorithm

To see this algorithm in a single file and execute it follow these steps

• Unzip Download WiserSocrates.zip .
• Load “WiserSocrates.bat” in the CLIPS using keys “ALT F B”.
• Type (run) or press CTRL R.

Part 3

Now that we learnt how to program an expert system in CLIPS, it is time to see how to integrate it into an application. In the concluding part of this series I will show you how to embed a CLIPS application into programming languages like C++, C# and Java.

Man, Marriage and Machine – Adventures in Artificial Advice, part 3

.