AI-Prolog
view release on metacpan or search on metacpan
bin/aiprolog view on Meta::CPAN
the following:
aiprolog location/of/spider.pro
?- % no more
That disables the pause where the shell waits for you to hit a ';' to get more
results or hit enter to continue. It gets very annoying while playing the
game, though it's useful when you really want to program.
Then issue the "start" command (defined in "spider.pro").
?- start.
=cut
data/sleepy.pro view on Meta::CPAN
print('The light from the den is keeping you awake.'), nl,
!, fail.
sleep :-
or(i_am_holding(flyswatter), at(flyswatter, bed)),
print('What? Sleep with a dirty old flyswatter?'), nl,
!, fail.
sleep :-
alive(fly),
print('As soon as you start to doze off, a fly lands'), nl,
print('on your face and wakes you up again.'), nl,
make_visible(fly),
make_visible(flyswatter),
!, fail.
sleep :-
print('Ahhh...you (yawn) made...it...zzzzzzzz.'), nl, nl,
finish.
swat(fly) :-
data/sleepy.pro view on Meta::CPAN
print('The game is over. Please enter the "halt." command.'),
nl.
/* This rule just prints out game instructions. */
instructions :-
nl,
print('Enter commands using standard Prolog syntax.'), nl,
print('Available commands are:'), nl,
print('start. -- to start the game.'), nl,
print('n. s. e. w. u. d. -- to go in that direction.'), nl,
print('take(Object). -- to pick up an object.'), nl,
print('drop(Object). -- to put down an object.'), nl,
print('use(Object). -- to manipulate an object.'), nl,
print('look. -- to look around you again.'), nl,
print('on. off. -- to control the room lights.'), nl,
print('sleep. -- to try to go to sleep.'), nl,
print('instructions. -- to see this message again.'), nl,
print('halt. -- to end the game and quit.'), nl,
nl.
/* This rule prints out instructions and tells where you are. */
start :-
instructions,
look.
/* These rules describe the various rooms. Depending on
circumstances, a room may have more than one description. */
describe(bedroom) :-
lit(bedroom),
print('You are in a bedroom with a large, comfortable bed.'), nl,
data/sleepy.pro view on Meta::CPAN
describe(den) :-
lit(den),
print('You are in your den. There is a lot of stuff here,'), nl,
print('but you are too sleepy to care about most of it.'), nl.
describe(den) :-
print('You are in your den. It is dark.'), nl.
/* This is a special form, to call predicates during load time. */
% :- retractall(i_am_holding(_)), start.
data/spider.pro view on Meta::CPAN
% This rule just prints out game instructions.
help :-
instructions.
instructions :-
nl,
print('Enter commands using standard Prolog syntax.'), nl,
print('Available commands are:'), nl,
print('start. -- to start the game.'), nl,
print('n. s. e. w. u. d. -- to go in that direction.'), nl,
print('take(Object). -- to pick up an object.'), nl,
print('drop(Object). -- to put down an object.'), nl,
print('kill. -- to attack an enemy.'), nl,
print('look. -- to look around you again.'), nl,
print('instructions. -- to see this message again.'), nl,
print('halt. -- to end the game and quit.'), nl,
nl.
% This rule prints out instructions and tells where you are.
start :-
instructions,
look.
% These rules describe the various rooms. Depending on
% circumstances, a room may have more than one description.
describe(meadow) :-
at(ruby, in_hand),
print('Congratulations!! You have recovered the ruby'), nl,
lib/AI/Prolog.pm view on Meta::CPAN
}
sub list {
my $proto = shift;
return
join ", " => map { /^$RE{num}{real}$/ ? $_ : $proto->quote($_) } @_;
}
sub continue {
my $self = shift;
return 1 unless $self->{_engine}; # we haven't started yet!
!$self->{_engine}->halt;
}
1;
__END__
=head1 NAME
AI::Prolog - Perl extension for logic programming.
lib/AI/Prolog.pm view on Meta::CPAN
=head1 QUICKSTART
For those who like to just dive right in, this distribution contains a Prolog
shell called C<aiprolog> and two short adventure games, C<spider.pro> and
C<sleepy.pro>. If you have installed the C<aiprolog> shell, you can run
either game with the command:
aiprolog data/spider.pro
aiprolog data/sleepy.pro
When the C<aiprolog> shell starts, you can type C<start.> to see how to play
the game. Typing C<halt.> and hitting return twice will allow you to exit.
See the C<bin/> and C<data/> directories in the distribution.
Additionally, you can read L<AI::Prolog::Article> for a better description of
how to use C<AI::Prolog>. This document is an article originally published in
The Perl Review (L<http://www.theperlreview.com/>) and which they have
graciously allowed me to redistribute.
See also Robert Pratte's perl.com article, "Logic Programming with Perl and
lib/AI/Prolog/Article.pod view on Meta::CPAN
I<describe> their goals rather than state how to achieve it. This is the
essence of logic programming. Rather than tell the computer how to achieve a
given goal, we tell the computer what the goal looks like and let it figure out
how to get there. Because of this, some refer to logic programming as
"specification-based programming" because the specification and the program are
one and the same.
This article will focus on C<AI::Prolog>. Prolog, though not a "pure" logic
programming language, is the most widely used in the field. C<AI::Prolog> is a
Prolog engine written entirely in Perl and it's very easy to install and use.
However, if you start doing serious work in Prolog, I strongly recommend you
take a look at Salvador FandiE<241>o's C<Language::Prolog::Yaswi>. This module
allows access to SWI-Prolog (http://www.swi-prolog.org/) from within Perl.
It's more difficult to compile and get running, but it's faster and much more
powerful. Luke Palmer's new C<Logic> distribution takes a somewhat different
approach to the same problem space.
=head2 3 Things to Learn
Most programming in Prolog boils down to learning three things: facts, rules,
and queries. The basics of these can be learned in just a few minutes and will
lib/AI/Prolog/Article.pod view on Meta::CPAN
has(bob, luck).
% who will give what to whom?
gives(WHO, WHAT, WHOM) :-
has(WHO, WHAT),
person(WHOM),
likes(WHO, WHOM).
gives(tom,book,harry).
When starting the shell, you can read in a file by supplying as a name on the
command line:
$ aiprolog gives.pro
Alternately, you can I<consult> the file from the shell:
$ aiprolog
Welcome to AI::Prolog v 0.732
Copyright (c) 2005, Curtis "Ovid" Poe.
lib/AI/Prolog/Article.pod view on Meta::CPAN
charlie => [ 'perl' ],
);
my %who_loves;
while ( my ($person, $things) = each %loves ) {
foreach my $thing ( @$things ) {
push @{ $who_loves{$thing} }, $person;
}
}
Now that's starting to get really ugly. To represent and search that data in
Prolog is trivial. Now do you really want to have fun?
gives(tom, book, sally).
How would you represent that in Perl? There could be multiple gift-givers,
each gift-giver could give multiple things. There can be multiple recipients.
Representing this cleanly in Perl would not be easy. In fact, when handling
relational data, Perl has several weaknesses in relation to Prolog.
=over 4
lib/AI/Prolog/Article.pod view on Meta::CPAN
bugs.
Math is also handled poorly in Prolog. Consider the following program:
convert(Celsius, Fahrenheit) :-
Celsius is (Fahrenheit - 32) * 5 / 9.
You can then issue the query C<convert(Celsuis, 32)> and it will dutifully
report that the celsius value is zero. However, C<convert(0, 32)> fails. This
is because Prolog is not able to solve the right hand side of the equation
unless C<Fahrenheit> has a value at the time that Prolog starts examining the
equation. One simplistic way of getting around this limitation is with multiple
predicates and testing which argument is an unbound variable:
convert(Celsius, Fahrenheit) :-
var(Celsius),
not(var(Fahrenheit)),
Celsius is (Fahrenheit - 32) * 5 / 9.
convert(Celsius, Fahrenheit) :-
var(Fahrenheit),
lib/AI/Prolog/Article.pod view on Meta::CPAN
constraints and these, though beyond the scope of this article, can get around
this and other issues. They can allow "logical" math and ensure that
"impossible" search branches are never explored. This can help to alleviate
many of the aforementioned concerns.
=head1 Conclusion
We've barely scratched the surface of what the Prolog language can do. The
language has many detractors and some criticisms are quite valid. However, the
language's simplicity and ease-of-use has kept it around. It's an excellent
starting point for understanding logic programming and exploration of AI. In
fact, many common uses for Prolog are heavily used in the AI arena:
=over 4
=item * Agent-based programming
=item * Expert Systems
=item * Fraud prevention (via inductive logic programming)
lib/AI/Prolog/Builtins.pod view on Meta::CPAN
with the L<AI::Prolog::Parser|AI::Prolog::Parser> can parse. This may cause
confusion when debugging.
X is 5 + 7.
% internally converted to
% is(X, plus(5, 7)).
The math predicates are officially deprecated and I<cannot> be used in the same
expression with regular Prolog math.
Number may be integers, floats, doubles, etc. A number that starts with a
minus sign (-) is considered negative. No number may end in a decimal point as
the period is interpreted as the end of a clause. The following is therefore a
syntax error:
X is 5. + 7.
Unfortunately, the parser doesn't yet yell about that. We'll try and figure
out why later.
Omit the period after the number or put a zero after it:
lib/AI/Prolog/Builtins.pod view on Meta::CPAN
The C<=> operator tries to unify the left-hand side with the right-hand side:
X = 3 + 2.
If C<X> is already instantiated, this goal succeeds if the value of C<X> is the
same goal as the right-hand side of the equation. Internally, if X is not
instantiated, it looks like this:
eq(plus(3,2), plus(3,2)).
When you first start using Prolog, you probably was C<is> instead of C<=>.
Logical comparisons are straightforward:
3 >= X.
Y > (4 + 3) * X.
X == Y. % a test for equality
X \= Y. % Not equal. See caveats for ne/2
% etc.
=head1 BUGS
lib/AI/Prolog/Cookbook.pod view on Meta::CPAN
Index is Previous + 1.
Please note that assignment in Prolog is via the C<is/2> infix operator. The
above code will fail if you use C<=/2>. This is a common source of bugs for
programmers new to Prolog. The C<=/2> predicate will unify the right hand side
with the left hand side. It will I<not> evaluate the left hand side. Thus:
X = 3 + Y.
% X is now plus(3,Y) (the internal form of the +/2 infix operator.)
If you prefer your list indices start with zero, alter the first clause as
follows:
member(0, SearchFor, [SearchFor|_]).
=head2 Gather elements from a list by indices.
Usage: C<gather(Indices, FromList, Result).>
This definition depends on the C<member/3> predicate defined in this document.
lib/AI/Prolog/Parser.pm view on Meta::CPAN
my $ATOM = qr/[[:alpha:]][[:alnum:]_]*/;
use constant NULL => 'null';
sub new {
my ( $class, $string ) = @_;
my $self = bless {
_str => PreProcessor->process($string),
_posn => 0,
_start => 0,
_varnum => 0,
_internal => 0,
_vardict => {},
} => $class;
lock_keys %$self;
return $self;
}
sub _vardict_to_string {
my $self = shift;
lib/AI/Prolog/Parser.pm view on Meta::CPAN
my $output = Clone::clone($self);
$output->{_vardict} = $self->_vardict_to_string;
return "{"
. substr( $self->{_str}, 0, $self->{_posn} ) . " ^ "
. substr( $self->{_str}, $self->{_posn} ) . " | "
. $self->_vardict_to_string . " }";
}
sub _posn { shift->{_posn} }
sub _str { shift->{_str} }
sub _start { shift->{_start} }
sub _varnum { shift->{_varnum} }
sub _vardict { shift->{_vardict} }
sub _internal {
my $self = shift;
if (@_) {
$self->{_internal} = shift;
return $self;
}
return $self->{_internal};
lib/AI/Prolog/Parser.pm view on Meta::CPAN
# all three get methods must be called before advance
# recognize a name (sequence of alphanumerics)
# XXX the java methods do not directly translate, so
# we need to revisit this if it breaks
# XXX Update: There was a subtle bug. I think
# I've nailed it, though. The string index was off by one
sub getname {
my $self = shift;
$self->{_start} = $self->{_posn};
my $getname;
if ( $self->current =~ /['"]/ ) {
# Normally, Prolog distinguishes between single and double quoted strings
my $string = substr $self->{_str} => $self->{_start};
$getname = extract_delimited($string);
$self->{_posn} += length $getname;
return substr $getname => 1, length($getname) - 2; # strip the quotes
}
else {
my $string = substr $self->{_str} => $self->{_start};
($getname) = $string =~ /^($ATOM)/;
$self->{_posn} += length $getname;
return $getname;
}
}
# recognize a number
# XXX same issues as getname
sub getnum {
my $self = shift;
$self->{_start} = $self->{_posn};
my $string = substr $self->{_str} => $self->{_start};
my ($getnum) = $string =~ /^($RE{num}{real})/;
if ( '.' eq substr $getnum => -1, 1 ) {
$getnum = substr $getnum => 0, length($getnum) - 1;
}
$self->{_posn} += length $getnum;
return $getnum;
}
# get the term corresponding to a name.
# if the name is new, create a new variable
'... and its to_string representation should be correct';
can_ok $step, 'term';
ok my $term = $step->term, '... and calling it should succeed';
isa_ok $term, Term, '... and the object it returns';
is $term->functor, 'STEP', '... and it should have the correct functor';
is $term->arity, 0, '... and the correct arity';
can_ok $step, 'next';
diag "Flesh out the Step tests when we start using this more";
__END__
ok my $termlist = $step->next, '... and calling it should succeed';
isa_ok $termlist, TermList, '... and the object it returns';
is_deeply $termlist, $termlist, '... and it should be the termlist we instantiated the Step with';
t/40parser.t view on Meta::CPAN
ok my $parser = $CLASS->new('p(x)'), '...and calling new with a string should succeed';
isa_ok $parser, $CLASS, '... and the object it returns';
can_ok $parser, '_str';
is $parser->_str, 'p(x)', '... and it should return the string we created the parser with.';
can_ok $parser, '_posn';
is $parser->_posn, 0,
'... and it should return the current position of where we are parsing the string';
can_ok $parser, '_start';
is $parser->_start, 0, '... and it should return the current starting point in the string';
can_ok $parser, '_varnum';
is $parser->_varnum, 0, '... and it should return the current variable number';
can_ok $parser, '_vardict';
is_deeply $parser->_vardict, {}, '... and it should be empty.';
can_ok $parser, 'to_string';
is $parser->to_string, '{ ^ p(x) | {} }',
'... and it should show the parser string, the position in the string and an empty vardict';
t/40parser.t view on Meta::CPAN
can_ok $parser, 'current';
is $parser->current, ' ', '... and it should return the current character the parser is pointing at';
can_ok $parser, 'advance';
$parser->advance;
is $parser->_posn, 1, '... and calling advance will move the parser forward one character';
can_ok $parser, 'skipspace';
$parser->skipspace;
is $parser->current, 'p', '... and calling skipspace will move the parser to the next non-whitespace character';
is $parser->_start, 0, '... and it will not change the starting position';
is $parser->_posn, 3, '... but the position will indicate the new position';
can_ok $parser, 'peek';
is $parser->peek, '(', '... and calling it should return the next character';
is $parser->current, 'p', '... and leave the current character intact';
is $parser->_start, 0, '... and it will not change the starting position';
is $parser->_posn, 3, '... or the current position';
$parser = $CLASS->new(' /* comment */ p(x)');
$parser->skipspace;
is $parser->current, 'p',
'skipspace() should ignore multiline comments';
is $parser->_start, 0, '... and it will not change the starting position';
is $parser->_posn, 16, '... but the position will indicate the new position';
eval {$CLASS->new('/* this is an unterminated comment')->skipspace};
ok $@, 'skipspace() should die if it encounters a comment with no end';
like $@, qr{Expecting terminating '/' on comment},
'... with an appropriate error message';
eval {$CLASS->new('/ * this is an unterminated comment')->skipspace};
ok $@, 'skipspace() should die if it encounters a poorly formed comment';
like $@, qr{Expecting '\*' after '/'},
'... with an appropriate error message';
$parser = $CLASS->new(<<'END_PROLOG');
% this is a comment
flies(pig, 789).
END_PROLOG
$parser->skipspace;
is $parser->current, 'f',
'skipspace() should ignore single line comments';
is $parser->_start, 0, '... and it will not change the starting position';
is $parser->_posn, 28, '... but the position will indicate the new position';
can_ok $parser, 'getname';
is $parser->getname, 'flies',
'... and it should return the name we are pointing at';
is $parser->current, '(',
'... and the current character should be the first one after the name';
is $parser->_start, 28, '... and have the parser start at that name';
is $parser->_posn, 33,
'... and have the posn point to the first char after the name';
$parser->advance; # skip '('
$parser->getname; # skip 'flies'
$parser->advance; # skip ','
$parser->skipspace; # you know what this does :)
can_ok $parser, 'getnum';
is $parser->getnum, 789,
'... and it should return the number the parser is pointing at';
is $parser->current, ')',
'... and the parser should point to the current character';
is $parser->_start, 39, '... and the new starting point is where the number begins';
is $parser->_posn, 42, '... and the new posn is the first character after the number';
can_ok $parser, 'empty';
ok ! $parser->empty, '... and it should return false if there is more stuff to parse';
$parser->advance; # skip ')'
$parser->advance; # skip '.'
$parser->skipspace;
ok $parser->empty, '... and return true when there is nothing left to parse. How sad.';
can_ok $parser, 'resolve';
t/40parser.t view on Meta::CPAN
$parser = $CLASS->new(<<'END_PROLOG');
owns("some person", gold).
owns(ovid, 'heap o\'junk').
END_PROLOG
$parser->getname; # owns
$parser->advance; # skip (
is $parser->getname, 'some person', 'The parser should be able to handle quoted atoms';
is $parser->current, ',',
'... and the current character should be the first one after the final quote';
is $parser->_start, 5, '... and have the parser should start at the first quote';
is $parser->_posn, 18,
'... and have the posn point to the first char after the last quote';
$parser->advance; # skip ,
$parser->skipspace;
$parser->getname;
$parser->advance; # skip )
$parser->advance; # skip .
$parser->skipspace;
$parser->getname; # owns
$parser->advance; # skip (
$parser->getname; # owns
$parser->advance; # skip ,
$parser->skipspace;
# not sure of the best way to handle this
is $parser->getname, 'heap o\\\'junk', 'The parser should be able to handle single quoted atoms with escape';
is $parser->current, ')',
'... and the current character should be the first one after the final quote';
is $parser->_start, 38, '... and have the parser should start at the first quote';
is $parser->_posn, 52,
'... and have the posn point to the first char after the last quote';
#
# really ensure that the parser can handle numbers
#
$parser = $CLASS->new('foo(32)');
$parser->advance for 1 .. 4;
is $parser->getnum, 32, 'getnum() should be able to handle positive integers';
( run in 0.538 second using v1.01-cache-2.11-cpan-0d8aa00de5b )