Your skill will accomplishwhat the force of many cannot PerlMonks

Combinations with constraints

 on Jun 28, 2022 at 17:13 UTC Need Help??

Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

Hi Monks, I am trying to write a function that takes a string argument \$str of the form shown below (letter + weight) and need to generate all combinations with certain restrictions; for example, no repeating numbers. I also need a perlish way to move the letter \$firstLetter with the largest weight into first position. The order of the other substrings do not matter. As a secondary restriction, I also want to ensure that the combination contains the substring \$substring. So, for this particular \$str example, [ c?6, b?2, a%3, a?1] is a valid combination.

Thank you very much for your help

```use strict;
use Math::Combinatorics;

my \$firstLetter="c";
my \$str="a?1,a?2,a%3,b?2,b?3,b%5,c%4,c%5,c?6,d%2";
my \$substring = "a?,b%,c?";

my @combos = Math::Combinatorics::combine(4,split ",",\$str);

foreach my \$combo (@combos) {

## check if numbers are all unique
my \$hash = {};
my (\$count) = grep { ++\$hash->{\$_} > 1 } map { (split '')[2] } @\$c
+ombo;
next if defined \$count;

## place \$firstLetter with largest weight in first position

## ensure that substring strings are contained within the combinat
+ion

}

Replies are listed 'Best First'.
Re: Combinations with constraints
by hv (Parson) on Jun 28, 2022 at 18:52 UTC

Could you clarify? You say the string is of the form "letter + weight", but I'm not sure how to parse the string in that sense. In "a?1", is "a" the letter and "1" the weight? If so, what role does "?" play?

Based on the example \$str and \$substring, I'll treat the first two characters as a notional "token", and say that elements actually consist of a two-character token followed by the numeric weight.

It appears the elements are unique, but neither tokens nor weights have to be.

The \$substring appears to list tokens, and my guess is that by "contained within" you mean that each of the listed tokens must appear as an element of a qualifying combination. Since "substring" usually implies both ordered and consecutive, I've renamed it to \$subset below.

It is not clear whether a qualifying combination can have repeated tokens. For example is (c?6, b%5, a?2, a?1)a valid combination? I've assumed below that it is valid.

Since I've assumed order is not relevant to the qualification criteria, it seems that placing the largest weight first is simply a display requirement.

Based on those assumptions, here's an attempt at some code:

```use strict;
use warnings;
use Math::Combinatorics;
use List::Util qw{ all };

my \$firstLetter = 'c';
my \$str = 'a?1,a?2,a%3,b?2,b?3,b%5,c%4,c%5,c?6,d%2';
my \$subset = 'a?,b%,c?';

print display(\$_, \$firstLetter), "\n"
for grep qualify(\$_, \$subset),
Math::Combinatorics::combine(4,split ",",\$str);

sub qualify {
my(\$combo, \$subset) = @_;

# Check if numbers are all unique, using the "postincrement" trick
my %seen;
\$seen{\$_}++ or return 0 for map substr(\$_, 2), @\$combo;

# Find all the tokens in the combo. If all the ones we need in the
# subset are represented, we're good.
my %token = map +(substr(\$_, 0, 2) => 1), @\$combo;
return all { \$token{\$_} } split /,/, \$subset;
}

sub display {
my(\$combo, \$first) = @_;
# Use a Schwartzian transform over a reverse sort on our
# calculated "firstness weight": -1 for elements with the wrong
# first letter, else the element's weight. sort() is overkill here,
# I'd use a different approach if we were considering larger sets.
return join ',',
map \$_->[0],
sort { \$b->[1] <=> \$a->[1] }
map [ \$_, substr(\$_, 0, 1) eq \$first ? substr(\$_, 2) : -1 ],
@\$combo;
}

This outputs:

```c?6,a?1,a?2,b%5
c?6,a?1,a%3,b%5
c?6,a?1,b?2,b%5
c?6,a?1,b?3,b%5
c?6,c%4,a?1,b%5
c?6,a?1,b%5,d%2
c?6,a?2,a%3,b%5
c?6,a?2,b?3,b%5
c?6,c%4,a?2,b%5

Does that look like the sort of thing you want?

WOW. Thank you for your beautiful solution. Your assumptions are all correct. I wrote a version of it as well, but yours is infinitely more elegant. Thank you!
Re: Combinations with constraints
by tybalt89 (Prior) on Jun 28, 2022 at 21:02 UTC

TMTOWTDI

```#!/usr/bin/perl

use strict; # https://perlmonks.org/?node_id=11145154
use warnings;
use ntheory qw( forcomb );
use List::Util qw( all );

my \$firstLetter = 'c';
my \$str = 'a?1,a?2,a%3,b?2,b?3,b%5,c%4,c%5,c?6,d%2';
my \$subset = 'a?,b%,c?';

my @str = sort { \$b =~ \$firstLetter <=> \$a =~ \$firstLetter or # sort o
+nly once
\$b =~ tr/0-9//cdr <=> \$a =~ tr/0-9//cdr } split /,/, \$str;
forcomb
{
my \$comb = join ',', @str[@_];
\$comb =~ /\b(\d+)\b.*\b\1\b/ or                  # duplicate number
all { \$comb =~ /\Q\$_/ } split /,/, \$subset and # each subset
print "\$comb\n";
} scalar @str, 4;

Outputs:

```c?6,c%4,b%5,a?2
c?6,c%4,b%5,a?1
c?6,b%5,a%3,a?2
c?6,b%5,a%3,a?1
c?6,b%5,b?3,a?2
c?6,b%5,b?3,a?1
c?6,b%5,a?2,a?1
c?6,b%5,b?2,a?1
c?6,b%5,d%2,a?1
Re: Combinations with constraints
by ikegami (Patriarch) on Jun 29, 2022 at 17:21 UTC

Generating all the combinations then filtering out the unneeded ones could take a lot lot lot longer than necessary. This is what the earlier solutions do. However, the following program avoids generating extra combinations.

```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

More interesting test:

```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
Re: Combinations with constraints
by Anonymous Monk on Jun 28, 2022 at 17:18 UTC
Sorry, correction: [ c?6, b%5, a%3, a?1] is a valid combination
> Sorry, correction: [ c?6, b%5, a%3, a?1] is a valid combination

That's wrong

("c?6", "a?1", "a?2", "b%5")

is one, a%3 doesn't fit your substring criteria.

> "a?,b%,c?"

Cheers Rolf
(addicted to the Perl Programming Language :)
Wikisyntax for the Monastery

Thanks for you comment, Rolf! It just has to contain the substring strings. Any additional strings within the combination are fine (they do not have to conform)

Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://11145154]
Approved by LanX
Front-paged by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (3)
As of 2022-08-19 20:49 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?

No recent polls found

Notices?