tall_man has asked for the
wisdom of the Perl Monks concerning the following question:
As a followup to OT: Finding Factor Closest To Square Root and Generating powerset with progressive ordering, I started thinking about the problem: how do you generate the series of numbers composed of a given list of prime factors, where each can be used an unlimited number of times? For example, the factors 2, 3,and 5 produce the infinite list (1,2,3,4,5,6,8,9,10,12...) This is known as the generalized Hamming sequence problem.
I found on the net an elegant solution in Haskell:
{ Merge two sorted lists }
merge (x:xs) (y:ys)
 x < y = x: merge xs (y:ys)
 x > y = y: merge (x:xs) ys
 x == y = x: merge xs ys
merge [] ys = ys
merge xs [] = xs
{ Generic Hamming sequence on a list of factors. }
genHam :: [Integer]>[Integer]
genHam [] = []
genHam (x:xs) = out
where
out = merge ( 1: map (*x) out) (genHam xs)
{ Usage:
take 10 (genHam [2,3,5])
}
The challenge would be to do this in perl. I believe perl6 has or will soon be getting Haskelllike lazy infinite lists. Can it be done in perl5?
Re: Hamming Sequences and Lazy Lists
by thinker (Parson) on Mar 17, 2005 at 08:56 UTC

Hi
You may be interested in this article by our very own dominus which discusses this.
Also of interest may be his recently published book
thinker
 [reply] 
Re: Hamming Sequences and Lazy Lists
by BrowserUk (Pope) on Mar 17, 2005 at 08:34 UTC

This horribly inefficient bruteforce conversion seems like it's getting close, but needs work.
#! perl slw
use strict;
sub merge {
return unless @_ == 2;
return @{ $_[1] } unless @{ $_[0] };
return @{ $_[0] } unless @{ $_[1] };
my( $x, $y ) = ( $_[0][0], $_[1][0] );
return shift @{ $_[0] }, merge( @_ ) if $x < $y;
return shift @{ $_[1] }, merge( @_ ) if $x > $y;
shift @{ $_[0] };
return shift @{ $_[1] }, merge( @_ );
}
my @out;
sub genHam {
return unless @_;
my( $x, @xs ) = @_;
return @out = merge [ 1, map{ $_*$x } @out ], [ genHam( @xs ) ];
}
print join'',genHam 2, 3, 5 for 1..5;
__END__
[ 8:26:05.53] P:\test>440284
1
1235
1234569101525
123456891012151820252730455075125
12345689101215161820242527303640455054607581
+90100125135150225250375625
Examine what is said, not who speaks  Silence betokens consent  Love the truth but pardon error.
Lingua non convalesco, consenesco et abolesco.
Rule 1 has a caveat!  Who broke the cabal?
 [reply] [d/l] 

BrowserUk,
I don't follow the results? It is my understanding that the results should be the multiples of all 3 factors merged with duplicates removed. Since the list is infinite, the list should be lazy only calculating what is needed. See Re: Hamming Sequences and Lazy Lists for my understanding an implementation of the problem.
Update: I still don't understand your output, but my understanding of the Hamming Sequence is wrong. I was so focused on lazy evaluation that I misunderstood "how do you generate the series of numbers composed of a given list of prime factors, where each can be used an unlimited number of times?" To me, that meant any positive multiple of any factor was valid.
 [reply] 
Re: Hamming Sequences and Lazy Lists
by kvale (Monsignor) on Mar 17, 2005 at 08:56 UTC

