view release on metacpan or  search on metacpan

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

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

	foreach $x ($node->get_xpath('//condition')) {
		my $attribute = undef;
		my $value = undef;

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

		$y = ($x->children('value'))[0];
		$value = $y->text();

		$self->{_rules}->{$name}->add_condition($attribute, $value);

		if(!defined($self->{_knowledge}->{$attribute})) {
			$self->{_number_of_attributes}++;
			$self->{_knowledge}->{$attribute} = AI::ExpertSystem::Simple::Knowledge->new($attribute);
		}
	}

	foreach $x ($node->get_xpath('//action')) {
		my $attribute = undef;
		my $value = undef;

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

		$y = ($x->children('value'))[0];
		$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}++;

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

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

	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()) {
		return 'finished';
	}

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

		$answers{$self->{_ask_about}}->{value} = $self->{_told_about};
		$answers{$self->{_ask_about}}->{setter} = '';

		$self->{_ask_about} = undef;
		$self->{_told_about} = undef;

		while(%answers) {
			my %old_answers = %answers;
			%answers = ();

			foreach my $answer (keys(%old_answers)) {
				my $n = $answer;
				my $v = $old_answers{$answer}->{value};
				my $s = $old_answers{$answer}->{setter};

				$self->_add_to_log( "Setting '$n' to '$v'" );

				$self->{_knowledge}->{$n}->set_value($v,$s);

				foreach my $key (keys(%{$self->{_rules}})) {
					if($self->{_rules}->{$key}->state() eq 'active') {
						my $state = $self->{_rules}->{$key}->given($n, $v);
						if($state eq 'completed') {
							$self->_add_to_log( "Rule '$key' has completed" );
							my %y = $self->{_rules}->{$key}->actions();
							foreach my $k (keys(%y)) {
								$self->_add_to_log( "Rule '$key' is setting '$k' to '$y{$k}'" );
								$answers{$k}->{value} = $y{$k};
								$answers{$k}->{setter} = $key;
							}
						} elsif($state eq 'invalid') {
							$self->_add_to_log( "Rule '$key' is now inactive" );
						}
					}
				}
			}
		}

		return 'continue';
	} else {
		my %scoreboard = ();

		foreach my $rule (keys(%{$self->{_rules}})) {
			if($self->{_rules}->{$rule}->state() eq 'active') {