Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling

AI::Perlog(2) unification proposition

by arhuman (Vicar)
on Aug 14, 2002 at 14:19 UTC ( #190085=note: print w/replies, xml ) Need Help??

in reply to AI::Perlog Unification help

No sir, AI::Perlog isn't in limbo ;-)

I've been playing with it lately (not as much as I wanted though )
and it still makes me dream...

Your code seems to assume that the positions do matter with the predicates
args, while your explanation seems to suggest the contrary
(Your funny relation with whiskey ;-)

I don't recall how it was in Prolog,
but I think that some predicates should be order dependant :
should only be read "arhuman is disciple's father"
it's definitly not the same as
whereas some predicates obviously shouldn't
could be also written

It's probably not that important, but if AI::Perlog will have to handle
both cases it may be a good idea to take it into account now.

Anyway, to contribute I've coded AI::Perlog2.
Don't be scare it's NOT a fork, takeover attempt or whatever,
it's only my way to try to play with concepts and
to experiment without messing too much with your code :-)
Take it only as an implementation playground (and maybe a test/bench helper)
to experiment/choose data structures.

While poorly coded AI::Perlog2 might even includes some ideas
which could be put into your module :
  • There's a rudimentary unification algorithm which (seems to) work(s).
  • I've tried to use simpler structures (that I could understand ;-)
  • It handles also "order independent" predicates
    (when first argument is a '?')
  • Included a dirty 'load_from_file' method
    which would allow to load facts easily regardless of the implementation
    (that's why I ruled serialization out))
    to enable use of both Perlog and Perlog2 on the same facts database...
UPDATE : display function slightly edited.

It's a quick rewrites of a now defunct (due to a stupid file overwrite) "cleaner" version
based on your code, so it's full of bugs, not consistent with lot of features missing...
I submit it to benefits from the monastery's experience
and be corrected on some problems/flaws already encountered
(that might even finally make me understand why you choose that 'monster structure' for your module ;-)

package AI::Perlog2; use strict; use Carp; #use Devel::StealthDebug; our $order_do_matter = 1; sub new { my $class = shift; my $self = { _predicates => {}, }; bless $self, $class; } sub add_fact { my ($self,$predicate,@args) = @_; my $predicate_id; if ( exists $self->{_predicates}{ $predicate } ) { $predicate_id = $self->{_predicates}{$predicate}{id}; } else { $self->{_predicates}{$predicate}{id}=$predicate_id = $self->{_next_vertex}++; { no strict 'refs'; my $package = ref $self; *{"$package::$predicate"} = sub { my $self = shift; unshift @_ => $predicate; $self->_predicate( @_ ); }; } } $self->{_collection}{$predicate_id}{join '+',sort @args} = \@a +rgs; return 1; } sub _predicate { my $self = shift; my $predicate = shift; my @args = @_; my %result; if ( $args[0] eq '?') { # Ugly way to handle shift @args; # position independant + predicate $order_do_matter = 0; # } carp "Predicate $predicate not found in database" if ! exists $self->{_predicates}{ $predicate }; my $key = join '+',sort @args; my $predicate_id = $self->{_predicates}{$predicate}{id}; if ($self->{_collection}{$predicate_id}{$key}) { return ( "$predicate($key)"=> ["ok"] ) + # Match ! } elsif ( grep {/^\$.+$/} @args ) { # # Instead using all the predicates relating to the id # (whe could use piped grep with the given args on th +e # keys %{$self->{_collection}{$predicate_id}} to rest +rict # to a small set of data to process and speed up thin +gs...) # # There's some var in the args # Let's try unification if ($order_do_matter) { for my $key (keys %{$self->{_collection}{$pred +icate_id}}) { my @stored = @{$self->{_collection}{$p +redicate_id}{$key} }; my %tempresults; my $ko = 0; for my $i (0..$#stored) { next if (($args[$i] eq '_') + or ($args[$i] eq $stored[$i])); if ($args[$i] =~ /^\$.+$/) { $tempresults{$args[$i] +} = $stored[$i]; } else { $ko = 1; } } for my $tempkey (keys %tempresults) { push @{$result{$tempkey}}, $te +mpresults{$tempkey } unless $ko; } } return %result; } else { for my $key (keys %{$self->{_collection}{$pred +icate_id}}) { my @stored = @{$self->{_collection}{$p +redicate_id}{$key} }; my %stored; for my $item (@stored) { $stored{$item} = 1; } my (%tempresults, $ko, %args); for my $i (grep {!/^\$.+$/} @args) { next if $i eq '_'; if ($stored{$i}) { delete $stored{$i}; next; } else { %stored = (); last; } } my $set = join'+', grep {/^\$.+$/} @ar +gs; if (%stored) { push @{$result{$set}}, join'+' +, keys %stored; } } } return %result; } else { return undef; + # No match } } # # "implementation independant" fact loader # sub load_from_file { my $self = shift; my $file = shift; open INFILE,"<$file" or die "Can't open $file ($!)"; while (my $method = <INFILE>) { chomp $method; eval "\$self->$method"; die "Load error : $@ line $. ($method)" if $@; } close INFILE; } sub display { if (!$#_) { print " No match\n"; return; } my %x = @_; my @var = keys %x; my $first = shift @var; my $pos; for my $sol (@{$x{$first}}) { print " possible $first = ",$sol; for my $var (@var) { print " , $var = ", ${$x{$var}}[$pos]; } print $/; $pos++; } } 1;

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://190085]
[afoken]: Also: All other attributes that start with csv_ and are not described above will be passed to Text::CSV_XS (without the csv_ prefix).
[Discipulus]: what about a good 'ol SOPW?
[erix]: Giro d'Italia won by Dumoulin (peccato Nibali)
[ELISHEVA]: csv_detect_bom doesn't work either
[erix]: (SCNR)
[ELISHEVA]: I may have to resort to SOPW - but was hoping that this would be something simple
[erix]: I'd just remove the BOM, it is pretty simple
[ELISHEVA]: Simple yes. and I did consider that. but this isn't one off . An important data source that I don't control is generating bom prefixed utf8 files and I'd rather not have to be munging files every few months.
[erix]: on teh other hand a SOPW is pretty much garanteed to get an answer from tux (and probably the module fixed)
[ELISHEVA]: plus it bugs me that something that *should* be simple, *should* work- unicode and noms aren't exactly the new kids on the block

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (9)
As of 2017-05-28 20:32 GMT
Find Nodes?
    Voting Booth?