# Copyright 2015 Kevin Ryde
#
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# This file is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with this file.  See the file COPYING.  If not, see
# <http://www.gnu.org/licenses/>.

package Graph::Maker::FibonacciTree;
use 5.004;
use strict;
use base 'Graph::Maker';

use vars '$VERSION';
$VERSION = 5;

# uncomment this to run the ### lines
# use Smart::Comments;

sub _default_graph_maker {
  require Graph;
  Graph->new(@_);
}

# require Math::NumSeq::FibonacciWord;
# my $seq = Math::NumSeq::FibonacciWord->new;

sub init {
  my ($self, %params) = @_;

  my $height         = delete($params{'height'}) || 0;
  my $series_reduced = delete($params{'series_reduced'}) ? 1 : 0;
  my $leaf_reduced   = delete $params{'leaf_reduced'};

  ### FibonacciTree ...
  ### $height

  my $graph_maker = delete($params{'graph_maker'});
  $graph_maker ||= \&_default_graph_maker;
  my $graph = $graph_maker->(%params);

  $graph->set_graph_attribute
    (name => "Fibonacci Tree height $height"
     . ($series_reduced && $leaf_reduced ? ', series and leaf reduced' : '')
     . ($series_reduced ? ', series reduced' : '')
     . ($leaf_reduced ? ', leaf reduced' : ''));

  if ($height > 0) {
    $graph->add_vertex(1);

    my @pending_n     = (1);
    my @pending_depth = (1);
    my @pending_type  = (0);  # left
    my $upto = 1;
    my $directed = $graph->is_directed;

    my $add = sub {
      my ($parent) = @_;
      my $n = ++$upto;
      $graph->add_edge($parent, $n);
      if ($directed) { $graph->add_edge($n, $parent); }
      return $n;
    };

    foreach (2 .. $height) {
      ### at: "row $_"
      ### pending_n: join(',',@pending_n)
      ### pending_depth: join(',',@pending_depth)
      ### pending_type: join(',',@pending_type)

      my @new_pending_n;
      my @new_pending_depth;
      my @new_pending_type;

      while (@pending_n) {
        my $parent = shift @pending_n;
        my $depth = shift @pending_depth;
        my $type = shift @pending_type;
        ### under: "parent=$parent  depth=$depth  type=$type"

        next if $depth >= $height;
        $depth++;

        #         0              0
        #        / \            / \
        #   d+1 0   1 d+1      0   0  d+2
        #      / \  |         / \
        #     0  1  0 d+2    0   0

        # left child
        {
          ### left to: "depth=$depth"
          push @new_pending_n,     $add->($parent);
          push @new_pending_depth, $depth;
          push @new_pending_type,  0; # non-delay
        }

        if ($type == 0) {
          if ($series_reduced && $depth < $height) {
            # series reduced, step down to depth+2
            $depth++;
          } elsif ($leaf_reduced && $depth == $height) {
            # leaf reduced, no node
            next;
          } else {
            $type = 1;
          }
        } else {
          # only single child under a delay
          next;
        }

        ### right to: "depth=$depth"
        push @new_pending_n,     $add->($parent);
        push @new_pending_depth, $depth;
        push @new_pending_type,  $type;  # right
      }

      @pending_n     = @new_pending_n;
      @pending_depth = @new_pending_depth;
      @pending_type  = @new_pending_type;
    }
  }
  return $graph;
}

Graph::Maker->add_factory_type('fibonacci_tree' => __PACKAGE__);
1;

__END__

=for stopwords Ryde

=head1 NAME

Graph::Maker::FibonacciTree - create Fibonacci tree graph

=for test_synopsis my ($graph)

=head1 SYNOPSIS

 use Graph::Maker::FibonacciTree;
 $graph = Graph::Maker->new ('fibonacci_tree', height => 4);

=head1 DESCRIPTION

C<Graph::Maker::FibonacciTree> creates C<Graph.pm> graphs of Fibonacci
trees.

=head2 Full Tree

The default is a tree in the style of Hugo Steinhaus "Mathematical
Snapshots", starting the tree at the first fork.

            1
          /   \          height => 4
        2       3      
       / \      |
      4   5     6
     / \  |    / \
    7  8  9  10   11

The number of nodes in each row are the Fibonacci numbers 1, 2, 3, 5, etc.

A tree of height H has a left sub-tree of height H-1 but the right delays by
one level and under there is a tree H-2.

                tree(H)
              /        \             tree of height H
        tree(H-1)       node          
         /    \           |
     tree(H-2) node    tree(H-2)
       /   \    |       /    \
     ...  ...  ...    ...   ...

