'depth n' combinations of a sequence of numbers

R

Rainer Weikusat

For some rather weird problem, I needed a way to generate an ordered
list of all pairs which can be formed from the sequence 0, 1, 2, ... 31.
I figured that it should be possible to write a recursive function
taking a 'ring size' (32 in this case) and a 'depth' (2) argument which
would return a generator cycling through all pairs, with the
function generating the generator being capable of returning a working
result for any combination of size and depth. This turned out to be
amazingly more complicated than I originally thought. The result I came
up with is

---------
sub ring
{
my $size = $_[0];
my $cur;

$cur = -1;
return sub {
return $cur = ($cur + 1) % $size;
}
}

sub rings
{
my ($size, $depth) = @_;
my ($cur, $ring_next, $tail, $last_t0);

$ring_next = ring($size);
return $ring_next if $depth == 1;

$last_t0 = $cur = -1;
$tail = rings($size, $depth - 1);

return sub {
my @tail;

@tail = $tail->();
$cur = $ring_next->() if !$tail[0] && $last_t0;
$last_t0 = $tail[0];

return ($cur, @tail);
};
}

my $r = rings(32, 2);

print(join(',', $r->()), "\n") for 0 .. 1023;
 
G

gamo

El 12/11/13 00:21, Rainer Weikusat escribió:
Are there other possibilities?
Click to expand...
Did you considered using Algorithm::Combinatorics?
It's written in C, with no recursion and based in the literature.
It claims to be efficient, and as far as I tested it is i.e. it
takes the same time to generate all the permutations that the circular
permutations, proportionally.

Best regards
 
C

Charles DeRykus

For some rather weird problem, I needed a way to generate an ordered
list of all pairs which can be formed from the sequence 0, 1, 2, ... 31.
I figured that it should be possible to write a recursive function
taking a 'ring size' (32 in this case) and a 'depth' (2) argument which
would return a generator cycling through all pairs, with the
function generating the generator being capable of returning a working
result for any combination of size and depth. This turned out to be
amazingly more complicated than I originally thought. The result I came
up with is

---------
sub ring
{
my $size = $_[0];
my $cur;

$cur = -1;
return sub {
return $cur = ($cur + 1) % $size;
}
}

sub rings
{
my ($size, $depth) = @_;
my ($cur, $ring_next, $tail, $last_t0);

$ring_next = ring($size);
return $ring_next if $depth == 1;

$last_t0 = $cur = -1;
$tail = rings($size, $depth - 1);

return sub {
my @tail;

@tail = $tail->();
$cur = $ring_next->() if !$tail[0] && $last_t0;
$last_t0 = $tail[0];

return ($cur, @tail);
};
}

my $r = rings(32, 2);

print(join(',', $r->()), "\n") for 0 .. 1023;
Click to expand...


perl -E 'use constant PERM => join ",",0..31;say join "\n",
glob "{@{[PERM]}},{@{[PERM]}}"'
 
B

Bo Lindbergh

For some rather weird problem, I needed a way to generate an ordered
list of all pairs which can be formed from the sequence 0, 1, 2, ... 31.
I figured that it should be possible to write a recursive function
taking a 'ring size' (32 in this case) and a 'depth' (2) argument which
would return a generator cycling through all pairs, with the
function generating the generator being capable of returning a working
result for any combination of size and depth. This turned out to be
amazingly more complicated than I originally thought.
Click to expand...
Are there other possibilities?
Click to expand...

Since Perl has arrays, iteration is simpler than recursion for this problem.

sub rings
{
my($size,@values);

$size=int(shift(@_));
@values=(0) x shift(@_);
sub
{
my(@result);

@result=@values;
$_=($_+1)%$size and last for reverse @values;
@result;
};
}

Or, as stated elsewhere in this thread, use Algorithm::Combinatorics.


/Bo Lindbergh
 
R

Rainer Weikusat

Bo Lindbergh said:
Since Perl has arrays, iteration is simpler than recursion for this
problem.
Click to expand...

Sorry but this was not a "Help me! I'm lost!" question. I was
specifically looking for a recursive solution.
sub rings
{
my($size,@values);

$size=int(shift(@_));
@values=(0) x shift(@_);
sub
{
my(@result);

@result=@values;
$_=($_+1)%$size and last for reverse @values;
@result;
};
}
Click to expand...

