File Coverage

blib/lib/Graph/Maker/Hanoi.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 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::Hanoi;
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_names_digits {
  my ($digits, $spindles) = @_;
  return join('',@$digits);
}
sub _vertex_names_integer {
  my ($digits, $spindles) = @_;
  my $pow = 1;
  my $ret = 0;
  foreach my $i (reverse 0 .. $#$digits) {
    $ret += $digits->[$i] * $pow;
    $pow *= $spindles;
  }
  return $ret;
}
my %vertex_names = (integer => \&_vertex_names_integer,
                    digits  => \&_vertex_names_digits);

sub init {
  my ($self, %params) = @_;
  my $discs     = delete($params{'discs'})     || 0;
  my $spindles  = delete($params{'spindles'})  || 3;
  my $adjacency = delete($params{'adjacency'}) || 'any';
  my $graph_maker = delete($params{'graph_maker'}) || \&_default_graph_maker;

  # this not documented yet ...
  my $vertex_names = delete($params{'vertex_names'}) || 'integer';
  my $vertex_name_func = $vertex_names{$vertex_names}
    || croak "Unrecognised vertex_names: ",$vertex_names;

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

  {
    my $name = "Hanoi $discs";
    if ($spindles != 3) {
      $name .= " Discs, $spindles Spindles";
    }
    if ($adjacency ne 'any') {
      $name .= ", \u$adjacency";
    }
    $graph->set_graph_attribute (name => $name);
  }

  my $offset_limit;
  if ($adjacency eq 'any' || $adjacency eq 'star') {
    $offset_limit = $spindles - 1;
  } elsif ($adjacency eq 'cyclic' || $adjacency eq 'linear') {
    $offset_limit = 1;
  } else {
    croak "Unrecognised adjacency: ",$adjacency;
  }
  my $directed = $graph->is_directed;
  ### $directed
  ### $offset_limit

  my @t = (0) x $discs;
  $graph->add_vertex($vertex_name_func->(\@t, $spindles)); # in case discs=0

 T: for (;;) {
    my $v = $vertex_name_func->(\@t, $spindles);

    my $seen_count = 0;
    my @seen;
    foreach my $pos (reverse 0 .. $#t) {
      my $from_digit = $t[$pos];
      next if $seen[$from_digit];
      $seen[$from_digit] = 1;
      next if $from_digit && $adjacency eq 'star';

      foreach my $offset (1 .. $offset_limit) {
        my $to_digit = $from_digit + $offset;
        if ($adjacency eq 'cyclic') {
          $to_digit %= $spindles;
        } else {
          last if $to_digit >= $spindles;
        }
        next if $seen[$to_digit];  # smaller disc on other spindle

        my @t2 = @t;
        $t2[$pos] = $to_digit;
        my $v2 = $vertex_name_func->(\@t2, $spindles);
        $graph->add_edge($v, $v2);
        if ($directed) { $graph->add_edge($v2, $v); }
        ### edge: "pos=$pos @t to @t2"
      }
    }

    # increment t ...
    foreach my $pos (reverse 0 .. $#t) {
      next T if ++$t[$pos] < $spindles;
      $t[$pos] = 0;
    }
    last; # no more @t configurations
  }
  return $graph;





  # # smallest disc $t2[-1] moves to either other spindle
  # foreach (1, 2) {
  #   $t2[-1]++;
  #   $t2[-1] %= 3;
  #   if ($directed || $t2[-1] > $t[-1]) {
  #     my $v2 = $vertex_name_func->(\@t2, $spindles);
  #     ### smallest disc: "$v to $v2"
  #     $graph->add_edge($v, $v2);
  #   }
  # }
  #
  # # on the spindles without the smallest disc, can move the smaller of
  # # their two top discs
  # for (my $pos = $#t-1; $pos >= 0; $pos--) {
  #   if ($t[$pos] != $t[-1]) {
  #     @t2 = @t;
  #     $t2[$pos]++;
  #     $t2[$pos] %= 3;
  #     if ($t2[$pos] == $t[-1]) {
  #       $t2[$pos]++;
  #       $t2[$pos] %= 3;
  #     }
  #     if ($directed || $t2[$pos] > $t[$pos]) {
  #       my $v2 = $vertex_name_func->(\@t2, $spindles);
  #       ### second disc: "$v to $v2"
  #       $graph->add_edge($v, $v2);
  #     }
  #     last;
  #   }
  # }
  #

  # # done in integers
  # if (0) {
  #   my $v_max = 3**$discs - 1;
  #   my $vpad_max = 3**($discs-1) - 1;
  #   ### $discs
  #   ### $v_max
  #   ### $vpad_max
  #
  #   foreach my $v (0 .. $v_max) {
  #     my $low = $v % 3;
  #     ### $v
  #
  #     foreach my $inc (1, 2) {
  #       ### $low
  #       ### $inc
  #       my $other = ($low + $inc) % 3;
  #       {
  #         my $v2 = $v - $low + $other;
  #         if ($directed || $v2 > $v) {
  #           ### smallest disc: "$v to $v2"
  #           $graph->add_edge($v, $v2);
  #         }
  #       }
  #
  #       ### $low
  #       ### $other
  #       my $pad = ($low - $inc) % 3;
  #       my $mod = 3;
  #       my $rem = $low;
  #       foreach (1 .. $discs) {
  #         $mod *= 3;
  #         $rem = 3*$rem + $low;
  #         my $got = $v % $mod;
  #         ### $mod
  #         ### $rem
  #         ### $got
  #         if ($got != $rem) {
  #           my $v2 = $v - $got + ((2*$got - $rem) % $mod);
  #           if ($directed || $v2 > $v) {
  #             ### second smallest: "$v to $v2"
  #             $graph->add_edge($v, $v2);
  #           }
  #           last;
  #         }
  #       }
  #
  #       # my $pad = ($low - $inc) % 3;
  #       # ### $other
  #       # ### $pad
  #       #
  #       # my $vpad = $v;
  #       # for (;;) {
  #       #   ### at: "vpad=$vpad  v2=$v2"
  #       #   last if $vpad >= $vpad_max || $v2 >= $vpad_max;
  #       #   $vpad = 3*$vpad + $pad;
  #       #   $v2   = 3*$v2 + $pad;
  #       #   if ($directed || $v2 > $vpad) {
  #       #     ### second smallest: "$vpad to $v2"
  #       #   }
  #       #     $graph->add_edge($vpad, $v2);
  #       # }
  #     }
  #   }
  # }
  #
  # return $graph;
}

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

__END__