Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses

AI in Perl - proof of concept

by Ovid (Cardinal)
on Jul 12, 2002 at 18:40 UTC ( #181368=perlmeditation: print w/replies, xml ) Need Help??

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.


Update: Fixed typo that Courage pointed out.

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

Replies are listed 'Best First'.
Re: AI in Perl - proof of concept
by Courage (Parson) on Jul 12, 2002 at 18:57 UTC
    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.

      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.


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

      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?


      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
Re: AI in Perl - proof of concept
by rbc (Curate) on Jul 12, 2002 at 20:27 UTC
    Good luck!
Re: AI in Perl - proof of concept
by shotgunefx (Parson) on Jul 13, 2002 at 01:14 UTC
    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"; 

    Fixed typo, added snippet.
(shockme) Re: AI in Perl - proof of concept
by shockme (Chaplain) on Jul 13, 2002 at 00:07 UTC
    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.


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

Re: AI in Perl - proof of concept
by Abigail-II (Bishop) on Jul 15, 2002 at 13:33 UTC
    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;
    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".


Re: AI in Perl - proof of concept
by John M. Dlugosz (Monsignor) on Jul 15, 2002 at 20:34 UTC
    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!


      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.


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

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlmeditation [id://181368]
Approved by VSarkiss
Front-paged by cjf
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others scrutinizing the Monastery: (5)
As of 2020-01-20 07:04 GMT
Find Nodes?
    Voting Booth?