Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

Challenge: Another Infinite Lazy List

by Limbic~Region (Chancellor)
on Mar 17, 2005 at 20:27 UTC ( #440531=perlquestion: print w/ replies, xml ) Need Help??
Limbic~Region has asked for the wisdom of the Perl Monks concerning the following question:

All,
In this node, tall_man asked how to generate the Hamming Sequence lazily in Perl5. I didn't understand the Haskell code and misunderstood the english explanation.

"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?"

I interpreted that to mean all multiples of all prime factors provided minus duplicates were valid. My mistake was exacerbated by the fact the sample series provided fit my interpretation. I took my licks after posting an incorrect solution.

I was happy to take the downvotes and be wrong since the mistake was just as interesting to me. My challenge then is to produce R as shown below for any set of given factors lazily:

Given: Factors 2, 3, 5 2, 4, 6, 8, 10, 12, 14, 16, 18, 20, 22, 24, 26, 28, 30, ... 3, 6, 9, 12, 15, 18, 21, 24, 27, 30, ... 5, 10, 15, 20, 25, 30, ... R = 2, 3, 4, 5, 6, 8, 9, 10, 12, 14, 15, 16, 18, 20, 21, 22, 24, 25, 2 +6, 27, 28, 30, ...
You can see my cleaned up solution below:
#!/usr/bin/perl use strict; use warnings; use constant HEAD => 0; use constant TAIL => -1; my $end = shift || 10; my @num = @ARGV ? @ARGV : (2, 3, 5); my $next = merge_multiple( \@num ); print $next->(), "\n" for 1 .. $end; sub merge_multiple { my $list = shift; return () if ! $list || ref $list ne 'ARRAY'; my $n = 1; my $h = $list->[TAIL]; my (@pool, @stream); return sub { return shift @pool if @pool; for ( 0 .. $#$list ) { my $mult = $list->[ $_ ]; my $beg = $h * ($n - 1) / $mult + 1; my $end = $h * $n / $mult; $stream[ $_ ] = [ map { $mult * $_ } $beg .. $end ]; } ++$n; @pool = merge( \@stream ); return shift @pool; } } sub merge { my $stream = shift; my $end = $#$stream; my @merged; while ( 1 ) { my $low; for ( 0 .. $end ) { my $val = $stream->[ $_ ][HEAD]; next if ! defined $val; $low = $_ if ! defined $low || $val < $stream->[ $low ][HE +AD]; } last if ! defined $low; my $num = shift @{ $stream->[ $low ] }; next if defined $merged[ TAIL ] && $merged[ TAIL ] == $num; push @merged, $num; } return @merged; }

Cheers - L~R

Comment on Challenge: Another Infinite Lazy List
Select or Download Code
Re: Challenge: Another Infinite Lazy List
by tlm (Prior) on Mar 17, 2005 at 21:05 UTC

    Using the subs whose definitions I posted in Re: Hamming Sequences and Lazy Lists, the following:

    my $ones; $ones = ll_new(1, memoize(sub { $ones })); my $integers; $integers = ll_new(0, memoize(sub { ll_add($ones, $integers) })); sub multiples { my $n = shift; return ll_map( sub { $n * $_[0] }, $integers ); } sub challenge { return [] unless @_; my $x = shift; my $out; $out = merge( multiples($x), challenge(@_) ); return $out; } my @first_200 = take( 200, challenge(2, 3, 5) ); print "@first_200\n";
    prints this out:
    0 2 3 4 5 6 8 9 10 12 14 15 16 18 20 21 22 24 25 26 27 28 30 32 33 34 +35 36 38 39 40 42 44 45 46 48 50 51 52 54 55 56 57 58 60 62 63 64 65 +66 68 69 70 72 74 75 76 78 80 81 82 84 85 86 87 88 90 92 93 94 95 96 +98 99 100 102 104 105 106 108 110 111 112 114 115 116 117 118 120 122 + 123 124 125 126 128 129 130 132 134 135 136 138 140 141 142 144 145 +146 147 148 150 152 153 154 155 156 158 159 160 162 164 165 166 168 1 +70 171 172 174 175 176 177 178 180 182 183 184 185 186 188 189 190 19 +2 194 195 196 198 200 201 202 204 205 206 207 208 210 212 213 214 215 + 216 218 219 220 222 224 225 226 228 230 231 232 234 235 236 237 238 +240 242 243 244 245 246 248 249 250 252 254 255 256 258 260 261 262 2 +64 265 266 267 268 270 272

    the lowliest monk

Re: Challenge: Another Infinite Lazy List
by Joost (Canon) on Mar 17, 2005 at 21:14 UTC
    I suspect this isn't bulletproof, but it appears to work for the given example:

    update2: after some thinking, I'm convinced it's ok.

    #!perl -w use strict; my $end = shift || 40; my $i = merge_multiple(@ARGV ? @ARGV : (2,3,5)); print $i->(),"\n" for 1 .. $end; sub merge_multiple { my $last = 0;
    my %vals = map { $_ => $_ } sort { $a <=> $b } @_;
    my %vals = map { $_ => $_ } @_; sub { for (keys %vals) { $vals{$_} += $_ if $vals{$_} <= $last; } my ($r) = sort { $a <=> $b } values %vals; $last = $r; } }
    Cheers. update: removed legacy sort, wasn't used anyway.

