How to generate this list?

B

Bryan

If I have the following:

4 A's, 2 B's, 1 C, 3 D's

What's the best way to create a list of -all- the possible combinations
of these letters?

Thanks!
 
V

Vlad Tepes

* Bryan said:
If I have the following:

4 A's, 2 B's, 1 C, 3 D's

What's the best way to create a list of -all- the possible combinations
of these letters?

Maybe you could use this? (untested, this'll be a long list...)

#!/usr/bin/perl
use strict;
use warnings;
use Algorithm::permute;

my $p = new Algorithm::permute([ split //, "AAAABBCDDD" ]);
while (my @res = $p->next) {
print join("", @res), "\n";
}

--
(,_ ,_, _,)
/|\`\._( )_./'/|\
· · \/ L /\ D · ·
/__|.-'`-\_/-`'-.|__\
`·..·´¯`·..·´¯`·..·´¯`·..·´¯`·..·´¯`·..·´¯`·.. ` " `
 
J

John W. Krahn

Bryan said:
If I have the following:

4 A's, 2 B's, 1 C, 3 D's

What's the best way to create a list of -all- the possible combinations
of these letters?

I don't know if this is the best way but:

my @array = qw/ A A A A B B C D D D /;

print "$_\n" for glob "{@{[ join ',', @array ]}}" x @array;


:)

John
 
V

Vlad Tepes

* Abigail said:
// > What's the best way to create a list of -all- the possible
// > combinations of these letters?
//
// Maybe you could use this? (untested, this'll be a long list...)
//
// #!/usr/bin/perl
// use strict;
// use warnings;
// use Algorithm::permute;
//
// my $p = new Algorithm::permute([ split //, "AAAABBCDDD" ]);
// while (my @res = $p->next) {
// print join("", @res), "\n";
// }


That will do 3628800 iterations, but there are only 12600 different
permutations.

You're right. I need to check up on my statistics. If all ten
characters had been unique, my solution would have be correct and
give 10! = 3628800 combinations. Here, however, the number of
different combinations are (as you say):

10! 5 * 6 * 7 * 8 * 9 * 10
----------------- = ------------------------ = 12600
4! * 2! * 1! * 3! 2 * 6

It doesn't look like Algorithm::permute is best way of creating
these combinations.
--
(,_ ,_, _,)
/|\`\._( )_./'/|\
· · \/ L /\ D · ·
/__|.-'`-\_/-`'-.|__\
`·..·´¯`·..·´¯`·..·´¯`·..·´¯`·..·´¯`·..·´¯`·.. ` " `
 
J

John W. Krahn

Mike said:
John W. Krahn said:
I don't know if this is the best way but:

my @array = qw/ A A A A B B C D D D /;

print "$_\n" for glob "{@{[ join ',', @array ]}}" x @array;

I don't know why, but on my Win2000 box this gives
the error:
Unmatched right square bracket at . . . line 6, at end of line.

I sure don't see that:

use strict;
use warnings;

y @array = qw/ A A A A B B C D D D /;

print "$_\n" for glob "{@{[ join ',', @array ]}}" x @array;

You didn't copy it correctly. What you have is the translation operator
y@@@ followed by 'array ]}}" x @array;'. Change "y @array" to "my
@array".


John
 
R

Roy Johnson

John W. Krahn said:
I don't know if this is the best way but:

my @array = qw/ A A A A B B C D D D /;

print "$_\n" for glob "{@{[ join ',', @array ]}}" x @array;

Would you explain the magic?
 
R

Roy Johnson

Bryan said:
If I have the following:

4 A's, 2 B's, 1 C, 3 D's

What's the best way to create a list of -all- the possible combinations
of these letters?

Thanks!

I don't know that there's a "best" way, but here's *a* way. The
recursion gets a bit costly, so I shortened the string some.

use strict;
use warnings;

my @array = split(//, 'AAABBCDD');

sub bucketize {
my %buckets;
$buckets{$_}++ for (@_);
return %buckets;
}

sub permute {
my %buckets = @_;
my @rlist = (); # list of arefs
my $bucket_found = 0;
for my $head (sort keys %buckets) {
next unless $buckets{$head} > 0;
$bucket_found = 1;
# Use $head as the first, and prepend it onto
# the permutations of all the others
--$buckets{$head};
# stick $head on the front of each ref'd array
foreach my $ar (permute(%buckets)) {
push @rlist, "$head$ar";
}
++$buckets{$head};
}
$bucket_found or @rlist = ('');
return @rlist;
}

for (permute bucketize @array) {
print "$_\n";
}
 
J

John W. Krahn

Roy said:
John W. Krahn said:
I don't know if this is the best way but:

my @array = qw/ A A A A B B C D D D /;

print "$_\n" for glob "{@{[ join ',', @array ]}}" x @array;

Would you explain the magic?

glob uses the comma separated list in braces as alternatives in the
result.

$ perl -le'print for glob "{AB,CD}XY"'
ABXY
CDXY
$ perl -le'print for glob "{A,B}{C,D}XY"'
ACXY
ADXY
BCXY
BDXY

So it passes a string of all the alternatives to glob which creates a
list of the alternatives.

print "$_\n" for glob
"{A,A,A,A,B,B,C,D,D,D}{A,A,A,A,B,B,C,D,D,D}{A,A,A,A,B,B,C,D,D,D}{A,A,A,A,B,B,C,D,D,D}{A,A,A,A,B,B,C,D,D,D}{A,A,A,A,B,B,C,D,D,D}{A,A,A,A,B,B,C,D,D,D}{A,A,A,A,B,B,C,D,D,D}{A,A,A,A,B,B,C,D,D,D}{A,A,A,A,B,B,C,D,D,D}";



John
 
C

Charles DeRykus

...
my @array = qw/ A A A A B B C D D D /;

print "$_\n" for glob "{@{[ join ',', @array ]}}" x @array;

:)

I don't know why, but on my Win2000 box this gives
the error:
Unmatched right square bracket at . . . line 6, at end of line.

I sure don't see that:

C:\>perl -e "my @array = qw/ A A A A B B C D D D /;print qq($_\n) for glob qq(@{
[ join ',',@array ]}) x @array"
A,A,A,A,B,B,C,D,D,DA,A,A,A,B,B,C,D,D,DA,A,A,A,B,B,C,D,D,DA,A,A,A,B,B,C,D,D,DA,A,
A,A,B,B,C,D,D,DA,A,A,A,B,B,C,D,D,DA,A,A,A,B,B,C,D,D,DA,A,A,A,B,B,C,D,D,DA,A,A,A,
B,B,C,D,D,DA,A,A,A,B,B,C,D,D,D

