AI-Prolog

 view release on metacpan or  search on metacpan

bin/aiprolog  view on Meta::CPAN

    my $key = ReadKey(0);
    ReadMode 'normal';
    if (';' eq $key) {
        print $OUT ";\n\n";
        return 1;
    }
    print $OUT "\n\nYes\n" if $RESULTS;
    return;
}

my $offset;
sub help {
    $offset ||= tell DATA;
    seek DATA, $offset, 0;
    pod2usage({
        -verbose => 2, 
        -input   => \*DATA,
        -exitval => 'NOEXIT',
    });
}

__DATA__

=head1 NAME 

data/sleepy.pro  view on Meta::CPAN

/* This rule tells how to look about you. */

look :-
        i_am_at(Place),
        describe(Place),
        nl,
        notice_objects_at(Place),
        nl.


/* These rules set up a loop to mention all the objects in your vicinity. */

notice_objects_at(Place) :-
    lit(Place),
        at(X, Place),
    visible_object(X),
        print('There is a '), print(X), print(' here.'), nl,
        fail.

notice_objects_at(_).

data/spider.pro  view on Meta::CPAN

path(meadow, n, cave_entrance) :-
        print('Go into that dark cave without a light?  Are you crazy?'), nl,
        fail.

path(meadow, s, building).
path(building, n, meadow).

path(building, w, cage).
path(cage, e, building).

path(closet, w, building).
path(building, e, closet) :- at(key, in_hand).
path(building, e, closet) :-
        print('The door appears to be locked.'), nl,
        fail.

% These facts tell where the various objects in the game are located.

at(ruby, spider).
at(key, cave_entrance).
at(flashlight, building).
at(sword, closet).

% This fact specifies that the spider is alive.

alive(spider).

% These rules describe how to pick up an object.

take(X) :-
        at(X, in_hand),
        print('You are already holding it!'),

data/spider.pro  view on Meta::CPAN

% This rule tells how to look about you.

look :-
        i_am_at(Place),
        describe(Place),
        nl,
        notice_objects_at(Place),
        nl.


% These rules set up a loop to mention all the objects in your vicinity.

notice_objects_at(Place) :-
        at(X, Place),
        print('There is a '), print(X), print(' here.'), nl,
        fail.

notice_objects_at(_).

% These rules tell how to handle killing the lion and the spider.

data/spider.pro  view on Meta::CPAN


describe(building) :-
        print('You are in a small building.  The exit is to the north.'), nl,
        print('There is a barred door to the west, but it seems to be'), nl,
        print('unlocked.  There is a smaller door to the east.'), nl.

describe(cage) :-
        print('You are in a den of the lion!  The lion has a lean and'), nl,
        print('hungry look.  You better get out of here!'), nl.

describe(closet) :-
        print('This is nothing but an old storage closet.'), nl.

describe(cave_entrance) :-
        print('You are in the mouth of a dank cave.  The exit is to'), nl,
        print('the south; there is a large, dark, round passage to'), nl,
        print('the east.'), nl.

describe(cave) :-
        alive(spider),
        at(ruby, in_hand),
        print('The spider sees you with the ruby and attacks!!!'), nl,

examples/data_structures.pl  view on Meta::CPAN

#!/usr/local/bin/perl -l

use strict;
use warnings;
use lib ('../lib/', 'lib/');
use Data::Dumper;
$Data::Dumper::Indent = 0;

use AI::Prolog;

# note that the following line sets an experimental interface option
AI::Prolog->raw_results(0);
my $database = <<'END_PROLOG';
append([], X, X).
append([W|X],Y,[W|Z]) :- append(X,Y,Z).
END_PROLOG

my $logic = AI::Prolog->new($database);
$logic->query('append(LIST1,LIST2,[a,b,c,d]).');
while (my $result = $logic->results) {
    print Dumper($result->LIST1);

lib/AI/Prolog.pm  view on Meta::CPAN

        # prime the pump
        $self->{_engine} = Engine->new( @{$self}{qw/_query _prog/} );
    }
    $self->{_engine}->query( $self->{_query} );
    return $self;
}

sub results {
    my $self = shift;
    unless ( defined $self->{_query} ) {
        croak "You can't fetch results because you have not set a query";
    }
    $self->{_engine}->results;
}