This is the genealogy of Fibonacci's original rabbit pairs.  The root node 1
is a pair of adult rabbits.  They remain alive as node 2 and they have a
pair of baby rabbits as node 3.  Those babies do not breed immediately but
only in the generation after at node 6.  Every right tree branch is a baby
rabbit pair which does not begin breeding until the month after.

The tree branching follows the Fibonacci word.  The Fibonacci word begins as
a single 0 and expands 0 -E<gt> 01 and 1 -E<gt> 0.  The tree begins as a
type 0 node in the root.  In each level a type 0 node has two child nodes, a
0 and a 1.  Type 1 is a baby rabbit pair and it descends to be a type 0
adult pair at the next level.

=head2 Series Reduced

Option C<series_reduced =E<gt> 1> eliminates non-leaf delay nodes.  These
are all the nodes with a single child.  In the height 4 example above they
are nodes 3 and 5.  The result is

            1
          /   \          height => 4        
        2       3        series_reduced => 1
       / \     / \       
      4   5   6   7
     / \
    8   9

A tree order N has left sub-trees order N-1 and right sub-tree N-2, starting
from orders 0 and 1 both a single node.

             root               tree of order N
           /      \               starting order 0 or 1 = single node
    order(N-1)    order(N-2)

This is the style of Knuth volume 3 section 6.2.1.

=for Test-Pari  vector(5,n,my(n=n-1); 2*fibonacci(n+1)-1) == [1,1,3,5,9]

Each node has 0 or 2 children.  The number of each in tree height H are

                      count
                     -------
    0 children       F(H+1)
    2 children       F(H+1)-1
    total nodes      2*F(H+1)-1

=for Test-Pari  my(H=4); 2*F(H+1)-1 == 9

=head2 Series and Leaf Reduced

Options C<series_reduced =E<gt> 1> and C<leaf_reduced =E<gt> 1> together
eliminate all the delay nodes.

            1
          /   \          height => 4        
        2       3        series_reduced => 1
       / \     /         leaf_reduced => 1
      4   5   6
     / 
    7  

This style can be formed by left and right sub-trees of order N-1 and N-2,
with an order 0 reckoned as no tree at all.

             root               tree of order N
           /      \               starting order 0 = no tree at all
    order N-1     order N-2                order 1 = single node


In this form nodes can have 0, 1 or 2 children.  For a tree height H the
number of nodes with each, and the total nodes in the tree, are

                    count
                   -------
    0 children      F(H)
    1 children      F(H-1), or 0 when H=0
    2 children      F(H) - 1, or 0 when H=0
    total nodes     F(H+2)-1

=for Test-Pari  my(H=4); F(H+2)-1 == 7

=for Test-Pari  vector(5,n,n--; fibonacci(n+2)-1) == [0,1,2,4,7]

=for Test-Pari  vector(100,n,n--; fibonacci(n) + if(n==0,0,fibonacci(n-1)) + if(n==0,0,fibonacci(n)-1)) == vector(100,n,n--; fibonacci(n+2)-1)

=for Test-Pari  vector(100,n,my(n=n-1); 2*fibonacci(n+1)-1 - (fibonacci(n+2)-1)) == vector(100,n,my(n=n-1); fibonacci(n-1))

The 1-child nodes are where C<leaf_reduced> has removed a leaf node from the
C<series_reduced> form.

This tree is the worst case for an AVL tree.  In an AVL tree each node has
left and right sub-tree heights differing by at most 1.  In this Fibonacci
tree every node is unbalanced with left and right sub-tree heights differing
by 1.

=head2 Leaf Reduced

Option C<leaf_reduced =E<gt> 1> alone eliminates from the full tree just the
delay nodes which are leaf nodes.  In the height 4 example of L</Full Tree>
above these are nodes 8 and 11.

            1
          /   \          height => 4
        2       3        leaf_reduced => 1
       / \      |
      4   5     6
     /    |    /
    7     8   9

The effect of this is merely to repeat the second last row, ie. a single
child under every node of the second last row.

=head1 FUNCTIONS

=over

=item C<$graph = Graph::Maker-E<gt>new('fibonacci_tree', key =E<gt> value, ...)>

The key/value parameters are

    height          =>  integer
    series_reduced  =>  boolean (default false)
    leaf_reduced    =>  boolean (default false)

Other parameters are passed to C<Graph-E<gt>new()>.

C<height> is reckoned in how many rows of nodes.  So C<height =E<gt> 1> is a
single root node.

