Click here to Skip to main content
Click here to Skip to main content
Go to top

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

, 13 Apr 2011
Rate this:
Please Sign up or sign in to vote.
‘Expert Systems’ is one of the most commercially successful application of Artificial Intelligence. This three part series describes how to develop an expert system based artificial advisor, using a backward reasoning algorithm.

Part 1 | Part 2

In part 2 of this article we learnt how to program an expert system in CLIPS. In the concluding part we will see how to embed an expert system into C++, C# and Java applications.

Converting the knowledge base into a ”CLIPS” file

A CLIPS file is simple text file. To create one in CLIPS press CTRL N. Then and save it as 'SocratesKnowledgeBase.clp'

You can use following editors :

  1. Notepad
  2. notepad++ (with its language set to LISP)

Organizing “a priori” questions

We will first group all of our questions using the “deffacts construct. This construct allows a set of 'a priori' or initial knowledge to be specified as a collection of facts. When the CLIPS environment is reset the facts in this construct are added to the facts list.

Now let us add the following sections to “SocratesKnowledgeBase.clp” text file.
Create a “question” template first

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

Then add the following “a priori” question facts

(deffacts questions 
    (question (factor your-age) (question-to-ask "What is your age?") (range 18 120) )
    (question (factor your-partner-age) (question-to-ask "What is the age of the person you wish to marry?") (range 18 120) )
    (question (factor your-work-status) (question-to-ask "What is your work status?") (choices student employed retired) )
    (question (factor your-partner-work-status) (question-to-ask "What is the work status of the person you wish marry ?") (choices student employed retired) )
    (question (factor your-annual-income) (question-to-ask "What is your annual income in USD?") (range 20000 1000000) )
    (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) ))

Next create a “question-rule” template

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

Then add the following “a priori” question-rules facts.

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

Organizing “a priori” domain rules

Create a domain-rule template

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

Then add the following “a priori” domain-rules facts to be used by the backward chaining algorithm

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

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

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

    (domain-rule (if your-annual-income is-more-than 100000 and 
                    your-partner-annual-income is-more-than 100000)
    (then based-on income-tax the-expert-system-favours-getting-married-with-certainty 60.0 %)) 

    (domain-rule (if your-annual-income is-less-than 100000 and 
                your-partner-annual-income is-less-than 100000)
    (then based-on income-tax the-expert-system-favours-getting-married-with-certainty 80.0 %)))

Creating rules to infer additional facts

Define an answer template first

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

Then add rules to infer age and income 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 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)) ))))

Next add a fact template for conclusion

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

Creating a rule of mark questions with pre conditions

In the previous article we manually marked a question with a pre-condition. Now let us see how make the expert system do it automatically using this rule

(defrule mark-questions-with-pre-conditions
    ?q <-(question (factor ?f) (has-pre-condition no))
    (question-rule (then-ask-question ?f) (if $?i&:(> (length$ ?i) 0)) )
   =>
    (modify ?q (has-pre-condition yes)) )

Adding the rules to accept and validate user input

We now add rules to prompt the user with a question, validate it and then capture the response in an answer facts

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

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

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

Implementing the backward changing algorithm for domain-rule

Now add rules that implements our backward chaining algorithm

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

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

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

Implementing rules to resolve question dependencies

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

Combining confidence factors

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

Formatting and printing the final conclusion

(defrule print-conclusions
    (declare (salience -5000))
    ?c<- (conclusion (confidence-factor ?cf) (name ?n))
  =>
    (printout t "Based on [ " (upcase ?n) " ] expert systems confidence favouring getting married is " ?cf " %" crlf))

Save “SocratesKnowledgeBase.clp”. This file should look like SocratesKnowledgeBase.zip.

Running the CLIPS file

Follow these steps to run this file in CLIPS

  1. Disable tracing by pressing CTRL W and then click the 'None' button
  2. Clear the CLIPS environment by typing (clear).
  3. Clear the CLIPS window by typing (clear-window).
  4. Load "SocratesKnowledgeBase.clp" by pressing CTRL L.
  5. Reset the CLIPS environment (to assert the initial facts) by typing (reset)
  6. Run this file by typing (run).

Integrating CLIPS with C++

Install CLIPS source code using this link.

Create a new C++ console application using MS VS 2008 and name it “Socrates_AsCppConsoleApp”. Add a cpp file to this project and name it “Socrates_AsCppConsoleApp.cpp”. Add the following code to your this file. Make sure you change the file paths of "clipscpp.h" and "CLIPSCPP.lib" to the CLIPS source code folder.

#include "C:\Program Files\CLIPS\Projects\Source\Integration\clipscpp.h"
#pragma comment(lib, "C:\\Program Files\\CLIPS\\Projects\\Libraries\\Microsoft\\CLIPSCPP.lib")
int main()
{ 
    CLIPS::CLIPSCPPEnv theEnv; 
    theEnv.Load("..//SocratesKnowledgeBase.clp");
    theEnv.Reset();
    theEnv.Run(-1);
    return 0;
}

Sample Code

Integrating CLIPS with C# using CLIPSNet

Unzip CLIPSNet_libs.zip and extract “CLIPSNet” libraries. (To download the latest version of CLIPSNet using this link.)

Create a .net console application and name it “Socrates_AsCSharpApp”. Add a reference to CLIPSNet.dll and make sure you copy the “CLIPSLib.dll” to the bin/debug folder. Then in the program.cs file add the following code