Here is a solution that is not lazy and not quite as efficient as the Haskell version, but is simple:
use Algorithm::Loops qw(NestedLoops);
use List::Util qw(reduce);
my @factors = (2,3,5); # Assmue increasing sequence
my $seq_len = 10;
my $depth = int( $seq_len ** (1/@factors)) + 1;
my @seq;
my @list= NestedLoops(
[ ( [ 0..$depth ] ) x @factors ],
sub { push @seq, reduce {$a * $b}
map {$factors[$_]**$_[$_]} 0..$#_;},
);
my @sorted = sort {$a <=> $b} @seq;
print "$sorted[$_] " foreach 0..$seq_len1;
Update: Improved the depth bound.
 [reply] [d/l] 

kvale,
I don't think this is right. Shouldn't the result include all factors of all 3 lists merged minus duplicates? If you change $seq_len = 23 for instance, why is 16 for instance missing from the results? See Re: Hamming Sequences and Lazy Lists for my understanding and implementation of the problem.
 [reply] 

Given the OP's reference to the factors of a composite number thread, I interpreted 'use an unlimited number of times" to mean create numbers of the form
2**$i * 3**$j * 5**$k
with $i, $j, and $k as integers >= 0. The program I wrote generalizes this by handling an arbitrary number of arbitrary factors.
I don't know what you mean by 'factors of 3 lists', but if I guess that each list is a multiple of each factor, then I think that must not be right. The example given by the OP had 1 as the first member, but 1 is not any multiple 2, 3, or 5.
That said, there is an error my program :) 16 should be in the list even in my understanding of the problem. The mistake with is that the bound on the $depth I set was too low. In the harsh light of the morning, a safe bound is
my $depth = $seq_len;
But I am sure this bound can be made tighter, right after I have some tea :)
 [reply] [d/l] [select] 

Re: Hamming Sequences and Lazy Lists (non'functional' iterator)
by tye (Sage) on Mar 17, 2005 at 17:22 UTC

This goes through the same steps as the functional version but doesn't use much functional programming (and so is probably more efficient):
#!/usr/bin/perl w
use strict;
sub gen {
my %list;
@list{@_}= map [1], 0..$#_;
return sub {
my @next;
for my $m ( keys %list ) {
if( ! @next  $list{$m}[0] < $list{$next[0]}[0] ) {
@next= $m;
} elsif( $list{$m}[0] == $list{$next[0]}[0] ) {
push @next, $m;
}
}
my $ret= $list{$next[0]}[0];
for my $m ( @next ) {
shift @{$list{$m}};
}
for my $m ( keys %list ) {
push @{$list{$m}}, $ret*$m;
}
return $ret;
};
}
@ARGV= (2,3,5) if ! @ARGV;
my $iter= gen(@ARGV);
print $iter>(), $/ while 1;
Ever notice that converting a functional program to a procedural one is a bit like doing a Fourier transform? (: I supposed I shouldn't be using a closure with such a claim, but they make convenient onemethod objects.
 [reply] [d/l] 
Re: Hamming Sequences and Lazy Lists
by Roy Johnson (Monsignor) on Mar 17, 2005 at 16:40 UTC

Here is a lazylist example of merge, with one of its arguments being a finite list, and the other an infinite list. I may not get around to figuring out the Hamming generator, but I think the techniques I've employed here tell you how it can be done.
use strict;
use warnings;
# Merge takes two iterators, which can be called
# with no arguments, in which case they iterate, returning
# their next value; or with a string 'peek', which will
# yield the next value without effectively shifting it.
# Exhausted iterators return undef on all subsequent calls
#
# Merge itself is an iterator, returning the next element in
# the merged series, plus a continuation coderef
sub merge {
my ($a, $b) = @_;
my ($car_a, $car_b) = ($a>('peek'), $b>('peek'));
# Base case: if one of them is empty, return the other
defined $car_a or return ($b>(), sub {merge($a, $b)});
defined $car_b or return ($a>(), sub {merge($a, $b)});
# Pull off lesser (both if equal) first element(s)
my $low_car;
if ($car_a <= $car_b) { $low_car = $a>() }
if ($car_b <= $car_a) { $low_car = $b>() }
return ($low_car, sub {merge($a, $b)} );
}
my $I1 = do {
my @arr = (1..10);
sub {
if (@arr == 0) {
return undef;
}
elsif (@_) { # should be peek, but any other arg works (undocu
+mented)
return $arr[0];
}
else {
return shift @arr;
}
}
};
my $I2 = do {
my $i = 2;
sub {
if (@_) {
return $i;
} else {
my $i_was = $i; $i += 2; return $i_was;
}
}
};
my $iterations_to_print = 30;
for ( my ($elem, $cont) = merge($I1, $I2);
$iterations_to_print > 0;
($elem, $cont) = $cont>()
) {
print "<$elem>\n";
}
Caution: Contents may have been coded under pressure.
 [reply] [d/l] 

