Permutations..?? 2

[travs69]

I'm not sure if this is considered a permutation or not.

I'm looking to find every combination of a..z,0..9 X wide.
so 2 wide would start like
a a
a b
a c
and end up like
z y
z z

3 wide would be
a a a
a a b
a a c
etc etc..

All the permutations I have found just go as wide as the available char's.

Right now I have something like this hard coded, but I really want something that can just take a var for how wide it should be.

 for $fl (a..z,0..9){
 for my $sl (a..z,0..9){
  for my $kl (a..z,0..9){
   print "$fl $sl $kl\n";
}}}

Thanks in advance as always.

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Travis - Those who say it cannot be done are usually interrupted by someone else doing it; Give the wrong symptoms, get the wrong solutions;

 

[MillerH]

Hi Travs69,

Fun problem.

There are of course serious methods to solve this using simple recursion, but one fun method is to use the euclidean and convert a simple iterator to base 36. Of course, the serious limitation of this method is that you have to worry about the maximum integer. On my system, 9 letters is the last one that worked, but of course you can get more using bignum if you're cool sacrificing performance.

use strict;

my @letters = ('a'..'z',0..9);

my $count = 2;

for my $num (0 .. @letters ** $count - 1) {
	my @set;

	# Euclidean Algorithm Fun.
	for my $i (1..$count) {
		my $r = $num % @letters;
		$num = ($num - $r) / @letters;
		unshift @set, $letters[$r];
	}
	
	print "@set\n";
}

- Miller

 

[MillerH]

And another way is to still use base 36, but to keep track of the digits as you go. This removes the 9 element limitation. You can test this by reducing your character set to just a..b and trying to do 11 elements.

use strict;

my @letters = ('a'..'z',0..9);

my $count = 3;

my @num = (0) x $count;

while (@num == $count) {
	my @set = reverse @letters[@num];
	
	print "@set\n";
	
	# Increment
	$num[0]++;
	for my $i (0..$#num) {
		if ($num[$i] == @letters) {
			$num[$i] = 0;
			$num[$i+1]++;
		} else {
			last;
		}
	}
}

Note that in both of these examples I've kept the order for the permutations as you originally described, but you can simplify the logic a little bit of the order doesn't matter.

- Miller

 

[MillerH]

And yet another way using Math::Combinatorics[/LINK]. It's out of order, but it works.

use Math::Combinatorics;

use strict;

my @letters = ('a'..'z',0..9);

my $count = 3;

my $o = Math::Combinatorics->new(
	count => $count,
	data => [@letters],
	frequency => [($count) x @letters],
);

while ( my @x = $o->next_multiset ) {
	my $p = Math::Combinatorics->new(
		data => \@x,
		frequency => [(1) x @x],
	);
	while ( my @y = $p->next_string ) {
		print "@y\n";
	}
}

- Miller

 

[travs69]

Wow.. thanks for the help.. order doesn't matter as long as they all get covered. I'll play with these and report back

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Travis - Those who say it cannot be done are usually interrupted by someone else doing it; Give the wrong symptoms, get the wrong solutions;

 

[prex1]

On my machine, the first version by MillerH, with [tt]$count=5[/tt], but only calculating, not displaying, the results, takes 300 seconds or 5 minutes. The second version takes half that time, or about 2.5 minutes. Didn't try the third version, but should be longer.
The following code is similar in the principle to the second version, but stores the indices of the chars in [tt]@combi[/tt], instead of the chars themselves, and handles the incremental procedure by means of a [tt]while[/tt] loop, not in an array of indices, such as [tt]@num[/tt].
It takes 15 seconds, one tenth the second version above!

use strict;
my @letters=('a'..'z',0..9);
my $letter_count=$#letters;
my $count=5;
my $count_minus_one=$count-1;
my @combi=(0) x $count;
my $loc;
MAIN: while(1){
  $loc=$count_minus_one;
  while(++$combi[$loc]>$letter_count){
    $combi[$loc--]=0;
    last MAIN if $loc<0;
  }
  for(@combi){print $letters[$_]}print"\n";
}

Franco

http://www.xcalcs.com

: Online engineering calculations

http://www.megamag.it

: Magnetic brakes for fun rides

http://www.levitans.com

: Air bearing pads

 

[prex1]

A correction: the line starting with [tt]for(@combi)...[/tt] should be placed before the inner [tt]while[/tt] loop, otherwise the very first combination is lost.

Franco

http://www.xcalcs.com

: Online engineering calculations

http://www.megamag.it

: Magnetic brakes for fun rides

http://www.levitans.com

: Air bearing pads

 

[MillerH]

Needlessly returning to this post. I believe that my favorite solution to this is probably a combination of my 2nd along with some of the enhancements proposed by prex1. Nice one mate.

my @letters = (0..9,'a'..'z');
my $count = 3;

my @num = (0) x $count;

MAIN: while (1) {
	my @set = @letters[@num];

	print "@set\n";

	# Increment
	my $i = $#num;
	while (++$num[$i] == @letters) {
		$num[$i--] = 0;
		last MAIN if $i < 0;
	}
}

However, I just came by a solution that would enable us to do this using a regular expression instead. Not sure what purpose it serves, other than just being neat. So take from it whatever you will:

my @letters = ('a'..'z',0..9);
my $count = 3;

my $str = $letters[0] x $count;

my %trans = map {@letters[$_,$_+1]} (0..$#letters);
$trans{$letters[-1]} = join '', @letters[1,0];

while ($count == length $str) {
	print "$str\n";
	
	$str =~ s{([@letters])($letters[-1]*)$}{
		$trans{$1} . $letters[0] x length($2)
	}e;
}

- Miller