sub trace {
    my $self = shift;
    if (@_) {
        $self->{_engine}->trace(shift);
        return $self;
    }

lib/AI/Prolog.pm  view on Meta::CPAN


 my $prolog = AI::Prolog->new($program_text);

See L<AI::Prolog::Builtins|AI::Prolog::Builtins> and the C<examples/> directory
included with this distribution for more details on the program text.

Returns an C<AI::Prolog> object.

=head2 C<trace([$boolean])>

One can "trace" the program execution by setting this property to a true value
before fetching engine results:

 AI::Prolog->trace(1);
 while (my $result = $engine->results) {
     # do something with results
 }

This sends trace information to C<STDOUT> and allows you to see how the engine
is trying to satify your goals.  Naturally, this slows things down quite a bit.

Calling C<trace> without an argument returns the current C<trace> value.

=head2 C<raw_results([$boolean])>

You can get access to the full, raw results by setting C<raw_results> to true.
In this mode, the results are returned as an array reference with the functor
as the first element and an additional element for each term.  Lists are
represented as array references.

 AI::Prolog->raw_results(1);
 $prolog->query('steals(badguy, STUFF, VICTIM)');
 while (my $r = $prolog->results) {
     # do stuff with $r in the form:
     # ['steals', 'badguy', $STUFF, $VICTIM]
 }

lib/AI/Prolog/Article.pod  view on Meta::CPAN


  No
 ?- 

That final "No" is Prolog telling you that there are no more results which
satisfy your goal (query).  (If you hit I<Enter> before Prolog prints "No", it
will print "Yes", letting you know that it found results for you.  This is
standard behavior in Prolog.)

One thing you might notice is that the last result, C<gives(tom, book, harry)>,
does not match the rule we set up for C<gives/3>.  However, we get this result
because we chose to hard-code this fact as the last line of the Prolog program.

=head2 How this works

At this point, it's worth having a bit of a digression to explain how this
works.

Many deductive systems in artificial intelligence are based on two algorithms:
backtracking and unification.  You're probably already familiar with backtracking
from regular expressions.  In fact, regular expressions are very similar to

lib/AI/Prolog/Article.pod  view on Meta::CPAN

internally (though this behavior is not guaranteed), but its value will not be
taken into account when trying to determine if terms unify.

Taking the first term in the rule, the logic engine might try to unify this
with the first fact in the knowledge base, C<parent(sally, tom)>. C<Person>
unifies with I<sally>.  The underscore, C<_>, unifies with I<tom> but since
we stated this unification is unimportant, we can ignore that.

We now have a fact which unifies with the first term in the rule, so we push
this information onto a stack.  Since there are still additional facts we can
try, we set a "choice point" in the stack telling us which fact we last tried.
If we have to backtrack to see a choice point, we move on to the next fact and
try again.

Moving on to the next term in the rule, C<male(Person)>, we know that "sally"
is unified to C<Person>, so we now try to unify C<male(sally)> with all of the
corresponding rules in the knowledge base. Since we can't, the logic engine
backs up to the last item where we could make a new choice and sees
C<parent(bill, tom)>. C<Person> gets unified with I<bill>. Then in moving to
the next rule we see that we unify with C<male(bill)>. Now, we check the first
item in the rule and see that it's C<father(Person)>. and the logic engine

lib/AI/Prolog/Article.pod  view on Meta::CPAN

=item * Often you need to change your code if your relations change.

=item * The code can get complex, leading to more bugs.

=back

=head2 Prolog versus SQL

At this point, there's a good chance that you're thinking that you would just
stuff this into a relational database. Of course, this assumes you need
relational data and want to go to the trouble of setting up a database and
querying it from Perl.  This is a good solution if you only need simple
relations.  In fact, Prolog is often used with relational databases as the two
are closely related.  SQL is a I<special purpose> declarative language whereas
Prolog is a I<general purpose> declarative language.

Firing up SQLite, let's create two tables and insert data into them.

 sqlite> CREATE TABLE parent_2 (parent VARCHAR(32), child VARCHAR(32));
 sqlite> CREATE TABLE male_1   (person VARCHAR(32));

lib/AI/Prolog/Builtins.pod  view on Meta::CPAN


=over 4

=item Improve printing.

There are some bugs with printing and escaping characters.  Maybe I'll look
into them :)

=item More builtins.

Currently, we only have a tiny subset of builtins available.  More are coming.

=back

=head1 MATH

Since version .70, math is fully available in C<AI::Prolog>.  Note that math is
implemented via the
L<AI::Prolog::Parser::PreProcessor::Math|AI::Prolog::Parser::PreProcessor::Math>
module.  This module rewrites Prolog math to an internal, predicate-based form
with the L<AI::Prolog::Parser|AI::Prolog::Parser> can parse.  This may cause

