AI-ExpertSystem-Simple
view release on metacpan or search on metacpan
you are even running this code for in the first place.
TO DO
* More documentation (you can never have too much)
REQUIREMENTS
* Developed under 5.6.1 but should work on anything 5+.
* Written completely in Perl. XS is not required.
* Requires XML::Twig to parse the XML
AUTHOR
Peter Hickman <peterhi@ntlworld.com>
Copyright (c) 2003, Peter Hickman. All rights reserved.
This module is free software. It may be used, redistributed and/or
modified under the same terms as Perl itself.
CHANGES IN THIS RELEASE
V1.02:
- The explain method now works
V1.01:
- Implemented the reset method
- Simpleshell now works with the consult the Tcl/Tk shell
- Included a copy of the Tcl/Tk shell
V1.00:
- First release to CPAN
bin/consult view on Meta::CPAN
#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"
################################################################################
# To do
# -----
# Save defaults for program to run, text colour etc
################################################################################
package require cmdline
bin/consult view on Meta::CPAN
text .text -yscrollcommand {.textscroll set}
scrollbar .textscroll -orient vertical -command {.text yview}
pack .text -side top -anchor w -fill both -expand 1
pack .textscroll -side right -fill y -in .text
# Define some colours
.text tag config is_status -foreground blue
.text tag config is_question -foreground red
.text tag config is_response -foreground cyan
.text tag config is_answer -foreground green
.text tag config is_information -foreground grey
# A nice hello message
status "Welcome to the Tcl/Tk expert system shell"
status ""
status "This program is used to call the command line"
status "expert system called simpleshell and allows"
status "you to interact with it via the gui"
bin/consult view on Meta::CPAN
status "Run the file..."
status "This may take a few moments to get started..."
.save configure -state normal
.run configure -state disabled
global filename
global program
set filehandle [open "|$program -t $filename" "r+"]
set question ''
set responses [list]
.text delete 0.1 end
while {![eof $filehandle]} {
set text [gets $filehandle]
if {[regexp {^status:(.*)} $text match newtext]} {
status $newtext
} elseif {[regexp {^question:(.*)} $text match newtext]} {
set question $newtext
set responses [list]
question $newtext
} elseif {[regexp {^response:(.*)} $text match newtext]} {
if {$newtext != "*"} {
lappend responses "$newtext"
response "One possible answer is => $newtext"
} else {
set is [ask_the_user $question $responses]
puts $filehandle $is
flush $filehandle
incr is -1
set word [lindex $responses $is]
answer "Your answer is => $word"
}
} elseif {[regexp {^information:(.*)} $text match newtext]} {
information $newtext
} elseif {[regexp {^explaination:(.*)} $text match newtext]} {
status $newtext
} else {
status $text
}
}
.run configure -state normal
}
proc do_save {} {
status "Save the output..."
set types { {{Text Files} {.txt} } {{All Files} * } }
set filename [tk_getSaveFile -filetypes $types -title "Save the results of a run" -initialfile "Results.txt"]
if {$filename != ""} {
if {[file isfile $filename] == 0} {
status "The file you selected is not really a file"
} elseif {[file writeable $filename] == 0} {
status "The file you selected in not writeable"
} else {
status "Saving the output to $filename"
set handle [open $filename "w"]
puts $handle [.text get 0.1 end]
bin/consult view on Meta::CPAN
status "No file was selected"
}
}
################################################################################
# Utility functions
################################################################################
proc status {text} { mymessage $text is_status }
proc question {text} { mymessage $text is_question }
proc response {text} { mymessage $text is_response }
proc answer {text} { mymessage $text is_answer }
proc information {text} {
global display_information
if {$display_information == 1} {
mymessage $text is_information
}
}
proc mymessage {text tag} {
bin/simpleshell view on Meta::CPAN
elsif ( $r eq 'failed' ) {
say_status("Unable to answer your question");
$running = undef;
}
}
if($tkinterface) {
$continue = 'no';
} else {
$continue = ask_question( 'Another consoltation', 'yes', 'no' );
$s->reset();
}
}
######################################################################
# Ask a question of the user showing the available responses
######################################################################
sub ask_question {
my ( $text, @responses ) = @_;
my $number = scalar(@responses);
my $x = 0;
while ( $x < 1 or $x > $number ) {
say_question($text);
for ( my $y = 1 ; $y <= $number ; $y++ ) {
say_something('response', " $y : ", $responses[$y - 1]);
}
if($tkinterface) {
say_something('response', '', '*');
} else {
print '** ';
}
$x = <STDIN>;
$x = 0 if $x !~ m#^[0-9]+$#;
}
return $responses[ $x - 1 ];
}
######################################################################
# The various ways of printing out a message
######################################################################
sub say_status { say_something('status', '>> ', shift) }
sub say_question { say_something('question', '', shift) }
sub say_something {
examples/Animal.xml view on Meta::CPAN
<attribute>type.animal</attribute>
<value>deer/moose/antelope</value>
</action>
</actions>
</rule>
</rules>
<questions>
<question>
<attribute>long.powerful.arms</attribute>
<text>Does your animal have long, powerful arms?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>lives.in.desert</attribute>
<text>Does your animal normally live in the desert?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>thintail</attribute>
<text>Does your animal have a thin tail?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>bivalve</attribute>
<text>Is your animal protected by two half-shells?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>hunted</attribute>
<text>Is your animal, unfortunately, commercially hunted?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>jump</attribute>
<text>Does your animal jump?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>hooves</attribute>
<text>Does your animal have hooves?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>always.in.water</attribute>
<text>Is your animal always in water?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>horns</attribute>
<text>Does your animal have horns?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>two.toes</attribute>
<text>Does your animal stand on two toes/hooves per foot?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>flat.bodied</attribute>
<text>Does your animal have a flat body?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>live.prime.in.soil</attribute>
<text>Does your animal live primarily in soil?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>domesticated</attribute>
<text>Is your animal domesticated?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>pouch</attribute>
<text>Does your animal have a pouch?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>over.400</attribute>
<text>Does an adult normally weigh over 400 pounds?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>opposing.thumb</attribute>
<text>Does your animal have an opposing thumb?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>can.eat.meat</attribute>
<text>Does your animal eat red meat?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>warm.blooded</attribute>
<text>Is the animal warm blooded?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>limbs</attribute>
<text>Does your animal have limbs?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>body.in.segments</attribute>
<text>Is the animals body in segments?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>has.breasts</attribute>
<text>Normally, does the female of your animal nurse its young with milk?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>fleece</attribute>
<text>Does your animal have fleece?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>nearly.hairless</attribute>
<text>Is your animal nearly hairless?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>prehensile.tail</attribute>
<text>Does your animal have a prehensile tail?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>rounded.shell</attribute>
<text>Does the animal have a rounded shell?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>scally</attribute>
<text>Is your animal covered with scaled skin?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>boney</attribute>
<text>Does your animal have a boney skeleton?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>large.ears</attribute>
<text>Does your animal have large ears?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>one.horn</attribute>
<text>Does your animal have one horn?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>land.based</attribute>
<text>Is your animal land based?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>plating</attribute>
<text>Is your animal covered with a protective plating?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>tail</attribute>
<text>Does your animal have a tail?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>backbone</attribute>
<text>Does your animal have a backbone?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>front.teeth</attribute>
<text>Does your animal have large front teeth?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>multicelled</attribute>
<text>Is your animal made up of more than one cell?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>stationary</attribute>
<text>Is your animal attached permanently to an object?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>fly</attribute>
<text>Can your animal fly?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>spiral.shell</attribute>
<text>Does your animal have a spiral-shaped shell?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>spikes</attribute>
<text>Does your animal normally have spikes radiating from it's body?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>live.in.water</attribute>
<text>Does your animal live in water?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>digest.cells</attribute>
<text>Does your animal use many cells to digest it's food instead of a stomach?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>shell</attribute>
<text>Does your animal have a shell?</text>
<response>yes</response>
<response>no</response>
</question>
</questions>
</knowledgebase>
examples/Doctor.xml view on Meta::CPAN
<action>
<attribute>type.disease</attribute>
<value>prickly.heat</value>
</action>
</actions>
</rule>
<rule>
<name>30</name>
<conditions>
<condition>
<attribute>rest.temp.over.100</attribute>
<value>yes</value>
</condition>
</conditions>
<actions>
<action>
<attribute>fever</attribute>
<value>yes</value>
</action>
</actions>
</rule>
examples/Doctor.xml view on Meta::CPAN
<attribute>type.disease</attribute>
<value>diptheria</value>
</action>
</actions>
</rule>
</rules>
<questions>
<question>
<attribute>squeaky.breath</attribute>
<text>Does the child squeake as he breaths?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>itching</attribute>
<text>Does the child complain of itchy or scratchy skin?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>high.fever</attribute>
<text>Is the child's temperature over 103?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>fatigue</attribute>
<text>Does the child complain of general fatigue?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>clear.nasal.discharge</attribute>
<text>Does the child have a clear nasal discharge?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>tender.joints</attribute>
<text>Does the child complain of tender joints?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>sputum</attribute>
<text>Is the child producing sputum?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>sneeze</attribute>
<text>Is the child sneezing?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>neck.swelling</attribute>
<text>Does the child have extensive swelling in the side of his neck?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>ivy.rash</attribute>
<text>Are there clusters of small blisters on reddened shiny skin?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>itchy.nose</attribute>
<text>Does the child complain of an itchy nose?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>delayed.cough</attribute>
<text>Did the child start coughing about one week after getting the cold?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>cough</attribute>
<text>Does the child have a cough?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>impetigo.rash</attribute>
<text>Are there pimples on the child with a partly brown crust?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>cough.when.move</attribute>
<text>Does the child start coughing violently when he either lays down or gets up?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>vibration.chest</attribute>
<text>Can you feel a vibration in the child's chest as he breaths?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>tender.abdomen</attribute>
<text>Does the child have a tender abdomen on the right side?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>scratchy.throat</attribute>
<text>Does the child have a scratchy throat?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>rapid.breathing</attribute>
<text>Does the child have rapid, shallow breathing?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>vomiting</attribute>
<text>Is the child vomiting?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>naval.pain</attribute>
<text>Has the child complained of pain around his naval for several hours?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>inflammed.ears</attribute>
<text>Does the child have inflammed ears?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>hoarse.cough</attribute>
<text>Does the child have a hoarse cough?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>sinus.pain</attribute>
<text>Does the child have any sinus pain?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>dirty.white.patches</attribute>
<text>Does the child have dirty white patches on his tonsils?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>scarlet.rash</attribute>
<text>Does the child have a red blush-like rash on his skin?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>scabies.rash</attribute>
<text>Are there groups of pimples topped with scabs on the child?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>ringworm.rash</attribute>
<text>Are there circular patches of rough skin on the child?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>prickly.rash</attribute>
<text>Does the child have patches of tan-pink pimples?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>headache</attribute>
<text>Does the child complain of headache?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>difficulty.breathing</attribute>
<text>Does the child have difficulty breathing?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>active.temp.over.101</attribute>
<text>Has the child been active in the last hour and his temp is greater than 101?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>wheezing</attribute>
<text>Is the child wheezing?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>touch.to.chest</attribute>
<text>Is it impossible for the child to touch his chin to his chest?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>tonsils.swollen</attribute>
<text>Are the child's tonsils swollen with white patches on them?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>sore.throat</attribute>
<text>Does the child have a sore throat?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>rest.temp.over.100</attribute>
<text>Has the child been resting for over an hour and his temp is greater than 100?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>pox.rash</attribute>
<text>Does the child's skin have separate, raised pimples, several with blisters?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>nervous.disease</attribute>
<text>Does the child have twitching or writhing movements in DIFFERENT places?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>much.cough</attribute>
<text>Does the child cough a lot, and cough syrup is roughly ineffective?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>measle.rash</attribute>
<text>Does the child have flat pink spots on the skin?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>hives.rash</attribute>
<text>Does the child have raised welts that are white in color?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>eczema</attribute>
<text>Does the child have patches of rough, red, rash, scaly skin?</text>
<response>yes</response>
<response>no</response>
</question>
</questions>
</knowledgebase>
examples/Glass.xml view on Meta::CPAN
</condition>
<condition>
<attribute>plain</attribute>
<value>yes</value>
</condition>
<condition>
<attribute>etched</attribute>
<value>no</value>
</condition>
<condition>
<attribute>empress</attribute>
<value>yes</value>
</condition>
</conditions>
<actions>
<action>
<attribute>type.glass</attribute>
<value>empress</value>
</action>
</actions>
</rule>
<rule>
<name>23</name>
<conditions>
<condition>
<attribute>rays</attribute>
<value>no</value>
</condition>
examples/Glass.xml view on Meta::CPAN
<value>yes</value>
</condition>
<condition>
<attribute>etched</attribute>
<value>no</value>
</condition>
</conditions>
<actions>
<action>
<attribute>type.glass</attribute>
<value>forest.green</value>
</action>
</actions>
</rule>
<rule>
<name>28</name>
<conditions>
<condition>
<attribute>fuchsia</attribute>
<value>yes</value>
</condition>
examples/Glass.xml view on Meta::CPAN
<attribute>type.glass</attribute>
<value>rose.point</value>
</action>
</actions>
</rule>
</rules>
<questions>
<question>
<attribute>lariat</attribute>
<text>Does the piece have a looped rim?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>cherry.blossom</attribute>
<text>Are there small cherries in the pattern?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>pretzel</attribute>
<text>Does the glass have a laced pattern?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>moonstone</attribute>
<text>Is the glass beaded with a white edge?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>fuchsia</attribute>
<text>Are there Fuchsia, or hanging flowers with stems in them, in the glass?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>etched</attribute>
<text>Is the glass etched? (versus pressed)</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>empress</attribute>
<text>Does the rim look as though there are knotches?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>waterford</attribute>
<text>Does the glass have a laced pattern?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>rays</attribute>
<text>Are there 'rays' starting in the center of the piece moving toward the edge?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>geometric</attribute>
<text>Is there a geometric pattern in the glass?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>fire.king</attribute>
<text>Are flowers missing from the pattern?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>emblem</attribute>
<text>Does the glass bear an emblem?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>plain</attribute>
<text>Is the glass basically without a pattern?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>octagon</attribute>
<text>Is the glass eight sided?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>iris</attribute>
<text>Does the glass have iris flowers?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>cupid</attribute>
<text>Is there a cupid figure in the emblem?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>decagon</attribute>
<text>Is the glass ten sided?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>candlewick</attribute>
<text>Does the glass have balls around the rim?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>avocado</attribute>
<text>Are there two avocado plants present (looks like two pears)?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>sunflower</attribute>
<text>Are there sunflowers in the pattern?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>pineapple</attribute>
<text>Are there images of pineapples in the glass?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>orchid</attribute>
<text>Are there orchids in the glass?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>lace.edge</attribute>
<text>Does the piece have a flat rim with holes, giving a lacey apperance?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>alice</attribute>
<text>Are there small flowers only around the rim of the piece?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>ruby</attribute>
<text>Is the piece a deep ruby red in color?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>rose.in.emblem</attribute>
<text>Is there a rose in the emblem?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>square</attribute>
<text>Does the glass have a square pattern?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>sharon</attribute>
<text>Are there six 'spokes' in the piece?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>large.rose</attribute>
<text>Are there large roses in the glass?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>cube</attribute>
<text>Does the glass have a cubed pattern?</text>
<response>yes</response>
<response>no</response>
</question>
<question>
<attribute>bead.block</attribute>
<text>Does the glass have squares with beads connecting the squares?</text>
<response>yes</response>
<response>no</response>
</question>
</questions>
</knowledgebase>
examples/sie-1.0.dtd view on Meta::CPAN
<!ELEMENT goal (attribute, text)>
<!ELEMENT rules (rule*)>
<!ELEMENT rule (name, conditions, actions)>
<!ELEMENT conditions (condition*)>
<!ELEMENT condition (attribute, value)>
<!ELEMENT actions (action*)>
<!ELEMENT action (attribute, value)>
<!ELEMENT questions (question*)>
<!ELEMENT question (attribute, text, response*)>
<!ELEMENT attribute (#PCDATA)>
<!ELEMENT text (#PCDATA)>
<!ELEMENT name (#PCDATA)>
<!ELEMENT value (#PCDATA)>
<!ELEMENT response (#PCDATA)>
examples/test.xml view on Meta::CPAN
<attribute>one</attribute>
<value>yes</value>
</action>
</actions>
</rule>
</rules>
<questions>
<question>
<attribute>two</attribute>
<text>Answer yes to make this work</text>
<response>yes</response>
<response>no</response>
</question>
</questions>
</knowledgebase>
lib/AI/ExpertSystem/Simple.pm view on Meta::CPAN
$self->{_log} = ();
$self->{_number_of_rules} = 0;
$self->{_number_of_attributes} = 0;
$self->{_number_of_questions} = 0;
return bless $self, $class;
}
sub reset {
my ($self) = @_;
die "Simple->reset() takes no arguments" if scalar(@_) != 1;
foreach my $name (keys %{$self->{_rules}}) {
$self->{_rules}->{$name}->reset();
}
foreach my $name (keys %{$self->{_knowledge}}) {
$self->{_knowledge}->{$name}->reset();
}
$self->{_ask_about} = undef;
$self->{_told_about} = undef;
$self->{_log} = ();
}
sub load {
my ($self, $filename) = @_;
lib/AI/ExpertSystem/Simple.pm view on Meta::CPAN
}
eval { $t->purge(); }
}
sub _question {
my ($self, $t, $node) = @_;
my $attribute = undef;
my $text = undef;
my @responses = ();
$self->{_number_of_questions}++;
my $x = ($node->children('attribute'))[0];
$attribute = $x->text();
$x = ($node->children('text'))[0];
$text = $x->text();
foreach $x ($node->children('response')) {
push(@responses, $x->text());
}
if(!defined($self->{_knowledge}->{$attribute})) {
$self->{_number_of_attributes}++;
$self->{_knowledge}->{$attribute} = AI::ExpertSystem::Simple::Knowledge->new($attribute);
}
$self->{_knowledge}->{$attribute}->set_question($text, @responses);
eval { $t->purge(); }
}
sub process {
my ($self) = @_;
die "Simple->process() takes no arguments" if scalar(@_) != 1;
my $n = $self->{_goal}->name();
lib/AI/ExpertSystem/Simple.pm view on Meta::CPAN
}
}
}
return 'continue';
} else {
my %scoreboard = ();
foreach my $rule (keys(%{$self->{_rules}})) {
if($self->{_rules}->{$rule}->state() eq 'active') {
my @listofquestions = $self->{_rules}->{$rule}->unresolved();
my $ok = 1;
my @questionstoask = ();
foreach my $name (@listofquestions) {
if($self->{_knowledge}->{$name}->has_question()) {
push(@questionstoask, $name);
} else {
$ok = 0;
}
}
lib/AI/ExpertSystem/Simple.pm view on Meta::CPAN
=head1 SYNOPSIS
This class implements a simple expert system shell that reads the rules from an XML
knowledge base and questions the user as it attempts to arrive at a conclusion.
=head1 DESCRIPTION
=head2 Overview
This class is where all the work is being done and the other three classes are only
there for support. At present there is little you can do with it other than run it. Future
version will make subclassing of this class feasable and features like logging will be introduced.
To see how to use this class there is a simple shell in the bin directory which allows you
to consult the example knowledge bases and more extensive documemtation in the docs directory.
There is a Ruby version that reads the same XML knowledge bases, if you are interested.
=head2 Constructors and initialisation
=over 4
=item new( )
The constructor takes no arguments and just initialises a few basic variables.
=back
=head2 Public methods
=over 4
=item reset( )
Resets the system back to its initial state so that a new consoltation can be run
=item load( FILENAME )
This method takes the FILENAME of an XML knowledgebase and attempts to parse it to set up the data structures
required for a consoltation.
=item process( )
Once the knowledgebase is loaded the consultation is run by repeatedly calling this method.
It returns four results:
=over 4
=item "question"
The system has a question to ask of the user.
The question and list of valid responses is available from the get_question( ) method and the users response should be returned via the answer( ) method.
Then simply call the process( ) method again.
=item "continue"
The system has calculated some data but has nothing to ask the user but has still not finished.
This response will be removed in future versions.
Simply call the process( ) method again.
=item "finished"
The consoltation has finished and the system has an answer for the user which is available from the answer( ) method.
=item "failed"
The consoltation has finished and the system has failed to find an answer for the user. It happens.
=back
=item get_question( )
If the process( ) method has returned "question" then this method will return the question to ask the user
and a list of valid responses.
=item answer( VALUE )
The user has been presented with the question from the get_question( ) method along with a set of
valid responses and the users selection is returned by this method.
=item get_answer( )
If the process( ) method has returned "finished" then the answer to the users query will be
returned by this method.
=item log( )
Returns a list of the actions undertaken so far and clears the log.
lib/AI/ExpertSystem/Simple.pm view on Meta::CPAN
=head1 ENVIRONMENT
None
=head1 DIAGNOSTICS
=over 4
=item Simple->new() takes no arguments
When the constructor is initialised it requires no arguments. This message is given if
some arguments were supplied.
=item Simple->reset() takes no arguments
When the method is called it requires no arguments. This message is given if
some arguments were supplied.
=item Simple->load() takes 1 argument
When the method is called it requires one argument. This message is given if more or
less arguments were supplied.
=item Simple->load() argument 1 (FILENAME) is undefined
The corrct number of arguments were supplied with the method call, however the first
argument, FILENAME, was undefined.
=item Simple->load() XML parse failed
XML Twig encountered some errors when trying to parse the XML knowledgebase.
=item Simple->load() unable to use file
The file supplied to the load( ) method could not be used as it was either not a file
or not readable.
=item Simple->process() takes no arguments
When the method is called it requires no arguments. This message is given if
some arguments were supplied.
=item Simple->get_question() takes no arguments
When the method is called it requires no arguments. This message is given if
some arguments were supplied.
=item Simple->answer() takes 1 argument
When the method is called it requires one argument. This message is given if more or
less arguments were supplied.
=item Simple->answer() argument 1 (VALUE) is undefined
The corrct number of arguments were supplied with the method call, however the first
argument, VALUE, was undefined.
=item Simple->get_answer() takes no arguments
When the method is called it requires no arguments. This message is given if
some arguments were supplied.
=item Simple->log() takes no arguments
When the method is called it requires no arguments. This message is given if
some arguments were supplied.
=item Simple->explain() takes no arguments
When the method is called it requires no arguments. This message is given if
some arguments were supplied.
=back
=head1 BUGS
None
=head1 FILES
lib/AI/ExpertSystem/Simple.pm view on Meta::CPAN
AI::ExpertSystem::Simple::Knowledge - A utility class
AI::ExpertSystem::Simple::Rule - A utility class
=head1 AUTHORS
Peter Hickman (peterhi@ntlworld.com)
=head1 COPYRIGHT
Copyright (c) 2003, Peter Hickman. All rights reserved.
This module is free software. It may be used, redistributed and/or
modified under the same terms as Perl itself.
lib/AI/ExpertSystem/Simple/Goal.pm view on Meta::CPAN
as the answer for the consoltation.
=back
=head2 Public methods
=over 4
=item is_goal( NAME )
This method compares the given NAME with that of the attribute name given when the object was constructed and
returns true if they are the same or false if not.
=item name( )
This method return the value of the NAME argument that was set when the object was constructed.
=item answer( VALUE )
This method take VALUE to be the value of the goal attribute and will use it to interpolate and return the MESSAGE that was given
when the object was constructed.
lib/AI/ExpertSystem/Simple/Goal.pm view on Meta::CPAN
=head1 ENVIRONMENT
None
=head1 DIAGNOSTICS
=over 4
=item Goal->new() takes 2 arguments
When the constructor is initialised it requires two arguments. This message is given if more or less arguments were supplied.
=item Goal->new() argument 1 (NAME) is undefined
The correct number of arguments were supplied to the constructor, however the first argument, NAME, was undefined.
=item Goal->new() argument 2 (MESSAGE) is undefined
The correct number of arguments were supplied to the constructor, however the second argument, MESSAGE, was undefined.
=item Goal->is_goal() takes 1 argument
When the method is called it requires one argument. This message is given if more or less arguments were supplied.
=item Goal->is_goal() argument 1 (NAME) is undefined
The correct number of arguments were supplied with the method call, however the first argument, NAME, was undefined.
=item Goal->name() takes no arguments
When the method is called it takes no arguments. This message is given if some were supplied.
=item Goal->answer() takes 1 argument
When the method is called it requires one argument. This message is given if more or less arguments were supplied.
=item Goal->answer() argument 1 (VALUE) is undefined
The correct number of arguments were supplied with the method call, however the first argument, VALUE, was undefined.
=back
=head1 BUGS
None to date
lib/AI/ExpertSystem/Simple/Goal.pm view on Meta::CPAN
AI::ExpertSystem::Simple::Knowledge - A utility class
AI::ExpertSystem::Simple::Rules - A utility class
=head1 AUTHORS
Peter Hickman (peterhi@ntlworld.com)
=head1 COPYRIGHT
Copyright (c) 2003, Peter Hickman. All rights reserved.
This module is free software. It may be used, redistributed and/or
modified under the same terms as Perl itself.
lib/AI/ExpertSystem/Simple/Knowledge.pm view on Meta::CPAN
die "Knowledge->new() takes 1 argument" if scalar(@_) != 2;
die "Knowledge->new() argument 1, (NAME) is undefined" if ! defined($name);
my $self = {};
$self->{_name} = $name;
$self->{_value} = undef;
$self->{_setter} = undef;
$self->{_question} = undef;
$self->{_responses} = ();
return bless $self, $class;
}
sub reset {
my ($self) = @_;
die "Knowledge->reset() takes no arguments" if scalar(@_) != 1;
$self->{_value} = undef;
$self->{_setter} = undef;
}
sub set_value {
my ($self, $value, $setter) = @_;
die "Knowledge->set_value() takes 2 argument" if scalar(@_) != 3;
die "Knowledge->set_value() argument 1, (VALUE) is undefined" if ! defined($value);
lib/AI/ExpertSystem/Simple/Knowledge.pm view on Meta::CPAN
sub is_value_set {
my($self) = @_;
die "Knowledge->is_value_set() takes no arguments" if scalar(@_) != 1;
return defined($self->{_value});
}
sub set_question {
my ($self, $question, @responses) = @_;
if(defined($self->{_question})) {
die "Knowledge->set_question() has already been set";
}
die "Knowledge->set_question() takes 2 arguments" if scalar(@_) < 3;
die "Knowledge->set_question() argument 1, (QUESTION) is undefined" if ! defined($question);
# This test just doesnt work for a list
# die "Knowledge->set_question() argument 2, (RESPONSES) is undefined" if scalar(@responses) == 0;
$self->{_question} = $question;
push(@{$self->{_responses}}, @responses);
}
sub get_question {
my ($self) = @_;
die "Knowledge->get_question() takes no arguments" if scalar(@_) != 1;
if(!defined($self->{_question})) {
die "Knowledge->set_question() has not been set";
}
return ($self->{_question}, @{$self->{_responses}});
}
sub has_question {
my ($self) = @_;
die "Knowledge->has_question() takes no arguments" if scalar(@_) != 1;
return (defined($self->{_question}) and !defined($self->{_value}));
}
lib/AI/ExpertSystem/Simple/Knowledge.pm view on Meta::CPAN
AI::ExpertSystem::Simple::Knowledge - Utility class for a simple expert system
=head1 VERSION
This document refers to verion 1.2 of AI::ExpertSystem::Simple::Knowledge, released June 10, 2003
=head1 SYNOPSIS
This class handles the attributes and their values within the expert system along with the optional question that
can be asked of the user to set the value of the attribute. The valid responses to the optional question are also held.
=head1 DESCRIPTION
=head2 Overview
This is a utility class for AI::ExpertSystem::Simple
=head2 Constructors and initialisation
=over 4
=item new( NAME )
The constructor sets up the basic attribute name / value pairing. In the base case an attribute has a name with no value.
Optional questions and the valid responses can be set later and the value of the attribute is set during the consultation.
=back
=head2 Public methods
=over 4
=item reset( )
Resets the state of knowledge back to what it was when the object was created
=item set_value( VALUE, SETTER )
During the consultation process the VALUE for an attribute can be set by either asking the user a question or by deduction. The value is then recorded along with the rule that set the value (or blank it if was a question).
=item get_value( )
Returns the current value of the attribute.
lib/AI/ExpertSystem/Simple/Knowledge.pm view on Meta::CPAN
=item get_setter( )
Returns the current setter of the attribute.
=item is_value_set( )
Returns true if the value of the attribute is set or false if not.
=item set_question( QUESTION, RESPONSES )
Allows a question to ask of the user to set the value of the attribute. QUESTION is the text that will be displayed to the user and RESPONSES is a list of valid responses that the user may select from.
=item get_question( )
Returns the QUESTION and list of valid RESPONSES for the attribute.
=item has_question( )
Returns true if the attribute has a question to ask the user if the VALUE of the attribute has not already been set.
=item name( )
lib/AI/ExpertSystem/Simple/Knowledge.pm view on Meta::CPAN
=head1 ENVIRONMENT
None
=head1 DIAGNOSTICS
=over 4
=item Knowledge->new() takes 1 argument
When the constructor is initialised it requires one argument. This message is given if more of less arguments are given.
=item Knowledge->new() argument 1, (NAME) is undefined
The correct number of arguments were supplied to the constructor, however the first argument, NAME, was undefined.
=item Knowledge->reset() takes no arguments
When the method is called it requires no arguments. This message is given if some where supplied.
=item Knowledge->set_value() takes 2 argument
When the method is called it requires two arguments. This message is given if more of less arguments are given.
=item Knowledge->set_value() argument 1, (VALUE) is undefined
The correct number of arguments were supplied to the method call, however the first argument, VALUE, was undefined.
=item Knowledge->set_value() argument 2, (SETTER) is undefined
The correct number of arguments were supplied to the method call, however the second argument, SETTER, was undefined.
=item Knowledge->set_value() has already been set
This method has already been called and the value set. It cannot be called twice.
=item Knowledge->get_value() takes no arguments
When the method is called it requires no arguments. This message is given if some where supplied.
=item Knowledge->get_setter() takes no arguments
When the method is called it requires no arguments. This message is given if some where supplied.
=item Knowledge->is_value_set() takes no arguments
When the method is called it requires no arguments. This message is given if some where supplied.
=item Knowledge->set_question() takes 2 arguments
When the method is called it requires two arguments. This message is given if more of less arguments are given.
=item Knowledge->set_question() argument 1, (QUESTION) is undefined
The correct number of arguments were supplied to the method call, however the first argument, QUESTION, was undefined.
=item Knowledge->set_question() has already been set
This method has already been called and the value set. It cannot be called twice.
=item Knowledge->get_question() takes no arguments
When the method is called it requires no arguments. This message is given if some where supplied.
=item Knowledge->get_question() has not been set
The value has not been set by Knowledge->set_question() and, therefore, cannot be retrieved.
=item Knowledge->has_question() takes no arguments
When the method is called it requires no arguments. This message is given if some where supplied.
=item Knowledge->name() takes no arguments
When the method is called it requires no arguments. This message is given if some where supplied.
=back
=head1 BUGS
None
=head1 FILES
See Knowledge.t in the test directory
lib/AI/ExpertSystem/Simple/Knowledge.pm view on Meta::CPAN
AI::ExpertSystem::Simple::Goal - A utility class
AI::ExpertSystem::Simple::Rules - A utility class
=head1 AUTHORS
Peter Hickman (peterhi@ntlworld.com)
=head1 COPYRIGHT
Copyright (c) 2003, Peter Hickman. All rights reserved.
This module is free software. It may be used, redistributed and/or
modified under the same terms as Perl itself.
lib/AI/ExpertSystem/Simple/Rule.pm view on Meta::CPAN
$self->{_name} = $name;
$self->{_conditions} = ();
$self->{_tested} = ();
$self->{_counter} = 0;
$self->{_actions} = ();
$self->{_state} = 'active';
return bless $self, $class;
}
sub reset {
my ($self) = @_;
# Check the input
die "Rule->reset() takes no arguments" if scalar(@_) != 1;
$self->{_state} = 'active';
$self->{_counter} = 0;
foreach my $name (keys %{$self->{_tested}}) {
$self->{_tested}->{$name} = 0;
$self->{_counter}++;
}
}
lib/AI/ExpertSystem/Simple/Rule.pm view on Meta::CPAN
}
sub conditions {
my ($self) = @_;
die "Rule->conditions() takes no arguments" if(scalar(@_) != 1);
return %{$self->{_conditions}};
}
sub unresolved {
my ($self) = @_;
die "Rule->unresolved() takes no arguments" if(scalar(@_) != 1);
my @list = ();
foreach my $name (keys(%{$self->{_tested}})) {
if($self->{_tested}->{$name} == 0) {
push(@list, $name);
}
}
return @list;
lib/AI/ExpertSystem/Simple/Rule.pm view on Meta::CPAN
=item new( NAME )
The constructor takes one argument, the NAME of the rule. The consition and actions are added later.
=back
=head2 Public methods
=over 4
=item reset( )
Resets the state of the rule back to active and all the condition attributes to untested.
=item add_condition( NAME, VALUE )
This adds a condition attribute name / value pair.
=item add_action( NAME, VALUE )
This adds an action attribute name / value pair.
lib/AI/ExpertSystem/Simple/Rule.pm view on Meta::CPAN
Returns the name of the rule.
=item state( )
Returns the current state of the rule.
=item given( NAME, VALUE )
The NAME / VALUE attribute pair is checked against the rule's conditions to see if a condition is met and the state of the rule
is changed in light of the result.
=item actions( )
Returns a list of the actions set in the rule.
=item conditions( )
Returns a list of the conditions matched in the rule.
=item unresolved( )
Returns a list of all the unresolved condition of the rule.
=back
=head2 Private methods
None
=head1 ENVIRONMENT
None
=head1 DIAGNOSTICS
=over 4
=item Rule->new() takes 1 argument
When the constructor is initialised it requires one argument. This message is given if more or less arguments were supplied.
=item Rule->new() argument 1 (NAME) is undefined
The corrct number of arguments were supplied to the constructor, however the first argument, NAME, was undefined.
=item Rule->reset() takes no arguments
When the method is called it requires no arguments. This message is given if more or less arguments were supplied.
=item Rule->add_condition() takes 2 arguments
When the method is called it requires two arguments. This message is given if more or less arguments were supplied.
=item Rule->add_condition() argument 1 (NAME) is undefined
The corrct number of arguments were supplied with the method call, however the first argument, NAME, was undefined.
=item Rule->add_condition() argument 2 (VALUE) is undefined
The corrct number of arguments were supplied with the method call, however the second argument, VALUE, was undefined.
=item Rule->add_condition() has already been set
This method has already been called and the value set. It cannot be called twice.
=item Rule->add_action() takes 2 arguments
When the method is called it requires two arguments. This message is given if more or less arguments were supplied.
=item Rule->add_action() argument 1 (NAME) is undefined
The corrct number of arguments were supplied with the method call, however the first argument, NAME, was undefined.
=item Rule->add_action() argument 2 (VALUE) is undefined
The corrct number of arguments were supplied with the method call, however the second argument, VALUE, was undefined.
=item Rule->add_action() has already been set
This method has already been called and the value set. It cannot be called twice.
=item Rule->name() takes no arguments
When the method is called it requires no arguments. This message is given if more or less arguments were supplied.
=item Rule->state() takes no arguments
When the method is called it requires no arguments. This message is given if more or less arguments were supplied.
=item Rule->given() takes 2 arguments
When the method is called it requires two arguments. This message is given if more or less arguments were supplied.
=item Rule->given() argument 1 (NAME) is undefined
The corrct number of arguments were supplied with the method call, however the first argument, NAME, was undefined.
=item Rule->given() argument 2 (VALUE) is undefined
The corrct number of arguments were supplied with the method call, however the second argument, VALUE, was undefined.
=item Rule->actions() takes no arguments
When the method is called it requires no arguments. This message is given if more or less arguments were supplied.
=item Rule->conditions() takes no arguments
When the method is called it requires no arguments. This message is given if more or less arguments were supplied.
=item Rule->unresolved() takes no arguments
When the method is called it requires no arguments. This message is given if more or less arguments were supplied.
=back
=head1 BUGS
None
=head1 FILES
See Rules.t in the test directory
lib/AI/ExpertSystem/Simple/Rule.pm view on Meta::CPAN
AI::ExpertSystem::Simple::Goal - A utility class
AI::ExpertSystem::Simple::knowledge - A utility class
=head1 AUTHORS
Peter Hickman (peterhi@ntlworld.com)
=head1 COPYRIGHT
Copyright (c) 2003, Peter Hickman. All rights reserved.
This module is free software. It may be used, redistributed and/or
modified under the same terms as Perl itself.
t/Knowledge.t view on Meta::CPAN
################################################################################
# Check the question
################################################################################
eval { $x->get_question(1); };
like($@, qr/^Knowledge->get_question\(\) takes no arguments /, 'Too many arguments');
my ($y, @z) = $x->get_question();
is($y, 'to be or not to be', 'Get the question back');
is(scalar(@z), 2, 'Get the responses back');
is($z[0], 'be', 'Checking response');
is($z[1], 'not', 'Checking response');
################################################################################
# Check the reset method for the value part
################################################################################
eval { $x->reset(1); };
like($@, qr/^Knowledge->reset\(\) takes no arguments /, 'Too many arguments');
$x->reset();
is($x->is_value_set(), '', 'Value is not set');
$x->set_value('fred', '');
is($x->is_value_set(), '1', 'Value is set');
$x->reset();
is($x->is_value_set(), '', 'Value is not set');
################################################################################
# Check the reset method for both parts
################################################################################
$x->reset();
is($x->has_question(), '1', 'The question has been set');
is($x->is_value_set(), '', 'Value is not set');
$x->set_value('fred', '');
is($x->is_value_set(), '1', 'Value is set');
is($x->has_question(), '', 'The question has been answered');
$x->add_action('c', 3);
eval { $x->add_action('c', 3); };
like($@, qr/^Rule->add_action\(\) has already been set /, 'Is already set');
eval { $x->state(1); };
like($@, qr/^Rule->state\(\) takes no arguments /, 'Too many arguments');
is($x->state(), 'active', 'Is the rule active');
eval { $x->unresolved(1); };
like($@, qr/^Rule->unresolved\(\) takes no arguments /, 'Too many arguments');
is(scalar($x->unresolved()), 2, 'Unresolved list');
eval { $x->given(1); };
like($@, qr/^Rule->given\(\) takes 2 arguments /, 'Too few arguments');
eval { $x->given(1, 2, 3); };
like($@, qr/^Rule->given\(\) takes 2 arguments /, 'Too many arguments');
eval { $x->given(undef, 2); };
like($@, qr/^Rule->given\(\) argument 1 \(NAME\) is undefined /, 'Name is undefined');
eval { $x->given(1, undef); };
like($@, qr/^Rule->given\(\) argument 2 \(VALUE\) is undefined /, 'Value is undefined');
is($x->given('b', 2), 'active', 'Is the rule still active');
is(scalar($x->unresolved()), 1, 'Unresolved list');
is($x->given('a', 1), 'completed', 'Is the rule now complete');
is(scalar($x->unresolved()), 0, 'Unresolved list');
################################################################################
# Reset the rule and start again
################################################################################
eval { $x->reset(1); };
like($@, qr/^Rule->reset\(\) takes no arguments /, 'Too many arguments');
$x->reset();
is($x->state(), 'active', 'Is the rule active');
is($x->given('b', 1), 'invalid', 'Is the rule now invalid');
################################################################################
# Check the results
################################################################################
eval { $x->actions(1); };
like($@, qr/^Rule->actions\(\) takes no arguments /, 'Too many arguments');
my %r = $x->actions();
is(scalar keys %r, 1, 'Check the action is ok');
is($r{c}, 3, 'Check the action is ok');
eval { $x->get_answer(1); };
like($@, qr/^Simple->get_answer\(\) takes no arguments /, 'Too many arguments');
is($x->get_answer(), 'You have set the goal to pretzel', 'Got the answer');
################################################################################
# Reset and do it all again
################################################################################
eval { $x->reset(1); };
like($@, qr/^Simple->reset\(\) takes no arguments /, 'Too many arguments');
$x->reset();
is($x->process(), 'question', 'We have a question to answer');
($t, $r) = $x->get_question();
$x->answer('yes');
is($x->process(), 'continue', 'Carry on');
is($x->process(), 'finished', 'Thats all folks');
<attribute>one</attribute>
<value>yes</value>
</action>
</actions>
</rule>
</rules>
<questions>
<question>
<attribute>two</attribute>
<text>Answer yes to make this work</text>
<response>yes</response>
<response>no</response>
</question>
</questions>
</knowledgebase>
( run in 1.059 second using v1.01-cache-2.11-cpan-49f99fa48dc )