Roy Johnson,
I don't think this is right. It is my understanding that the results should be the multiples of the factors merged minus duplicates. If you change $iterations_to_print = 23 and @arr = (2,3,5), where is 15 in the results for instance? See Re: Hamming Sequences and Lazy Lists for my understanding and implementation of the problem.
 [reply] 

 [reply] 

Re: Hamming Sequences and Lazy Lists
by Roy Johnson (Monsignor) on Mar 17, 2005 at 18:00 UTC

Lazy, fast, and I think it's correct.
use strict;
use warnings;
sub lazy_ham {
my ($how_many) = @_;
my @output_stream = (1);
my @streams = map {
my $base = $_; # All your base are belong to us
my $index = 0;
sub {
if (@_) {
return $base * $output_stream[$index];
} else {
return $base * $output_stream[$index++];
}
}
} (2, 3, 5);
for (1..$how_many) {
# Find the lowest next item in the available streams
my ($lowest) = sort {$a <=> $b} map {$_>('peek')} @streams;
$_>('peek') == $lowest and $_>() for @streams;
push(@output_stream, $lowest);
}
shift @output_stream; # Get rid of the seed 1
@output_stream;
}
print join(', ', lazy_ham(1000)), "\n";
2, 3, 4, 5, 6, 8, 9, 10, 12, 15, 16, 18, 20, 24, 25, 27, 30, 32, 36, 4
+0, 45, 48, 50, 54, 60, 64, 72, 75, 80, 81, 90, 96, 100, 108, 120, 125
+, 128, 135, 144, 150, 160, 162, 180, 192, 200, 216, 225, 240, 243, 25
+0, 256, 270, 288, 300, 320, 324, 360, 375, 384, 400, 405, 432, 450, 4
+80, 486, 500, 512, 540, 576, 600, 625, 640, 648, 675, 720, 729, 750,
+768, 800, 810, 864, 900, 960, 972, 1000, 1024, 1080, 1125, 1152, 1200
+, 1215, 1250, 1280, 1296, 1350, 1440, 1458, 1500, 1536, 1600, 1620, 1
+728, 1800, 1875,...
Caution: Contents may have been coded under pressure.
 [reply] [d/l] [select] 

The number 1 = 2**0 * 3**0 * 5**0, so it is a legitimate part of the series, not just a seed to be stripped off. It is part of the answer produced by the Haskell genHam above. Otherwise, your generator looks great and the output checks with the Haskell one.
 [reply] 

Ok, well here it is, corrected for that, and without using coderefs for streams. I realized there really wasn't much point to that. All I really need to know is what my multiplier is, and which element of the output stream I'm looking at.
use strict;
use warnings;
sub lazy_ham {
my ($how_many) = @_;
my @output_stream = (1);
my @streams = map [$_,0], (2, 3, 5);
for (@output_stream+1..$how_many) {
# Find the lowest next item in the available streams
my @peeks = map {$output_stream[$_>[1]] * $_>[0]} @streams;
my ($lowest) = sort {$a <=> $b} @peeks;
$peeks[$_] == $lowest and $streams[$_][1]++ for 0..$#streams;
push(@output_stream, $lowest);
}
@output_stream;
}
print join(', ', lazy_ham(80)), "\n";
Caution: Contents may have been coded under pressure.
 [reply] [d/l] 

Roy Johnson,
Shouldn't 14 be in the results since it is a multiple of 2?
 [reply] 

 [reply] 

