AI-ExpertSystem-Simple

 view release on metacpan or  search on metacpan

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

	# 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"
	status ""
	status "First select a knowledgebase to load with the Load button"
	status "Then start a consultation with the Run button"
	status "You can rerun the consultation as many times as you like"
	status ""
	status "The Save button allows you to save the contents of the"
	status "session to a file"
	status ""
	status "The \"Display 'information' messages\" check box is used"
	status "to turn the grey information messages on and off. The "
	status "information messages tell you what the expert system is"
	status "up to and can be quite voluminous"
	status ""

bin/consult  view on Meta::CPAN

		.run  configure -state normal
		status "Loading file $filename"
		status "The next step is to Run it..."

		wm title . [append newtitle "Simple Inference Engine: " [file tail $filename]]
	}
}

proc do_run {} {
	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]

bin/consult  view on Meta::CPAN

	}
}

proc mymessage {text tag} {
	.text insert end "$text\n" $tag
	.text see end
	update
}

################################################################################
# The program starts here
################################################################################

# Was there a filename on the command line

set p_count 0

while {[set err [cmdline::getopt argv {f.arg p.arg} opt val]] > 0} {
	switch -- $opt {
		f {
			if {$filename == ""} {

examples/Doctor.xml  view on Meta::CPAN

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

examples/Glass.xml  view on Meta::CPAN

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

t/Rule.t  view on Meta::CPAN

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');