#!/usr/bin/perl
use strict;
use warnings;
my ( $target, @treasures, $calls );
$target = 5;
@treasures = ( 50, 2, 4, 3, 1, 2, 4, 8 );
print "Looking for numbers that add up to target: $target...\n";
print <<__OUT__;
Solution: @{ try_treasures( \@treasures, $target ) || 'none?' }
Calls: $calls
__OUT__
sub try_treasures
{
my ( $treasures, $target ) = @_;
my @legit_treasures = grep { $_ <= $target } @$treasures; # save some cycles
# try each number, with all others
for ( my $i = 0; $i < @legit_treasures; $i++ )
{
my $add_this = $legit_treasures[ $i ];
my @to_these = @legit_treasures;
splice @to_these, $i, 1; # every number except the one we're working with
my $attempt = try_bucket( [], $target, [ $add_this, @to_these ] );
return $attempt if $attempt; # when everything adds up perfectly in sequence
for ( my $j = 0; $j < @to_these; $j++ ) # ...when everything does not
{
my @try_without = @to_these;
# start trying combinations of numbers while sequentially omitting
# ones that didn't work before
splice @try_without, $j, 1;
my $attempt = try_bucket( [], $target, [ $add_this, @try_without ] );
return $attempt if $attempt;
}
}
}
sub try_bucket
{
$calls++;
my ( $bucket, $target, $choices ) = @_;
return undef unless @$choices;
push @$bucket, shift @$choices;
# calculate sum of all numbers in the bucket, unless there's only one
my $bucket_sum = @$bucket == 1 ? $bucket->[0] : add_these( @$bucket );
if ( $bucket_sum == $target )
{
return $bucket;
}
elsif ( $bucket_sum < $target )
{
return try_bucket( $bucket, $target, $choices );
}
}
sub add_these
{
my @add_these = @_;
my $total = 0;
print qq(Adding up [ @{[ join ' + ', @add_these ]} ] = );
for my $this_one ( @add_these ) { $total += $this_one }
print qq{$total\n};
return $total;
}