There are some things about this code I really dislike, eg, the $size =
int(shift(@_)) instead of the equivalent $size = $_[0]. Also, you're not
treating the initial state specially despite it is special which means
the code has to do an intermediate copy of the result array. But the
for-loop is decidedly a good idea. Combining some parts of both leads to

----------
sub rings
{
my ($size, @tuple);

$size = $_[0];
@tuple = (-1) x $_[1];

return sub {
$_ = ($_ + 1) % $size and last for reverse(@tuple);
return @tuple;
}
}
----------

Which is what I will likely actually use.
Or, as stated elsewhere in this thread, use Algorithm::Combinatorics.
Click to expand...

I understand that "download shit from the internet" (and stitch that
together by applied ingenuity aka 'bizarre workarounds nobody
understands') is some people's natural first reaction to any programming
problem and I won't begrudge them the (commercial) successes they
achieve in this way with "our free software who runs your company",
however, I don't care about that because I know that I will have to
maintain this 'shit' at some point in time and fixing bugs in
unfamiliar code takes longer than writing code in many cases (I don't do
"fire, bill got paid, anything else not my problem, forget" jobs).

Since the same people usually can't stop showing off their impressive
downloading skills, I've instructed my newsreader to stop them for me
:).
 
R

Rainer Weikusat

Charles DeRykus said:
For some rather weird problem, I needed a way to generate an ordered
list of all pairs which can be formed from the sequence 0, 1, 2, ... 31.
I figured that it should be possible to write a recursive function
Click to expand...
[...]
Are there other possibilities?
Click to expand...


perl -E 'use constant PERM => join ",",0..31;say join "\n",
glob "{@{[PERM]}},{@{[PERM]}}"'
Click to expand...

Again, I wanted a recursive solution. But this is nevertheless a neat
idea. In somewhat demystified from, it looks like this:

perl -E 'say(join("\n", glob(sprintf("{%s},{%s}", (join(",", 0 .. 31)) x 2))))'

which is based on using so-called 'brace expansion' to create a
cartesian product (is this the right term?) of n sets. The drawback
would be that this is a rather memory intense process which means that

perl -E 'say(join("\n", glob(sprintf("{%s},{%s},{%s},{%s},{%s}", (join(",", 0 .. 31)) x 5))))'

pushes the computer where I ran this (512M) into thrashing while the
equivalent, array-based routine I posted in the other reply produces the
result set with constant memory usage in about 5s (as do the other two,
albeit they take somewhat longer).
 
C

Charlton Wilbur

RW> There are some things about this code I really dislike, eg, the
RW> $size = int(shift(@_)) instead of the equivalent $size =
RW> $_[0].

Those are not, strictly speaking, equivalent.

Charlton
 
G

George Mpouras

# I hope this is fancy enough for you !

my $iterator = CodeGen();


print $iterator->();
print $iterator->();

while (my $res = $iterator->()) {print $res}




sub CodeGen
{
my ($i,$j)=(0,0);

sub
{
$i++;
if ($i>31){$i=0;$j++}
if ($j>31){return undef}
return "$i,$j\n"
}
}
 
R

Rainer Weikusat

George Mpouras said:
# I hope this is fancy enough for you !

my $iterator = CodeGen();
[...]

sub CodeGen
{
my ($i,$j)=(0,0);

sub
{
$i++;
if ($i>31){$i=0;$j++}
if ($j>31){return undef}
return "$i,$j\n"
}
}
Click to expand...

This starts with 1, 0 and not with 0, 0. It doesn't return a list. And
it doesn't cycle. Something simple which works (as intended) just for pairs from 0
... 31 could be

sub gen
{
use integer;
my $x = -1;

return sub {
++$x;
return ($x / 32, $x % 32);
};
}

or

sub gen
{
use integer;
my $x = -1;
sub { (++$x / 32, $x % 32) }
}

[Compared with the overhead of the function call, the time needed for
the divisions is probably a negligible quantity]
 
T

Tim McDaniel

RW> There are some things about this code I really dislike, eg, the
RW> $size = int(shift(@_)) instead of the equivalent $size =
RW> $_[0].

Those are not, strictly speaking, equivalent.
Click to expand...

I was about to kvetch about that, but in this particular context,
there was no need for the two places of shifting @_. That is, I'm
sure he knows that; he just expressed himself a bit unclearly.
 