Like C<Graph::Maker::BalancedTree>, if the graph is directed (the default)
then edges are added both up and down between each parent and child.  Option
C<undirected =E<gt> 1> creates an undirected graph and for it there is a
single edge from parent to child.

=back

=head1 SEE ALSO

L<Graph::Maker>, L<Graph::Maker::BalancedTree>

L<Math::NumSeq::FibonacciWord>

=head1 LICENSE

Copyright 2015 Kevin Ryde

This file is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by the
Free Software Foundation; either version 3, or (at your option) any later
version.

This file is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
more details.

You should have received a copy of the GNU General Public License along with
This file.  If not, see L<http://www.gnu.org/licenses/>.

=cut

# Harborth and Lohmann "Mosaic Numbers of Fibonacci Trees"
#   Steinhaus style fixed height
#
#                   * *   *
#                   |  \ /
# T3 = *   *   T4=  *   *
#       \ /          \ /
#        *            *
# F(h) on level h, being F(h-1) type A and F(h-2) type B

# Knuth 0 = single node
#       1 = single node
#
# Horibe 1 = single node   = Knuth order+1
#        2 = single node
#
# Nievergelt and Reingold
#    0 = empty
#    1 = single node
#
# Jia and McLaughlin "Balaban's Index"
#    both reduced, tree T1 as single node




  # my $zero_node     = delete $params{'zero_node'};
  # ### $zero_node
  # my $right_stretch = delete $params{'right_stretch'};
  # ### $right_stretch
  # my $order         = delete($params{'order'}) || 0;
  ### $order
  # {
  #   my $upto = 1;
  #   if ($height > 0) {
  #     $graph->add_vertex(1);
  #     my $upto = 1;
  #     my $row_start = 1;
  #     my $row_end = 1;
  # 
  #     require Math::NumSeq::FibonacciWord;
  #     my $seq = Math::NumSeq::FibonacciWord->new;
  # 
  #     foreach (2 .. $height) {
  #       ### row: "row=$_   $row_start to $row_end"
  # 
  #       my $fibbinary = 1;
  #       foreach my $parent ($row_start .. $row_end) {
  #         my ($i, $value) = $seq->next;
  #         # ### assert: ($fibbinary&1) == $value;
  #         print(($fibbinary & 1),$value,"  ");
  # 
  #         # 1 or 2 children for $parent
  #         foreach (1 .. (1 + ($fibbinary & 1))) {
  #           $graph->add_edge($parent, ++$upto);
  #         }
  # 
  #         my $filled = ($fibbinary >> 1) | $fibbinary;
  #         my $mask = (($filled+1) ^ $filled) >> 1;
  #         $fibbinary = ($fibbinary | $mask) + 1;
  #       }
  #       print "\n";
  #       $row_start = $row_end+1;
  #       $row_end = $upto;
  #     }
  # 
  #     ### final row: "$row_start to $row_end"
  #   }
  #   return $graph;
  # }
  # 
  # {
  #   my $upto = 1;
  #   if ($order > 0 || $zero_node) { $graph->add_vertex($upto); }
  #   if ($order <= 1) {
  #     return $graph;
  #   }
  # 
  #   # breadth-first traversal
  #   my @pending_n = ($upto);
  #   my @pending_order = ($order);
  #   $upto++;
  #   my $directed = $graph->is_directed;
  # 
  #   my $add = sub {
  #     my ($parent) = @_;
  #     my $n = ++$upto;
  #     $graph->add_edge($parent, $n);
  #     if ($directed) { $graph->add_edge($parent, $n); }
  #     return $n;
  #   };
  # 
  #   while (@pending_n) {
  #     # vertex $n is $order>=2 and is to have below it $order-1 and $order-2
  # 
  #     my $n = shift @pending_n;
  #     my $order = shift @pending_order;
  #     ### at: "$n order=$order"
  #     ### pending: join(',',@pending_n)."    ".join(',',@pending_order)
  # 
  #     if ($order < 0) {  # right_stretch
  #       $n = $add->($n);
  #       $order = -$order;
  #       if ($order >= 2) {
  #         push @pending_n, $n;
  #         push @pending_order, $order;
  #       }
  #       next;
  #     }
  # 
  #     ### assert: abs($order) >= 2
  # 
  #     foreach my $right (0, 1) {
  #       $order--;
  #       my $new_n;
  #       if ($order || $zero_node) {
  #         $new_n = $add->($n);
  #         if ($order >= 2 || ($right && $right_stretch)) {
  #           push @pending_n, $new_n;
  #           push @pending_order, ($right && $right_stretch ? -$order : $order);
  #         }
  #       }
  #     }
  #   }
  #   return $graph;
  # }
