Sponsoring The Perl Toolchain Summit 2025: Help make this important event another success Learn more

#!/usr/bin/perl -w
# Copyright 2011, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath 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.
#
# Math-PlanePath 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 Math-PlanePath. If not, see <http://www.gnu.org/licenses/>.
# Usage: perl beta-omega-table.pl
#
# Print the state tables used in BetaOmega.pm.
#
# This isn't a thing of beauty. A state incorporates the beta vs omega
# shape and the orientation of that shape as 4 rotations by 90-degrees, a
# transpose swapping X,Y, and a reversal for numbering points the opposite
# way around.
#
# The reversal is only needed for the beta, as noted in the
# Math::PlanePath::BetaOmega POD. For an omega the reverse is the same as
# the forward. make_state() collapses a reverse omega down to corresponding
# plain forward omega.
#
# State values are 0, 4, 8, etc. Having them 4 apart means a base 4 digit
# from N in n_to_xy() can be added state+digit to make an index into the
# tables.
#
# For @max_digit and @min_digit the input is instead 3*3=9 values, and in
# those tables the index is "state*3 + input". 3*state puts states 12
# apart, which is more than the 9 input values needs, but 3*state is a
# little less work in the code than say (state/4)*9 to change from 4-stride
# to exactly 9-stride.
#
use 5.010;
use strict;
use List::Util 'max';
# uncomment this to run the ### lines
#use Smart::Comments;
sub print_table {
my ($name, $aref) = @_;
print "my \@$name = (";
my $entry_width = max (map {length($_//'')} @$aref);
foreach my $i (0 .. $#$aref) {
printf "%*s", $entry_width, $aref->[$i]//'undef';
if ($i == $#$aref) {
print ");\n";
} else {
print ",";
if (($i % 16) == 15
|| ($entry_width >= 3 && ($i % 4) == 3)) {
print "\n ".(" " x length($name));
} elsif (($i % 4) == 3) {
print " ";
}
}
}
}
sub print_table12 {
my ($name, $aref) = @_;
print "my \@$name = (";
my $entry_width = max (map {length($_//'')} @$aref);
foreach my $i (0 .. $#$aref) {
printf "%*s", $entry_width, $aref->[$i]//'undef';
if ($i == $#$aref) {
print ");\n";
} else {
print ",";
if (($i % 12) == 11) {
print "\n ".(" " x length($name));
} elsif (($i % 4) == 3) {
print " ";
}
}
}
}
my @next_state;
my @digit_to_x;
my @digit_to_y;
my @xy_to_digit;
my @min_digit;
my @max_digit;
sub state_string {
my ($state) = @_;
my $digit = $state % 4; $state = int($state/4);
my $transpose = $state % 2; $state = int($state/2);
my $rot = $state % 4; $state = int($state/4);
my $rev = $state % 2; $state = int($state/2);
my $omega = $state % 2; $state = int($state/2);
my $omega_str = ($omega ? 'omega' : 'beta');
return "$omega_str transpose=$transpose rot=$rot rev=$rev";
}
sub make_state {
my ($omega, $rev, $rot, $transpose, $digit) = @_;
if ($omega && $rev) {
$rev = 0;
if ($transpose) {
$rot--;
} else {
$rot++;
}
$transpose ^= 1;
}
$transpose %= 2;
$rev %= 2;
$rot %= 4;
return $digit + 4*($transpose + 2*($rot + 4*($rev + 2*$omega)));
}
foreach my $omega (0, 1) {
foreach my $rev (0, ($omega ? () : (1))) {
foreach my $rot (0, 1, 2, 3) {
foreach my $transpose (0, 1) {
my $state = make_state ($omega, $rev, $rot, $transpose, 0);
### $state
# range 0 [X,_]
# range 1 [X,X]
# range 2 [_,X]
foreach my $xrange (0,1,2) {
foreach my $yrange (0,1,2) {
my $xr = $xrange;
my $yr = $yrange;
my $bits = $xr + 3*$yr; # before transpose etc
if ($rot & 1) {
($xr,$yr) = ($yr,2-$xr);
}
if ($rot & 2) {
$xr = 2-$xr;
$yr = 2-$yr;
}
if ($transpose) {
($xr,$yr) = ($yr,$xr);
}
if ($rev) {
# 2--1
# | |
# 3 0
$xr = 2-$xr;
}
my ($min_digit, $max_digit);
# 1--2
# | |
# 0 3
if ($xr == 0) {
# 0 or 1 only
if ($yr == 0) {
# x,y both low, 0 only
$min_digit = 0;
$max_digit = 0;
} elsif ($yr == 1) {
# y either, 0 or 1
$min_digit = 0;
$max_digit = 1;
} elsif ($yr == 2) {
# y high, 1 only
$min_digit = 1;
$max_digit = 1;
}
} elsif ($xr == 1) {
# x either, any 0,1,2,3
if ($yr == 0) {
# y low, 0 or 3
$min_digit = 0;
$max_digit = 3;
} elsif ($yr == 1) {
# y either, 0,1,2,3
$min_digit = 0;
$max_digit = 3;
} elsif ($yr == 2) {
# y high, 1,2 only
$min_digit = 1;
$max_digit = 2;
}
} else {
# x high, 2 or 3
if ($yr == 0) {
# y low, 3 only
$min_digit = 3;
$max_digit = 3;
} elsif ($yr == 1) {
# y either, 2 or 3
$min_digit = 2;
$max_digit = 3;
} elsif ($yr == 2) {
# y high, 2 only
$min_digit = 2;
$max_digit = 2;
}
}
### range store: $state+$bits
my $key = 3*$state + $bits;
if (defined $min_digit[$key]) {
die "oops min_digit[] already: state=$state bits=$bits value=$min_digit[$state+$bits], new=$min_digit";
}
$min_digit[$key] = $min_digit;
$max_digit[$key] = $max_digit;
}
}
### @min_digit
foreach my $orig_digit (0, 1, 2, 3) {
my $digit = $orig_digit;
if ($rev) {
$digit = 3-$digit;
}
my $xo = 0;
my $yo = 0;
my $new_transpose = $transpose;
my $new_rot = $rot;
my $new_omega = 0;
my $new_rev = $rev;
if ($omega) {
# 1---2
# | |
# --0 3--
$new_omega = 0;
if ($digit == 0) {
$new_transpose = $transpose ^ 1;
if ($transpose) {
$new_rot = $rot + 1;
} else {
$new_rot = $rot - 1;
}
} elsif ($digit == 1) {
$yo = 1;
if ($transpose) {
$new_rot = $rot - 1;
} else {
$new_rot = $rot + 1;
}
} elsif ($digit == 2) {
$xo = 1;
$yo = 1;
$new_transpose = $transpose ^ 1;
$new_rev ^= 1;
} elsif ($digit == 3) {
$xo = 1;
$new_rot = $rot + 2;
$new_rev ^= 1;
}
} else {
# 1---2
# | |
# --0 3
# |
if ($digit == 0) {
$new_transpose = $transpose ^ 1;
if ($transpose) {
$new_rot = $rot + 1;
} else {
$new_rot = $rot - 1;
}
} elsif ($digit == 1) {
$yo = 1;
if ($transpose) {
$new_rot = $rot - 1;
} else {
$new_rot = $rot + 1;
}
} elsif ($digit == 2) {
$xo = 1;
$yo = 1;
$new_transpose = $transpose ^ 1;
$new_rev ^= 1;
} elsif ($digit == 3) {
$xo = 1;
if ($transpose) {
$new_rot = $rot + 1;
} else {
$new_rot = $rot - 1;
}
$new_omega = 1;
}
}
### base: "$xo, $yo"
if ($transpose) {
($xo,$yo) = ($yo,$xo);
}
### transp to: "$xo, $yo"
if ($rot & 2) {
$xo ^= 1;
$yo ^= 1;
}
if ($rot & 1) {
($xo,$yo) = ($yo^1,$xo);
}
### rot to: "$xo, $yo"
$digit_to_x[$state+$orig_digit] = $xo;
$digit_to_y[$state+$orig_digit] = $yo;
$xy_to_digit[$state + $xo*2+$yo] = $orig_digit;
my $next_state = make_state
($new_omega, $new_rev, $new_rot, $new_transpose, 0);
$next_state[$state+$orig_digit] = $next_state;
}
}
}
}
}
### @next_state
### @digit_to_x
### @digit_to_y
### next_state length: 4*(4*2*2 + 4*2)
### next_state length: scalar(@next_state)
my $next_state_size = scalar(@next_state);
my $state_count = $next_state_size/4;
print "# next_state table has $next_state_size entries, is $state_count states\n";
print_table ("next_state", \@next_state);
print_table ("digit_to_x", \@digit_to_x);
print_table ("digit_to_y", \@digit_to_y);
print_table ("xy_to_digit", \@xy_to_digit);
print_table12 ("min_digit", \@min_digit);
print_table12 ("max_digit", \@max_digit);
my $invert_state = make_state (0, # omega
0, # rev
3, # rot
1, # transpose
0); # digit
### $invert_state
print "\n";
{
my @pending_state = (0);
my $count = 0;
my @seen_state;
my $depth = 0;
$seen_state[0] = $depth;
while (@pending_state) {
$depth++;
my @new_pending_state;
foreach my $state (@pending_state) {
$count++;
### consider state: $state
foreach my $digit (0 .. 3) {
my $next_state = $next_state[$state+$digit];
if (! defined $seen_state[$next_state]) {
$seen_state[$next_state] = $depth;
push @new_pending_state, $next_state;
### push: "$next_state depth $depth"
}
}
}
@pending_state = @new_pending_state;
}
for (my $state = 0; $state < @next_state; $state += 4) {
print "# used state $state depth $seen_state[$state]\n";
}
print "used state count $count\n";
}
{
print "\n";
print "initial 0: ",state_string(0),"\n";
print "initial 28: ",state_string(28),"\n";
require Graph::Easy;
my $g = Graph::Easy->new;
for (my $state = 0; $state < scalar(@next_state); $state += 4) {
my $next = $next_state[$state];
$g->add_edge("$state: ".state_string($state),
"$next: ".state_string($next));
}
print $g->as_ascii();
}
exit 0;