Re: Challenge: Another Infinite Lazy List
by kvale (Monsignor) on Mar 17, 2005 at 21:20 UTC
    Here is a simple iterative solution:
    my @factors = (2,3,5); # Assmue increasing sequence my $seq_len = 10; my $index = 0; foreach my $num (1..$seq_len*$factors[0]) { foreach my $factor (@factors) { unless ($num % $factor) { print "$num "; $index++; last; } } last if $index >= $seq_len; }

    -Mark

      If you want a pure iterative solution, you could compute a factor wheel and print everything but the usual trial divisors. The code looks messier, but it requires no mod calculations in the loop, just adds. I computed the wheel using Math::Big::Factors (so for people following the original articles, we have come full circle...).

        I am confused. Where is the "infinite lazy list"?

        In the implementation I posted, a variable like

        my $lazy235 = challenge( 2, 3, 5 );
        is, effectively, an infinite lazy list. One can repeatedly extract an arbitrarily long prefix from it, using take, or repeatedly find its n-th element with something like:
        sub nth { my $ll = shift; my $n = shift; die "Invalid argument: $n\n" if $n < 0; return $n == 0 ? head( $ll ) : nth( tail( $ll ), $n - 1 ); }
        For example, the following:
        my @first_50 = take( 50, $lazy235 ); my @again = take( 50, $lazy235 ); print "@first_50\n\n@again\n\n"; for ( map int( rand( 1000 ) ), ( 1 .. 5 ) ) { printf "%3d %d\n", $_, nth( $lazy235, $_ ); }
        prints out something like
        0 2 3 4 5 6 8 9 10 12 14 15 16 18 20 21 22 24 25 26 27 28 30 32 33 34 +35 36 38 39 40 42 44 45 46 48 50 51 52 54 55 56 57 58 60 62 63 64 65 +66 0 2 3 4 5 6 8 9 10 12 14 15 16 18 20 21 22 24 25 26 27 28 30 32 33 34 +35 36 38 39 40 42 44 45 46 48 50 51 52 54 55 56 57 58 60 62 63 64 65 +66 347 474 857 1168 530 723 994 1355 579 789

        the lowliest monk

