my @first_200 = take(200, gen_hamm(2, 3, 5)); print "@first_200\n"; #### 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 432 450 480 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 1728 1800 1875 1920 1944 2000 2025 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 5832 6000 6075 6144 6250 6400 6480 6561 6750 6912 7200 7290 7500 7680 7776 8000 8100 8192 8640 8748 9000 9216 9375 9600 9720 10000 10125 10240 10368 10800 10935 11250 11520 11664 12000 12150 12288 12500 12800 12960 13122 13500 13824 14400 14580 15000 15360 15552 15625 16000 16200 #### 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 ) ); } ) ); } } #### 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"; #### 0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765 10946 17711 28657 46368 75025 121393 196418 317811 514229 832040 1346269 2178309 3524578 5702887 9227465 14930352 24157817 39088169 63245986 102334155 165580141 267914296 433494437 701408733 1134903170 1836311903 2971215073 4807526976 7778742049 12586269025 20365011074 32951280099 53316291173 86267571272 139583862445 225851433717 365435296162 591286729879 956722026041 1548008755920 2504730781961 4052739537881 6557470319842 10610209857723 17167680177565 27777890035288 44945570212853 72723460248141 117669030460994 190392490709135 308061521170129 498454011879264 806515533049393 1.30496954492866e+15 2.11148507797805e+15 3.41645462290671e+15 5.52793970088476e+15 8.94439432379146e+15 1.44723340246762e+16 2.34167283484677e+16 3.78890623731439e+16 6.13057907216116e+16 9.91948530947555e+16 1.60500643816367e+17 2.59695496911123e+17 4.2019614072749e+17 6.79891637638612e+17 1.1000877783661e+18 1.77997941600471e+18 2.88006719437082e+18 4.66004661037553e+18 7.54011380474635e+18 1.22001604151219e+19 1.97402742198682e+19 3.19404346349901e+19 5.16807088548583e+19 8.36211434898484e+19 1.35301852344707e+20 2.18922995834555e+20 #### 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 ] }, @_ ); }