Re: Hamming Sequences and Lazy Lists
by QM (Parson) on Mar 17, 2005 at 14:38 UTC

 [reply] 
Re: Hamming Sequences and Lazy Lists
by tlm (Prior) on Mar 17, 2005 at 20:39 UTC

Here's a pretty general solution, I think. Full code below.
my @first_200 = take(200, gen_hamm(2, 3, 5));
print "@first_200\n";
yields
1 2 3 4 5 6 8 9 10 12 15 16 18 20 24 25 27 30 32 36 40 45 48 50 54 60
+64 72 75 80 81 90 96 100 108 120 125 128 135 144 150 160 162 180 192
+200 216 225 240 243 250 256 270 288 300 320 324 360 375 384 400 405 4
+32 450 480 486 500 512 540 576 600 625 640 648 675 720 729 750 768 80
+0 810 864 900 960 972 1000 1024 1080 1125 1152 1200 1215 1250 1280 12
+96 1350 1440 1458 1500 1536 1600 1620 1728 1800 1875 1920 1944 2000 2
+025 2048 2160 2187 2250 2304 2400 2430 2500 2560 2592 2700 2880 2916
+3000 3072 3125 3200 3240 3375 3456 3600 3645 3750 3840 3888 4000 4050
+ 4096 4320 4374 4500 4608 4800 4860 5000 5120 5184 5400 5625 5760 583
+2 6000 6075 6144 6250 6400 6480 6561 6750 6912 7200 7290 7500 7680 77
+76 8000 8100 8192 8640 8748 9000 9216 9375 9600 9720 10000 10125 1024
+0 10368 10800 10935 11250 11520 11664 12000 12150 12288 12500 12800 1
+2960 13122 13500 13824 14400 14580 15000 15360 15552 15625 16000 1620
+0
This output came out instantenously.
The merge and gen_hamm procedures have similar forms as the originals in Haskell, although they're nowhere nearly as streamlined:
sub gen_hamm {
return [] unless @_;
my $x = shift;
my $out;
$out = merge(
ll_new(
1,
memoize(
sub {
ll_map( sub { $x * $_[ 0 ] }, $out );
}
)
),
gen_hamm( @_ )
);
return $out;
}
sub merge {
my ( $x, $y ) = @_;
return $y if ll_null_p( $x );
return $x if ll_null_p( $y );
my ( $x0, $y0 ) = map head( $_ ), ( $x, $y );
if ( $x0 < $y0 ) {
return ll_new( $x0, memoize( sub { merge( tail( $x ), $y ) } ) );
}
elsif ( $y0 < $x0 ) {
return ll_new( $y0, memoize( sub { merge( $x, tail( $y ) ) } ) );
}
else {
return ll_new(
$x0,
memoize(
sub {
merge( tail( $x ), tail( $y ) );
}
)
);
}
}
This implementation is general beyond the Hamming problem. For example, we can define a Fibonacci lazy list like this:
my $fibs;
$fibs = ll_new(0, memoize(sub { ll_new(1,
memoize(sub {
ll_add(tail($fibs),
$fibs);
}))
}));
my @first_100 = take( 100, $fibs );
print "@first_100\n";
The output of the above came out instantaneously:
0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765 1
+0946 17711 28657 46368 75025 121393 196418 317811 514229 832040 13462
+69 2178309 3524578 5702887 9227465 14930352 24157817 39088169 6324598
+6 102334155 165580141 267914296 433494437 701408733 1134903170 183631
+1903 2971215073 4807526976 7778742049 12586269025 20365011074 3295128
+0099 53316291173 86267571272 139583862445 225851433717 365435296162 5
+91286729879 956722026041 1548008755920 2504730781961 4052739537881 65
+57470319842 10610209857723 17167680177565 27777890035288 449455702128
+53 72723460248141 117669030460994 190392490709135 308061521170129 498
+454011879264 806515533049393 1.30496954492866e+15 2.11148507797805e+1
+5 3.41645462290671e+15 5.52793970088476e+15 8.94439432379146e+15 1.44
+723340246762e+16 2.34167283484677e+16 3.78890623731439e+16 6.13057907
+216116e+16 9.91948530947555e+16 1.60500643816367e+17 2.59695496911123
+e+17 4.2019614072749e+17 6.79891637638612e+17 1.1000877783661e+18 1.7
+7997941600471e+18 2.88006719437082e+18 4.66004661037553e+18 7.5401138
+0474635e+18 1.22001604151219e+19 1.97402742198682e+19 3.1940434634990
+1e+19 5.16807088548583e+19 8.36211434898484e+19 1.35301852344707e+20
+2.18922995834555e+20
 [reply] [d/l] [select] 
