|
Re: Unique Character Combinations
by Roy Johnson (Monsignor) on May 02, 2005 at 14:07 UTC
|
The output order isn't the same, but...
sub comb {
glob(join '', map "{$_,}", @_);
}
See also Re^3: Generating powerset with progressive ordering
Caution: Contents may have been coded under pressure.
| [reply]
[d/l] |
Re: Unique Character Combinations
by thor (Priest) on May 01, 2005 at 23:31 UTC
|
Here it is without the need for a global array and BEGIN block:
use strict;
use warnings;
print join "\n", comb( 'A' .. 'C' );
sub comb {
my @c_out = ();
push @c_out, permute( '', $_, @_ ) for ( 0 .. $#_ );
return @c_out;
}
sub permute {
my @results;
my ( $str, $depth, @chars ) = @_;
if ( !$depth-- ) {
foreach (@chars) {
push @results, $str . $_;
}
}
else {
push @results,
permute( $str . $chars[$_],
$depth, @chars[ ( $_ + 1 ) .. ($#chars) ] )
for ( 0 .. $#chars );
}
return @results;
}
Other clean-up is left as an exercise to the reader. ;)
thor
Feel the white light, the light within
Be your own disciple, fan the sparks of will
For all of us waiting, your kingdom will come
| [reply]
[d/l] |
|
|
sub comb {
map permute( '', $_, @_ ), ( 0 .. $#_ );
}
sub permute {
my ( $str, $depth, @chars ) = @_;
map $str.$_,
$depth
? (map permute( $chars[$_],
$depth-1, @chars[ ( $_ + 1 ) .. ($#chars) ] )
, (0..$#chars))
: @chars;
}
That benchmarks about 10% faster than the original for me, but the powerset code below is 15x faster than either of them.
sub powerset {
my ($car, @cdr) = @_;
my @cdr_powerset = @cdr ? powerset(@cdr) : ();
return
# sort {length $a <=> length $b or $a cmp $b}
($car, map("$car$_", @cdr_powerset), @cdr_powerset);
}
If you include the sort that is currently commented out, the order will be correct, but the performance will degrade, though it is still about 7x faster for A..G. When I increase the range, the advantage for powerset increases. Even with the sort in place, it is 18x faster for A..L (30x without the sort).
Caution: Contents may have been coded under pressure.
| [reply]
[d/l]
[select] |
Re: Unique Character Combinations
by Roy Johnson (Monsignor) on May 03, 2005 at 22:32 UTC
|
A non-recursive solution (benchmarks about half as fast as powerset with sort, somewhat disappointingly). The idea is that, for example, A in generation 1 becomes AB, AC, AD in generation 2. B in generation 1 becomes BC, BD in generation 2. Each entry in a generation is mapped to each of the characters after its last character to create the next generation.
sub comb {
my @alphabet = @_;
my @generation = (['', 0]);
my @return;
while (@generation) {
my @next_generation;
for my $gen (@generation) {
my ($base, $start_at) = @$gen;
for my $i ($start_at..$#alphabet) {
my $new_str = $base.$alphabet[$i];
push @return, $new_str;
push @next_generation, [$new_str, $i+1] if $i < $#alph
+abet;
}
}
@generation = @next_generation;
}
@return;
}
Caution: Contents may have been coded under pressure.
| [reply]
[d/l] |
Re: Unique Character Combinations
by TedPride (Priest) on May 02, 2005 at 17:52 UTC
|
Well, you certainly win the prize for most concise code, and no doubt for speed too. I can't for the life of me figure out how it works, tho. | [reply] |
|
|
I'm guessing that this reply was intended for me, regarding the glob solution. Whenever the subject of combinations comes up, a glob solution usually shows up, and someone who hasn't seen it used that way before is delighted or baffled or both.
As the documentation tells you, glob takes a pattern and expands it into all the filenames that the shell would. Of course, we're not dealing with filenames here, but for alternations ({this,that}), glob doesn't really look at filenames. It just generates all the combinations.
So all I did was construct a glob pattern of {A,}{B,}{C,} etc., and glob came up with the strings that matched. Having the empty string as an alternative (as I did) is legal in globs.
Running a quick benchmark, I find that, including the sort I mention in 453284, glob is about 2.5x as fast as your solution, while powerset is 2x-or-so as fast as the glob.
Caution: Contents may have been coded under pressure.
| [reply]
[d/l]
[select] |
Re: Unique Character Combinations
by TedPride (Priest) on May 02, 2005 at 04:45 UTC
|
Your solution is perhaps more elegant, but it's also less efficient, as data has to be passed back between instances of the function. I tested, and on the call:
my @arr = comb('A'..'R');
my code took approx. 23 seconds, while yours took 30. | [reply]
[d/l] |
|
|
But you can work around this passing a reference to the final array:
use strict;
use warnings;
print join "\n", comb_thormod('A'..'R');
sub comb_thormod {
my $c_out = [];
permute_thormod( '', $_, $c_out, @_ ) for ( 0 .. $#_ );
return @$c_out;
}
sub permute_thormod {
my ( $str, $depth, $c_out, @chars ) = @_;
if ( !$depth-- ) {
foreach (@chars) {
push @$c_out, $str . $_;
}
}
else {
permute_thormod( $str . $chars[$_], $depth, $c_out,
@chars[ ( $_ + 1 ) .. ($#chars) ] )
for ( 0 .. $#chars );
}
}
even if results show your solution is still slightly more efficient (-2% / 5% scissor).
OTOH, I'd still prefer the version without the static variable - should work in a multithreaded environment, at least :)
Flavio (perl -e 'print(scalar(reverse("\nti.xittelop\@oivalf")))')
Don't fool yourself.
| [reply]
[d/l]
[select] |