using System;
namespace Socrates_AsCSharpApp
{
   class Program
   {
    static void Main(string[] args)
    {
        CLIPSNet.Environment theEnv = new CLIPSNet.Environment();
        theEnv.Load(@"..\..\..\SocratesKnowledgeBase.clp");
        theEnv.Reset();
        theEnv.Run(-1);
    }
   }
}

Sample Code

Integrating CLIPS with Java using JESS

Install JESS using this link.

Create a new Java project using Eclipse. Add jess.jar to its list of external jars. Create a new class in the project and name it “Socrates_AsJavaApp”. Add the following code to this class

import jess.JessException;
import jess.Rete;
public class Socrates_AsJavaApp{
public static void main(String[] args) {
    try {
    Rete env = new Rete();
    env.batch("..\\SocratesKnowledgeBase.clp");
    env.reset();
    env.run();
    } catch (JessException e) {
    e.printStackTrace();
    }
  }
}

Sample Code

Congratulations!!. You made to the last section of this really long series of articles. To reward your patience I will give away the entire “Socrates” knowledge base free and also show you how to route the results to a text file.

The complete Socrates Expert System

Using MS VS 2008 create a new C++ console project and name is “Socrates”. Add a header file this project and name it “CustomFileRouter.h”.

CLIPS I/O router

CLIPS lets you to write generic I/O functions and the assign them logical names. These routers can then be used in any of the following I/O functions

  1. Open
  2. Close
  3. Printout
  4. Read
  5. Readline
  6. Format
  7. Rename

The first step to write a router in C++ is to extend the “CLIPSCPPRouterclass and override its Query, Print and GetContents functions. Type the code below in CustomFileRouter.h

using namespace CLIPS;
class CustomFileRouter : public CLIPSCPPRouter
{
    FILE* _resultsFile;
    char* fName;
public:
    CustomFileRouter(char* fileName)
    {
        _resultsFile = NULL;
        fName = fileName;
    }
    int Query(CLIPSCPPEnv *e,char * name)
    {
        if (strcmp(name,fName) == 0) 
        {
            if(_resultsFile == NULL)
            _resultsFile = fopen(fName , "w+");
            return(TRUE);
        }
        return(FALSE); 
    }
    int Print(CLIPSCPPEnv *e,char * name,char *p)
    {
        fputs(p ,_resultsFile);
        return(TRUE);
    } 
    int Exit(CLIPSCPPEnv *e,int)
    {
        return(TRUE);
    }
    char* GetContents()
    {
        fseek (_resultsFile , 0 , SEEK_END);
        long lSize = ftell (_resultsFile);
        rewind (_resultsFile);
        char *buffer = (char*) malloc (sizeof(char)*lSize);
        ZeroMemory(buffer,lSize);
        fread (buffer,1,lSize,_resultsFile);
        fclose(_resultsFile);
        _resultsFile = NULL;
        return buffer;
    } 
}; 

Adding the router to CLIPS runtime

Add a new file to the project and name it Socrates.cpp. In the main function add the following code

CLIPSCPPEnv theEnv; 
CustomFileRouter* results_fileRouter = new CustomFileRouter("results_file");
theEnv.AddRouter("results_file",10,results_fileRouter);
CustomFileRouter* questions_fileRouter = new CustomFileRouter("questions_file");
theEnv.AddRouter("questions_file",10,questions_fileRouter);

This will add two logical routers to CLIPS runtime namely: “results_file”, “questions_file”.
You can use these routers within CLIPS in any I/O function. For example this command will print to the “results_file” instead of console.

(printout results_file "Hello custom router !!" crlf)

Embedding the rules file as a resource

To package “socrates” as a single app with the rules file embedded as a resource follow these steps.

Add the CLIPS rules files to your project.
Then in resources.h file add the following code

#define    CLIPS_RULE_FILE 201 
#define    IDR_CLP_FILE 101 

and in the .rc file add this

IDR_CLP_FILE     CLIPS_RULE_FILE      "SocratesExpertSystemRules.clp" 

And this is how you can load the resource at run time

HMODULE handle = ::GetModuleHandle(NULL); 
HRSRC rc = ::FindResource(handle, MAKEINTRESOURCE(IDR_CLP_FILE), MAKEINTRESOURCE(CLIPS_RULE_FILE)); 
HGLOBAL rcData = ::LoadResource(handle, rc); 
size = ::SizeofResource(handle, rc); 
data = static_cast<const char*>(::LockResource(rcData)); 

Sample Code

Conclusion

Artificial advisors are expert systems which are a type of knowledge based systems . For such systems to reason well they must know a lot about the domain in which they operate. So for ‘Socrates’ to reason accurately additional domain expertise needs to be added than what is the sample code.

It wasn't possible for me to cover all aspects of experts systems in these articles, so here is a list of websites that you can use as a reference.

Let the adventure in artificial advising begin!!

.

License

This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

Share

About the Author

asheesh goja
Architect
United States United States
I work as an software architect in NJ USA.
 
Here is my technical blog.

Comments and Discussions

 
GeneralRashid Bagheri Pinmemberrashid13681-Jun-11 0:09 

General General    News News    Suggestion Suggestion    Question Question    Bug Bug    Answer Answer    Joke Joke    Rant Rant    Admin Admin   

Use Ctrl+Left/Right to switch messages, Ctrl+Up/Down to switch threads, Ctrl+Shift+Left/Right to switch pages.

| Advertise | Privacy | Mobile
Web01 | 2.8.140916.1 | Last Updated 13 Apr 2011
Article Copyright 2011 by asheesh goja
Everything else Copyright © CodeProject, 1999-2014
Terms of Service
Layout: fixed | fluid