File Coverage

blib/lib/Graph/Maker/TwinAlternateAreaTree.pm

Criterion	Covered	Total	%
statement	9	11	81.8
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	13	15	86.6

# Copyright 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::TwinAlternateAreaTree;
use 5.004;
use strict;
use Carp 'croak';
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(@_);
}
sub _vertex_name_func_decimal {
  my ($v) = @_;
  return $v;
}
sub _vertex_name_func_binary {
  my ($v) = @_;
  return sprintf '%b', $v;
}
sub _vertex_name_func_xy {
  my ($v) = @_;
  my $x = 0;
  my $y = 0;
  my $bit = 1;
  while ($v) {
    if ($v & 1) { $x |= $bit; }
    $v >>= 1;
    if ($v & 1) { $y |= $bit; }
    $v >>= 1;
    $bit <<= 1;
  }
  $x = $y-$x;
  return "$x,$y";
}
sub init {
  my ($self, %params) = @_;

  my $level = delete($params{level}) || 0;
  my $graph_maker = delete($params{'graph_maker'}) || \&_default_graph_maker;

  # undocumented parameter
  my $vertex_name_type = delete($params{'vertex_name_type'}) || 'decimal';
  my $vertex_names_func = $self->can("_vertex_name_func_$vertex_name_type")
    || croak 'Unrecognised vertex_name_type: ',$vertex_name_type;

  ### $level
  ### $vertex_name_type

  my $graph = $graph_maker->(%params);
  $graph->set_graph_attribute(name => "Twin Alternate Area Tree $level");
  $graph->set_graph_attribute(vertex_name_type => $vertex_name_type);
  $graph->add_vertex($vertex_names_func->(0));
  my $directed = $graph->is_directed;

 V: foreach my $v (0 .. 2**$level-1) {
    ### $v

    # ...1 edge to ...0
    if ($v & 1) {
      ### horizontal ...
      my $to = $v ^ 1;
      my $v_name = $vertex_names_func->($v);
      my $to_name = $vertex_names_func->($to);
      $graph->add_edge($v_name, $to_name);
      if ($directed) { $graph->add_edge($to_name, $v_name); }
    }

    #  ...00 11...11
    #        \-----/ zero or more low 1 bits
    # edge to
    #  ...11 00...00
    #
    my $bit  = 1;
    for (my $pos = 1; ; $pos++, $bit<<=1) {
      $pos < $level or next V;
      next if $v & $bit;  # still all 1s
      unless ($v & ($bit<<1)) {  # 00 11..11
        my $to = $v+1+($bit<<1);

        my $v_name = $vertex_names_func->($v);
        my $to_name = $vertex_names_func->($to);
        $graph->add_edge($v_name, $to_name);
        if ($directed) { $graph->add_edge($to_name, $v_name); }
      }
      last;
    }
  }
  return $graph;
}

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