Re: Hamming Sequences and Lazy Lists
by Roy Johnson (Monsignor) on Mar 18, 2005 at 00:56 UTC

I offer one last solution, which addresses an issue raised in Re: Functional perl please: "(we exclude "solutions" which must store the entire sequence in a large array and the like)". My previous solutions did store the array, because they returned it as one piece.
This sub is an iterator, returning the next in the sequence on each call. It maintains only the portion of the output stream that it needs to continue generating.
I used Math::BigInt so I could get into interesting numbers. It takes several minutes to find the 100000th or so in the series. But if you're interested, #100001 through 100005 are
290237644800000000000000000000000000000
290420756304773155911401472000000000000
290469810882260083566182400000000000000
290565366750000000000000000000000000000
290748685015200298451950845000000000000
with 5446 elements in the queue.
use strict;
use warnings;
use Math::BigInt;
{
my @history = (Math::BigInt>new('1'));
my @streams = map {base => $_, index => 0}, (2, 3, 5);
sub print_status {
print "$_>{base}: $_>{index}\n" for @streams;
print "History is " . @history . " elements\n";
}
sub ham_iter {
# Make sure all stream indexes are > 0
while ($streams[2]{index} == 0) {
# Find the next lowest value to push onto history
my @peeks = map {
$history[$_>{index}]>copy()>bmul($_>{base})
} @streams;
my ($lowest) = sort {$a>bcmp($b)} @peeks;
$peeks[$_]>bcmp($lowest) or $streams[$_]{index}++ for 0..
+$#streams;
push(@history, $lowest);
}
# Now adjust all the indexes for the element being removed
$_>{index} for @streams;
shift @history;
}
}
# Skipping however many
ham_iter() for (1..10);
# Then print the next five
print ham_iter>bstr(), "\n" for (1..5);
# Then tell us about what's stored
print_status();
Caution: Contents may have been coded under pressure.
 [reply] [d/l] [select] 
Re: Hamming Sequences and Lazy Lists
by Limbic~Region (Chancellor) on Mar 17, 2005 at 16:44 UTC

tall_man,
The only thing that is recursive is merge() which could also be iterative. I believe it does what you want.
Update: This is wrong. I was so focused on lazy evaluation that I misunderstood "how do you generate the series of numbers composed of a given list of prime factors, where each can be used an unlimited number of times?" To me, that meant any positive multiple of any factor was valid.  [reply] [d/l] 
Re: Hamming Sequences and Lazy Lists
by tlm (Prior) on Mar 17, 2005 at 23:06 UTC

