http://qs321.pair.com?node_id=1228541


in reply to Perl ARRAY() result

I cleaned up the code to where it can recurse in a single sub, and a few other tweaks that make it a little faster. Here's a speed comparison:

$ perl ./script
Benchmark: timing 5000 iterations of new, orig...
       new: 11 wallclock secs (10.03 u +  0.00 s = 10.03 CPU) @ 498.50/s (n=5000)
      orig: 11 wallclock secs (10.98 u +  0.00 s = 10.98 CPU) @ 455.37/s (n=5000)
And the code...see the solve2() sub for the cleaned up version. 
#!/usr/bin/perl
use strict;
use warnings;
use Benchmark qw(timethese);

sub solve1 {
    my ( $goal, $elements ) = @_;
    my ( @results, $RecursiveSolve, $nextValue );
    $RecursiveSolve = sub {
        my ( $currentGoal, $included, $index ) = @_;
        for ( ; $index < @$elements ; ++$index ) {
            $nextValue = $elements->[$index];
            if ( $currentGoal > 2 * $nextValue ) {
                $RecursiveSolve->(
                    $currentGoal - $nextValue,
                    [ @$included, $nextValue ],
                    $index + 1
                );
            }
            else {
                if ( $currentGoal == $nextValue ) {
                    push @results, [ @$included, $nextValue ];
                }
                return if $nextValue >= $currentGoal;
            }
        }
    };
    $RecursiveSolve->( $goal, [], 0 );
    undef $RecursiveSolve;    #Avoid memory leak from circular referen
+ce
    return @results;
}

sub solve2 {
    my ( $goal, $list, $index, $inc, $results ) = @_;
    for ( $index .. @$list - 1 ) {
        if ( $goal > 2 * $$list[$_] ) {
            solve2( $goal - $$list[$_],
                $list, $_ + 1, [ @$inc, $$list[$_] ], $results );
        } elsif ( $$list[$_] >  $goal ) {
            return;
        } elsif ( $goal == $$list[$_] ) {
            push @$results, [ @$inc, $$list[$_] ];
            last;
        }
    }
    return @$results;
}

my $goal = 869;
my $tosolve = [15,43,51,56,60,67,122,152,193,204,229,271,293,301];
timethese(
    5000,
    {
        'orig' => sub { solve1( $goal, $tosolve ) },
        'new' => sub { solve2( $goal, $tosolve, 0, [], [] ) }
    }
);
exit; #comment out to see it produces the same result
print "solve2:\n";
for ( solve2( $goal, $tosolve, 0, [], [] ) ) {
    print join( ',', @$_ ), "\n";
}
print "solve1:\n";
for ( solve1( $goal, $tosolve ) ) {
    print join( ',', @$_ ), "\n";
}

[download]

In Section Seekers of Perl Wisdom