File Coverage

blib/lib/Graph/Maker/KnightGrid.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::KnightGrid;
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(@_);
}

# last $dim runs fastest, per Graph::Maker::Grid
sub _coordinates_to_vertex {
  my ($c, $dims) = @_;
  my $v = $c->[0];
  die if $c->[0] >= $dims->[0];
  foreach my $i (1 .. $#$dims) {
    $v *= $dims->[$i];
    $v += $c->[$i];
    die if $c->[$i] >= $dims->[$i];
  }
  return $v+1;
}

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

  my $dims   = delete($params{'dims'}) || [];
  my $cyclic = delete($params{'cyclic'});
  my $graph_maker = delete($params{'graph_maker'}) || \&_default_graph_maker;

  ### KnightGrid ...
  ### $dims

  my $graph = $graph_maker->(%params);

  $graph->set_graph_attribute(name => "Knight Grid "
                              . @$dims ? join('x',@$dims) : 'empty');
  unless (_aref_any_nonzero($dims)) {
    ### all dims zero ...
    return $graph;
  }

  my @c = (0) x scalar(@$dims);
  for (;;) {
    my $v = _coordinates_to_vertex(\@c, $dims);
    $graph->add_vertex($v);
    ### at: join(',',@c)."=[$v]"

    foreach my $i (0 .. $#c) {
      foreach my $j (0 .. $#c) {
        next if $i == $j;
        foreach my $isign (1,-1) {
          foreach my $jsign (1,-1) {
            foreach my $offset (0, 1) {
              my @c2 = @c;
              $c2[$i] += (1+$offset)*$isign;
              $c2[$j] += (2-$offset)*$jsign;
              if ($cyclic) {
                $c2[$i] %= $dims->[$i];
                $c2[$j] %= $dims->[$j];
              } else {
                next unless ($c2[$i] >= 0 && $c2[$i] < $dims->[$i]
                             && $c2[$j] >= 0 && $c2[$j] < $dims->[$j]);
              }
              my $v2 = _coordinates_to_vertex(\@c2, $dims);
              ### edge: join(',',@c)."=[$v] to ".join(',',@c2)."=[$v2]"
              unless ($graph->has_edge($v,$v2)) {
                $graph->add_edge($v,$v2);
              }
            }
          }
        }
      }
    }

    # increment @c coordinates
    for (my $i = 0; ; $i++) {
      if ($i > $#$dims) {
        return $graph;
      }
      if (++$c[$i] < $dims->[$i]) {
        last;
      }
      $c[$i] = 0;
    }
  }
}

sub _aref_any_nonzero {
  my ($aref) = @_;
  foreach my $elem (@$aref) {
    if ($elem) {
      return 1;
    }
  }
  return 0;
}

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

__END__