AI-ExpertSystem-Simple
5 results

 view release on metacpan or  search on metacpan

bin/simpleshell  view on Meta::CPAN 

	} else {
		$continue = ask_question( 'Another consoltation', 'yes', 'no' );
		$s->reset();
	}
}

######################################################################
# Ask a question of the user showing the available responses
######################################################################

sub ask_question {
	my ( $text, @responses ) = @_;

	my $number = scalar(@responses);
	my $x      = 0;

	while ( $x < 1 or $x > $number ) {
		say_question($text);

		for ( my $y = 1 ; $y <= $number ; $y++ ) {
			say_something('response', " $y : ", $responses[$y - 1]);

bin/simpleshell  view on Meta::CPAN 

		$x = 0 if $x !~ m#^[0-9]+$#;
	}

	return $responses[ $x - 1 ];
}

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

sub say_status   { say_something('status',   '>> ', shift) }
sub say_question { say_something('question', '',    shift) }

sub say_something {
	my ($tag1, $tag2, $text) = @_;

	if($tkinterface) {
		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 

use warnings;

use XML::Twig;

use AI::ExpertSystem::Simple::Rule;
use AI::ExpertSystem::Simple::Knowledge;
use AI::ExpertSystem::Simple::Goal;

our $VERSION = '1.2';

sub new {
	my ($class) = @_;

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

	my $self = {};

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

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


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

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

	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(
			twig_handlers => { goal => sub { $self->_goal(@_) },
					   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;
	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();

	if(!defined($self->{_rules}->{$name})) {
		$self->{_rules}->{$name} = AI::ExpertSystem::Simple::Rule->new($name);
		$self->{_number_of_rules}++;

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

	eval { $t->purge(); }
}

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

	my $attribute = undef;
	my $text = undef;
	my @responses = ();

	$self->{_number_of_questions}++;

	my $x = ($node->children('attribute'))[0];
	$attribute = $x->text();

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

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

			if($scoreboard{$name} > $max_value) {
				$max_value = $scoreboard{$name};
				$self->{_ask_about} = $name;
			}
		}

		return $self->{_ask_about} ? 'question' : 'failed';
	}
}

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

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

	return $self->{_knowledge}->{$self->{_ask_about}}->get_question();
}

sub answer {
	my ($self, $value) = @_;

	die "Simple->answer() takes 1 argument" if scalar(@_) != 2;
	die "Simple->answer() argument 1 (VALUE) is undefined" if ! defined($value);

	$self->{_told_about} = $value;
}

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

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

package AI::ExpertSystem::Simple::Goal;

use strict;
use warnings;

our $VERSION = '1.0';

sub new {
	my ($class, $name, $message) = @_;

	# Check the input

	die "Goal->new() takes 2 arguments" if scalar(@_) != 3;
	die "Goal->new() argument 1 (NAME) is undefined" if ! defined($name);
	die "Goal->new() argument 2 (MESSAGE) is undefined" if ! defined($message);

	# All OK, create the object

	my $self = {};

	$self->{_name} = $name;
	$self->{_message} = $message;

	return bless $self, $class;
}

sub is_goal {
	my ($self, $name) = @_;

	# Check the input

	die "Goal->is_goal() takes 1 argument" if scalar(@_) != 2;
	die "Goal->is_goal() argument 1 (NAME) is undefined" if ! defined($name);

	# All OK, do the stuff

	return $self->{_name} eq $name;
}

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

	# Check the input

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

	# All OK, do the stuff

	return $self->{_name};
}

sub answer {
	my ($self, $value) = @_;

	# Check the input

	die "Goal->answer() takes 1 argument" if scalar(@_) != 2;
	die "Goal->answer() argument 1 (VALUE) is undefined" if ! defined($value);

	# All OK, do the stuff

	my @text = ();

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

package AI::ExpertSystem::Simple::Knowledge;

use strict;
use warnings;

our $VERSION = '1.2';

sub new {
	my ($class, $name) = @_;

    die "Knowledge->new() takes 1 argument" if scalar(@_) != 2;
    die "Knowledge->new() argument 1, (NAME) is undefined" if ! defined($name);

	my $self = {};

	$self->{_name} = $name;
	$self->{_value} = undef;
	$self->{_setter} = undef;
	$self->{_question} = undef;
	$self->{_responses} = ();

	return bless $self, $class;
}

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

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

	$self->{_value} = undef;
	$self->{_setter} = undef;
}

sub set_value {
	my ($self, $value, $setter) = @_;

    die "Knowledge->set_value() takes 2 argument" if scalar(@_) != 3;
    die "Knowledge->set_value() argument 1, (VALUE) is undefined" if ! defined($value);
    die "Knowledge->set_value() argument 2, (SETTER) is undefined" if ! defined($setter);

	if(defined($self->{_value})) {
		die "Knowledge->set_value() has already been set";
	}

	$self->{_value} = $value;
	$self->{_setter} = $setter;
}

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

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

	return $self->{_value};
}

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

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

	return $self->{_setter};
}

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

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

	return defined($self->{_value});
}

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;

	if(!defined($self->{_question})) {
		die "Knowledge->set_question() has not been set";
	}

	return ($self->{_question}, @{$self->{_responses}});
}

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

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

	return (defined($self->{_question}) and !defined($self->{_value}));
}

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

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

	return $self->{_name};
}

1;

=head1 NAME

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

package AI::ExpertSystem::Simple::Rule;

use strict;
use warnings;

our $VERSION = '1.2';

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

	if(defined($self->{_actions}->{$name})) {
		die "Rule->add_action() has already been set";
	}

	$self->{_actions}->{$name} = $value;
}

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

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

	return $self->{_name};
}

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

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

	return $self->{_state};
}

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

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

				$self->{_state} = 'completed';
			}
		} else {
			$self->{_state} = 'invalid';
		}
	}

	return $self->{_state};
}

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

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

	return %{$self->{_actions}};
}

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

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

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



( run in 0.275 second using v1.01-cache-2.11-cpan-a5abf4f5562 )