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.