lib/AI/Prolog/Cookbook.pod  view on Meta::CPAN

in the C<gather/3> predicate listed below, we can gather the items from a list
which match the supplied list of indices.

 gather([1,3], [a,b,c,d], Result). % Result is [a,c]

Or we can figure out which indices in a list match the resulting values:

 gather(Indices, [a,b,c,d], [a,d]). % Indices is [1,4]

However, if we wish to understand which lists will have the given lists for the
given indices, we have an infinite result set.  L<AI::Prolog|AI::Prolog> and
(other Prolog implementations) will return one result and then enter an
infinite loop if you request the goal be resatisfied (i.e., if you ask for
another result).  If you see behavior such as this in your programs, you can
issue the C<trace.> command to see how Prolog is internally attempting to
satisfy your goal.  C<notrace.> will turn off tracing.

=head1 THE PROBLEMS

=head2 Append two lists.

lib/AI/Prolog/Cookbook.pod  view on Meta::CPAN

naive reverse is frequently used as a benchmarking tool for logic programs.

If reversing a 30 element list via the naive reverse takes .1 seconds, we can
say that the Prolog implementation is running at about 5000 logical inferences
per second.  This is known by the unfortunate acronym of LIPS, the standard
measure of the speed of logic programs.  Modern Prolog implementations
frequently measure their performance in MLIPS, or MegaLIPS.  By contrast, the
human mind is frequently estimated to run between 1 to 4 LIPS.  This
demonstrates that there's much more to cognition than logic.

=head2 Checking if a list is a subset of another list.

Usage:  C<subset(Subset, List).>

This definition depends on the C<member/2> predicate defined in this document.

 subset([Head|Tail], List) :-
    member(Head, List),
    subset(Tail, List).
 subset([], _). % The empty list is a subset of all lists

=head2 Delete all occurences of a term from a list, giving a new list.

Usage:  C<delete(Term, List, Result).>

 delete(_,[],[]). % deleting anything from an empty list yields an empty list
 delete(Term, [Term|Tail], Result) :- 
    delete(Term, Tail, Result).
 delete(Term, [Head|Tail], [Head|TailResult]) :- 
    delete(Term, Tail, TailResult).

lib/AI/Prolog/Engine.pm  view on Meta::CPAN

value.

 Engine->formatted(1); # turn on formatting
 Engine->formatted(0); # turn off formatting (default)
 
 if (Engine->formatted) {
     # test if formatting is enabled
 }

B<Note>: if you choose to use the L<AI::Prolog|AI::Prolog> interface instead of
interacting directly with this class, that interface will set C<formatted> to
false.  You will have to set it back in your code if you do not wish this
behavior:

 use AI::Prolog;
 my $logic = AI::Prolog->new($prog_text);
 $logic->query($query_text);
 AI::Logic::Engine->formatted(1); # if you want formatted to true
 while (my $results = $logic->results) {
    print "$results\n";
 }

=head2 C<raw_results([$boolean])>

The default value of C<raw_results> is false.  Setting this property to a true
value automatically sets C<formatted> to false.  C<results> will return the raw
data structures generated by questions when this property is true.
 
 Engine->raw_results(1); # turn on raw results
 Engine->raw_results(0); # turn off raw results (default)
 
 if (Engine->raw_results) {
     # test if raw results is enabled
 }

=head2 C<trace($boolean)>

lib/AI/Prolog/Engine.pm  view on Meta::CPAN


If C<formatted> is false, C<$results> will be an object with methods matching
the variables in the query.  Call those methods to access the variables:

 AI::Prolog::Engine->formatted(0);
 $engine->query('steals(badguy, STUFF, VICTIM).');
 while (my $r = $engine->results) {
     printf "badguy steals %s from %s\n", $r->STUFF, $r->VICTIM;
 }

If necessary, you can get access to the full, raw results by setting
C<raw_results> to true.  In this mode, the results are returned as an array
reference with the functor as the first element and an additional element for
each term.  Lists are represented as array references.

 AI::Prolog::Engine->raw_results(1);
 $engine->query('steals(badguy, STUFF, VICTIM).');
 while (my $r = $engine->results) {
    # do stuff with $r in the form:
    # ['steals', 'badguy', $STUFF, $VICTIM]
 }

=head2 C<query($query)>

