view release on metacpan or  search on metacpan

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

        my $factor = $causes->get_value($cause, 'factor');
        if (!defined $factor) {
            $missing_factor++;
        }
        foreach my $dict (qw(initial_facts_dict inference_facts asked_facts)) {
            if ($self->{$dict}->find($cause)) {
                $match_counter++;
                if (defined $factor) {
                    $factor_counter = $factor_counter + $factor;
                } else {
                    $nonfactor_match++;
                }
            }
        }
    }
    # No matches?
    if ($match_counter eq 0) {
        return 0;
    }
    # None of the causes (matched or not) have a factor
    if ($causes_total eq $missing_factor) {
        return $match_counter / $causes_total;
    } else { # Some factors found
       if ($missing_factor) { # Oh, but some causes don't have it
           return $factor_counter + ($nonfactor_match / $causes_total);
       } else {
           return $factor_counter;
       }
    }
}

=head2 B<is_goal_in_our_facts($goal)>

Checks if the given C<$goal> is in:

=over 4

=item 1

The initial facts

=item 2

The inference facts

=item 3

The asked facts

=back

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

    my $last = $self->{'visited_rules'}->iterate;
    if (defined $last) {
        $self->{'visited_rules'}->remove($last);
        $self->{'visited_rules'}->populate_iterable_array();
    }
    return $last;
}

=head2 B<visit_rule($rule, $total_causes)>

Adds the given C<$rule> to the end of the L<visited_rules>.

=cut
sub visit_rule {
    my ($self, $rule, $total_causes) = @_;

    $self->{'visited_rules'}->prepend($rule,
            {
                causes_total => $total_causes,
                causes_pending => $total_causes
            });
    $self->{'visited_rules'}->populate_iterable_array();
}

=head2 B<copy_to_goals_to_check($rule, $facts)>

Copies a list of facts (usually a list of causes of a rule) to
L<goals_to_check_dict>.

The rule ID of the goals that are being copied is also stored in the hahs.

=cut
sub copy_to_goals_to_check {
    my ($self, $rule, $facts) = @_;

    while(my $fact = $facts->iterate_reverse) {
        $self->{'goals_to_check_dict'}->prepend(
                $fact,
                {
                    name => $fact,
                    sign => $facts->get_value($fact, 'sign'),
                    rule => $rule
                });
    }
}

=head2 B<ask_about($fact)>

Uses L<viewer> to ask the user for the existence of the given C<$fact>.

The valid answers are:

=over 4

=item B<+> or L<FACT_SIGN_POSITIVE>

In case user knows of it.

=item B<-> or L<FACT_SIGN_NEGATIVE>

In case user doesn't knows of it.

=item B<~> or L<FACT_SIGN_UNSURE>

In case user doesn't have any clue about the given fact.

=back

=cut
sub ask_about {
    my ($self, $fact) = @_;

    # The knowledge db has questions for this fact?
    my $question = $self->{'knowledge_db'}->get_question($fact);
    if (!defined $question) {
        $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()>

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

    my $ai = AI::ExpertSystem::Advanced->new(
            viewer_class => 'terminal',
            knowledge_db => $yaml_kdb,
            initial_facts => ['F', 'J']);
    $ai->forward();
    $ai->summary();

The forward chaining algorithm is one of the main methods used in Expert
Systems. It starts with a set of variables (known as initial facts) and reads
the available rules.

It will be reading rule by rule and for each one it will compare its causes
with the initial, inference and asked facts. If all of these causes are in the
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;
        }

        $self->{'viewer'}->debug("Checking rule: $current_rule") if
            $self->{'verbose'};
        
        if ($self->is_rule_shot($current_rule)) {
            $self->{'viewer'}->debug("We already shot rule: $current_rule")
                if $self->{'verbose'};
            next;
        }

        $self->{'viewer'}->debug("Reading rule $current_rule")
            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;

    my $yaml_kdb = AI::ExpertSystem::Advanced::KnowledgeDB::Factory->new('yaml',
        {
            filename => 'examples/knowledge_db_one.yaml'
            });

    my $ai = AI::ExpertSystem::Advanced->new(
            viewer_class => 'terminal',
            knowledge_db => $yaml_kdb,
            goals_to_check => ['J']);
    $ai->backward();
    $ai->summary();

The backward algorithm starts with a set of I<assumed> goals (facts). It will
start reading goal by goal. For each goal it will check if it exists in the
initial, inference and asked facts (see L<is_goal_in_our_facts()>) for more
information).

=over 4

=item *

If the goal exist then it will be removed from the dictionary, it will also
verify if there are more visited rules to shoot.

