AI in Perl - proof of concept

[Ovid]

So, after asking how one would program Who's a thief? in Perl, I decided to take a stab at it. Eventually, I plan to make this a more general module, but for now, this is a proof of concept. First, let's change the problem. I want to know who will steal from whom. Here's the Prolog (see the above link for an explanation, if it's not clear):

owns( merlyn, gold ).
owns( ovid, pocketLint ).
owns( ovid, cheapWhiskey ).
owns( kudra, dominationFund ).

valuable( gold ).
valuable( dominationFund ).

thief( badguy ).

rich( X ) :-
  owns( X, Y ),
  valuable( Y ).

steals_from( X, Y ) :-
  thief( X ),
  rich( Y ).

The last rule states that X will steal from Y if X is a thief and Y is rich.

To create this, I first created a %facts hash and added the 'owns', 'valuable', and 'thief' facts to it. Then, I created the rules for steals_from and rich. Asking the question, who will the badguy steal from becomes as simple as steals_from( $badguy, $victim ).

The code is pretty much a hack, but it's a start. This is not nearly as elegant as Abigail-II's regex solution for the n-queens problem, but I think it's a bit easier to understand.

Run the code below and it prints the following:

badguy will steal from merlyn
badguy will not steal from ovid
badguy will steal from kudra

#!/usr/bin/perl -w
use strict;

my %facts;

# poor ( X ) :-
#   not rich( X ). 

my @owns = (
  2,
  merlyn => 'gold',
  ovid   => 'pocket lint',
  ovid   => 'cheap whiskey',
  kudra  => 'domination fund'
);

my @valuable = (
  1,
  'gold',
  'domination fund'
);

my @thief = (
  1,
  'badguy'
);

$facts{ owns     } =  add_fact( \@owns     );
$facts{ valuable } =  add_fact( \@valuable );
$facts{ thief    } =  add_fact( \@thief    );

foreach ( qw/ merlyn ovid kudra / ) {
  my $modifier = steals_from( 'badguy', $_ ) ? '' : ' not';
  print "badguy will$modifier steal from $_\n";
}

sub steals_from {
  # steals_from( X, Y ) :-
  #   thief( X ),
  #   rich( Y ).
  my ( $perp, $victim ) = @_;
  return thief( $perp ) && rich( $victim );
}

sub thief {
  my $perp = shift;
  return grep { $_->[0] eq $perp } @{$facts{thief}};
}

sub rich {
  # rich ( X ) :-
  #  owns( X, Y ),
  #  valuable( Y ).
  my $person = shift;
  my @results;
  my @items = 
   map  { $_->[1] }
   grep { $_->[0] eq $person } 
     @{$facts{owns}};
  foreach my $item ( @items ) {
    push @results => $item
      if grep { $_->[0] eq $item } @{$facts{valuable}};
  }
  return @results ? 1 : 0;
}

sub add_fact {
  my $rule = shift;
  my $args = shift @$rule;
  my @rule;
 
  for ( my $i = 0; $i < @$rule; $i = $i + $args ) {
    my @args = @$rule[ $i .. $i + ( $args - 1 ) ];
    push @rule => \@args;
  }
  return \@rule;
}

Incidentally, for a hint on how Abigail-II' regex works, print the regex and look at the lines which resemble the following:

(?(?{attack $q [3], $q [4]})x|)

Basically, it says if one queen can attack another, match 'x' to the target string, otherwise, match the empty string. Since the target string is the empty string, this forces the backtracking. All in all, a very elegant bit of code. While my code does not even remotely resemble that beauty, I am considering adding regex backtracking support to mine in the future.

Cheers,
Ovid

Update: Fixed typo that Courage pointed out.

Join the Perlmonks Setiathome Group or just click on the the link and check out our stats.

[Courage]

Excelent speech! A couple of comments.

1. In your Prolog code, why you did not wrote a question clause ?

