Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

Re: AI in Perl - proof of concept

by shotgunefx (Parson)
on Jul 13, 2002 at 01:14 UTC ( #181431=note: print w/ replies, xml ) Need Help??


in reply to AI in Perl - proof of concept

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.
#!/usr/bin/perl -w use strict; package AI::Thingy; use overload ( '""' => \&stringify, ); my $THING_ID = 0; use Data::Dumper; our (%OBJS) = (); %OBJS = (); our $VERSION = '0.01'; our @EXPORT = qw (is has assert); our @EXPORT_OK = qw(); our @EXPORT_FAIL = qw(); ######################################################## sub import { no strict 'refs'; my $used_name = shift ; # Remove the Module name. my ($Version) = grep { m/^\d[\d.]*$/} @_; my @ex = grep { !m/^(\d[\d\.]+)$/} @_; die "Insufficient or missing \$VERSION: $VERSION, $Version require +d." if $Version && $VERSION <= $Version; push @ex, @EXPORT ; my %EXP = map {($_,'mKay')} @EXPORT,@EXPORT_OK; $EXP{$_} = 'Bad' for @EXPORT_FAIL; my $that_pack = caller(); foreach (@ex){ next if m/^\d[\d\.]+$/; die "Denied. Can't export $_" if defined $EXP{$_} && $EXP{$_} +eq 'Bad'; unless (defined $EXP{$_} && $EXP{$_} eq 'mKay') { # Lets make some accessors... die "Can't export unknown symbol $_" if $_ =~/^[\@\$\*\%]/ +; my $att = $_; *{__PACKAGE__.'::'.$att} = *{$that_pack.'::'.$att} = sub { my ($self,$what) = @_; return defined $what ? $self->{$att}{$what} : keys %{$self->{$att +}}; }; } m/^([\@\$\*\&\%]?)(\w+)/; my ($t,$v) = ($1,$2); $t = '&' unless $t; *{$that_pack.'::'.$v} = $t eq '@' && \@{$v} || $t eq '%' && \% +{$v} || $t eq '&' && \&{$v} || $t eq '$' && \${$v} || $t eq '*' && \*{$v} || \*{$_}; } } sub Objects { my ($Cl,$type) = @_; my @objs = map { $OBJS{$_}->{'__IDENTITY'} } sort keys %OBJS; return defined $type ? grep{ $OBJS{$_}->{is}{$type} } @objs : @obj +s; } ######################################################## sub new { my $class = shift; my $self = { has=>{}, is=>{} }; my $name = shift; $self->{__THINGID} = $THING_ID++; $self->{NAME} = $name || $self->{__THINGID}; bless($self, $class); $self->assert(@_); return $self; } ######################################################## sub has($$) { my $self = shift; my $what = shift; return sort keys %{$self->{has}} unless defined $what; return $self->{has}{$what} if exists $self->{has}{$what}; # Else look for it. my %seen = (); _has(\%seen,$what, keys %{ $self->{has} } ); } ######################################################## sub _has{ my ($seen,$target,@has) = @_; my $val; foreach my $h (@has){ $seen->{$h} ? next : $seen->{$h}++; return $OBJS{$h}{is}->{$target} if exists $OBJS{$h}{is}->{$tar +get}; $val = _is($seen,$target,keys %{$OBJS{$h}->{is} } ); last if $val; } return $val; } ######################################################## sub _is { my ($seen,$target,@is) = @_; foreach my $h (@is){ $seen->{$h} ? next : $seen->{$h}++; return $OBJS{$h}{is}->{$target} if exists $OBJS{$h}{is}->{$tar +get}; _has($seen,$target,keys %{$OBJS{$h}->{__IDENTITY}->{has} }); } return; } ######################################################## sub is($$) { my $self = shift; my $what = shift; return $what ? $OBJS{$self}{is}->{$what} : sort keys %{$OBJS{$self +}{is}}; } ######################################################## sub assert{ my $self = shift; my %args = ( has=> undef, is => undef, @_, ); foreach my $prop (keys %args){ if ($prop eq 'is'){ $OBJS{$self}->{'__IDENTITY'} = $self; foreach my $k (@{$args{$prop}}){ $OBJS{$self}->{is}{$k}++; } }else{ foreach my $k (@{$args{$prop}}){ $self->{$prop}{$k}++; } } } } sub stringify{ my $self = shift; return $self->{NAME}; } package main; AI::Thingy->import qw(has is knows wants); # Make these accessors my %things = ( merlyn =>{ has=>[ 'gold' ], is=>[ 'person', 'author'], knows=>['perl', 'kudra'], }, shotgunefx=>{ has=>['nothing'], is=>['person', 'depraved'], }, ovid =>{ is=>[ 'person'], has=>[ 'pocketLint', 'cheapWhiskey','diamonds' + ], knows=>['kungfu', 'munitions'], }, diamonds=>{ is=> ['gem'], }, gem=>{ is=>['valuable'], }, kungfu=>{ is=>['power', 'valuable'], }, power=>{ is=>['valuable'] }, kudra =>{ is=>[ 'person'], has=> [ 'dominationfund'], knows=>['ovid'], }, gold=> { is=>[ 'thing','currency'], }, currency=>{ is=>['valuable'], }, dominationfund=>{ is=>['thing'], }, cheapWhiskey=>{ is=>['thing'], }, pocketLint =>{ is=>['thing'], }, ); foreach my $p (keys %things){ $things{$p} = AI::Thingy->new($p, %{$things{$p}} ); } my @people = AI::Thingy->Objects('person'); # Retrieve all the peop +le # For is() && has() will try and do taxonomy. ovid has diamonds, diamo +nds are gems, gems are valuable. foreach my $person ( @people ){ if ( has($person,'valuable') ){ print "$person has valuables\n"; }else{ print "$person is a thief\n"; # Rob anyone who is rich and we don't know. print map {"\twill fleece $_\n"} grep {"$_" ne "$person" && has($_,'valuable') && !know +s($person,$_) } @people } }


-Lee

"To be civilized is to deny one's nature."


Comment on Re: AI in Perl - proof of concept
Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://181431]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (8)
As of 2015-07-04 19:15 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (60 votes), past polls