File Coverage

blib/lib/Graph/Maker/FibonacciTree.pm

Criterion	Covered	Total	%
statement	6	8	75.0
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	9	11	81.8

# Copyright 2015, 2016, 2017 Kevin Ryde
#
# This file is part of Graph-Maker-Other.
#
# 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 Graph-Maker-Other.  See the file COPYING.  If not, see
# .

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

use vars '$VERSION','@ISA';
$VERSION = 7;
@ISA = ('Graph::Maker');

# 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'};
  my $graph_maker = delete($params{'graph_maker'}) || \&_default_graph_maker;

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

  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__