C:\>


hth,
 
R

Roy Johnson

John W. Krahn said:
my @array = qw/ A A A A B B C D D D /;

print "$_\n" for glob "{@{[ join ',', @array ]}}" x @array;

Would you explain the magic?

glob uses the comma separated list in braces as alternatives in the
result.

The snag is that it puts out every string of the length of the array
that can be made with any of the letters. e.g., DDDDDDDDDD is the last
string out. You could filter the results by comparing the results to
the original array, though:

#untested
my $arstr = join('', sort @array);
for (glob "{@{[ join ',', @array ]}}" x @array) {
print "$_\n" if $arstr eq join('', sort (split '', $_));
}
 
D

David Combs

Roy said:
John W. Krahn said:
I don't know if this is the best way but:

my @array = qw/ A A A A B B C D D D /;

print "$_\n" for glob "{@{[ join ',', @array ]}}" x @array;

Would you explain the magic?

glob uses the comma separated list in braces as alternatives in the
result.

$ perl -le'print for glob "{AB,CD}XY"'
ABXY
CDXY
$ perl -le'print for glob "{A,B}{C,D}XY"'
ACXY
ADXY
BCXY
BDXY

So it passes a string of all the alternatives to glob which creates a
list of the alternatives.

Yes, the clever curly-bracket notation from csh -- forms
the cartesian product.

Also works if they're *nested*.

Now this, for John, Abigail, MJD, etc:

"YOUR TASK, MR. PHELPS, IS TO PROGRAM THAT CSH ALGORITHM"

How about an efficient algorithm on doing that?

(I once saw a 5-liner in ML that did it, but what
with the redefined-operators and other clever tricks in
that particular program, I had no idea how it worked -- still
don't. (don't even have a copy -- drat!) )

Perhaps first show it in some algol-like notation --
then, I suppose, in perl, with it's fancy data-structures,
maps, greps, etc.

THANKS!

David
 
J

James E Keenan

David Combs said:
[snip]
Now this, for John, Abigail, MJD, etc:

"YOUR TASK, MR. PHELPS, IS TO PROGRAM THAT CSH ALGORITHM"

How about an efficient algorithm on doing that?
Hey, David, instead of always asking these guys to write some Perl, why
don't *you* do that?
 
A

Anno Siegel

David Combs said:
Roy said:
"John W. Krahn" <[email protected]> wrote in message
I don't know if this is the best way but:

my @array = qw/ A A A A B B C D D D /;

print "$_\n" for glob "{@{[ join ',', @array ]}}" x @array;

Would you explain the magic?

glob uses the comma separated list in braces as alternatives in the
result.

$ perl -le'print for glob "{AB,CD}XY"'
ABXY
CDXY
$ perl -le'print for glob "{A,B}{C,D}XY"'
ACXY
ADXY
BCXY
BDXY

So it passes a string of all the alternatives to glob which creates a
list of the alternatives.

Yes, the clever curly-bracket notation from csh -- forms
the cartesian product.

Also works if they're *nested*.

Now this, for John, Abigail, MJD, etc:

"YOUR TASK, MR. PHELPS, IS TO PROGRAM THAT CSH ALGORITHM"

How about an efficient algorithm on doing that?

(I once saw a 5-liner in ML that did it, but what
with the redefined-operators and other clever tricks in
that particular program, I had no idea how it worked -- still
don't. (don't even have a copy -- drat!) )

Perhaps first show it in some algol-like notation --
then, I suppose, in perl, with it's fancy data-structures,
maps, greps, etc.

