#!/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; exit; ##```## -> 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 ##``````## #!/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; } ##``````## Looking for numbers that add up to target: 5... Adding up [ 2 + 4 ] = 6 Adding up [ 2 + 3 ] = 5 Solution: 2 3 Calls: 4 ```