Well, here's my go. Since I wasn't familiar too with Algorithm::Loops when i started (ive since looked into it) I wrote my own iterator generator. Actually it was the part of this problem I found interesting. Especially as it seems there are tons of modules for producing permutations but none that do choose in a simple way. I guess Algorithm::Loops is the closest, but the notationational requirements seem somewhat clumsy to me. IMO a shortcut for this task would be nice.
After post update: Heh, and now i learn of Math::Combinatorics. Well it was a nice exercise anyway. :-)
use strict; use warnings FATAL => 'all'; use Data::Dumper; # make_choose_iter( $choose, @list ) # ------------------------------------------------------ # Returns an anonymous subroutine to act as an iterator # over the set of combinations, returning each in turn # every time it is called. If the iter is called with an # argument or the list has been exhausted on a previous run # it resets itself and returns undef. # sub make_choose_iter { my ( $choose, @list )= @_; die "Can't do ".(0+@list)." choose ".($choose||0)."\n" if $choose>@list or !@list or !$choose; $choose--; # 1 based number passed in, but need it 0 based # done is used as a flag, and @idx is the first n positions my ( $done, @idx )= ( 0, 0 .. $choose ); return sub { if ( $done || @_ ) { # if we finished the list last call, or they are # forcing a reset via an argument # then we reset everthing and return undef/empty list ($done , @idx)= ( 0, 0 .. $choose ); return; } # we get the apropriate elements of the list for the # current state of @idx. this is what we will return my @ret= @list[@idx]; # assume that this is the last element. $done= 1; # Loop over the elements of @idx from the right # looking for the correct element: # We are simulating the behaviour of N # nested loops. This means we increment the # rightmost element whose increment does not # overflow and whose final value is sufficiently # low that the elements following it can be filled # with its successors without also overflowing for ( my $i= $choose ; $i >= 0 ; $i-- ) { if ( $idx[$i] < $#list && (my $end= $idx[$i] + 1 + $choose - $i) < @list ) { $idx[$i]++; @idx[ $i + 1 .. $choose ]= ( $idx[$i] + 1 .. $end ); $done= 0; last; } } return wantarray ? @ret : \@ret; }; } sub find_lances { my ($mechs,$count,$weight)=@_; my $iter= make_choose_iter( $count, sort { $b->{weight} <=> $a->{weight} } values %$mechs ); my @ret; while (my $items=$iter->()) { my $sum=0; $sum+=$_->{weight} for @$items; if ( $sum <= $weight ) { push @$items,$sum; push @ret,$items; } } return @ret; } my %mechs; while (<DATA>) { chomp; my ($mech,$weight,$clan) = split /\s+/,$_,3; next unless $mech; $mechs{$mech} = { name => $mech, weight => $weight, group => $clan }; } # find all lances with 5 members and 380t weight my @possible_lances = find_lances (\%mechs, 5, 380); print Dumper(\%mechs,\@possible_lances); __DATA__ Flea 20 clan Commando 25 clan UrbanMech 30 clan Hollander 35 clan Jenner 35 clan Raven 35 clan Wolfhound 35 clan Black 50 Hawk clan Hunchback 50 clan Rifleman 60 clan Catapult 65 clan Loki 65 clan Thor 70 clan Mad 75 Cat clan Gargoyle 80 clan Victor 80 clan Zeus 80 clan Longbow 85 clan Warhawk 85 clan Mauler 90 clan Atlas 100 clan
In reply to Re: find combinations (choose)
by demerphq
in thread find combinations
by holli
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |