AI-ExpertSystem-Simple

 view release on metacpan or  search on metacpan

bin/simpleshell  view on Meta::CPAN

$s->load($filename);

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

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

	if($self->{_knowledge}->{$n}->is_value_set()) {
		return 'finished';
	}

	if($self->{_ask_about}) {
		my %answers = ();

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

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

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

	}

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

1;

=head1 NAME

AI::ExpertSystem::Simple - A simple expert system shell

=head1 VERSION

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

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

=item explain( )

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

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

=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

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

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

=item get_setter( )

Returns the current setter of the attribute.

=item is_value_set( )

t/Simple.t  view on Meta::CPAN

like($@, qr/^Simple->load\(\) argument 1 \(FILENAME\) is undefined /, 'Filename is undefined');

eval { $x->load('no_test.xml'); };
like($@, qr/^Simple->load\(\) unable to use file /, 'Cant use this file');

eval { $x->load('t/empty.xml'); };
like($@, qr/^Simple->load\(\) XML parse failed: /, 'Cant use this file');

is($x->load('t/test.xml'), '1', 'File is loaded');

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

is($x->process(), 'question', 'We have a question to answer');

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

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

eval { $x->answer(); };
like($@, qr/^Simple->answer\(\) takes 1 argument /, 'Too few arguments');

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

eval { $x->answer(undef); };
like($@, qr/^Simple->answer\(\) argument 1 \(VALUE\) is undefined /, 'Value is undefined');

$x->answer('yes');

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

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

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