use strict; use warnings; use feature qw( say ); use Algorithm::Loops qw( NestedLoops ); use Math::Combinatorics qw( combine ); use Sort::Key qw( rukeysort ); # Optional. my @strings = qw( a?1 a?2 a%3 b?2 b?3 b%5 c%4 c%5 c?6 d%2 ); my @mandatory_types = qw( a? b% c? ); my $n = 4; $n -= @mandatory_types; # ( [ "a?1", "a?", 1 ], ... ) my @split_strings = map { [ /^((.+)(\d+))\z/a ] } @strings; my %by_weight; for ( @split_strings ) { push @{ $by_weight{ $_->[2] } }, $_; } my @mandatory_lists = map { my $type = $_; [ grep { $_->[1] eq $type } @split_strings ] } @mandatory_types; my @loops; for my $list ( @mandatory_lists ) { push @loops, sub { my %seen_weights = map { $_->[2] => 1 } @_; return [ grep { !$seen_weights{ $_->[2] } } @$list ]; }; } my $mandatory_iter = NestedLoops( \@loops ); while ( my @mandatory_picks = $mandatory_iter->() ) { my %seen_weights = map { $_->[2] => 1 } @mandatory_picks; my @buckets = map { $by_weight{ $_ } } grep { !$seen_weights{ $_ } } keys( %by_weight ); my $bucket_iter = Math::Combinatorics->new( count => $n, data => \@buckets, ); while ( my @bucket_picks = $bucket_iter->next_combination() ) { my $other_iter = NestedLoops( \@bucket_picks ); while ( my @other_picks = $other_iter->() ) { say join ",", map { $_->[0] } rukeysort { $_->[2] } @mandatory_picks, @other_picks; } } } #### c?6,b%5,a?2,a?1 c?6,b%5,b?2,a?1 c?6,b%5,d%2,a?1 c?6,b%5,a%3,a?1 c?6,b%5,b?3,a?1 c?6,b%5,c%4,a?1 c?6,b%5,a%3,a?2 c?6,b%5,b?3,a?2 c?6,b%5,c%4,a?2 c?6,b%5,a?2,a?1 #### my @strings = qw( a?1 a?2 a%3 b?2 b?3 b%5 c%4 c%5 c?6 d%2 a?7 c?7 ); my @mandatory_types = qw( a? b% c? ); # ^^^^^^^ my $n = 5; # ^ #### a?7,c?6,b%5,a%3,a?1 a?7,c?6,b%5,b?3,a?1 c?7,c?6,b%5,a%3,a?1 c?7,c?6,b%5,b?3,a?1 a?7,c?6,b%5,a?2,a?1 a?7,c?6,b%5,b?2,a?1 a?7,c?6,b%5,d%2,a?1 c?7,c?6,b%5,a?2,a?1 c?7,c?6,b%5,b?2,a?1 c?7,c?6,b%5,d%2,a?1 a?7,c?6,b%5,c%4,a?1 c?7,c?6,b%5,c%4,a?1 c?6,b%5,a%3,a?2,a?1 c?6,b%5,a%3,b?2,a?1 c?6,b%5,a%3,d%2,a?1 c?6,b%5,b?3,a?2,a?1 c?6,b%5,b?3,b?2,a?1 c?6,b%5,b?3,d%2,a?1 c?6,b%5,c%4,a%3,a?1 c?6,b%5,c%4,b?3,a?1 c?6,b%5,c%4,a?2,a?1 c?6,b%5,c%4,b?2,a?1 c?6,b%5,c%4,d%2,a?1 c?7,c?6,b%5,c%4,a?1 c?7,b%5,c%4,a%3,a?1 c?7,b%5,c%4,b?3,a?1 c?7,b%5,c%4,a?2,a?1 c?7,b%5,c%4,b?2,a?1 c?7,b%5,c%4,d%2,a?1 c?7,c?6,b%5,a%3,a?1 c?7,c?6,b%5,b?3,a?1 c?7,c?6,b%5,a?2,a?1 c?7,c?6,b%5,b?2,a?1 c?7,c?6,b%5,d%2,a?1 c?7,b%5,a%3,a?2,a?1 c?7,b%5,a%3,b?2,a?1 c?7,b%5,a%3,d%2,a?1 c?7,b%5,b?3,a?2,a?1 c?7,b%5,b?3,b?2,a?1 c?7,b%5,b?3,d%2,a?1 c?6,b%5,c%4,a?2,a?1 a?7,c?6,b%5,c%4,a?2 c?7,c?6,b%5,c%4,a?2 c?6,b%5,c%4,a%3,a?2 c?6,b%5,c%4,b?3,a?2 a?7,c?6,b%5,a?2,a?1 c?7,c?6,b%5,a?2,a?1 c?6,b%5,a%3,a?2,a?1 c?6,b%5,b?3,a?2,a?1 a?7,c?6,b%5,a%3,a?2 a?7,c?6,b%5,b?3,a?2 c?7,c?6,b%5,a%3,a?2 c?7,c?6,b%5,b?3,a?2 c?7,b%5,a%3,a?2,a?1 c?7,b%5,b?3,a?2,a?1 c?7,b%5,c%4,a?2,a?1 c?7,c?6,b%5,a?2,a?1 c?7,b%5,c%4,a%3,a?2 c?7,b%5,c%4,b?3,a?2 c?7,c?6,b%5,a%3,a?2 c?7,c?6,b%5,b?3,a?2 c?7,c?6,b%5,c%4,a?2 a?7,c?6,b%5,c%4,a?2 a?7,c?6,b%5,c%4,b?2 a?7,c?6,b%5,c%4,d%2 a?7,c?6,b%5,a%3,a?2 a?7,c?6,b%5,b?3,a?2 a?7,c?6,b%5,a%3,b?2 a?7,c?6,b%5,b?3,b?2 a?7,c?6,b%5,a%3,d%2 a?7,c?6,b%5,b?3,d%2 a?7,c?6,b%5,a?2,a?1 a?7,c?6,b%5,b?2,a?1 a?7,c?6,b%5,d%2,a?1 a?7,c?6,b%5,c%4,a%3 a?7,c?6,b%5,c%4,b?3 a?7,c?6,b%5,c%4,a?1 a?7,c?6,b%5,a%3,a?1 a?7,c?6,b%5,b?3,a?1