The challenge would be to do this in perl. I believe perl6 has or will soon be getting Haskelllike lazy infinite lists. Can it be done in perl5?
To address this question more directly, I think it'd take very little to make this possible in Perl5. All that is required is a special function to mimic the ':' operator in Haskell. The crucial requirement for this operator is that its last operand not be evaluated unless it is specifically requested.
In what I posted, I had to do this "by hand"; i.e. what should have been simply
ll_new( $x, < any perl expression > )
had to be recast into
ll_new( $x, memoize( sub { < any perl expression > } ) )
The business with memoize is in some sense not essential; this would have, in principle, worked too:
ll_new( $x, sub { < any perl expression > } )
Wrapping the second argument with an anonymous sub effectively delays its evaluation. But without the memoization, this whole scheme becomes hopelessly bogged down with all the recursive calls.
If perl did not evaluate the second argument of ll_new, then the whole implementation would look a lot cleaner. For example, the definition of $fibs above would go from:
$fibs = ll_new(
0,
memoize (
sub {
ll_new(
1,
memoize (
sub {
ll_add( tail( $fibs ), $fibs );
}
)
);
}
)
);
to the relatively pithy:
$fibs = ll_new( 0, ll_new( 1, ll_add( tail( $fibs ), $fibs ) ) );
which holds its own against the Haskell rendition of the same:
fibs = 0:1:[a+b (a,b) < zip fibs (tail fibs) ]
 [reply] [d/l] [select] 
Re: Hamming Sequences and Lazy Lists
by Roy Johnson (Monsignor) on Mar 21, 2005 at 17:45 UTC

use strict;
use warnings;
# A stream is an array ref, in which the first element is an ordinary
# value, and the second element is a continuation: a sub that yields
# a stream. In other words, a lazy list.
# Takes an ordinary list and turns it into a stream
sub stream_up {
my ($x, @rest) = @_;
return [ $x, sub { @rest ? stream_up(@rest) : [] } ];
}
# Yields the first N elements from a stream
sub take {
my ($N, $x_xs) = @_;
$N > 0 or return ();
if (!@$x_xs) { return () }
my ($x, $xs) = @$x_xs;
return($x, take($N1, $xs>()));
}
# merge takes two streams, and returns one
sub merge {
my ($x_xs, $y_ys) = @_;
if (!@$x_xs) { return $y_ys }
if (!@$y_ys) { return $x_xs }
my ($x, $xs) = @$x_xs;
my ($y, $ys) = @$y_ys;
if ($x < $y) { return [$x, sub { merge($xs>(), $y_ys) } ] }
if ($x > $y) { return [$y, sub { merge($x_xs , $ys>())} ] }
if ($x == $y) { return [$x, sub { merge($xs>(), $ys>())} ] }
}
# Like map, but applies coderef to stream, returning a stream
sub stream_map {
my ($coderef, $x_xs) = @_;
if (!@$x_xs) { return $x_xs }
my ($x, $xs) = @$x_xs;
local $_ = $x;
return [$coderef>($x), sub { stream_map($coderef, $xs>()) }];
}
# genHam takes a stream and returns a stream
sub genHam {
my ($x_xs) = @_;
if (!@$x_xs) { return $x_xs }
my ($x, $xs) = @$x_xs;
my $out;
$out = merge([1, sub {stream_map(sub{$_ * $x}, $out)}], genHam($xs
+>()));
}
print "$_\n" for take 20, genHam stream_up(2,3,5);
Caution: Contents may have been coded under pressure.
 [reply] [d/l] 
Re: Hamming Sequences and Lazy Lists
by Limbic~Region (Chancellor) on Apr 21, 2005 at 15:02 UTC

tall_man,
This idea poppped into my head today and I didn't really get a chance to play with it before a marathon meeting.
use List::Util 'min';
my $iter = hamming(2, 3, 5);
print $iter>(), "\n" while 1;
sub hamming {
my @factor = @_;
my %pool = (1 => 1);
return sub {
my $next = delete $pool{ min keys %pool };
@pool{ map { $next * $_ } @factor } = map { $next * $_ } @fact
+or;
return $next;
};
}
Update: Removed faulty optimization
 [reply] [d/l] 

No need to populate values, though.
return sub {
my $next = min keys %pool;
@pool{ map { $next * $_ } @factor } = ();
delete $pool{$next};
return $next;
};
Caution: Contents may have been coded under pressure.
 [reply] [d/l] 
Re: Hamming Sequences and Lazy Lists
by ambrus (Abbot) on Oct 31, 2006 at 23:34 UTC

 [reply] 