R

Rainer Weikusat

Charlton Wilbur said:
RW> There are some things about this code I really dislike, eg, the
RW> $size = int(shift(@_)) instead of the equivalent $size =
RW> $_[0].

Those are not, strictly speaking, equivalent.
Click to expand...

In the given context,

,----
| sub rings
| {
| my($size,@values);
|
| $size=int(shift(@_));
| @values=(0) x shift(@_);
| sub
| {
| my(@result);
|
| @result=@values;
| $_=($_+1)%$size and last for reverse @values;
| @result;
| };
| }
`----

they were 'mostly' equivalent: Technically, the first shift is needed,
because otherwise, the second shift will return the wrong argument. But
since @_ isn't accessed anymore after the second shift, the first can be
replaced with $_[0] and the second with $_[1] which is (IMHO) clearer
because there's no point in shifting @_. This would turn the

$size = int(shift(@_))

into

$size = int($_[0])

If the value of $size is <= UV_MAX, $x % $size == $x % int($size),
example of the other case (on a 32-bit system):

[rw@sable]~#perl -e '$a = 2**33; $b = 2**32 + 1.3; print($a % $b, " ", $a % int($b), "\n")'
4294967294.7 4294967295

but practically, that's outside of the domain of 'sensible' $size
values.

Nevertheless, I didn't know that about the latter.
 
J

James

Using "glob" as suggested by DeRykus, for list [$p..$q] and depth $d,

use Data::Dump qw(dump);
($p, $q, $d) = @ARGV;
$x = join ",", $p..$q;

dump run($x,$d);

sub run {
my ($T, $d) = @_;
if ($d == 1) {
glob "{@{[$T]}}";
} else {
$T = join ",", run($T, --$d);
glob "{@{[$x]}}_{@{[$T]}}";
}
}

James
 
G

gamo

El 15/11/13 02:06, James escribió:
Using "glob" as suggested by DeRykus, for list [$p..$q] and depth $d,

use Data::Dump qw(dump);
($p, $q, $d) = @ARGV;
$x = join ",", $p..$q;

dump run($x,$d);

sub run {
my ($T, $d) = @_;
if ($d == 1) {
glob "{@{[$T]}}";
} else {
$T = join ",", run($T, --$d);
glob "{@{[$x]}}_{@{[$T]}}";
}
}

James
Click to expand...

I'm afraid this has to be parsed and that delays the final result.

Here is a comparison of methods:

Brute force method takes 0.000116 s.
Intelligent method takes 0.001029 s.
Reiner #a gen() takes 0.000337 s. (requires finish)
Reiner #b rings() takes 0.000573 s. (requires finish)
James glob method takes 0.00066 s. and bad return, to be parsed

Then, and in counter-intuitive results, the best method to do
variations_with_repetition of order 2 in a short list is:

@data = 0..31;

for $i (@data){
for $j (@data){
push @results, ($i,$j);
}
}


which I call it the "brute force" approach. It's simpler, more
agile, in a task that it's not very sensitive a priori by the
upper bound of only 1 milisecond.

Best regards
 
J

James

El 15/11/13 02:06, James escribió:
Using "glob" as suggested by DeRykus, for list [$p..$q] and depth $d,
use Data::Dump qw(dump);
Click to expand...
($p, $q, $d) = @ARGV;
Click to expand...
$x = join ",", $p..$q;

dump run($x,$d);

sub run {
Click to expand...
my ($T, $d) = @_;
Click to expand...
if ($d == 1) {
Click to expand...
glob "{@{[$T]}}";
Click to expand...
} else {
Click to expand...
$T = join ",", run($T, --$d);
Click to expand...
glob "{@{[$x]}}_{@{[$T]}}";
}
Click to expand...
}
Click to expand...
James
Click to expand...
Click to expand...



I'm afraid this has to be parsed and that delays the final result.



Here is a comparison of methods:



Brute force method takes 0.000116 s.

Intelligent method takes 0.001029 s.

Reiner #a gen() takes 0.000337 s. (requires finish)

Reiner #b rings() takes 0.000573 s. (requires finish)

James glob method takes 0.00066 s. and bad return, to be parsed



Then, and in counter-intuitive results, the best method to do

variations_with_repetition of order 2 in a short list is:



@data = 0..31;



for $i (@data){

for $j (@data){

push @results, ($i,$j);

}

}





which I call it the "brute force" approach. It's simpler, more

agile, in a task that it's not very sensitive a priori by the

upper bound of only 1 milisecond.



Best regards
Click to expand...

Have you tried benchmark for depth 3 or more?

Regards,
James
 
R

Rainer Weikusat

gamo said:
El 15/11/13 02:06, James escribió:
[...]

I'm afraid this has to be parsed and that delays the final result.

Here is a comparison of methods:

Brute force method takes 0.000116 s.
Intelligent method takes 0.001029 s.
Reiner #a gen() takes 0.000337 s. (requires finish)
Reiner #b rings() takes 0.000573 s. (requires finish)
James glob method takes 0.00066 s. and bad return, to be parsed

Then, and in counter-intuitive results, the best method to do
variations_with_repetition of order 2 in a short list is:

@data = 0..31;

for $i (@data){
for $j (@data){
push @results, ($i,$j);
}
}


which I call it the "brute force" approach.
Click to expand...

This is not a generator, it is certainly not a generator constructed by
a recursive function and it doesn't even create pairs, just a flat list
of numbers. Considering this, something which is going to be a hell lot
faster and also doesn't work would be

perl -e ';'
 
G

gamo

El 18/11/13 21:12, James escribió:
Have you tried benchmark for depth 3 or more?
Click to expand...

No, but I tried now. Let's say the order of the variations is 4, higher
enough to not to try to loop over @data. Then, the number of variations
with repetition is 32**4. I stored in an array all the variations from
the literature method (module in C) and the Rainer's method. It takes
a decent size to not to try with 5 at home. Timing is 1.157 sec. for the
classical method and 0.819 for the Rainer's method, which suggest
that is a good method. But at end of the Rainer's array (stopped at
++$count == 32**4) I saw an anomaly: the quad 31 31 31 31 is repeated
in 32**4-1 and 32**4. The output in the classic method is correct:
31 31 31 30 and 31 31 31 31. So, I don't know what to say. I need to
check later.

Best regards
 
G

gamo

El 19/11/13 02:50, gamo escribió:
El 18/11/13 21:12, James escribió:

No, but I tried now. Let's say the order of the variations is 4, higher
enough to not to try to loop over @data. Then, the number of variations
with repetition is 32**4. I stored in an array all the variations from
the literature method (module in C) and the Rainer's method. It takes
a decent size to not to try with 5 at home. Timing is 1.157 sec. for the
classical method and 0.819 for the Rainer's method, which suggest
that is a good method. But at end of the Rainer's array (stopped at
++$count == 32**4) I saw an anomaly: the quad 31 31 31 31 is repeated
in 32**4-1 and 32**4. The output in the classic method is correct:
31 31 31 30 and 31 31 31 31. So, I don't know what to say. I need to
check later.

Best regards
Click to expand...

Oops! It's my fault. I pushed two times the @tuple.
Sorry.

So, the Rainer's method appears to be very good.

Good night
 
G

gamo

El 18/11/13 21:30, Rainer Weikusat escribió:
This is not a generator, it is certainly not a generator constructed by
a recursive function and it doesn't even create pairs, just a flat list
of numbers. Considering this, something which is going to be a hell lot
faster and also doesn't work would be

perl -e ';'
Click to expand...
Well in fact, running perl to do nothing could take 2 miliseconds, where
generating the list of variations takes 1.

Jokes and "negation mode" apart, if you have the list of pairs of
variations you could cycle over it as free as you want, one by one,
by steps, take random pairs, etc. You know perfectly this, and I
know that you know.

Best regards
 

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

Similar Threads

building generators in Perl 1
Recursive generator for combinations of a multiset? 0
Regex testing and UTF8 awarenes or Regex and numeric pattern matching 2
Calculate rang and derang of ordering of subsets 0
Calculate rang and derang of ordering of subsets 1
multinomial combinations 0
How can I get my menu inside of a menu to function properly? 1
How to multiply two matrices of size in using inline assembly in C++ 3

Members online

Total: 61 (members: 2, guests: 59)
Robots: 404

Forum statistics

Threads
473,968
Messages
2,570,154
Members
46,702
Latest member
LukasConde

Latest Threads

Top