«

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!

* Bryan <> (CCLXXIV'th day of year MMIII)

> 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:ermute;

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

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

Bryan wrote:
>
> 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
--
use Perl;
program
fulfillment

* Abigail <> (CCLXXIV'th day of year MMIII)

> // > 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:ermute;
> //
> // my $p = new Algorithm:ermute([ 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:ermute is best way of creating
these combinations.
--
(,_ ,_, _,)
/|\`\._( )_./'/|\
· · \/ L /\ D · ·
/__|.-'`-\_/-`'-.|__\
`·..·´¯`·..·´¯`·..·´¯`·..·´¯`·..·´¯`·..·´¯`·.. ` " `

Mike Flannigan wrote:
>
> "John W. Krahn" wrote:
> >
> > 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
--
use Perl;
program
fulfillment

"John W. Krahn" <> wrote in message news:<>...

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

Bryan <> wrote in message news:<QEDeb.413$ y.com>...
> 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";
}

Roy Johnson wrote:
>
> "John W. Krahn" <> wrote in message news:<>...
>
> > 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
--
use Perl;
program
fulfillment

In article <>,
Mike Flannigan <> wrote:
>
>>...
>> 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,
--
Charles DeRykus

"John W. Krahn" <> wrote in message news:<>...
> > >
> > > 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 '', $_));
}