Re: Challenge: Another Infinite Lazy List
by demerphq (Chancellor) on Mar 18, 2005 at 09:34 UTC

    Heres my go without reviewing your code first.

    Update: It looks like this is the lazy version of the iterative solution by kvale.
    Update2: BrowserUk correctly points out the sort needs to be numeric, which ive fixed.

    Update3: I tweaked my original a little to support a DESTROY method, and added a second more efficient variant.
    Update4: Added readmore around original code.

    use strict; use warnings; use overload '""'=>'stringify'; sub stringify { $_[0]->() }; sub lcf { my @f=sort {$a<=>$b} @_; my @v=shift @f; for my $f (@f) { push @v,$f unless grep !($f % $_),@v; } @v } sub make_sub1 { my ($N) = my @f = lcf( @_ ); return bless sub{ return "Simple Factors = [ @f ] Cur = $N" if @_; for(;;$N++){ $N % $_ || return $N++ for @f } }; } sub make_sub2 { my @f = my @v = lcf( @_ ); return bless sub { return "Smart Factors = [ @f ] Cur = [ @v ]" if @_; my ($min,$ret); do { $min = 0; $v[$min] >= $v[$_] and $min=$_ for 1..$#v; $ret = $v[$min]; $v[$min] += $f[$min]; } while grep !($ret % $f[$_]), 0 .. $min-1; return $ret; }; } sub DESTROY { my $s=shift; warn "DESTROY: $s ",$s->(1),"\n"; } @ARGV=(2,3,4,5,6) unless @ARGV; @ARGV=sort @ARGV; { local $"=", "; local $\="\n"; print "Factors: @ARGV"; foreach (@ARGV) { my $f=make_sub1($_); print "F($_) = @{[($f) x 25]}"; } for my $o ( make_sub1(@ARGV),make_sub2(@ARGV)) { print "R(@ARGV) = @{[($o) x 25]}"; } print "----"; } __END__ DESTROY: main=CODE(0x1ac5130) Simple Factors = [ 2 ] Cur = 51 DESTROY: main=CODE(0x1ac5130) Simple Factors = [ 3 ] Cur = 76 DESTROY: main=CODE(0x1ac5130) Simple Factors = [ 4 ] Cur = 101 DESTROY: main=CODE(0x1ac5130) Simple Factors = [ 5 ] Cur = 126 DESTROY: main=CODE(0x1ac5130) Simple Factors = [ 6 ] Cur = 151 DESTROY: main=CODE(0x1ac21c8) Smart Factors = [ 2, 3, 5 ] Cur = [ 36, + 36, 35 ] DESTROY: main=CODE(0x1c0535c) Simple Factors = [ 2, 3, 5 ] Cur = 35 Factors: 2, 3, 4, 5, 6 F(2) = 2, 4, 6, 8, 10, 12, 14, 16, 18, 20, 22, 24, 26, 28, 30, 32, 34, + 36, 38, 40, 42, 44, 46, 48, 50 F(3) = 3, 6, 9, 12, 15, 18, 21, 24, 27, 30, 33, 36, 39, 42, 45, 48, 51 +, 54, 57, 60, 63, 66, 69, 72, 75 F(4) = 4, 8, 12, 16, 20, 24, 28, 32, 36, 40, 44, 48, 52, 56, 60, 64, 6 +8, 72, 76, 80, 84, 88, 92, 96, 100 F(5) = 5, 10, 15, 20, 25, 30, 35, 40, 45, 50, 55, 60, 65, 70, 75, 80, +85, 90, 95, 100, 105, 110, 115, 120, 125 F(6) = 6, 12, 18, 24, 30, 36, 42, 48, 54, 60, 66, 72, 78, 84, 90, 96, +102, 108, 114, 120, 126, 132, 138, 144, 150 R(2, 3, 4, 5, 6) = 2, 3, 4, 5, 6, 8, 9, 10, 12, 14, 15, 16, 18, 20, 21 +, 22, 24, 25, 26, 27, 28, 30, 32, 33, 34 R(2, 3, 4, 5, 6) = 2, 3, 4, 5, 6, 8, 9, 10, 12, 14, 15, 16, 18, 20, 21 +, 22, 24, 25, 26, 27, 28, 30, 32, 33, 34 ----
    ---
    demerphq

      You need to make your sorts numeric.

      [10:09:10.72] P:\test>copy con junk.pl use strict; use warnings; use overload '""'=>'stringify'; sub stringify { $_[0]->() }; sub make_sub { my ($N) = ( my @f = sort @_ ); return bless sub{ for(;;$N++){ $N % $_ || return $N++ for @f } }; } @ARGV=(2,3,5) unless @ARGV; @ARGV=sort @ARGV; { local $"=", "; local $\="\n"; print "Factors: @ARGV"; foreach (@ARGV) { my $f=make_sub($_); print "F($_) = @{[($f) x 25]}"; } my $o=make_sub(@ARGV); print "R(@ARGV) = @{[($o) x 25]}"; print "----"; } ^Z 1 file(s) copied. [10:09:30.92] P:\test>junk 3 22 111 Factors: 111, 22, 3 F(111) = 111, 222, 333, 444, 555, 666, 777, 888, 999, 1110, 1221, 1332 +, 1443, 1554, 1665, 1776, 1887, 1998, 2109, 2220, 2331, 2442, 2553, 2 +664, 2775 F(22) = 22, 44, 66, 88, 110, 132, 154, 176, 198, 220, 242, 264, 286, 3 +08, 330, 352, 374, 396, 418, 440, 462, 484, 506, 528, 550 F(3) = 3, 6, 9, 12, 15, 18, 21, 24, 27, 30, 33, 36, 39, 42, 45, 48, 51 +, 54, 57, 60, 63, 66, 69, 72, 75 R(111, 22, 3) = 111, 114, 117, 120, 123, 126, 129, 132, 135, 138, 141, + 144, 147, 150, 153, 154, 156, 159, 162, 165, 168, 171, 174, 176, 177 ----

      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?
Re: Challenge: Another Infinite Lazy List
by Roy Johnson (Monsignor) on Mar 18, 2005 at 13:27 UTC
    This is actually a simpler problem, because the output for each iteration comes directly off of one of the input streams. One interesting property of that is that you can easily advance yourself in the output stream without generating the whole sequence.
    use strict; use warnings; { my @streams = map [$_, 0], (2,3,5); sub limbic_sequence { my $first_after = shift; if (defined $first_after) { $_->[1] = int($first_after/$_->[0]) for @streams; } my ($lowest) = sort {$a <=> $b} map {($_->[1]+1) * $_->[0]} @s +treams; $_->[1]++ for grep {($_->[1]+1) * $_->[0] == $lowest} @streams +; $lowest; } } print join ', ', map limbic_sequence, 1..50; print "\n"; printf "First after 100000 is: %d\n", limbic_sequence(100000); print join ', ', map limbic_sequence, 1..50; print "\n"; __END__ #Output 2, 3, 4, 5, 6, 8, 9, 10, 12, 14, 15, 16, 18, 20, 21, 22, 24, 25, 26, 2 +7, 28, 30, 32, 33, 34, 35, 36, 38, 39, 40, 42, 44, 45, 46, 48, 50, 51 +, 52, 54, 55, 56, 57, 58, 60, 62, 63, 64, 65, 66, 68 First after 100000 is: 100002 100004, 100005, 100006, 100008, 100010, 100011, 100012, 100014, 100015 +, 100016, 100017, 100018, 100020, 100022, 100023, 100024, 100025, 100 +026, 100028, 100029, 100030, 100032, 100034, 100035, 100036, 100038, +100040, 100041, 100042, 100044, 100045, 100046, 100047, 100048, 10005 +0, 100052, 100053, 100054, 100055, 100056, 100058, 100059, 100060, 10 +0062, 100064, 100065, 100066, 100068, 100070, 100071

    Caution: Contents may have been coded under pressure.

      Am I right in thinking you are basically doing the same thing as my make_sub2() implementation but rotating the data (Ie, i have two array of N elements, you have N arrays of 2 elements)?

      ---
      demerphq

        It looks like we're working with the same data, though I don't think we're doing the same thing with it to get our results. Here's mine explained: Each stream stores its base (2, 3, or 5) and the multiplier last used with that base to generate an output element. To generate the next element of the sequence, I check what the next output would be from each stream (multiply the base by the last multiplier + 1) and choose the lowest of those, incrementing the multiplier of each stream that would give me that lowest number. That's it.

        Caution: Contents may have been coded under pressure.
Re: Challenge: Another Infinite Lazy List
by tall_man (Parson) on Mar 18, 2005 at 15:43 UTC
    This particular challenge can be done much more simply with a filter approach instead of merging multiple lists. Here is an implementation using the Stream.pm class given by Dominus in this article.
    use strict; use Stream; use Math::Pari qw(gcd); # We can test all the factors at once using the greatest common diviso +r algorithm. my @factors = @ARGV; my $test_number = 1; $test_number *= $_ for @factors; die "Must provide a list of non-zero factors\n" unless $test_number > +1; sub has_common_factor { gcd($_[0], $test_number) != 1 } my $integers = Stream::tabulate( sub { $_[0] }, 1); my $challenge = $integers->filter(\&has_common_factor); $challenge->show(50);

      This particular challenge can be done much more simply with a filter approach instead of merging multiple lists.

      This is the precise description of my solution (except that no "filtering" is required; it's enough to merge the lists of multiples).

      Update: see here and here.

      the lowliest monk

        The two approaches are not the same at all. Say there are N numbers and R prime factors. The merge methods use:

        N*(1/p1 + 1/p2 + ... 1/pR)*(R-1)

        comparison operations to process a list of size N.

        The filter method tests each number with a single gcd calculation, which is O(logN) and is independent of the total number of factors. So to produce a list of size N should be O(NlogN).

        Depending on the size and quantity of factors, one or the other will be better. I would expect the filter to be better when there are many small factors, and the merge to be better when there are few factors or the factors are large.

Re: Challenge: Another Infinite Lazy List
by kelan (Deacon) on Mar 18, 2005 at 18:20 UTC

    Here's my naive Haskell implementation, done without studying any of the others here, though after finishing and looking briefly through them, it is rather similar to some.

    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 supermerge (x:[]) = x supermerge (x:y:ys) = supermerge $ (merge x y) : ys multiples x = map (*x) [1..] multiplesFromList x = supermerge $ map (multiples) x limbic's_challenge = multiplesFromList [2,3,5]
    I'm not sure how fast it is comparatively (especially since I'm running it in Hugs), but I can get a million items in about 20 seconds.

Re: Challenge: Another Infinite Lazy List
by tmoertel (Chaplain) on Mar 19, 2005 at 01:25 UTC
    For comparision with Haskell, we can define R for any given list of factors by folding the merge operator through the list of lists of multiples:
    r = foldr merge [] . map (\n -> map (*n) [1..])
    We use a duplicate-eating merge:
    merge [] ys = ys merge xs [] = xs merge (x:xs) (y:ys) | x < y = x : merge xs (y:ys) | y < x = y : merge (x:xs) ys | otherwise = x : merge xs ys
    Sample output:
    > take 60 (r [2,3,5]) [2,3,4,5,6,8,9,10,12,14,15,16,18,20,21,22,24,25,26,27,28,30,32,33,34,3 +5,36,38,39,40,42,44,45,46,48,50,51,52,54,55,56,57,58,60,62,63,64,65,6 +6,68,69,70,72,74,75,76,78,80,81,82]

      I guess I don't have enough practice with Haskell yet. When trying to think of an easy way to merge a list of lists I completely forgot about folding. ++ to you.

Re: Challenge: Another Infinite Lazy List
by Limbic~Region (Chancellor) on Mar 22, 2005 at 00:19 UTC

    My solution in the root thread required was only minimally better than my original solution (to the wrong problem). This minimally tested version is vast improvement over both previous solutions.
    #!/usr/bin/perl use strict; use warnings; my $end = shift || 22; my $next = lazy_merge( [ @ARGV ? @ARGV : (2, 3, 5) ] ); print $next->(), "\n" for 1 .. $end; sub lazy_merge { my ($list, $last) = (shift(), 0); my $by_n = sub { my ($n, $k) = (shift(), 0); return sub { $_[0] ? +$k += $n : $k } }; $_ = $by_n->( $_ ) for @$list; return sub { my $low; for ( @$list ) { my $val = $_->(); $val = $_->( 'next' ) if $val <= $last; $low = $val if ! defined $low || $val < $low; } return $last = $low; }; }

    Cheers - L~R

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://440531]
Approved by sweetblood
Front-paged by sweetblood
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (9)
As of 2014-07-14 11:33 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    When choosing user names for websites, I prefer to use:








    Results (258 votes), past polls