package SearchTree;

=head1 NAME

SearchTree - search a tree of nodes in a variety of ways.

=head1 SYNOPSIS

  # First define your own MyNode hash reference object
  # with the following methods.
  { package MyNode; 
    sub new      { }   # the object must be a hash references, i.e. $self={}
    sub expand   { }   # return a reference to list of nodes below given node.
    sub isGoal   { }   # return true if this node is the goal else false.
    sub areEqual { }   # return true if two nodes represent equivalent states.
    sub asText   { }   # return node as text (for verbose>1 output)
  }

  my $rootNode = MyNode->new( );    # Create the top node in the tree.

  # Return a reference to a list of nodes starting at $rootNode
  # ending at $goalNode, such that $goalNode->isGoal() is true.
  use SearchTree;
  my $nodePath = SearchTree::breadthFirst( root    => $rootNode, 
                                           depth   => 5, 
					   VERBOSE => 1);
  # or
  my $nodePath = SearchTree::depthFirst( root    => $rootNode, 
                                           depth   => 5, );

  print "Here's a path to the goal :\n";
  foreach my $node (@$nodePath) { print $node->asText() . "\n" }

=head1 DESCRIPTION

This module will search through a tree of node objects.

The logic of the tree itself - how to generate new nodes
below a given one, how to detect if the goal as been reached,
and so on - must be defined in another package.
Moreover, the node objects should be implemented as hash references,
so that SearchTree can store various data such as parent and depth
within the nodes themselves, in the form $object->{_ST_dataname}.

The calling routine defines a package that implements the logic
behind the tree of nodes to be searched, including methods to find 
the subnode children of a given node (expand), 
to test if the goal has been reached (isGoal), to return a string
representation of a node (asText), and to see if the internals of 
a given node are equivalent to that of another node (areEqual).

See the SearchTree.pm source code for the sampleNode package 
which illustrates these methods.

The search algorithms implemented are

* breadthFirst, 
which looks for the goal in all the nodes at each depth
before moving deeper, keeping all unique nodes in memory, and

* depthFirst, 
which uses less memory but descends quickly to the
maximum depth without exploring simpler alternatives.

To see the algorithms run on a simple test tree you can run the package
with "perl SearchTree.pm".

=head2 EXPORT

By default: nothing. By request: breadthFirst, depthFirst.

=head1 SEE ALSO

  Perl

=head1 COPYRIGHT AND LICENSE

Copyright 2003 by Jim Mahoney, E<lt>mahoney@marlboro.edu<gt>

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=cut

use strict;
use warnings;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw( breadthFirst depthFirst );

our $VERSION = 0.1;
our $VERBOSE;           # print some progress messages if >0, more if >1.

our $defaultDepth = 3;
our $maxDepth;
our $pastNodes;         # nodes previously searched
our $presentNodes;      # nodes actively being searched
our $futureNodes;       # nodes which will be searched.
our $nodeCount;
our $answerPath = [];   # When recursive descent terminates, this is filled in.

# -- depthFirst ------------------------------------------------------
# Search a set of nodes to a given maximum depth, descending down
# each path before looking across.  No attempt is made to prune 
# the tree by discarding areEqual() nodes.
sub depthFirst {
  my (%params)   = @_;
  $VERBOSE       = $params{VERBOSE}  || 0;
  $maxDepth      = $params{depth}    || $defaultDepth;
  my $rootNode   = $params{root} or die "Oops - root node not specified";
  $nodeCount     = 0;
  descend($rootNode, 0);

  # If no answer returned, then the search was not successful.
  if ($VERBOSE and scalar(@$answerPath)==0){
    print   "   ** No path to goal found in $nodeCount"
          . " nodes down to depth $maxDepth .\n";
  }
  return $answerPath;  
}

# Recursive descent for depthFirst search.
sub descend {
  my ($node, $depth) = @_;
  $nodeCount++;
  if ($node->isGoal){
    print   "   ** Path to goal found at depth $depth" 
          . " with $nodeCount nodes examined.\n" if $VERBOSE;
    $answerPath = nodePath($node);
    return;
  }
  return if $depth >= $maxDepth;
  my $subnodes = $node->expand;
  my $deeper = $depth+1;
  while (@$subnodes and scalar(@$answerPath)==0) {
    my $subnode = shift @$subnodes;
    $subnode->{_ST_parent} = $node;
    $subnode->{_ST_depth} = $deeper;
    descend($subnode,$deeper);
  }
}

