Algorithm-Functional-BFS

 view release on metacpan or  search on metacpan

lib/Algorithm/Functional/BFS.pm  view on Meta::CPAN

=head1 SYNOPSIS

    use Algorithm::Functional::BFS;

    # Create your object.
    my $bfs = Algorithm::Functional::BFS->new
    (
        adjacent_nodes_func => $some_func,
        victory_func        => $some_other_func,
    );
    # Get a list (ref) of all the routes from your start node to the node(s)
    # that satisfy the victory condition.
    my $routes_ref = $bfs->search($start_node);

=head1 METHODS

=cut

=head2 new(%params)

Create a new Algorithm::Functional::BFS object with the specified parameters.

Required parameters:

lib/Algorithm/Functional/BFS.pm  view on Meta::CPAN

    of adjacent nodes.  If the node has no adjacent nodes, this function must
    return an empty array ref.

    victory_func:
    A function (referenec to a sub) that, given a node, returns a value that
    evaluates to true if and only if the node satisfies the victory condition
    of this search.

Optional parameters:

    include_start_node:
    If this is a true value, then the start node is a candidate for the
    victory condition.  That is, if the start node matches the victory
    condition, then a single route will be returned by the search algorithm,
    and that route will contain only the start node.

    one_result:
    If this is a true value, then the search stops after a single route is
    found, instead of searching for all the routes that satisfy the victory
    condition at the depth of the first route.

=cut
sub new
{
    my ($class, %opts) = @_;

    confess 'Missing "adjacent_nodes_func" parameter' unless
        $opts{adjacent_nodes_func};
    confess 'Missing "victory_func" parameter' unless $opts{victory_func};

    my %self =
    (
        adjacent_nodes_func => $opts{adjacent_nodes_func},
        victory_func        => $opts{victory_func},
        include_start_node  => $opts{include_start_node},
        one_result          => $opts{one_result},
    );

    bless(\%self, $class);
}

=head2 search($start_node)

    Perform a breadth-first-search from the specified node until the depth at
    which at least one node satisfies the victory condition.

    Returns an array ref of routes.  Each route is an array ref of the nodes
    that are along the route from the start node to the node at which the
    victory condition was satisfied.  Because this implementation works on
    cyclic graphs, multiple routes may be returned (and, indeed, multiple
    nodes at the same depth level may satisfy the victory condition).  If the
    "one_result" option was passed to the constructor, then only one route
    will be returned, but it will still be encapsulated in another array ref.