If you already have an engine object instantiated, call the C<query()> method
for subsequent queries.  Internally, when calling C<new()>, the engine
bootstraps a set of Prolog predicates to provide the built ins.  However, this
process is slow.  Subsequent queries to the same engine with the C<query()>
method can double the speed of your program.
 
 my $engine   = Engine->new($query, $database);
 while (my $results = $engine->results) {
    print $results, $/;
 }
 $query = Term->new("steals(ovid, X).");
 $engine->query($query);
 while (my $results = $engine->results) {

lib/AI/Prolog/KnowledgeBase.pm  view on Meta::CPAN

    return $string, $number;
}

sub put {
    my ( $self, $key, $termlist ) = @_;
    $self->{ht}{$key} = $termlist;
}

sub elements { [ values %{ shift->{ht} } ] }

sub reset {
    my $self = shift;
    $self->{ht}         = {};
    $self->{primitives} = {};
    $self->{oldIndex}   = '';
}

sub consult {
    my ( $self, $program ) = @_;
    $self->{oldIndex} = '';
    return Parser->consult( $program, $self );

lib/AI/Prolog/KnowledgeBase.pm  view on Meta::CPAN

    delete $self->{ht}{$predicate};
    return 1;
}

sub get {
    my ( $self, $term ) = @_;
    my $key = ref $term ? $term->to_string : $term;
    return $self->{ht}{$key};
}

sub set {
    my ( $self, $term, $value ) = @_;
    my $key = ref $term ? $term->to_string : $term;
    $self->{ht}{$key} = $value->clean_up;
}

sub _print { print @_ }

sub dump {
    my ( $self, $full ) = @_;
    my $i = 1;

lib/AI/Prolog/Parser.pm  view on Meta::CPAN

        }
        $self->advance;
        if ( $self->current ne "/" ) {
            $self->parseerror("Expecting terminating '/' on comment");
        }
        $self->advance;
        $self->skipspace;
    }
}

# reset the variable dictionary
sub nextclause {
    my $self = shift;
    $self->{_vardict} = {};
    $self->{_varnum}  = 0;
}

# takes a hash and extends it with the clauses in the string
# $program is a string representing a prolog program
# $db is an initial program that will be augmented with the
# clauses parsed.

lib/AI/Prolog/Parser.pm  view on Meta::CPAN

        unless ($is_primitive) {
            my $predicate = $head->predicate;
            $is_primitive = exists $db->{primitives}{$predicate};
        }
        my $add = $is_primitive ? 'add_primitive' : 'add_clause';
        my $clause = Clause->new( $head, $body );
        my $adding_builtins = Engine->_adding_builtins;
        $clause->is_builtin(1) if $adding_builtins;
        $db->$add( $clause, $adding_builtins );
        $self->skipspace;
        $self->nextclause;    # new set of vars
    }
    return $db;
}

sub resolve {
    my ( $class, $db ) = @_;
    foreach my $termlist ( values %{ $db->ht } ) {
        $termlist->resolve($db);
    }
}

lib/AI/Prolog/Parser.pm  view on Meta::CPAN

            }

            $self->advance;
            $term->{bound}   = 1;
            $term->{deref}   = 0;
            $term->{functor} = "cons";
            $term->{arity}   = 2;
            $term->{args}    = [];
            for my $j ( reverse 1 .. $i - 2 ) {
                my $term = $term->new( "cons", 2 );
                $term->setarg( 0, $ts->[$j] );
                $term->setarg( 1, $ts->[ $j + 1 ] );
                $ts->[$j] = $term;
            }
            $term->{args}[0] = $ts->[0];
            $term->{args}[1] = $ts->[1];
        }
    }
    elsif ( '!' eq $self->current ) {
        $self->advance;
        return $term->CUT;
    }

lib/AI/Prolog/Term.pm  view on Meta::CPAN

        $self->{deref} = 1;
        $self->{ref}   = $term;
    }
    else {
        croak(    "AI::Prolog::Term->bind("
                . $self->to_string
                . ").  Cannot bind to nonvar!" );
    }
}

# unbinds a term -- i.e., resets it to a variable
sub unbind {
    my $self = shift;
    $self->{bound} = 0;
    $self->{ref}   = undef;

    # XXX Now possible for a bind to have had no effect so ignore safety test
    # XXX if (bound) bound = false;
    # XXX else IO.error("Term.unbind","Can't unbind var!");
}

