#!/usr/bin/perl -w

##  sq1-tables.pl - Print tables of arrangements of 60/30 deg pieces 
##                  in the 'Sqaure 1' puzzle
##
##  Usage:
##    sq1-tables.pl [-html] layer|shape
##

use strict;

my $progname = 'sql-tables.pl';

sub usage {
  my($errmsg) = @_;
  print STDERR<<END;
@{[defined($errmsg) ? "Error - $errmsg\n\n" : '']}Usage:
    $progname [options] <report>

  Print configurations of 60/30-degree pieces in the Square 1 puzzle.
  <report> is one of:
      'layer' -- list canonical layer patterns
      'shape' -- list canonical shapes (ignoring state of middle layer)

  Valid options are:
    -html      * Print output as HTML table rows
                 (Default is to just print as plain text)

END
  exit(1);
}

use Getopt::Long;
my $bigch = 'A';
my $smallch = 'a';
my $bs_perms = { };
my $sizeperm = { };
my $rotsym = { };
my $refsym = { };
my $reflection = { };
my $html = 0;
my $rpt_layer = 0;
my $rpt_shape = 0;

main: {
  my $printHelp = 0;
  usage()
    if (!GetOptions(
      "help|?!" => \$printHelp,
      "html!" => \$html,
    ));

  usage() if ($printHelp);
  usage("No <report> argument specified")
    if (scalar(@ARGV) < 1);
  usage("More than one <report> argument specified")
    if (scalar(@ARGV) > 1);
  my $rpt_type = $ARGV[0];
  if ($rpt_type eq 'layer') {
    $rpt_layer = 1;
  } elsif ($rpt_type eq 'shape') {
    $rpt_shape = 1;
  } else {
    usage("Unknown report type '$rpt_type'");
  }

  make_layers();
  make_shapes();
  exit(0);
}