2. How do you think, is it possible to create a module that will allow to write very Prolog-like programs? I mean with a help of Filter::Simple module create another filter module which will transform Prolog-like input into perl program?

Courage, the Cowardly Dog
PS. s/Owid/Ovid/ in your prolog code.

[Ovid]

Glad you liked it and thanks for pointing out the tyop :)

I didn't print out the question clause because I threw this together rather quickly.

As for writing Prolog type programs, I want to play with this some more to better identify patterns in the code before I start refactoring it. Writing a filter when I'm still generating a proof of concept is a bit premature. Of course, if you want to play with this and extend it...

Typo on your post: s/Excelent/Excellent/; :)

Heading off for a three day weekend, so I won't be able to comment further.

Cheers,
Ovid

Join the Perlmonks Setiathome Group or just click on the the link and check out our stats.

[vladb]

Answering to your question #2, I think it shouldn't be a challenge for Perl. I've looked at the Prolog Tutorial and the syntax doesn't appear to be overly complex. I guess, prolog could be translated in comparable Perl code and then executed? Say, just like what Ovid did with his AI example, it should be possible to write a Prolog to Perl translator at the least.

In fact, there have already been some steps undertaken in this direction. Take a look at the Language::Prolog::Interpreter module. It's A simple interpreter which doesn't allow infix operators (except for C<:-> and C<,>, both of which are built in).

There's also these Language::Prolog::* modules. They do appear to be the first courageous step towards accomplishing what you are asking for?

Update:

Ahh, taking Ovid's lead, let me fix another grammatical error in your post:

1. In your Prolog code, why you did not wrote a question clause ?

Should be...

1. In your Prolog code, why did you not write a question clause ?

Err.. don't take me wrong, I'm not an English grammar wiz as well :). I simply write the way it sounds right ;-).

_____________________

# Under Construction

[rbc]

Good luck!

[shotgunefx]

Here's a different take that I'm sure is has a couple gotchas. It's definitely rough around the edges but it's very flexible. Will need to add negations.

my $ p = AI::Thingy->new('shotgunefx',is=>[qw(person programmer)], knows=>['everything'],has=>[qw(angst coupe)] );
print $p, has($p,'valuable') ? " has " : "doesn't have ", "something valuable\n"; 

---

update
Fixed typo, added snippet.
Read more... (8 kB)

[shockme]

Great work, Ovid! It's been years since my eyes beheld Prolog, but this has given me a renewed thirst. I might have to check out GNU Prolog over the weekend.

Thanks!

If things get any worse, I'll have to ask you to stop helping me.

[Abigail-II]

Here's the regex variant.

#!/usr/bin/perl -w

use strict;
use warnings 'all';
use re 'eval';
         
use vars qw /%owns %valuable @thief/;
         
%owns = (merlyn  => [qw /gold/],
         ovid    => [qw /pocketLint cheapWhiskey/],
         kudra   => [qw /dominationFund/],
         badguy  => [qw /water/],
         Abigail => [qw /pearls rubies/],)
;  

%valuable = map {$_ => 1} qw /gold dominationFund pearls/;

@thief    = qw /badguy Abigail/;

my $regex;
 
my $thief_rule  = join "|\n" => map {"(?{ \$thief = qq !$_! })"} @thie
+f;
   $regex      .= "(?: $thief_rule )\n";
my $victim_rule = join "|\n" => map {"(?{ \$victim = qq !$_! })"} keys
+ %owns;
   $regex      .= "(?: $victim_rule )\n";
   
   # Don't steal from yourself.
   $regex      .= "(?(?{ \$thief eq \$victim }) fail)\n";
 
   # Victim needs to be rich.
   $regex      .=
       "(?(?{ \@loot = grep {\$valuable {\$_}} \@{\$owns {\$victim}} }
+) |\n" .
         "(?{ print qq !\$thief does not steal from \$victim\n!}) fail
+)\n";

   $regex      .= "(?(?{ print qq !\$thief steals \@loot from \$victim
+\n! })" .
                        "fail)\n";