It isn't that hard. First write a procedure that does the product
of two factors (given as arrayrefs):

sub combine_two {
my ( $l1, $l2) = @_;
map { my $first = $_;
map "$first$_", @$l2;
} @$l1;
}

Then set up recursion to do it for any number of factors:

sub combine {
if ( @_ ) {
my $l = shift;
combine_two( $l, [ combine( @_)]);
} else {
('');
}
}

Anno
 
D

David Combs

David Combs said:
[snip]
Now this, for John, Abigail, MJD, etc:

"YOUR TASK, MR. PHELPS, IS TO PROGRAM THAT CSH ALGORITHM"

How about an efficient algorithm on doing that?
Hey, David, instead of always asking these guys to write some Perl, why
don't *you* do that?

If I knew how, I'd have done it a long time ago.

The recursions, the several levels and "directions"
of them, quickly overwhelmed my weak brain.

Heck, I couldn't even write down how I'd do
it *by hand*, that expansion.

Heck, I've never been able to figure out how
to generate simple one-level "combinations",
except maybe by representing it by a bit-pattern,
and brute-force generate via for-loop all the
integers 1..<num-items>, converting that to
binary, and outputting whatever's got a 1-bit.

DFS trees I can do, likewise BFS, but applying
it to the csh-curly-bracket-generator-problem,
nested and all -- too much to hold in my head.

Sorry.

David
 
M

Mark Jason Dominus

Yes, the clever curly-bracket notation from csh -- forms
the cartesian product.

Also works if they're *nested*.

Now this, for John, Abigail, MJD, etc:

"YOUR TASK, MR. PHELPS, IS TO PROGRAM THAT CSH ALGORITHM"

How about an efficient algorithm on doing that?

Funny you should mention that, because I was using that as a basic
example of a 'Cartesian product' in chapter VII of my book
(http://perl.plover.com/book/chap07.html) so I was planning to write
that anyway. In fact, I thought I had written it already, but if I
did I can't find it. I think the delay was occasioned by the fact
that I thought of two or three different ways to do it, but I wasn't
sure which one I liked best.

I do have analogous code which takes a regular expression and
generates a list of all the strings that will match the regex. This
includes your problem as a sub-case, because the regex might be

/^(A|B)(C|D)XY$/

which is equivalent to the "{A,B}{C,D}XY" example you have above, only
with different notation.

Note that when each pair of curly braces contains only a finite number
of alternatives, the problem is quite easy, because you can generate
the result with what is esentially a set of nested 'for' loops. For
example, when the expression to expand is

foo{x,y,z}{1,2,3}.txt

you want to execute some code that is equivalent to

for $a ('x', 'y', 'z') {
for $b (1, 2, 3) {
# do something with "foo$a$b.txt"
}
}

The problem becomes much more interesting when when one or more of the
sets of alternatives mught be infinite. In that case the 'nested for
loop' approach no longer works. Suppose the expression to expand is

foo{a,b,c,...,z,aa,ab,ac,...}{1,2,3,...}.txt

Then the analogous 'for' loops are

for $a ('a', 'b', 'c', ..., 'z', 'aa', 'ab', ...) {
for $b (1, 2, 3, ...) {
# do something with "foo$a$b.txt"
}
}

but, because the inner loop is infinite, the program never gets to the
second iteration of the outer loop, and so only produces strings that
begin with "fooa". So you need a different (and more complicated)
strategy if any of the alternatives might contain infinite sets.

Anyway, the problem in the finite case is not that hard, and I am sure
you would be able to solve it if you put your mind to do it. I would
suggest that you first try to solve the problem for the case where the
string contains only one curly-brace expression. That will give you
code that takes a string and eliminates a single set of curly braces
from it, yielding a list of strings. Once you do that, it's easy to
deal with many sets of curly braces: just call your one-curly-brace
handler repeatedly to eliminate one set of curly braces after another.
 
B

Ben Morrow

The problem becomes much more interesting when when one or more of the
sets of alternatives mught be infinite. In that case the 'nested for
loop' approach no longer works. Suppose the expression to expand is

foo{a,b,c,...,z,aa,ab,ac,...}{1,2,3,...}.txt

Then the analogous 'for' loops are

for $a ('a', 'b', 'c', ..., 'z', 'aa', 'ab', ...) {
for $b (1, 2, 3, ...) {
# do something with "foo$a$b.txt"
}
}

but, because the inner loop is infinite, the program never gets to the
second iteration of the outer loop, and so only produces strings that
begin with "fooa". So you need a different (and more complicated)
strategy if any of the alternatives might contain infinite sets.

This is of course equivalent to the problem of enumerating the
rationals, which was solved IIRC by Cantor... :)

Ben
 
M

Mark Jason Dominus

This is of course equivalent to the problem of enumerating the
rationals, which was solved IIRC by Cantor... :)

In some sense, although I don't think he ever left any compilable code.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Members online

Forum statistics

Threads
473,744
Messages
2,569,482
Members
44,901
Latest member
Noble71S45

Latest Threads

Top