AI-ExpertSystem-Simple
view release on metacpan or search on metacpan
lib/AI/ExpertSystem/Simple.pm view on Meta::CPAN
my $text = undef;
my $x = ($node->children('attribute'))[0];
$attribute = $x->text();
$x = ($node->children('text'))[0];
$text = $x->text();
$self->{_goal} = AI::ExpertSystem::Simple::Goal->new($attribute, $text);
eval { $t->purge(); }
}
sub _rule {
my ($self, $t, $node) = @_;
my $name = undef;
my $x = ($node->children('name'))[0];
$name = $x->text();
lib/AI/ExpertSystem/Simple.pm view on Meta::CPAN
$value = $y->text();
$self->{_rules}->{$name}->add_action($attribute, $value);
if(!defined($self->{_knowledge}->{$attribute})) {
$self->{_number_of_attributes}++;
$self->{_knowledge}->{$attribute} = AI::ExpertSystem::Simple::Knowledge->new($attribute);
}
}
eval { $t->purge(); }
}
sub _question {
my ($self, $t, $node) = @_;
my $attribute = undef;
my $text = undef;
my @responses = ();
$self->{_number_of_questions}++;
lib/AI/ExpertSystem/Simple.pm view on Meta::CPAN
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();
if($self->{_knowledge}->{$n}->is_value_set()) {
################################################################################
# Load the class
################################################################################
use_ok('AI::ExpertSystem::Simple::Goal');
################################################################################
# Create a AI::ExpertSystem::Simple::Goal incorrectly
################################################################################
eval { my $x = AI::ExpertSystem::Simple::Goal->new(); };
like($@, qr/^Goal->new\(\) takes 2 arguments /, 'Too few arguments');
eval { my $x = AI::ExpertSystem::Simple::Goal->new('fred'); };
like($@, qr/^Goal->new\(\) takes 2 arguments /, 'Too few arguments');
eval { my $x = AI::ExpertSystem::Simple::Goal->new('fred', 'a message', 'that is too long'); };
like($@, qr/^Goal->new\(\) takes 2 arguments /, 'Too many arguments');
eval { my $x = AI::ExpertSystem::Simple::Goal->new(undef, 'message'); };
like($@, qr/^Goal->new\(\) argument 1 \(NAME\) is undefined /, 'Name is undefined');
eval { my $x = AI::ExpertSystem::Simple::Goal->new('fred', undef); };
like($@, qr/^Goal->new\(\) argument 2 \(MESSAGE\) is undefined /, 'Message is undefined');
################################################################################
# Create a AI::ExpertSystem::Simple::Goal correctly
################################################################################
my $x = AI::ExpertSystem::Simple::Goal->new('fred', 'this is the fred');
isa_ok($x, 'AI::ExpertSystem::Simple::Goal');
################################################################################
# Check that the name is recalled
################################################################################
eval { $x->name('fred'); };
like($@, qr/^Goal->name\(\) takes no arguments /, 'Too many arguments');
is($x->name(), 'fred', 'Remember our name');
################################################################################
# Check the goal
################################################################################
eval { $x->is_goal(); };
like($@, qr/^Goal->is_goal\(\) takes 1 argument /, 'Too few arguments');
eval { $x->is_goal(1, 2); };
like($@, qr/^Goal->is_goal\(\) takes 1 argument /, 'Too many arguments');
eval { $x->is_goal(undef); };
like($@, qr/^Goal->is_goal\(\) argument 1 \(NAME\) is undefined /, 'name is undefined');
is($x->is_goal('fred'), '1', 'Matches the goal');
is($x->is_goal('tom'), '', 'Does not matches the goal');
################################################################################
# Check the goal
################################################################################
eval { $x->answer(); };
like($@, qr/^Goal->answer\(\) takes 1 argument /, 'Too few arguments');
eval { $x->answer(1, 2); };
like($@, qr/^Goal->answer\(\) takes 1 argument /, 'Too many arguments');
eval { $x->answer(undef); };
like($@, qr/^Goal->answer\(\) argument 1 \(VALUE\) is undefined /, 'Value is undefined');
is($x->answer('banana'), 'this is the banana', 'Get the answer');
t/Knowledge.t view on Meta::CPAN
################################################################################
# Load the class
################################################################################
use_ok('AI::ExpertSystem::Simple::Knowledge');
################################################################################
# Create a Rule incorrectly
################################################################################
eval { my $x = AI::ExpertSystem::Simple::Knowledge->new(); };
like($@, qr/^Knowledge->new\(\) takes 1 argument /, 'Too few arguments');
eval { my $x = AI::ExpertSystem::Simple::Knowledge->new(1,2); };
like($@, qr/^Knowledge->new\(\) takes 1 argument /, 'Too many arguments');
eval { my $x = AI::ExpertSystem::Simple::Knowledge->new(undef); };
like($@, qr/^Knowledge->new\(\) argument 1, \(NAME\) is undefined /, 'Name is undefined');
isnt($@, '', 'Died, incorrect number of arguments');
################################################################################
# Create a Rule correctly
################################################################################
my $x = AI::ExpertSystem::Simple::Knowledge->new('fred');
isa_ok($x, 'AI::ExpertSystem::Simple::Knowledge');
################################################################################
# Can we remember our name
################################################################################
eval { $x->name(1); };
like($@, qr/^Knowledge->name\(\) takes no arguments /, 'Too many arguments');
is($x->name(), 'fred', 'Checking the name');
################################################################################
# Check the question attribute
################################################################################
eval { $x->has_question(1); };
like($@, qr/^Knowledge->has_question\(\) takes no arguments /, 'Too many arguments');
eval { $x->set_question(1); };
like($@, qr/^Knowledge->set_question\(\) takes 2 arguments /, 'Too few arguments');
eval { $x->set_question(undef,2); };
like($@, qr/^Knowledge->set_question\(\) argument 1, \(QUESTION\) is undefined /, 'Question is undefined');
eval { $x->get_question(); };
like($@, qr/^Knowledge->set_question\(\) has not been set /, 'Question not set');
is($x->has_question(), '', 'No question has been set');
$x->set_question('to be or not to be', ('be', 'not'));
is($x->has_question(), '1', 'The question is now set');
eval { $x->set_question('fredfred', (1,2)); };
like($@, qr/^Knowledge->set_question\(\) has already been set /, 'Is already set');
################################################################################
# Check the question attribute
################################################################################
is($x->get_value(), undef, 'The value is unset');
is($x->has_question(), '1', 'The question has not been answered');
eval { $x->set_value(); };
like($@, qr/^Knowledge->set_value\(\) takes 2 argument /, 'Too few arguments');
eval { $x->set_value(1); };
like($@, qr/^Knowledge->set_value\(\) takes 2 argument /, 'Too few arguments');
eval { $x->set_value(1,2,3); };
like($@, qr/^Knowledge->set_value\(\) takes 2 argument /, 'Too many arguments');
eval { $x->set_value(undef,2); };
like($@, qr/^Knowledge->set_value\(\) argument 1, \(VALUE\) is undefined /, 'Value is undefined');
eval { $x->set_value(1,undef); };
like($@, qr/^Knowledge->set_value\(\) argument 2, \(SETTER\) is undefined /, 'Value is undefined');
eval { $x->is_value_set(1); };
like($@, qr/^Knowledge->is_value_set\(\) takes no arguments /, 'Too many arguments');
is($x->is_value_set(), '', 'Value is not set');
$x->set_value('fred', 'banana');
is($x->is_value_set(), '1', 'Value is set');
eval { $x->set_value('fredfred', 'banana'); };
like($@, qr/^Knowledge->set_value\(\) has already been set /, 'Is already set');
eval { $x->get_value(1); };
like($@, qr/^Knowledge->get_value\(\) takes no arguments /, 'Too many arguments');
eval { $x->get_setter(1); };
like($@, qr/^Knowledge->get_setter\(\) takes no arguments /, 'Too many arguments');
is($x->get_value(), 'fred', 'The value is set');
is($x->get_setter(), 'banana', 'The value is set');
is($x->has_question(), '', 'The question has been answered');
################################################################################
# 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();
use Test::More tests => 37;
use_ok('AI::ExpertSystem::Simple::Rule');
################################################################################
# Create a new rule
################################################################################
my $x;
eval { $x = AI::ExpertSystem::Simple::Rule->new(); };
like($@, qr/^Rule->new\(\) takes 1 argument /, 'Too few arguments');
eval { $x = AI::ExpertSystem::Simple::Rule->new(1,2); };
like($@, qr/^Rule->new\(\) takes 1 argument /, 'Too many arguments');
eval { $x = AI::ExpertSystem::Simple::Rule->new(undef); };
like($@, qr/^Rule->new\(\) argument 1 \(NAME\) is undefined /, 'Name is undefined');
$x = AI::ExpertSystem::Simple::Rule->new('fred');
isa_ok($x, 'AI::ExpertSystem::Simple::Rule');
eval { $x->name(1); };
like($@, qr/^Rule->name\(\) takes no arguments /, 'Too many arguments');
is($x->name(), 'fred', 'Checking the name');
################################################################################
# Populate the rule
################################################################################
eval { $x->add_condition(1); };
like($@, qr/^Rule->add_condition\(\) takes 2 arguments /, 'Too few arguments');
eval { $x->add_condition(1, 2, 3); };
like($@, qr/^Rule->add_condition\(\) takes 2 arguments /, 'Too many arguments');
eval { $x->add_condition(undef, 2); };
like($@, qr/^Rule->add_condition\(\) argument 1 \(NAME\) is undefined /, 'Name is undefined');
eval { $x->add_condition(1, undef); };
like($@, qr/^Rule->add_condition\(\) argument 2 \(VALUE\) is undefined /, 'Value is undefined');
$x->add_condition('a', 1);
eval { $x->add_condition('a', 1); };
like($@, qr/^Rule->add_condition\(\) has already been set /, 'Is already set');
$x->add_condition('b', 2);
eval { $x->add_action(1); };
like($@, qr/^Rule->add_action\(\) takes 2 arguments /, 'Too few arguments');
eval { $x->add_action(1, 2, 3); };
like($@, qr/^Rule->add_action\(\) takes 2 arguments /, 'Too many arguments');
eval { $x->add_action(undef, 2); };
like($@, qr/^Rule->add_action\(\) argument 1 \(NAME\) is undefined /, 'Name is undefined');
eval { $x->add_action(1, undef); };
like($@, qr/^Rule->add_action\(\) argument 2 \(VALUE\) is undefined /, 'Value is undefined');
$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->conditions(1); };
like($@, qr/^Rule->conditions\(\) takes no arguments /, 'Too many arguments');
%r = $x->conditions();
is(scalar keys %r, 2, 'Check the action is ok');
use Test::More tests => 28;
use_ok('AI::ExpertSystem::Simple');
################################################################################
# Create a new expert system
################################################################################
my $x;
eval { $x = AI::ExpertSystem::Simple->new(1); };
like($@, qr/^Simple->new\(\) takes no arguments /, 'Too many arguments');
$x = AI::ExpertSystem::Simple->new();
isa_ok($x, 'AI::ExpertSystem::Simple');
################################################################################
# Load a file
################################################################################
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();
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->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');
( run in 1.979 second using v1.01-cache-2.11-cpan-acf6aa7dc9e )