####################################################################
#                                                   COMBINE BRANCHES
#-------------------------------------------------------------------
# 
# Imagine a tree.  Lets separate it into 3 parts: branches, twigs, 
# and leaves.  Leaves are a certain color: green, red, golden, 
# ultraviolet...  On this tree, there are different kinds of twigs, 
# each growing leaves of a certain set of colors.  If the twig grows
# leaves of a color, it is the ONLY twig to grow leaves of that 
# color.  So one kind of twig might grow green, red, and yellow, 
# and another kind would grow purple, pink, and poka-dot.  Twigs have
# lots of empty space where they *could* be growing the other colors
# of leaves; they just don't.  Thus, we have a lot of redundant 
# twigs, and we should instead combine all the leaves onto one twig.
# This subroutine accomplishes that.
#
# For the purposes of this subroutine, a tree is a arrays of arrays
# (of arrays of arrays...) to an arbitrary depth.  The user passes 
# a $twig_depth and $leaf_depth to the subroutine.  The $twig_depth
# determines where branches become twigs, and similarly the 
# $leaf_depth determines the depth of the leaves.  The leaf 'color'
# is its array index.  Arrays are presumably sparsly populated at
# the leaf level.
#
# To clarify/generalize, a $twig could have more sub-$twigs coming
# off it and it is the FIRST twig which determines the colors of
# the leaves.  So when we're done combining leaves, we have one
# kind of twig left (which will be in array index 0).  That's 
# redundant too, so we remove that twig entirely, i.e. eliminating
# that entire depth of the tree ($depth -= 1 to all deeper
# elements).
#
# The subroutine is passed a reference to a $tree, the 
# $twig_depth, and a $leaf_depth, and returns a reference to a
# $tree.  Mind you, no copy of the tree is made; the first $tree is
# destroyed by this subroutine.  Returning the new tree is necessary
# because $twig_depth could be 0, in which case you cannot set the 
# original (outside of the subroutine) tree to point to the deeper
# twig.  Perhaps the better way to deal with this is to pass a 
# reference to a reference to an array, I am undecided.
# 
# A future version of this subroutine will handle having the leaf
# colors scattered across all twigs, specifically how to combine
# them in case of collisions.  See the TODO:'s towards the end.
# 
####################################################################

##</code><code>##


sub Combine_Branches {

  my $tree            = $_[0];
  my $twig_depth      = $_[1];
  my $leaf_depth      = $_[2];

  my @branches        = (\$tree);
  my @twigs           = ();
  my @branch_indeces  = (0);
  my @twig_indeces    = (0);
  
  my $depth           = 0;
  my $branch          = \$tree; # REFERENCE TO THE REFERENCE!!!
  my $twig            = \$tree;
  my $branch_index    = 0;
  my $twig_index      = 1;

  my $leaf_mode       = 0;
  my $loop_count      = 0;
  my $zero_count      = 0;

  if ($twig_depth >= $leaf_depth) { return };

  while (1) {
    $loop_count++;

    if ($depth < 0) { last } # END LOOP
    
########### If less than branching depth, traverse branches
    if ($depth < $twig_depth) {
      if (exists $$branch->[$branch_index]) {
        push @twigs,          undef;
        push @twig_indeces,   0;
        push @branches,       $branch;
        push @branch_indeces, $branch_index;
        $depth++;
        $branch = \$$branch->[$branch_index];
        $branch_index = 0;
        $twig_index   = 1;

      # continue to next branch
      } elsif ($branch_index < $#$$branch) { 
        $branch_index ++ 

          
      # drop back a branch
      } else { 
        $branch       =  pop @branches;
        $branch_index =   ( pop @branch_indeces ) + 1; 
        $depth -- 
      }
    }

########## If equal to branching depth, transition to traversing twigs.
    elsif ($depth == $twig_depth) {
      if (exists $$branch->[$twig_index]) {
        push @twigs,          $$branch;
        push @twig_indeces,   $twig_index;
        push @branches,       $branch;
        push @branch_indeces, $branch_index;
        
        $twig         = $$branch->[$twig_index];
        $branch       = \$$branch->[0];
        $branch_index = 0;
        $twig_index   = 0;
        $leaf_mode    = 1;
        $depth++;
      }
        
      elsif ($twig_index < $#$$branch) { $twig_index++ }

      else {

        $$branch = $$branch->[0];
        $branch                   = pop @branches ;
        $branch_index             = pop @branch_indeces;
        pop @twigs;
        pop @twig_indeces;
        $branch_index++;
        $depth --; 
      }
    }


########## If over branching depth and under leaf depth, traverse twigs 
    elsif ($depth > $twig_depth and $depth < $leaf_depth) {
      if (exists $twig->[$twig_index]) {
        push @twigs,          $twig;
        push @twig_indeces,   $twig_index;
        push @branches,       $branch;
        push @branch_indeces, $twig_index;
        
        $branch     = \$$branch->[$twig_index];
        $twig       = $twig->[$twig_index];
        $twig_index = 0;
        $depth++;
      }

      # Next index towards twig
      elsif ($twig_index < $#$twig) { $twig_index++ }

      # Past end of subbranch, backtrack.
      else {
        $depth--;
        $branch       =   pop @branches ;
        $branch_index = ( pop @branch_indeces );
        $twig         =   pop @twigs;
        $twig_index   = ( pop @twig_indeces ) + 1;
      }
    }


    # If at leaf depth, copy leaves
    elsif ($depth == $leaf_depth) {
      if (defined $twig) {
        if (defined $$branch ) {
          # TODO: Possibly throw an error if there is overlap.
        } else {
          $$branch = $twig;
          # TODO: Expand the possibility of combining leaves.
          #       Perhaps average, concatenate, overwrite, leave first, etc...
        }
      }
      $branch               =    pop @branches ;
      $twig                 =    pop @twigs;
      $branch_index         =    pop @branch_indeces;
      $twig_index           =  ( pop @twig_indeces ) + 1;
      $depth--;
    }

    # Else something went very wrong.
    else { die "Inconsistent State, Leaf Mode = $leaf_mode, Depth = $depth, $!" }
  }
         
  return ($tree ? $tree : []);
  
}

####################################################################
#                                                        PRINT STATE
#-------------------------------------------------------------------
# This is just a support subroutine for debugging.  You call is with
# the function call below:
#
#  print_state("This is a useful message", 
#              $depth, $branch_index, $twig_index, $tree, 
#              \@branches, \@branch_indeces, 
#              \@twigs, \@twig_indeces, 
#              $$branch, $twig );
#
####################################################################

sub print_state {
    my ( $message, $depth, 
         $branch_index, $twig_index, 
         $tree, $branches, $branch_indeces, 
         $twigs, $twig_indeces, 
         $branch, $twig ) = @_;
    print << "___STATE___";
<PRE>
<B>Depth:</B> $depth <B>Branch Index:</B> $branch_index <B>Twig Index:</B> $twig_index
<B>Message:</B> $message
<B>Tree:</B> @$tree
<B>Branch:</B> $branch <B>Index:</B> $branch_index <B>Branches:</B> @$branches <B>Branch Indeces:</B> @$branch_indeces
<B>Twig:</B> $twig <B>Twigs:</B> @$twigs <B>Twig Indeces:</B> @$twig_indeces
</PRE>
___STATE___
  print "<PRE><B>Branch:</B>\n" . Dumper($branch) . "</PRE>\n" ;
  print "<PRE><B>Twig:</B>\n" . Dumper($twig) . "</PRE>\n" ;
}