Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
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 rifling through the Monastery: (8)
As of 2014-09-15 05:48 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite cookbook is:










    Results (145 votes), past polls