AI-ExpertSystem-Advanced
view release on metacpan or search on metacpan
In case user knows of it.
- or FACT_SIGN_NEGATIVE
In case user doesn't knows of it.
~ or FACT_SIGN_UNSURE
In case user doesn't have any clue about the given fact.
get_rule_by_goal($goal)
Looks in the knowledge_db for the rule that has the given goal. If a
rule is found its number is returned, otherwise undef.
forward()
use AI::ExpertSystem::Advanced;
use AI::ExpertSystem::Advanced::KnowledgeDB::Factory;
my $yaml_kdb = AI::ExpertSystem::Advanced::KnowledgeDB::Factory->new('yaml',
{
filename => 'examples/knowledge_db_one.yaml'
});
inc/Module/Install.pm view on Meta::CPAN
BEGIN {
# All Module::Install core packages now require synchronised versions.
# This will be used to ensure we don't accidentally load old or
# different versions of modules.
# This is not enforced yet, but will be some time in the next few
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
$VERSION = '0.91';
# Storage for the pseudo-singleton
$MAIN = undef;
*inc::Module::Install::VERSION = *VERSION;
@inc::Module::Install::ISA = __PACKAGE__;
}
inc/Module/Install.pm view on Meta::CPAN
}
# Cloned from Params::Util::_CLASS
sub _CLASS ($) {
(
defined $_[0]
and
! ref $_[0]
and
$_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s
) ? $_[0] : undef;
}
1;
# Copyright 2008 - 2009 Adam Kennedy.
inc/Module/Install/Metadata.pm view on Meta::CPAN
artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php',
lgpl => 'http://opensource.org/licenses/lgpl-license.php',
lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php',
lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html',
bsd => 'http://opensource.org/licenses/bsd-license.php',
gpl => 'http://opensource.org/licenses/gpl-license.php',
gpl2 => 'http://opensource.org/licenses/gpl-2.0.php',
gpl3 => 'http://opensource.org/licenses/gpl-3.0.html',
mit => 'http://opensource.org/licenses/mit-license.php',
mozilla => 'http://opensource.org/licenses/mozilla1.1.php',
open_source => undef,
unrestricted => undef,
restrictive => undef,
unknown => undef,
);
sub license {
my $self = shift;
return $self->{values}->{license} unless @_;
my $license = shift or die(
'Did not provide a value to license()'
);
$self->{values}->{license} = $license;
inc/Module/Install/Metadata.pm view on Meta::CPAN
Module::Install::_write(
'MYMETA.json',
JSON->new->pretty(1)->canonical->encode($meta),
);
}
sub _write_mymeta_data {
my $self = shift;
# If there's no existing META.yml there is nothing we can do
return undef unless -f 'META.yml';
# We need Parse::CPAN::Meta to load the file
unless ( eval { require Parse::CPAN::Meta; 1; } ) {
return undef;
}
# Merge the perl version into the dependencies
my $val = $self->Meta->{values};
my $perl = delete $val->{perl_version};
if ( $perl ) {
$val->{requires} ||= [];
my $requires = $val->{requires};
# Canonize to three-dot version after Perl 5.6
lib/AI/ExpertSystem/Advanced.pm view on Meta::CPAN
=cut
sub is_goal_in_our_facts {
my ($self, $goal) = @_;
foreach my $dict (qw(initial_facts_dict inference_facts asked_facts)) {
if ($self->{$dict}->find($goal)) {
return 1;
}
}
return undef;
}
=head2 B<remove_last_ivisited_rule()>
Removes the last visited rule and return its number.
=cut
sub remove_last_visited_rule {
my ($self) = @_;
lib/AI/ExpertSystem/Advanced.pm view on Meta::CPAN
$question = "Do you have $fact?";
}
my @options = qw(Y N U);
my $answer = $self->{'viewer'}->ask($question, @options);
return $answer;
}
=head2 B<get_rule_by_goal($goal)>
Looks in the L<knowledge_db> for the rule that has the given goal. If a rule
is found its number is returned, otherwise undef.
=cut
sub get_rule_by_goal {
my ($self, $goal) = @_;
return $self->{'knowledge_db'}->find_rule_by_goal($goal);
}
=head2 B<forward()>
lib/AI/ExpertSystem/Advanced.pm view on Meta::CPAN
facts then the rule will be shoot and all of its goals will be copied/converted
to inference facts and will restart reading from the first rule.
=cut
sub forward {
my ($self) = @_;
confess "Can't do forward algorithm with no initial facts" unless
$self->{'initial_facts_dict'};
my ($more_rules, $current_rule) = (1, undef);
while($more_rules) {
$current_rule = $self->{'knowledge_db'}->get_next_rule($current_rule);
# No more rules?
if (!defined $current_rule) {
$self->{'viewer'}->debug("We are done with all the rules, bye")
if $self->{'verbose'};
$more_rules = 0;
last;
}
lib/AI/ExpertSystem/Advanced.pm view on Meta::CPAN
if $self->{'verbose'};
$self->{'viewer'}->debug("More rules to check, checking...")
if $self->{'verbose'};
my $rule_causes = $self->get_causes_by_rule($current_rule);
# any of our rule facts match with our facts to check?
if ($self->compare_causes_with_facts($current_rule)) {
# shoot and start again
$self->shoot($current_rule, 'forward');
# Undef to start reading from the first rule.
$current_rule = undef;
next;
}
}
return 1;
}
=head2 B<backward()>
use AI::ExpertSystem::Advanced;
use AI::ExpertSystem::Advanced::KnowledgeDB::Factory;
lib/AI/ExpertSystem/Advanced.pm view on Meta::CPAN
$self->{'viewer'}->debug(
"We are done, a positive fact was found"
);
return 1;
}
}
my $intuitive_facts = AI::ExpertSystem::Advanced::Dictionary->new(
stack => []);
my ($more_rules, $current_rule) = (1, undef);
while($more_rules) {
$current_rule = $self->{'knowledge_db'}->get_next_rule($current_rule);
# No more rules?
if (!defined $current_rule) {
$self->{'viewer'}->debug("We are done with all the rules, bye")
if $self->{'verbose'};
$more_rules = 0;
last;
}
lib/AI/ExpertSystem/Advanced/Dictionary.pm view on Meta::CPAN
isa => 'ArrayRef');
=head1 Methods
=head2 B<find($look_for, $find_by)>
Looks for a given value (C<$look_for>). By default it will look for the value
by reading the C<id> of each item, however this can be changed by passing
a different hash key (C<$find_by>).
In case there's no match C<undef> is returned.
=cut
sub find {
my ($self, $look_for, $find_by) = @_;
if (!defined($find_by)) {
if (defined $self->{'stack_hash'}->{$look_for}) {
return $look_for;
}
return undef;
}
foreach my $key (keys %{$self->{'stack_hash'}}) {
if ($self->{'stack_hash'}->{$key}->{$find_by} eq $look_for) {
return $key;
}
}
return undef;
}
=head2 B<get_value($id, $key)>
The L<AI::ExpertSystem::Advanced::Dictionary> consists of a hash of elements,
each element has its own properties (eg, extra keys).
This method looks for the value of the given C<$key> of a given element C<id>.
It will return the value, but if element doesn't have the given C<$key> then
C<undef> will be returned.
=cut
sub get_value {
my ($self, $id, $key) = @_;
if (!defined $self->{'stack_hash'}->{$id}) {
return undef;
}
if (defined $self->{'stack_hash'}->{$id}->{$key}) {
return $self->{'stack_hash'}->{$id}->{$key};
} else {
return undef;
}
}
=head2 B<append($id, %extra_keys)>
Adds a new element to the C<stack_hash> and C<stack>. The element gets added to
the end of C<stack>.
The C<$id> parameter specifies the id of the new element and the next parameter
is a stack of I<extra> keys.
=cut
sub append {
my $self = shift;
my $id = shift;
return $self->_add($id, undef, @_);
}
=head2 B<prepend($id, %extra_keys)>
Same as C<append()>, but the element gets added to the top of the C<stack>.
=cut
sub prepend {
my $self = shift;
my $id = shift;
lib/AI/ExpertSystem/Advanced/Dictionary.pm view on Meta::CPAN
my ($self) = @_;
return scalar(@{$self->{'stack'}});
}
=head2 B<iterate()>
Returns the first element of the C<iterable_array> and C<iterable_array> is
reduced by one.
If no more items are found in C<iterable_array> then C<undef> is returned.
=cut
sub iterate {
my ($self) = @_;
return shift(@{$self->{'iterable_array'}});
}
=head2 B<iterate_reverse()>
lib/AI/ExpertSystem/Advanced/KnowledgeDB/Base.pm view on Meta::CPAN
}
my $causes_dict = AI::ExpertSystem::Advanced::Dictionary->new(
stack => \@facts);
return $causes_dict;
}
=head2 B<find_rule_by_goal($goal)>
Looks for the first rule that has the given C<goal> in its goals.
If a rule is found then its number is returned, otherwise C<undef> is
returned.
B<NOTE>: Rewrite this method if you are not going to use the C<rules> hash (eg,
you will use a database engine).
=cut
sub find_rule_by_goal {
my ($self, $goal) = @_;
my $rule_counter = 0;
lib/AI/ExpertSystem/Advanced/KnowledgeDB/Base.pm view on Meta::CPAN
foreach my $look_in (qw(id name)) {
if (defined $rule_goal->{$look_in}) {
if ($rule_goal->{$look_in} eq $goal) {
return $rule_counter;
}
}
}
}
$rule_counter++;
}
return undef;
}
=head2 B<get_question($fact)>
Looks for a question about the given C<$fact>. If a question exists then this is
returned, otherwise C<undef> is returned.
B<NOTE>: Rewrite this method if you are not going to use the C<rules> hash (eg,
you will use a database engine).
=cut
sub get_question {
my ($self, $fact) = @_;
if (defined $self->{'questions'}->{$fact}) {
return $self->{'questions'}->{$fact};
}
return undef;
}
=head2 B<get_next_rule($current_rule)>
Returns the ID of the next rule. When there are no more rules to work then
C<undef> should be returned.
When it starts looking for the first rule, C<$current_rule> value will
be C<undef>.
B<NOTE>: Rewrite this method if you are not going to use the C<rules> hash (eg,
you will use a database engine).
=cut
sub get_next_rule {
my ($self, $current_rule) = @_;
my $next_rule;
if (defined $current_rule) {
$next_rule = $current_rule+1;
} else {
$next_rule = 0;
}
if (defined $self->{'rules'}->[$next_rule]) {
return $next_rule;
} else {
return undef;
}
}
=head1 AUTHOR
Pablo Fischer (pablo@pablo.com.mx).
=head1 COPYRIGHT
Copyright (C) 2010 by Pablo Fischer.
lib/AI/ExpertSystem/Advanced/KnowledgeDB/Factory.pm view on Meta::CPAN
use strict;
use warnings;
use Class::Factory;
use base qw(Class::Factory);
our $VERSION = '0.02';
sub new {
my ($pkg, $type, @params) = @_;
my $class = $pkg->get_factory_class($type);
return undef unless ($class);
my $self = "$class"->new(@params);
return $self;
}
__PACKAGE__->register_factory_type(yaml =>
'AI::ExpertSystem::Advanced::KnowledgeDB::YAML');
=head1 AUTHOR
Pablo Fischer (pablo@pablo.com.mx).
lib/AI/ExpertSystem/Advanced/Viewer/Factory.pm view on Meta::CPAN
use strict;
use warnings;
use Class::Factory;
use base qw(Class::Factory);
our $VERSION = '0.01';
sub new {
my ($pkg, $type, @params) = @_;
my $class = $pkg->get_factory_class($type);
return undef unless ($class);
my $self = "$class"->new(@params);
return $self;
}
__PACKAGE__->register_factory_type(terminal =>
'AI::ExpertSystem::Advanced::Viewer::Terminal');
=head1 AUTHOR
Pablo Fischer (pablo@pablo.com.mx).
( run in 0.889 second using v1.01-cache-2.11-cpan-d80b1682f3f )