Re: [QUIZ] Perl 'Medium' Quiz of the Whatever #2008-02-28 - Kakuro Digit Sums

Martijn Lievaart <[email protected]> Fri, 07 Mar 2008 09:34:14 +0100
Newsgroups gmane.comp.lang.perl.qotw.discuss
Message-ID <[email protected]>
Premysl Anydot Hruby wrote:
> On (28/02/08 21:40), Shlomi Fish wrote:
>   
>> To: [email protected]
>> From: Shlomi Fish <shlomif-ik1l9ssToec+JF/[email protected]>
>> Subject: [QUIZ] Perl 'Medium' Quiz of the Whatever #2008-02-28 - Kakuro Digit
>> 	Sums
>>
>> IMPORTANT: Please do not post solutions, hints, or other spoilers
>> until at least 60 hours after the date of this message.  Thanks.
>>
>> Kakuro (a.k.a Cross-sums) is a kind of puzzle game:
>>
>> http://en.wikipedia.org/wiki/Kakuro
>>
>> In it, one fills in squares in a crossword-like grid that sum to their sums. 
>> One can fill in the digits from 1 to 9, and no digit can be repeated twice.
>>
>> Your object is to find all posssible combinations for a given sum and a given 
>> number of squares. You'll write a function get_digits_sum($sum, $num_places), 
>> that will return an array reference of array references, each one containing 
>> an possible solution (in ascending order). The solutions themselves should be 
>> in ascending order too, starting from the lowest numbers. Here are some 
>> examples:
>>
>> get_digits_sum(7, 3) => returns [[1,2,4]].
>>
>> get_digits_sum(7, 2) => returns [[1,6],[2,5],[3,4]];
>>
>> The daily puzzle in http://www.kakuro.com/index.php#daily (requires Flash) has 
>> a feature to display the permutations in a similar manner.
>>
>> Regards,
>>
>> 	Shlomi Fish
>>
>>     

[ Haven't got the original mail, so piggying here ]

"Any programming problem can be solved by adding another layer of 
indirection".

Here's my solution. Run this program to produce a program which 
satisfies the requirements. I also expect this solution to be the 
fastest around.... :-)

Regards,
M4


#!/usr/bin/perl

use strict;
use warnings;

sub get_digits_sum {
  my ($sum, $num_places) = @_;
  return [solve($sum, $num_places, 0, 0)];
}

sub solve {
  my ($sum, $places_left, $running, $previous, @partial) = @_;
  return map solve($sum, $places_left-1, $running+$_, $_, @partial, $_),
    ($previous+1..($sum - $running > 9 ? 9 : $sum - $running))
      if $places_left;
  return $sum == $running ? [@partial] : ();
}


print <<'EOT';
#!/usr/bin/perl

use strict;
use warnings;

use Test::More tests => 8;

my %sol = (
EOT

use Data::Dumper;
for my $sum (1..45) {
  print "$sum => {\n";
  for my $places (1..9) {
    my $answer = get_digits_sum($sum, $places);
    if (@$answer) {
      print "  $places => \n";
      my $t = Dumper($answer);
      $t =~ s/\$VAR1\s*=\s*/\t/;
      $t =~ s/;/,/;
      print "$t\n";
    }
  }
  print "},\n\n";
}


print <<'EOT';
);

sub get_digits_sum {
  my ($sum, $num_places) = @_;
  return exists $sol{$sum} && exists $sol{$sum}{$num_places} ?
    $sol{$sum}{$num_places} : [];
}

my @tests = (
         [5,1, [[5]], "5 over 1"],

         [15,1, [], "15 over 1"],

         [3,2, [[1,2]], "3 over 2"],

         [7,3, [[1,2,4]], "7 over 3"],

         [15,5, [[1,2,3,4,5]], "15 over 5"],

         [25,5,
          [
           [1,2,5,8,9],
           [1,2,6,7,9],
           [1,3,4,8,9],
           [1,3,5,7,9],
           [1,3,6,7,8],
           [1,4,5,6,9],
           [1,4,5,7,8],
           [2,3,4,7,9],
           [2,3,5,6,9],
           [2,3,5,7,8],
           [2,4,5,6,8],
           [3,4,5,6,7],
          ],
          "25 over 5",
         ],

         [14,2, [[5,9],[6,8],], "14 over 2",],

         [99,2, [], "99 over 2",],
        );


for (@tests) {
  my ($sum, $digits, @x) = @$_;
  my $got = get_digits_sum($sum, $digits);
  is_deeply($got, @x);
}

EOT