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