AI-ExpertSystem-Simple

 view release on metacpan or  search on metacpan

bin/consult  view on Meta::CPAN

set filehandle ""
set filename ""
set program "simpleshell"
set error ""
set choice ""

toplevel .askme
wm withdraw .askme

################################################################################
# The question asking dialog
################################################################################

proc ask_the_user {message argv} {
	# Restore the toplevel item so that we can 
	# put the dialog box together

	wm deiconify .askme
	wm title .askme "What I want to know is?"

	# Set the question text

	label .askme.l -text $message -padx 10 -pady 10 -wraplength 300
	pack .askme.l -side top -anchor n

	# The is where the users choice will go

bin/consult  view on Meta::CPAN

	# The top frame holds the buttons

	frame .top
	button .load -text "Load..." -command "do_load" -width 8 
	button .run  -text "Run"     -command "do_run"  -width 8 -state disabled
	button .save -text "Save..." -command "do_save" -width 8 -state disabled
	checkbutton .display -text "Display 'information' messages" -variable display_information -onvalue 1 -offvalue 0
	pack .load .run .save .display -side left -anchor n -in .top
	pack .top -anchor nw

	# A log of the output is written here

	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

bin/simpleshell  view on Meta::CPAN

say_status("Consulting $filename");

my $continue = 'yes';

while($continue eq 'yes') {
	my $running = 1;

	while ($running) {
		my $r = $s->process();

		process_log();

		if ( $r eq 'question' ) {
			$s->answer( ask_question( $s->get_question() ) );
		}
		elsif ( $r eq 'finished' ) {
			say_status('The answer is : ' . $s->get_answer());
			$s->explain();
			process_log( 'explaination' , 1);
			$running = undef;
		}
		elsif ( $r eq 'failed' ) {
			say_status("Unable to answer your question");
			$running = undef;
		}
	}

	if($tkinterface) {
		$continue = 'no';

bin/simpleshell  view on Meta::CPAN

		print "$tag1:$text\n";
	} else {
		print "$tag2$text\n";
	}
}

######################################################################
# The various ways of printing out a message
######################################################################

sub process_log {
	my ($prefix, $override) = @_;

	$prefix = 'information' unless $prefix;

	my @log = $s->log();

	if($tkinterface or $override) {
		foreach my $line (@log) {
			say_something($prefix, '', $line);
		}
	}
}

lib/AI/ExpertSystem/Simple.pm  view on Meta::CPAN

	my $self = {};

	$self->{_rules} = ();
	$self->{_knowledge} = ();
	$self->{_goal} = undef;
	$self->{_filename} = undef;

	$self->{_ask_about} = undef;
	$self->{_told_about} = undef;

	$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) = @_;

lib/AI/ExpertSystem/Simple.pm  view on Meta::CPAN

	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) = @_;

	die "Simple->load() takes 1 argument" if scalar(@_) != 2;
	die "Simple->load() argument 1 (FILENAME) is undefined" if !defined($filename);

	if(-f $filename and -r $filename) {
		my $twig = XML::Twig->new(

lib/AI/ExpertSystem/Simple.pm  view on Meta::CPAN

					   rule => sub { $self->_rule(@_) },
					   question => sub { $self->_question(@_) } }
		);

		$twig->safe_parsefile($filename);

		die "Simple->load() XML parse failed: $@" if $@;

		$self->{_filename} = $filename;

		$self->_add_to_log( "Read in $filename" );
		$self->_add_to_log( "There are " . $self->{_number_of_rules} . " rules" );
		$self->_add_to_log( "There are " . $self->{_number_of_attributes} . " attributes" );
		$self->_add_to_log( "There are " . $self->{_number_of_questions} . " questions" );
		$self->_add_to_log( "The goal attibutes is " . $self->{_goal}->name() );
		return 1;
	} else {
		die "Simple->load() unable to use file";
	}
}

