Data::Hierarchy::Traverser - Perl extension for generic hierarchy structure traversal.

  use Data::Hierarchy::Traverser;

  hierarchy_traverse (
     $roots,   # a scalar for one root,
               # or a ref to a list of roots,
               # or a ref to a list of the wrappers of root.

    \&get_children,   # a function for getting child nodes
    {                                        # Options:
      depth          => 1,                   # how depth limitaion. (default undef, no limitation)
      pre_branch     => $per_banch_function, # the function called before visit childeren nodes
      post_branch    => $per_banch_function, # the fucntion called after visite all it children nodes
      bare_branch    => $per_banch_function, # the function for empty branches
      leaf           => $leaf_function,      # the function for leaf nodes
      is_leaf        => $is_leaf_function,   # the function for check if a node is leaf
                                             # all default functions are default to be {}
                                             # (do nothing and return false.
                                             # (?Should it just skip the call to an empty funcion?)
     } ,
  );

This module export one recursive function hierarchy_traverse, which traverses a hierarchy structure in the depth-first fashion.

Caution: As it is a recursive function, pay attention of the usage of gobal variables such as $_, <FH>.

More detail will be added here.

sub hierarchy_traverse

  use Data::Hierarchy::Traverser;

  my $roots=[
             [6,[2,3,4,6],[]],
            ];
  hierarchy_traverse(
    $roots,
    \&get_children,
    { is_leaf => sub { $_[0]->[0] == 0 } ,
      leaf    => sub {
                       print join ', ', @{$_[0]->[2]};
                       print "\n"
                       # exit; #if want only one solution
                     },
    }
  );

  sub get_children {
    my ($target, $remain, $result) = @{shift()};
    return if $target < 0;
    return if 0 == @$remain;
    my $item = shift @$remain;
    my $new_result;
    $new_result = [@$result, $item];
    return [
      [$target - $item, [@$remain],  [@$new_result]],
      [$target        , [@$remain],  [@$result]]
    ];
  }

  use Data::Hierarchy::Traverser;

  my $n = $ARGV[0];
  $n ||= 8;
  my $checkboard;

  for my $x (0..$n -1) {
    for my $y (0..$n -1) {
     push @$checkboard, [$x, $y];
    }
  };

  hierarchy_traverse(
    [ [0, $checkboard,[]], ],
    \&get_children,
    { is_leaf => sub { $_[0]->[0] ==  $n; } ,
      leaf    => sub { printCheckBoard($_[0]->[2]);
                       #exit; # if you just only want one solution
                     },
    }
  );

  sub get_children {
    my ($row, $points, $qs) = @{shift()};
    my $results = [];
    foreach my $point (grep {$_->[0] == $row} @$points) {
      my @remain_points =
          grep {
            not (
                 $_->[0] == $point->[0]                        # exclude the column
              or $_->[1] == $point->[1]                        # the row
              or $_->[0]-$_->[1] == $point->[0] - $point->[1]  # the "\" diagonal
              or $_->[0]+$_->[1] == $point->[0] + $point->[1]  # the "/" diagonal
            )
          } @$points; 
      my @new_qs = (@$qs, $point);
      push @$results, [$row+1, [@remain_points], [@new_qs]];
    }
    return $results;
  }

  sub printCheckBoard {
    my $cross = shift;
    print "~~~" x ($n), "\n";
    print "+--" x $n, "+\n";
    for my $x (0..$n -1) {
      for my $y (0..$n -1) {
        if (grep {$x == $_->[0] and $y == $_->[1]} @$cross ){
           print '|Q ';
         } else {
           print '|  ';
         } 
       }
       print "|\n" . '+--' x $n, "+\n";
    }
  }

Ge Peng, <tigerpeng2001@yahoo.com>

Copyright 2007 by Ge Peng

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