#!/usr/bin/perl

use strict;
use warnings;

my ( $target, @treasures, $calls );

$target = 5;
@treasures = ( 50, 2, 4, 3, 1, 2, 4, 8 );

sub find_share
{
   my ( $target, $treasures, $share, $depth ) = @_;

   $depth ||= 0; $depth += 1;
   $share ||= [];

   $calls++;

   printf qq{%-8s Calls: %-5d Depth: %-5d Share: %-10s Target: %-5d Treasures: %-16s ... },
      ( '-' x $depth ) . '>',
      $calls,
      $depth,
      "[ @$share ]",
      $target,
      "[ @$treasures ]";

   print qq{Returning "[]" because target == 0\n\n}
      and return [] if $target == 0;

   print qq{Returning undef because target < 0\n\n}
      and return undef if $target < 0;

   print qq{Returning undef because no treasures remaining\n\n}
      and return undef if @$treasures == 0;

   my ( $first, @rest ) = @$treasures;

   print qq(Putting "$first" into the share, leaving treasures [ @rest ]\n\n);

   my $solution = find_share( $target - $first, \@rest, [ @$share, $first ], $depth );

   print qq(A recursive call at depth @{[ $depth + 1 ]} found that a solution of [ @{[$first,@$solution]} ] adds up to my target of $target at depth $depth\n\n)
      and return [ $first, @$solution ] if $solution;

   print '-' x $depth, '> ',
      qq{Situation failed.  Couldn't hit target.  Omitting treasure [ $first ] and backtracking to target of $target, treasures [ @rest ] at depth $depth\n\n};

   return find_share( $target, \@rest, $share, $depth );
}

print qq<Solution: @{ find_share( $target, \@treasures ) }>;

exit;


##</code><code>##

->       Calls: 1     Depth: 1     Share: [  ]       Target: 5     Treasures: [ 50 2 4 3 1 2 4 8 ] ... Putting "50" into the share, leaving treasures [ 2 4 3 1 2 4 8 ]

-->      Calls: 2     Depth: 2     Share: [ 50 ]     Target: -45   Treasures: [ 2 4 3 1 2 4 8 ] ... Returning undef because target < 0

-> Situation failed.  Couldn't hit target.  Omitting treasure [ 50 ] and backtracking to target of 5, treasures [ 2 4 3 1 2 4 8 ] at depth 1

-->      Calls: 3     Depth: 2     Share: [  ]       Target: 5     Treasures: [ 2 4 3 1 2 4 8 ] ... Putting "2" into the share, leaving treasures [ 4 3 1 2 4 8 ]

--->     Calls: 4     Depth: 3     Share: [ 2 ]      Target: 3     Treasures: [ 4 3 1 2 4 8 ]  ... Putting "4" into the share, leaving treasures [ 3 1 2 4 8 ]

---->    Calls: 5     Depth: 4     Share: [ 2 4 ]    Target: -1    Treasures: [ 3 1 2 4 8 ]    ... Returning undef because target < 0

---> Situation failed.  Couldn't hit target.  Omitting treasure [ 4 ] and backtracking to target of 3, treasures [ 3 1 2 4 8 ] at depth 3

---->    Calls: 6     Depth: 4     Share: [ 2 ]      Target: 3     Treasures: [ 3 1 2 4 8 ]    ... Putting "3" into the share, leaving treasures [ 1 2 4 8 ]

----->   Calls: 7     Depth: 5     Share: [ 2 3 ]    Target: 0     Treasures: [ 1 2 4 8 ]      ... Returning "[]" because target == 0

A recursive call at depth 5 found that a solution of [ 3 ] adds up to my target of 3 at depth 4

A recursive call at depth 3 found that a solution of [ 2 3 ] adds up to my target of 5 at depth 2

Solution: 2 3

##</code><code>##

#!/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;
}


##</code><code>##

Looking for numbers that add up to target: 5...
Adding up [ 2 + 4 ] = 6
Adding up [ 2 + 3 ] = 5
Solution: 2 3
Calls: 4