view release on metacpan or search on metacpan
bin/simpleshell
bin/consult
Changes
examples/Animal.xml
examples/Doctor.xml
examples/Glass.xml
examples/test.xml
lib/AI/ExpertSystem/Simple/Goal.pm
lib/AI/ExpertSystem/Simple/Knowledge.pm
lib/AI/ExpertSystem/Simple/Rule.pm
lib/AI/ExpertSystem/Simple.pm
Makefile.PL
MANIFEST
README
t/empty.xml
t/Goal.t
t/Knowledge.t
t/Rule.t
t/Simple.t
t/test.xml
on a variety of systems that I do not have access to. Suits me.
Also when I get to upgrade my Ruby version of this class it too can
use the same shell. Go ahead and learn Tcl and Tk - it's rather
usefull in it's own way.
INSTALLATION
% perl Makefile.PL
% make
% make test
% sudo make install
TEST FAILURES
The tests are there to make sure that I have broken nothing when I
fiddle with the code and will teach you very little about how to use
the code.
To see how to use the code look at simpleshell in the bin directory
and read the contents of the docs directory (when I have written them).
I am assuming that you know what an expert system is and know why
you are even running this code for in the first place.
TO DO
lib/AI/ExpertSystem/Simple.pm view on Meta::CPAN
some arguments were supplied.
=back
=head1 BUGS
None
=head1 FILES
See the Simple.t file in the test directory and simpleshell in the bin directory.
=head1 SEE ALSO
AI::ExpertSystem::Simple::Goal - A utility class
AI::ExpertSystem::Simple::Knowledge - A utility class
AI::ExpertSystem::Simple::Rule - A utility class
=head1 AUTHORS
lib/AI/ExpertSystem/Simple/Goal.pm view on Meta::CPAN
The correct number of arguments were supplied with the method call, however the first argument, VALUE, was undefined.
=back
=head1 BUGS
None to date
=head1 FILES
See Goal.t in the test directory
=head1 SEE ALSO
AI::ExpertSystem::Simple - The base class for the expert system shell
AI::ExpertSystem::Simple::Knowledge - A utility class
AI::ExpertSystem::Simple::Rules - A utility class
=head1 AUTHORS
lib/AI/ExpertSystem/Simple/Knowledge.pm view on Meta::CPAN
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;
lib/AI/ExpertSystem/Simple/Knowledge.pm view on Meta::CPAN
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
=head1 SEE ALSO
AI::ExpertSystem::Simple - The base class for the expert system shell
AI::ExpertSystem::Simple::Goal - A utility class
AI::ExpertSystem::Simple::Rules - A utility class
=head1 AUTHORS
lib/AI/ExpertSystem/Simple/Rule.pm view on Meta::CPAN
sub new {
my ($class, $name) = @_;
die "Rule->new() takes 1 argument" if(scalar(@_) != 2);
die "Rule->new() argument 1 (NAME) is undefined" if(!defined($name));
my $self = {};
$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}++;
}
}
sub add_condition {
my ($self, $name, $value) = @_;
die "Rule->add_condition() takes 2 arguments" if(scalar(@_) != 3);
die "Rule->add_condition() argument 1 (NAME) is undefined" if(!defined($name));
die "Rule->add_condition() argument 2 (VALUE) is undefined" if(!defined($value));
if(defined($self->{_conditions}->{$name})) {
die "Rule->add_condition() has already been set";
}
$self->{_conditions}->{$name} = $value;
$self->{_tested}->{$name} = 0;
$self->{_counter}++;
}
sub add_action {
my ($self, $name, $value) = @_;
die "Rule->add_action() takes 2 arguments" if(scalar(@_) != 3);
die "Rule->add_action() argument 1 (NAME) is undefined" if(!defined($name));
die "Rule->add_action() argument 2 (VALUE) is undefined" if(!defined($value));
lib/AI/ExpertSystem/Simple/Rule.pm view on Meta::CPAN
}
sub given {
my ($self, $name, $value) = @_;
die "Rule->given() takes 2 arguments" if(scalar(@_) != 3);
die "Rule->given() argument 1 (NAME) is undefined" if(!defined($name));
die "Rule->given() argument 2 (VALUE) is undefined" if(!defined($value));
if(defined($self->{_conditions}->{$name})) {
if($self->{_tested}->{$name} == 1) {
# Already done this one
} elsif($self->{_conditions}->{$name} eq $value) {
$self->{_tested}->{$name} = 1;
$self->{_counter}--;
if($self->{_counter} == 0) {
$self->{_state} = 'completed';
}
} else {
$self->{_state} = 'invalid';
}
}
return $self->{_state};
lib/AI/ExpertSystem/Simple/Rule.pm view on Meta::CPAN
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;
}
1;
=head1 NAME
lib/AI/ExpertSystem/Simple/Rule.pm view on Meta::CPAN
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.
=item name( )
lib/AI/ExpertSystem/Simple/Rule.pm view on Meta::CPAN
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
=head1 SEE ALSO
AI::ExpertSystem::Simple - The base class for the expert system
AI::ExpertSystem::Simple::Goal - A utility class
AI::ExpertSystem::Simple::knowledge - A utility class
=head1 AUTHORS
#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 18;
################################################################################
# Load the class
################################################################################
use_ok('AI::ExpertSystem::Simple::Goal');
################################################################################
# Create a AI::ExpertSystem::Simple::Goal incorrectly
################################################################################
t/Knowledge.t view on Meta::CPAN
#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 44;
################################################################################
# Load the class
################################################################################
use_ok('AI::ExpertSystem::Simple::Knowledge');
################################################################################
# Create a Rule incorrectly
################################################################################
#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 37;
use_ok('AI::ExpertSystem::Simple::Rule');
################################################################################
# Create a new rule
################################################################################
my $x;
eval { $x = AI::ExpertSystem::Simple::Rule->new(); };
#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 28;
use_ok('AI::ExpertSystem::Simple');
################################################################################
# Create a new expert system
################################################################################
my $x;
eval { $x = AI::ExpertSystem::Simple->new(1); };
eval { $x->load(); };
like($@, qr/^Simple->load\(\) takes 1 argument /, 'Too few arguments');
eval { $x->load(1,2); };
like($@, qr/^Simple->load\(\) takes 1 argument /, 'Too many arguments');
eval { $x->load(undef); };
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();