If there are still more visited rules to shoot then it will check from what
rule the goal comes from, if it was copied from a rule then this data will
exist. With this information then it will see how many of the causes of this
given rule are still in the L<goals_to_check_dict>.

In case there are still causes of this rule in L<goals_to_check_dict> then the
amount of causes pending will be reduced by one. Otherwise (if the amount is
0) then the rule of this last removed goal will be shoot.

=item *

If the goal doesn't exist in the mentioned facts then the goal will be searched
in the goals of every rule.

In case it finds the rule that has the goal, this rule will be marked (added)
to the list of visited rules (L<visited_rules>) and also all of its causes
will be added to the top of the L<goals_to_check_dict> and it will start
reading again all the goals.

If there's the case where the goal doesn't exist as a goal in the rules then
it will ask the user (via L<ask_about()>) for the existence of it. If user is
not sure about it then the algorithm ends.

=back

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

any positive inference fact, if only one is found then this ends the algorithm
with the assumption it knows what's happening.

In case no positive inference fact is found then it will start reading the
rules and creating a list of intuitive facts.

For each rule it will get a I<certainty factor> of its causes versus the
initial, inference and asked facts. In case the certainity factor is greater or
equal than L<found_factor> then all of its goals will be copied to the
intuitive facts (eg, read it as: it assumes the goals have something to do with
our first initial facts).

Once all the rules are read then it verifies if there are intuitive facts, if
no facts are found then it ends with the intuition, otherwise it will run the
L<backward()> algorithm for each one of these facts (eg, each fact will be
converted to a goal). After each I<run> of the L<backward()> algorithm it will
verify for any positive inference fact, if just one is found then the algorithm
ends.

At the end (if there are still no positive inference facts) it will run the
L<forward()> algorithm and restart (by looking again for any positive inference
fact).

A good example to understand how this algorithm is useful is: imagine you are
a doctor and know some of the symptoms of a patient. Probably with the first
symptoms you have you can get to a positive conclusion (eg that a patient has
I<X> disease). However in case there's still no clue, then a set of questions
(done by the call of L<backward()>) of symptons related to the initial symptoms
will be asked to the user. For example, we know that that the patient has a
headache but that doesn't give us any positive answer, what if the patient has
flu or another disease? Then a set of these I<related> symptons will be asked
to the user.

=cut
sub mixed {
    my ($self) = @_;

    if (!$self->forward()) {
        $self->{'viewer'}->print_error("The first execution of forward failed");
        return 0;
    }

    use Data::Dumper;

    while(1) {
        # We are satisfied if only one inference fact is positive (eg, means we
        # got to our result)
        while(my $fact = $self->{'inference_facts'}->iterate) {
            my $sign = $self->{'inference_facts'}->get_value($fact, 'sign');
            if ($sign eq FACT_SIGN_POSITIVE) {
                $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;
            }

            # Wait, we already shot this rule?
            if ($self->is_rule_shot($current_rule)) {
                $self->{'viewer'}->debug("We already shot rule: $current_rule")
                    if $self->{'verbose'};
                next;
            }

            my $factor = $self->get_causes_match_factor($current_rule);
            if ($factor ge $self->{'found_factor'} && $factor lt 1.0) {
                # Copy all of the goals (usually only one) of the current rule to
                # the intuitive facts
                my $goals = $self->get_goals_by_rule($current_rule);
                while(my $goal = $goals->iterate_reverse) {
                   $intuitive_facts->append($goal,
                           {
                               name => $goal,
                               sign => $goals->get_value($goal, 'sign')
                           });
               }
            }
        }
        if ($intuitive_facts->size() eq 0) {
            $self->{'viewer'}->debug("Done with intuition") if
                $self->{'verbose'};
            return 1;
        }
        
        $intuitive_facts->populate_iterable_array();

        # now each intuitive fact will be a goal
        while(my $fact = $intuitive_facts->iterate) {
            $self->{'goals_to_check_dict'}->append(
                    $fact,
                    {
                        name => $fact,
                        sign => $intuitive_facts->get_value($fact, 'sign')
                    });
            $self->{'goals_to_check_dict'}->populate_iterable_array();
            print "Running backward for $fact\n";
            if (!$self->backward()) {
                $self->{'viewer'}->debug("Backward exited");
                return 1;
            }
            # Now we have inference facts, anything positive?
            $self->{'inference_facts'}->populate_iterable_array();
            while(my $inference_fact = $self->{'inference_facts'}->iterate) {
                my $sign = $self->{'inference_facts'}->get_value(
                        $inference_fact, 'sign');
                if ($sign eq FACT_SIGN_POSITIVE) {