Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

Re: Hamming Sequences and Lazy Lists

by tlm (Prior)
on Mar 17, 2005 at 20:39 UTC ( #440537=note: print w/ replies, xml ) Need Help??


in reply to Hamming Sequences and Lazy Lists

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

the lowliest monk


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 ) ); } ) ); } } sub ll_map { my $proc = shift; my $s = shift; if ( ll_null_p( $s ) ) { return []; } else { ll_new( $proc->( head( $s ) ), memoize( sub { ll_map( $proc, tail( $s ) ) } ) ); } } sub take { my $n = shift; my $s = shift; return $n < 1 ? () : ( head( $s ), take( $n - 1, tail( $s ) ) ); } sub memoize (&) { my $proc = shift; my $already_run = 0; my $result; return sub { return $result if $already_run; $already_run = 1; return $result = $proc->(); } } sub ll_new { [ @_[ 0, 1 ] ]; } sub force { my $sub = shift; $sub->(); } sub head { shift->[ 0 ]; } sub tail { force( shift->[ 1 ] ); } sub ll_null_p { !@{ $_[ 0 ] }; } sub element_wise { my $op = shift; my ( $s1, $s2 ) = @_; ll_new( $op->( head( $s1 ), head( $s2 ) ), memoize( sub { element_wise( $op, tail( $s1 ), tail( $s2 ) ); } ) ); } sub ll_add { element_wise( sub { $_[ 0 ] + $_[ 1 ] }, @_ ); }


Comment on Re: Hamming Sequences and Lazy Lists
Select or Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://440537]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (18)
As of 2015-07-01 19:32 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (17 votes), past polls