http://paperlined.org/dev/src/pl/kenken/findpatterns.pl
#!/usr/bin/perl
# find all the "easy patterns" in KenKen
#
# This is an interesting algorithm. The most efficient way to implement it is an "inverted form" of
# they way you'd initially think of implementing it.
use strict;
use warnings;
use Data::Dumper;
use List::Util qw[reduce max min];
my $num_cells = 3;
my $max_val = 5;
my $max_dupes = 2;
# $num_cells $max_dupes
# ---------- -----------
# 2 1
# 3 ("L") 2
# 3 (line) 1
# 4 (square) 2
# 4 (line) 1
# 5 (squarish) 3
# 5 ("L") 2
# 5 (line) 1
my @digits = map {1} 1..$num_cells;
my %results;
#for (1..20) {
# #getnext_incrementonly(\@digits);
# #getnext_inorder(\@digits);
# getnext_inorder_compact(\@digits);
# defined(getnext_inorder_noalldupes(\@digits)) or last;
# print_digits(\@digits);
#}
#exit;
# compute the "rainbow table"
if ($max_dupes < $num_cells) {
getnext_inorder_nodupes(\@digits); # the first sequence (1,1,1,...) is ALWAYS an all-dupe one
}
for (;;) {
record_result('add', [@digits], reduce {$a + $b} @digits);
record_result('mul', [@digits], reduce {$a * $b} @digits);
if ($num_cells == 2) {
record_result('sub', [@digits], max(@digits) - min(@digits));
record_result('div', [@digits], max(@digits) / min(@digits));
}
#defined(getnext_inorder_compact(\@digits)) or last;
defined(getnext_inorder_nodupes(\@digits)) or last;
}
# display all outputs that have only a single possible input
my %ops = qw[
add +
sub -
mul *
div /
];
foreach my $operation (qw[add sub mul div]) {
foreach my $result (sort {$a <=> $b} keys %{$results{$operation}}) {
next unless ($results{$operation}{$result}{numfound} == 1);
my %dups;
foreach my $d (@{$results{$operation}{$result}{lastfound}}) {
$dups{$d}++;
}
my $any_dups = max(values %dups);
next if ($any_dups > $max_dupes);
#printf "%-10s %s %s\n",
printf "%-10s %s\n",
"$result " . $ops{$operation},
join(" ", @{$results{$operation}{$result}{lastfound}}),
($any_dups > 1 ? "*" : "");
}
}
#print Dumper \%results;
#print Dumper $results{add};
sub record_result {
my $operation = shift;
my $digits = shift;
my $result = shift;
return unless (int($result) == $result); # ignore fractional results
return unless ($result >= 1); # ignore non-positive results
$results{$operation}{$result}{numfound}++;
$results{$operation}{$result}{lastfound} = $digits;
}
# simply increment the digits
sub getnext_incrementonly {
my $digits = shift;
if (scalar(grep {$_ != $max_val} @$digits) == 0) {
# we hit the end
return undef;
}
my $carry = 1;
for (my $ctr=$#digits; $ctr>=0; $ctr--) {
($digits->[$ctr], $carry) = half_adder($digits->[$ctr], $carry);
last if ($carry == 0);
}
return $digits; # we modified it in-place
}
# http://en.wikipedia.org/wiki/Adder_(electronics)#Half_adder
sub half_adder {
my ($a, $b) = @_;
my $sum = $a + $b - 1;
my $result = ($sum % $max_val) + 1;
my $carry = $result < $sum ? 1 : 0;
return ($result, $carry);
}
# keep incrementing until we find the next sequence that's in-order
sub getnext_inorder {
my $digits = shift;
for (;;) {
defined(getnext_incrementonly($digits))
or return undef;
my $last = 0;
my $good = 1;
foreach (@$digits) {
if ($_ < $last) {
$good = 0;
last;
}
$last = $_;
}
return $digits if ($good);
}
}
# an optimized version of getnext_incrementonly + getnext_inorder
sub getnext_inorder_compact {
my $digits = shift;
if (scalar(grep {$_ != $max_val} @$digits) == 0) {
# we hit the end
return undef;
}
for (my $ctr=$#digits; $ctr>=0; $ctr--) {
$digits->[$ctr]++;
if ($digits->[$ctr] <= $max_val) {
# if we've no longer on the last digit, then propogate this value all the way down to the last digit
for (my $ctr2=$#digits; $ctr2>$ctr; $ctr2--) {
$digits->[$ctr2] = $digits->[$ctr];
}
last;
} else {
# Else we move on, and increment the next digit on the next iteration of the loop.
# The reason we don't have to "fix" this digit is because we're going to overwrite it as
# soon as the next digit is incremented.
}
}
return $digits; # we modified it in-place
}
# same as getnext_inorder(), but guarantees that no duplicate-numbers will occur
sub getnext_inorder_nodupes {
my $digits = shift;
for (;;) {
defined(getnext_inorder_compact($digits))
or return undef;
my @count;
my $good = 1;
foreach my $digit (@$digits) {
if (++$count[$digit] > $max_dupes) {
$good = 0;
last;
}
}
if ($good) {
return $digits;
}
}
}
# same as getnext_inorder(), but guarantees that no instances where EVERY digit is exactly the same, will occur
sub getnext_inorder_noalldupes {
my $digits = shift;
for (;;) {
defined(getnext_inorder_compact($digits))
or return undef;
foreach my $d (@$digits) {
if ($d != $digits[0]) {
return $digits;
}
}
}
}
sub print_digits {
my $digits = shift;
print join(" ", @$digits), "\n";
}
Generated by GNU enscript 1.6.4.