sub make_layers {
  foreach my $nbig (6,5,4,3,2) {
    my $nsmall = (6 - $nbig) * 2;
    print '-' x 40 . "\nnbig=$nbig, nsmall=$nsmall\n" if ($rpt_layer && !$html);
    my @layerperms;
    my $rotcount = 0;
    my $len = $nbig + $nsmall;
    foreach my $origperm (@{genperms(($bigch x $nbig) . ($smallch x $nsmall))}) {
      my($minperm, $nrot) = minperm($origperm);
      if (!defined($rotsym->{$minperm})) {
        push(@layerperms, $minperm);
        $rotsym->{$minperm} = ($len / $nrot);
        $rotcount += $nrot;
      }
    }
    @layerperms = sort(@layerperms);
    $sizeperm->{$nbig} = [ @layerperms ];
    $rotcount = fmtfrac($rotcount, $len, 1);
    my $id = 1;
    my $nspan = scalar (@layerperms);
    foreach my $perm (sort @layerperms) {
      my $rev = join('', reverse split(//, $perm));
      my($minrev, $nrot) = minperm($rev);
      $reflection->{$perm} = $minrev;
      $refsym->{$perm} = ($minrev eq $perm);
      if ($rpt_layer && $html) {
        print "  <tr>\n";
        if ($id == 1) {
          print "    <td align=center rowspan=$nspan>$nbig</td>\n";
          print "    <td align=center rowspan=$nspan>$nsmall</td>\n";
        }
        print "    <td align=center>$nbig-$id</td>\n";
        print "    <td>$perm</td>\n";
        print "    <td align=center>@{[$refsym->{$perm} ? 'Y' : 'N']}</td>\n";
        print "    <td align=center>@{[$rotsym->{$perm}]}</td>\n";
        print "    <td align=center>@{[fmtfrac(1, $rotsym->{$perm}, 1)]}</td>\n";
        if ($id == 1) {
          print "    <td align=center rowspan=$nspan>$rotcount</td>\n";
        }
        print "  </tr>\n";
      } elsif ($rpt_layer) {
        print "$perm ";
        print ($refsym->{$perm} ? 'Y' : 'N');
        print " " . $rotsym->{$perm};
        print "\n";
      }
      $id++;
    }
  }
}

sub make_shapes {
  my $id = 0;
  my $done = { };
  foreach my $nbigtop (6,5,4) {
    my $nbigbot = 8 - $nbigtop;
    foreach my $topelt (@{$sizeperm->{$nbigtop}}) {
      foreach my $botelt (@{$sizeperm->{$nbigbot}}) {
        my $top = $topelt;
        my $bot = $botelt;
	($top, $bot) = ($bot, $top) if ($top gt $bot);
        my $k = "$top/$bot";
	my $topref = $reflection->{$top};
	my $botref = $reflection->{$bot};
	($topref, $botref) = ($botref, $topref) if ($topref gt $botref);
        my $kref = "$topref/$botref";
	($top, $bot, $k) = ($topref, $botref, $kref) if ($k gt $kref);
        next if (defined($done->{$k}));
	$done->{$k} = 1;
        $id++;
	my $toprot = $rotsym->{$top};
	my $botrot = $rotsym->{$bot};
	my $g2 = ($top eq $bot) ? 'Y' : 'N';
	my $g3 = ($top eq $reflection->{$top} &&
	          $bot eq $reflection->{$bot}) ? 'Y' : 'N';
	my $g4 = ($top eq $reflection->{$bot} &&
	          $bot eq $reflection->{$top}) ? 'Y' : 'N';
	my $g234size = '?';
	my $tbcount = '?';
	if ($rpt_shape) {
	  if ($html) {
            print "<TR><TD>$id</TD><TD>$top</TD><TD align=center>$toprot</TD><TD>$bot</TD><TD align=center>$botrot</TD>\n";
            print "    <TD align=center>$g2</TD><TD align=center>$g3</TD><TD align=center>$g4</TD><td align=right>$g234size</td><td align=right>$tbcount</td></TR>\n";
	  } else {
            print sprintf("%2d  $top [$toprot] / $bot [$botrot]  g2=$g2 g3=$g3 g4=$g4 g234=$g234size tbcount=$tbcount\n", $id);
	  }
	}
      }
    }
  }
}

sub fmtfrac {
  ##  Return formatted $num/$denom
  ##
  my($num, $denom, $vulgar) = @_;
  my $g = gcd($num, $denom);
  $num /= $g;
  $denom /= $g;
  my $whole = int($num / $denom);
  my $rem = $num % $denom;
  my $retval;
  if ($rem == 0) {
    $retval = $whole;
  } else {
    $retval = "$rem/$denom";
    if ($whole > 0) {
      if ($html) {
        $retval = "$num/$denom<br>=&nbsp;$whole&nbsp;&nbsp;$retval"
      } else {
        $retval = "$num/$denom = $whole $retval"
      }
    }
  }
  return $retval;
}

my $perm_cache = { };

sub genperms {
  my ($str) = @_;

  if (!defined($perm_cache->{$str})) {
    ##  Look under canonical sorted string
    ##
    my @chars = split(//, $str);
    $str = join('', sort(@chars));  ##  $str is now sorted
    if (!defined($perm_cache->{$str})) {
      my @uniqs = keys %{{map(($_=>1), @chars)}};
      if (scalar(@uniqs) < 1) {
        $perm_cache->{$str} = [ $str ];
      } else {
        foreach my $uniq_char (sort @uniqs) {
          my $suff = join('', split(/$uniq_char/, $str, 2));
          push(@{$perm_cache->{$str}},
            map("$uniq_char$_", @{genperms($suff)})
          );
        }
      }
    }
  }
  return $perm_cache->{$str};
}

sub minperm {
  my ($orig) = @_;
  my $minperm = $orig;
  my $curr = $orig;
  my $nrot = 0;
  for (;;) {
    $nrot++;
    my ($first, $rest) = ($curr =~ m{^(.)(.*)$});
    $curr = "$rest$first";
    last if ($curr eq $orig);
    $minperm = $curr if ($minperm gt $curr);
  }
  return ($minperm, $nrot);
}

sub gcd {
  my($a,$b) = @_;
  ($a, $b) = ($b, $a) if ($a > $b);
  return $b if ($a == 0);
  return gcd($a, $b % $a);
}