=cut
sub search
{
    my ($self, $start_node) = @_;

    confess 'Start node must be defined' unless $start_node;

    # Short circuit if the start node matches the victory condition.
    return [ [ $start_node ] ] if
        $self->{include_start_node} && $self->{victory_func}->($start_node);

    # Quick-to-read list of nodes we've already seen.
    my %seen = ( $start_node => 1 );

    # All the routes we've taken so far that are still valid.  This list
    # is used more-or-less like a queue.
    my @candidates = ( [ $start_node ] );

    # The final route list result.
    my @results;

    # Iterate until we have results or no candidates are left.
    until (@results > 0 || @candidates == 0)
    {
        # Keep new candidates separate from all candidates so that we can use
        # pop() in the while loop below.
        my @new_candidates;

t/tests/Test/CyclicGraph.pm  view on Meta::CPAN

my $adjacent_nodes_func = sub
{
    my ($node) = @_;
    my @adjacent_nodes = map { $haystack{$_} } @{$node->{adjacent}};
    return \@adjacent_nodes;
};

# Retrieve only one result from A to D.
sub search_one_result_equidistant : Tests(1)
{
    my $start_node_name = q{A};
    my $end_node_name = q{D};

    my $victory_func = sub { shift->{name} eq $end_node_name };

    my $bfs = Algorithm::Functional::BFS->new
    (
        adjacent_nodes_func => $adjacent_nodes_func,
        victory_func        => $victory_func,
        one_result          => 1,
    );

    my $routes_ref = $bfs->search($haystack{$start_node_name});
    is(scalar(@$routes_ref), 1, 'correct number of routes');
}

# Retrieve all routes from A to D.
sub search_all_results_equidistant : Tests(1)
{
    my $start_node_name = q{A};
    my $end_node_name = q{D};

    my $victory_func = sub { shift->{name} eq $end_node_name };

    my $bfs = Algorithm::Functional::BFS->new
    (
        adjacent_nodes_func => $adjacent_nodes_func,
        victory_func        => $victory_func,
    );

    my $routes_ref = $bfs->search($haystack{$start_node_name});
    is(scalar(@$routes_ref), 2, 'correct number of routes');
}

# Retrieve all routes from A to G.
sub search_all_results_nonequidistant : Tests(1)
{
    my $start_node_name = q{A};
    my $end_node_name = q{G};

    my $victory_func = sub { shift->{name} eq $start_node_name };

    my $bfs = Algorithm::Functional::BFS->new
    (
        adjacent_nodes_func => $adjacent_nodes_func,
        victory_func        => $victory_func,
    );

    my $routes_ref = $bfs->search($haystack{$end_node_name});
    is(scalar(@$routes_ref), 1, 'correct number of routes');
}

t/tests/Test/ObjectsAsNodes.pm  view on Meta::CPAN

$haystack{K}->set_adjacent_nodes([ $haystack{'J'} ]);

my $adjacent_nodes_func = sub
{
    my ($node) = @_;
    return $node->get_adjacent_nodes();
};

sub search_long : Tests(2)
{
    my $start_node = $haystack{A};
    my $end_node = $haystack{J};

    my $victory_func = sub { shift->get_name() eq $end_node->get_name() };

    my $bfs = Algorithm::Functional::BFS->new
    (
        adjacent_nodes_func => $adjacent_nodes_func,
        victory_func        => $victory_func,
    );

    my $routes_ref = $bfs->search($start_node);
    is(scalar(@$routes_ref), 1, 'correct number of routes');
    is(scalar(@{$routes_ref->[0]}), 6, 'route has correct length');
}

package Node;

use common::sense;

sub new
{

t/tests/Test/Parameters.pm  view on Meta::CPAN

    {
        my $bfs = Algorithm::Functional::BFS->new
        (
            adjacent_nodes_func => $func,
        );
    };

    ok(defined($@), 'constructor died');
}

sub undefined_start_node : Tests(1)
{
    my $bfs = Algorithm::Functional::BFS->new
    (
        adjacent_nodes_func => $func,
        victory_func        => $func,
    );

    eval
    {
        $bfs->search();

t/tests/Test/SingletonGraph.pm  view on Meta::CPAN

# Each node is a hash ref from the haystack hash.  Adjacent nodes are found by
# dereferencing the current node's list of adjacent nodes and then retrieving
# each of those nodes from the haystack.
my $adjacent_nodes_func = sub
{
    my ($node) = @_;
    my @adjacent_nodes = map { $haystack{$_} } @{$node->{adjacent}};
    return \@adjacent_nodes;
};

sub singleton_route_exclude_start_node : Tests(1)
{
    my $start_node_name = q{A};
    my $end_node_name = q{A};

    my $victory_func = sub { shift->{name} eq $start_node_name };

    my $bfs = Algorithm::Functional::BFS->new
    (
        adjacent_nodes_func => $adjacent_nodes_func,
        victory_func        => $victory_func,
    );

    my $routes_ref = $bfs->search($haystack{$end_node_name});
    is(scalar(@$routes_ref), 0, 'correct number of routes');
}

sub singleton_route_include_start_node : Tests(1)
{
    my $start_node_name = q{A};
    my $end_node_name = q{A};

    my $victory_func = sub { shift->{name} eq $start_node_name };

    my $bfs = Algorithm::Functional::BFS->new
    (
        adjacent_nodes_func => $adjacent_nodes_func,
        victory_func        => $victory_func,
        include_start_node  => 1,
    );

    my $routes_ref = $bfs->search($haystack{$end_node_name});
    is(scalar(@$routes_ref), 1, 'correct number of routes');
}

1;

t/tests/Test/StartNodeInclusion.pm  view on Meta::CPAN

# Each node is a hash ref from the haystack hash.  Adjacent nodes are found by
# dereferencing the current node's list of adjacent nodes and then retrieving
# each of those nodes from the haystack.
my $adjacent_nodes_func = sub
{
    my ($node) = @_;
    my @adjacent_nodes = map { $haystack{$_} } @{$node->{adjacent}};
    return \@adjacent_nodes;
};

# Search for the start node, inclusive of the start node.
sub start_node_include : Tests(3)
{
    my $node_name = q{A};

    my $victory_func = sub { shift->{name} eq $node_name };

    my $bfs = Algorithm::Functional::BFS->new
    (
        adjacent_nodes_func => $adjacent_nodes_func,
        victory_func        => $victory_func,
        include_start_node  => 1,
    );

    my $routes_ref = $bfs->search($haystack{$node_name});
    is(scalar(@$routes_ref), 1, 'correct number of routes');

    my @route = @{$routes_ref->[0]};
    my @expected_route = map { $haystack{$_} } qw(A);
    is(scalar(@route), scalar(@expected_route), 'correct route length');

    for (my $i = 0; $i < scalar(@route); ++$i)
    {
        is($route[$i], $expected_route[$i], "route node $i correct");
    }
}

# Search for the start node, exclusive of the start node.
sub start_node_exclude : Tests(1)
{
    my $node_name = q{A};

    my $victory_func = sub { shift->{name} eq $node_name };

    my $bfs = Algorithm::Functional::BFS->new
    (
        adjacent_nodes_func => $adjacent_nodes_func,
        victory_func        => $victory_func,
        include_start_node  => undef,
    );

    my $routes_ref = $bfs->search($haystack{$node_name});
    is(scalar(@$routes_ref), 0, 'correct number of routes');
}

1;