"" =~ /$regex/x;

Output:

badguy does not steal from ovid
badguy steals pearls from Abigail
badguy steals dominationFund from kudra
badguy steals gold from merlyn
Abigail does not steal from ovid
Abigail does not steal from badguy
Abigail steals dominationFund from kudra
Abigail steals gold from merlyn

I'm not quite satisfied with the regex though; it would be nice if the regex could be independent of the content of the variables. I haven't been able to find a way to say "this (sub)expressions just failed. Let's try the same thing again".

Abigail

[John M. Dlugosz]

In college, a programming assignment was to write an inference engine in Pascal. Although everyone else in class thought it was a huge deal (a semester-long project) and turned in huge monstrosoties of programs, I thought it was a simple, beautiful, elegant problem, and made a 5-page solution.

So, I think it's easy enough to implement reusable logic to go through a fact base. It would be easy to represent the facts in Perl, too.

The cool thing that Prolog does is "variable unification", and Perl has nothing like that. There was a Perl6 RFC that was dismissed as being too complex and still not complete enough to be worthwhile, and I reciently read about the backtracking scope in the new regex and wondered if that might be made more general, but it's not really the same thing.

I wonder, though, if full-blown Unification is needed to solve the problems with an inference-engine approach. The big deal about it is that it makes tail-end recursion possible (e.g. no cleanup step after the call returns), while doing the same thing with "undo" code living on the stack would mean you really do need to keep a stack of everything you've been though. Today machines have millions of times more storage, so is that an issue?

Also, you would want "how" and "why" features on your inference engine.

You have your fundimental facts and your rules stored in different ways—lists and subs. The subs are hand-written. How is that reusable? I think it illustrates a "pattern" commonly found in code, to solve a complex problem in a top-down manner.

However, I think it would be more interesting to start by expressing your rules as Perl data, in a simple and natural manner:

[owns => 'merlyn', 'gold'],
[valuable => 'gold'],
[[steals_from => '$X', '$Y'] => [thief => '$X'], [rich => '$Y']

and come up with a fully reusable function that takes this data and makes inferences on it. Here, I used '$X' etc. as placeholders, like variables in Prolog or the questionmark stuff in CLIPS. Seems like you could generate source code on the fly based on the rule!

—John

[Ovid]

Your points are perfectly correct. I have no intention of simply being able to add facts to the database and forcing the end user to write the rules by hand. This was merely a "proof of concept" to test some ideas. I'm actually preparing a much longer write-up with the intention of starting some useful discussion.

Auto-generating some of the rules will be a must. If I have the following facts:

drinks(lemming,scotch).
drinks(ovid,scotch).
drinks(grep,guiness).

I should be able to auto-generate queries like the following:

?- drinks(ovid,scotch).
yes

And with unification (associating variables with items):

?- drinks(grep,Drink).
Drink=guiness
yes

?- drinks(Who,scotch).
Who=lemming
Who=ovid
yes

Those should be fairly easy to auto-generate. However, some rules have to be crafted by hand:

steals(Perp,Item) :-
  thief(Perp),
  owns(Victim,Item),
  Valuable(Item).

The problem there will be to create an easy to use (and parse!) syntax that supports this. You mention that my facts and rules are stored different ways and I like your example, but I'll have to play with it to see if that's what I really want.

You also bring up the tail-recursion issue (tail recursion, for those who are wondering, is where the return value of a recursive call returns directly to the caller rather than propogating back through the call stack). You stated that machines today have "millions of times more storage", thus suggesting that this might not be an issue. I think it is an issue because full-blown AI systems can store millions of facts and being able to take advantage of any optimizations will be critical, as Perl is not well-suited to this task. That's an issue I think I can put off for later, though.

In the meantime, I'll have a fairly detailed post later this evening outlining some of the issues that I need to tackle before I can really begin serious work on this.

Cheers,
Ovid

Join the Perlmonks Setiathome Group or just click on the the link and check out our stats.