sub _goal {
	my ($self, $t, $node) = @_;

	my $attribute = undef;

lib/AI/ExpertSystem/Simple.pm  view on Meta::CPAN

		while(%answers) {
			my %old_answers = %answers;
			%answers = ();

			foreach my $answer (keys(%old_answers)) {
				my $n = $answer;
				my $v = $old_answers{$answer}->{value};
				my $s = $old_answers{$answer}->{setter};

				$self->_add_to_log( "Setting '$n' to '$v'" );

				$self->{_knowledge}->{$n}->set_value($v,$s);

				foreach my $key (keys(%{$self->{_rules}})) {
					if($self->{_rules}->{$key}->state() eq 'active') {
						my $state = $self->{_rules}->{$key}->given($n, $v);
						if($state eq 'completed') {
							$self->_add_to_log( "Rule '$key' has completed" );
							my %y = $self->{_rules}->{$key}->actions();
							foreach my $k (keys(%y)) {
								$self->_add_to_log( "Rule '$key' is setting '$k' to '$y{$k}'" );
								$answers{$k}->{value} = $y{$k};
								$answers{$k}->{setter} = $key;
							}
						} elsif($state eq 'invalid') {
							$self->_add_to_log( "Rule '$key' is now inactive" );
						}
					}
				}
			}
		}

		return 'continue';
	} else {
		my %scoreboard = ();

lib/AI/ExpertSystem/Simple.pm  view on Meta::CPAN

sub get_answer {
	my ($self) = @_;

	die "Simple->get_answer() takes no arguments" if scalar(@_) != 1;

	my $n = $self->{_goal}->name();

	return $self->{_goal}->answer($self->{_knowledge}->{$n}->get_value());
}

sub log {
	my ($self) = @_;

	die "Simple->log() takes no arguments" if scalar(@_) != 1;

	my @return = ();
	@return = @{$self->{_log}} if defined @{$self->{_log}};

	$self->{_log} = ();

	return @return;
}

sub _add_to_log {
	my ($self, $message) = @_;

	push( @{$self->{_log}}, $message );
}

sub explain {
	my ($self) = @_;

	die "Simple->explain() takes no arguments" if scalar(@_) != 1;

	my $name  = $self->{_goal}->name();
	my $rule  = $self->{_knowledge}->{$name}->get_setter();
	my $value = $self->{_knowledge}->{$name}->get_value();

	my $x = "The goal '$name' was set to '$value' by " . ($rule ? "rule '$rule'" : 'asking a question' );
	$self->_add_to_log( $x );

	my @processed_rules;
	push( @processed_rules, $rule ) if $rule;

	$self->_explain_this( $rule, '', @processed_rules );
}

sub _explain_this {
	my ($self, $rule, $depth, @processed_rules) = @_;

	$self->_add_to_log( "${depth}Explaining rule '$rule'" );

	my %dont_do_these = map{ $_ => 1 } @processed_rules;

	my @check_these_rules = ();

	my %conditions = $self->{_rules}->{$rule}->conditions();
	foreach my $name (sort keys %conditions) {
		my $value = $conditions{$name};
		my $setter = $self->{_knowledge}->{$name}->get_setter();

		my $x = "$depth Condition '$name' was set to '$value' by " . ($setter ? "rule '$setter'" : 'asking a question' );
		$self->_add_to_log( $x );

		if($setter) {
			unless($dont_do_these{$setter}) {
				$dont_do_these{$setter} = 1;
				push( @check_these_rules, $setter );
			}
		}
	}

	my %actions = $self->{_rules}->{$rule}->actions();
	foreach my $name (sort keys %actions) {
		my $value = $actions{$name};

		my $x = "$depth Action set '$name' to '$value'";
		$self->_add_to_log( $x );
	}

	@processed_rules = keys %dont_do_these;

	foreach my $x ( @check_these_rules ) {
		push( @processed_rules, $self->_explain_this( $x, "$depth ", keys %dont_do_these ) );
	}

	return @processed_rules;
}

lib/AI/ExpertSystem/Simple.pm  view on Meta::CPAN

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

lib/AI/ExpertSystem/Simple.pm  view on Meta::CPAN

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

=item explain( )

Explain how the given answer was arrived at. The explanation is added to the log.

=back

=head2 Private methods

=over 4

=item _goal

A private method to get the goal data from the knowledgebase.

=item _rule

A private method to get the rule data from the knowledgebase.

=item _question

A private method to get the question data from the knowledgebase.

=item _add_to_log

A private method to add a message to the log.

=item _explain_this

A private method to explain how a single attribute was set.

=back

=head1 ENVIRONMENT

None

lib/AI/ExpertSystem/Simple.pm  view on Meta::CPAN

=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

t/Simple.t  view on Meta::CPAN

($t, $r) = $x->get_question();

$x->answer('yes');

is($x->process(), 'continue', 'Carry on');
is($x->process(), 'finished', 'Thats all folks');

is($x->get_answer(), 'You have set the goal to pretzel', 'Got the answer');

my @log = $x->log();

isnt(scalar @log, 0, 'The log has data');

@log = $x->log();

is(scalar @log, 0, 'The log is empty');

eval { $x->explain(1); };
like($@, qr/^Simple->explain\(\) takes no arguments /, 'Too many arguments');

$x->explain();
@log = $x->log();

isnt(scalar @log, 0, 'The log has data');