# -- breadthFirst ------------------------------------------------------
# Search a set of nodes to a given depth, looking across at
# all nodes of each depth before going deeper, keeping all
# nodes in memory.  Discard nodes whose internal state
# is equivalent to an earlier node.
sub breadthFirst {
  my (%params)   = @_;
  $VERBOSE       = $params{VERBOSE}  || 0;
  $maxDepth      = $params{depth}    || $defaultDepth;
  my $rootNode   = $params{root} or die "Oops - root node not specified";

  $pastNodes    = [];
  $presentNodes = [];
  $futureNodes  = [$rootNode];

  my $currentDepth = 0;
  while ($currentDepth < $maxDepth) {
    $currentDepth++;

    # re-assign the various nodes into their appropriate categories.
    push @$pastNodes, @$presentNodes;
    $presentNodes = $futureNodes;
    $futureNodes = [];

    if ($VERBOSE) {
      # Print a summary how many nodes have been searched so far.
      my $nNow  = scalar(@$presentNodes) || 0;
      my $nPast = scalar(@$pastNodes) || 0;
      print "   -- Depth ", $currentDepth-1," -- ";
      print " Exploring $nNow node" , $nNow eq 1 ? '' : 's' , 
        " ($nPast already examined).\n";
    }

    # Look at each node at this depth in the search tree.
    foreach my $node (@$presentNodes) {
      my $subnodes = $node->expand;
      if ($VERBOSE>1) {
        print "       Expanding ", $node->asText, 
              " which has " , scalar(@$subnodes), " below it. \n";
      }
      foreach my $subnode (@$subnodes) {
        print "         Considering " . $subnode->asText if $VERBOSE>1;
        if (seenAlready($subnode)){
          print " - discard.\n" if $VERBOSE>1;
          next;
        }
        $subnode->{_ST_parent} = $node;
        $subnode->{_ST_depth}  = $currentDepth;
        if ($subnode->isGoal){
          print " - GOAL! \n" if $VERBOSE>1;
          print   "   ** Path to goal found at depth $currentDepth with "
          . (scalar(@$pastNodes)+scalar(@$presentNodes)+scalar(@$futureNodes))
          . " nodes generated.\n" if $VERBOSE;
          return nodePath($subnode);
        }
        push @$futureNodes, $subnode;
        print " - keep.\n" if $VERBOSE>1;
      }
    }
  }
  # Goal not reached; return an empty list.
  print   "   ** No path to goal found in "
        . (scalar(@$pastNodes)+scalar(@$presentNodes))
        . " nodes down to depth ", $currentDepth,".\n" if $VERBOSE;
  return [];
}

# ---- utility routines --------------------------------

# Return a list of nodes from the goal back to top
# using $node->{_ST_parent}, and where 
# top is only node with $node->{_ST_parent} false.
sub nodePath {
  my $node = shift;
  my $result = [];
  while ($node) {
    unshift @$result, $node;
    $node = $node->{_ST_parent};
  }
  return $result;
}

# return true if a node in any of the three lists
# evaluates true when when passed to areEqual() subroutine.
sub seenAlready {
  my $node =shift;
  return 0 unless $node->can('areEqual');
  return 1 if isInList($node, $pastNodes);
  return 1 if isInList($node, $presentNodes);
  return 1 if isInList($node, $futureNodes);
  return 0;
}
# return true if $node is in @$nodeList.
sub isInList {
  my ($node, $nodeList) = @_;
  foreach my $n (@$nodeList){
    return 1 if $node->areEqual($n);
  }
  return 0;
}

# == testing ============================================================

unless (caller()){
  print '
 # Testing SearchTree.pm by 
 # breadFirst search for a path from 1 to 100
 #      1
 #     / \
 #    2   3
 #   / \   \
 #  4   5   1
 #  |  / \  
 #  2 8  100

';
  {package sampleNode;
   sub new { 
     my $class=shift;
     my ($number) = @_;
     $number=1 unless $number;
     return bless { number => $number }, $class;
   }
   sub newList {
     my @numbers=@_;
     my $list=[];
     push @$list, sampleNode->new($_) for @numbers;
     return $list;
     
   }
   sub expand {
     my $self=shift;
     return newList(2,3)   if $self->{number} == 1;
     return newList(4,5)   if $self->{number} == 2;
     return newList(1)     if $self->{number} == 3;
     return newList(2)     if $self->{number} == 4;
     return newList(8,100) if $self->{number} == 5;
     return [];
   }
   sub isGoal  {
     my $self=shift;
     return 1 if $self->{number} == 100;
     return 0;
   }
   sub areEqual { 
     my $self=shift;
     my ($other)=@_;
     return $self->{number} == $other->{number};
   }
   sub asText  {
     my $self=shift;
     return "'".$self->{number} . "'=" . $self;
   }
 }
 #use SearchTree;
 print "
 Here's the breadthFirst search from root to goal to maxDepth 6
 with areEqual() pruning.\n";
 my $answerPath = SearchTree::breadthFirst( root    => sampleNode->new(1),
                                            depth   => 6,
                                            VERBOSE => 1, );
 foreach my $node (@$answerPath){
   print "  " . $node->asText() . "\n";
 }

 print "
 And here's the depthFirst search from root to goal to maxDepth 6
 without any pruning. \n";
 $answerPath = SearchTree::depthFirst( root    => sampleNode->new(1),
					 depth   => 6,
					 VERBOSE => 1, );
 foreach my $node (@$answerPath){
   print "  " . $node->asText() . "\n";
 }


}
# ==================================================================

1;