# set specific arguments.  A primitive way of constructing terms is to
# create them with Term(s,f) and then build up the arguments.  Using the
# parser is much simpler
sub setarg {
    my ( $self, $pos, $val ) = @_;
    if ( $self->{bound} && !$self->{deref} ) {
        $self->{args}[$pos] = $val;
    }
    else {
        croak(    "AI::Prolog::Term->setarg($pos, "
                . $val->to_string
                . ").  Cannot setarg on variables!" );
    }
}

# retrieves an argument of a term
sub getarg {
    my ( $self, $pos ) = @_;

    # should check if position is valid
    if ( $self->{bound} ) {
        return $self->{ref}->getarg($pos) if $self->{deref};

lib/AI/Prolog/Term.pm  view on Meta::CPAN

    }    # at least one arg not bound ...
    if ( $self->{bound} ) {

        # added missing occurcheck
        if ( $self->occurcheck ) {
            if ( $self->occurs( $term->varid ) ) {
                return;
            }
        }
        $term->bind($self);
        push @{$stack} => $term;    # side-effect -- setting stack vars
        return 1;
    }

    # do occurcheck if turned on
    return if $self->occurcheck && $term->occurs( $self->varid );
    $self->bind($term);
    push @{$stack} => $self;        # save for backtracking
    return 1;
}

t/20term.t  view on Meta::CPAN

    use_ok($CLASS) or die;
}

# I hate the fact that they're interdependent.  That brings a 
# chicken and egg problem to squashing bugs.
use aliased 'AI::Prolog::Parser';

can_ok $CLASS, 'occurcheck';
is $CLASS->occurcheck, 0, '... and it should return a false value';
$CLASS->occurcheck(1);
is $CLASS->occurcheck, 1, '... but we should be able to set it to a true value';

can_ok $CLASS, 'new';

eval { $CLASS->new(1,2,3,4) };
ok $@, 'Calling new with arguments it does not expect should croak()';
like $@, qr/Unknown arguments to Term->new/,
    '... with an appropriate error message';

# new, unbound term

t/25cut.t  view on Meta::CPAN

    use_ok($CLASS) or die;
}

# I hate the fact that they're interdependent.  That brings a 
# chicken and egg problem to squashing bugs.
use aliased 'AI::Prolog::Parser';

can_ok $CLASS, 'occurcheck';
is $CLASS->occurcheck, 0, '... and it should return a false value';
$CLASS->occurcheck(1);
is $CLASS->occurcheck, 1, '... but we should be able to set it to a true value';

can_ok $CLASS, 'new';

ok my $cut = $CLASS->new(7), 'Calling it without arguments should succeed';
isa_ok $cut, $CLASS, '... and the object it returns';
isa_ok $cut, Term, '... and the object it returns';

can_ok $cut, 'functor';
is $cut->functor, '!', '... and its functor should always be a bang (!)';

t/25number.t  view on Meta::CPAN

    use_ok($CLASS) or die;
}

# I hate the fact that they're interdependent.  That brings a 
# chicken and egg problem to squashing bugs.
use aliased 'AI::Prolog::Parser';

can_ok $CLASS, 'occurcheck';
is $CLASS->occurcheck, 0, '... and it should return a false value';
$CLASS->occurcheck(1);
is $CLASS->occurcheck, 1, '... but we should be able to set it to a true value';

can_ok $CLASS, 'new';

ok my $number = $CLASS->new(7), 'Calling it without arguments should succeed';
isa_ok $number, $CLASS, '... and the object it returns';
isa_ok $number, Term, '... and the object it returns';

can_ok $number, 'functor';
is $number->functor, '7', '... and its functor should always be the numeric value';

t/99regression.t  view on Meta::CPAN

    no_intersect([], _).
    no_intersect([Head|Tail], List) :-
        not(member_of(Head, List)),
        no_intersect(Tail, List).

    unique([]).
    unique([Head|Tail]) :-
        no_intersect([Head], Tail),
        unique(Tail).

    set_of_balls(A,B) :-
        balls(Balls),
        member_of(A, Balls),
        member_of(B, Balls),
        unique([A,B]).
END_PROLOG
$prolog->query('set_of_balls(X,Y).');
my @results;
Engine->formatted(0);
while (my $results = $prolog->results) {
    push @results => [@{$results}[1,2]];
}
my @expected = (
  [ 'a', 'b' ],
  [ 'a', 'c' ],
  [ 'b', 'a' ],
  [ 'b', 'c' ],



( run in 1.276 second using v1.01-cache-2.11-cpan-49f99fa48dc )