view release on metacpan or  search on metacpan

lib/Algorithm/SixDegrees.pm  view on Meta::CPAN

use warnings;
use strict;
use Scalar::Util qw(reftype);

=encoding UTF-8

=head1 NAME

Algorithm::SixDegrees - Find a path through linked elements in a set

=head1 VERSION

Version 1.01

=cut

our $VERSION = '1.01';
our $ERROR = '';

=head1 SYNOPSIS

	use Algorithm::SixDegrees;

	my $sd1 = Algorithm::SixDegrees->new();
	$sd1->data_source( actors => \&starred_in );
	$sd1->data_source( movies => \&stars_of );
	@elems = $sd1->make_link('actors', 'Tom Cruise', 'Kevin Bacon');

	my $sd2 = Algorithm::SixDegrees->new();
	$sd2->forward_data_source( friends => \&friends, @args );
	$sd2->reverse_data_source( friends => \&friend_of, @args );
	@elems = $sd2->make_link('friends', 'Bob', 'Mark');

=head1 DESCRIPTION

C<Algorithm::SixDegrees> is a Perl implementation of a breadth-first
search through a set of linked elements in order to find the shortest
possible chain linking two specific elements together.

In simpler terms, this module will take a bunch of related items and
attempt to find a relationship between two of them.  It looks for the
shortest (and generally, simplest) relationship it can find.

=head1 CONSTRUCTOR

=head2 new()

C<Algorithm::SixDegrees> requires use as an object; it can't (yet) be used
as a stand-alone module.  C<new> takes no arguments, however.

=cut

sub new {
	my $class = shift;
	my $self = {
		_source_left  => {},
		_source_right => {},
		_sources      => [],
		_investigated => {},
	};
	return bless $self,$class;
}

=head1 FUNCTIONS

=head2 forward_data_source( name => \&sub, @args );

Tells C<Algorithm::SixDegrees> that all items in the data set relating to
C<name> can be retrieved by calling C<sub>.  See L</SUBROUTINE RULES>.

In our friends example above, if Bob considers Mark a friend, but Mark
doesn't consider Bob a friend, calling the sub with "Bob" as an argument
should return "Mark", but calling the sub with "Mark" as an argument
should not return "Bob".

=cut

sub forward_data_source {
	my ($self, $name, $sub, @args) = @_;
	die "Data sources must be named\n" unless defined($name);
	die "Data sources must have code supplied\n" unless defined($sub);
	die "Data sources must have a coderef argument\n" unless ref($sub) && reftype($sub) eq 'CODE';
	$self->{'_source_left'}{$name}{'sub'} = $sub;
	$self->{'_source_left'}{$name}{'args'} = \@args;
	foreach my $source (@{$self->{'_sources'}}) {
		return if $source eq $name;
	}
	push(@{$self->{'_sources'}},$name);
	return;
}

=head2 reverse_data_source( name => \&sub, @args );

Tells C<Algorithm::SixDegrees> that all items in the data set related to 
by C<name> can be retrieved by calling C<sub>.  See L</SUBROUTINE RULES>.

In the same friends example, calling the sub with "Bob" as an argument
should not return "Mark", but calling the sub with "Mark" as an argument
should return "Bob".

=cut

sub reverse_data_source {
	my ($self, $name, $sub, @args) = @_;
	die "Data sources must be named\n" unless defined($name);
	die "Data sources must have code supplied\n" unless defined($sub);
	die "Data sources must have a coderef argument\n" unless ref($sub) && reftype($sub) eq 'CODE';
	$self->{'_source_right'}{$name}{'sub'} = $sub;
	$self->{'_source_right'}{$name}{'args'} = \@args;
	foreach my $source (@{$self->{'_sources'}}) {
		return if $source eq $name;
	}
	push(@{$self->{'_sources'}},$name);
	return;
}

=head2 data_source( name => \&sub, @args );

Sets up a data source as both forward and reverse.  This is useful if
the data source is mutually relational; that is, in our actors/movies
example, Kevin Bacon is always in Mystic River, and Mystic River always