in reply to amount permutations

gr0k,
I was all impressed that I got over a 300% increase from your original code which should get better with larger combinations sets until I saw kvale's code. Here it is anyway: 
#!/usr/bin/perl
use strict;
use warnings;
use Algorithm::Loops 'NestedLoops';

my ($val, $sum, $count, $key);
my (%seen, %uniq);
my (@matches, @key);

my ($amount, $depth) = (28, 7);
my $RS = [10, 5, 13, 3, 15, 1, 4];

NestedLoops( [ ( $RS ) x $depth ], { OnlyWhen => \&ok }, sub{} );

print_results();

sub ok {
    $count++;
    %uniq = ();
    $sum = 0;
    for $val ( @_ ) {
        $uniq{$val}++;
        return 0 if $uniq{$val} > 1;
        $sum += $val;
        return 0 if $sum > $amount;
    }
    $key = join " " , sort {$b <=> $a} @_;
    return 0 if exists $seen{$key};
    $seen{$key} = undef;
    push @matches , $key if $sum == $amount;
}

sub print_results {
    my %convert;
    @convert{ @$RS } = 'A' .. 'H';
    print "Searched $count combinations...\n";
    for my $match ( @matches ) {
        for my $value ( split " " , $match ) {
            print "$convert{$value} ";
        }
        print "\n";
    }
}

[download]
Cheers - L~R

Replies are listed 'Best First'.
Re: Re: amount permutations
by gr0k (Novice) on Mar 04, 2004 at 19:55 UTC
    This does appear to be a bit faster and looks like it will work for what we need it to do. Have to do a bit more testing with our data. One question though, I notice it produces a lot more combinations, any idea how I could calculate the number of combinations from the number of records searched? That way I could output some status information to let them know how far they are into the search. Thanks!
[reply]
      gr0k,
      Well, it depends on what answer you want. To be honest you were checking the same number of combinations as me. The difference is you weren't counting ones that you discarded. There was effort spent on determing they could be discarded though - which is why I included all combinations.

      In order to make my $count look like your count will require more work - and make the process slower. If you want - you can change the position of $count++ to after the for loop. There you would only be counting the number of combinations that did not have a duplicate number in them and whose combined value was not greater than the target sum.

      I would recommend in the real problem removing all candidates that were already larger than the target number.

      Cheers - L~R
[reply]
Re: Re: amount permutations
by gr0k (Novice) on Mar 04, 2004 at 22:27 UTC
    Upon closer inspection your code has a bug where it would eliminate two checks with the same amount since you're checking an array of amounts. :( I'll have to modify it to allow that and run some tests to see if it will still result in a speed increase...
[reply]
      gr0k,
      You will have to explain what you mean or else explain what you think the following is doing: 
      @_ == keys %{@_,reverse @_}

      [download]
      Besides - this is a terribly inefficient way to go about what you are trying to do as explained by everyone. I was just showing ways to improve the efficiency of what you already had.

      L~R

[reply]
[d/l]
[reply]

        Ah, what I meant was, with your code, if there were two checks with the same amount. ie. A = 10 and G = 10, it wouldn't match a search for amount 20 since your array would look like this: my $RS = [10, 5, 13, 3, 15, 1, 4, 10]; And your line here return 0 if $uniq{$val} > 1; would ignore it thinking it was a duplicate in the sequence.

        It was a very slight change to pass the array of unique checks instead of the array of amounts and then:

        $sum += $rs_ref->{$check}->{'amount'};

[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom