Stories
Slash Boxes
Comments
NOTE: use Perl; is on undef hiatus. You can read content, but you can't post it. More info will be forthcoming forthcomingly.

All the Perl that's Practical to Extract and Report

use Perl Log In

Log In

[ Create a new account ]

runrig (3385)

runrig
  dougwNO@SPAMcpan.org

Just another perl hacker somewhere near Disneyland

I have this homenode [perlmonks.org] of little consequence on Perl Monks [perlmonks.org] that you probably have no interest in whatsoever.

I also have some modules [cpan.org] on CPAN [cpan.org] some of which are marginally [cpan.org] more [cpan.org] useful [cpan.org] than others.

Journal of runrig (3385)

Wednesday July 18, 2007
01:20 AM

Adventures in functional idiocy

[ #33835 ]

I'm no functional guru (but that doesn't stop me from trying), and I was curious about the hamming numbers (numbers with only 2, 3, and/or 5 as prime factors) and the code from MJD's book, and after a brief digression into Wikipedia (mental note to self...must work syntonic comma into casual conversation), I started thinking about MJD's code ( Fair use license verbage: from Higher-Order Perl by Mark Dominus, published by Morgan Kaufmann Publishers, Copyright 2005 by Elsevier Inc):

sub scale {
  my ($s, $c) = @_;
  transform { $_[0]*$c } $s;
}
my $hamming;
$hamming = node(1,
                promise {
                  merge(scale($hamming, 2),
                  merge(scale($hamming, 3),
                        scale($hamming, 5),
                       ))
                }
               );

I thought hmmm, I wonder (just for fun) if I can get rid of that cyclical reference. So I pull everyone's favorite combinator out of Moose::Autobox::Code (and modify it to make it non-OO) and try this:

sub u {
    my $f = shift;
    sub { $f->($f, @_) };
}

sub Y {
    my $f = shift;
    u(sub { my $h = shift; sub { $f->(u($h)->())->(@_) } })->();
}

my $hamming = Y( sub {
  my $h = shift;
  sub {
    node(1,
      promise {
      merge(scale($h, 2),
      merge(scale($h, 3),
      scale($h, 5),
    ))})
  }
});

And get:

Not an ARRAY reference at C:/Perl/site/lib/HOP/Stream.pm line 127.

Oh crap, I forgot, a HOP::Stream isn't a function, stupid, it's an array reference (C'mon, can't I just make shit up and expect the computer to know what I mean?). Let's try something else:

my $mk_hamm = Y( sub {
  my $h = shift;
  sub {
    my $s = node(1, $h);
    node(1,
      promise {
      merge(scale($s, 2),
      merge(scale($s, 3),
      scale($s, 5),
    ))})
  }
});
my $hamming = $mk_hamm->();

And get this:

1
2
2
3
3
4
4
5
5
6
6
8
8
9
9
10
10
12
12

Hey, that's close! Hmm, what happens if I try this (let's just make more shit up):

my $mk_hamm = Y( sub {
  my $h = shift;
  sub {
    my $s = node(0, $h);
    node(1,
      promise {
      merge(scale($s, 2),
      merge(scale($s, 3),
      scale($s, 5),
    ))})
  }
});

And we get:

1
0
2
0
3
0
4
0
5
0
6
0
8
0
9
0
10
0
12
0
15

Hey, now all I have to do is change this line:

#my $hamming = $mk_hamm->();
my $hamming = filter { $_[0] > 0 } $mk_hamm->();

And we get the right output. But that's still not quite satisfying, due to the extra cruft that we have to filter out. The "node" being assigned in the original is the same reference as in all of the merge clauses, so let's try just skipping the original node and just merge all the other streams that do have the same node as a basis:

my $mk_hamm = Y( sub {
  my $h = shift;
  sub {
    my $s = node(1, $h);
    merge(scale($s, 2),
    merge(scale($s, 3),
    scale($s, 5),
    ))
  }
});
my $hamming = $mk_hamm->();

And all we're missing is the initial "1" in the stream:

2
3
4
5
6
8
9
10
12

So, let's just "unshift" the "1" back on after the fact by changing this line:

#my $hamming = $mk_hamm->();
my $hamming = node(1, $mk_hamm->());

And it works! I'm still not altogether sure exactly what was going on with the previous versions, but I'm too tired now to figure it out. G'nite.

The Fine Print: The following comments are owned by whoever posted them. We are not responsible for them in any way.
 Full
 Abbreviated
 Hidden
More | Login | Reply
Loading... please wait.