The Labs.Com Issue_07_Infinite

TPJ: Issue_07_Infinite

This is a collection of programs published by The Perl Journal. You can download all source-code also from TPJ: Programs.

1. tabulate
2. filter
3. hamming
4. random
5. primes
6. Stream.pm
7. hailstone
8. More Samples on Infinite

Download tabulate

#!/usr/bin/perl

use Stream;

sub tabulate {

my $f = shift;

my $n = shift;

Stream->new(&$f($n),

sub { &tabulate($f, $n+1) }

)

}

sub square { $_[0] * $_[0] }

$squares = &tabulate( \&square,  1);

$squares->show;

Issue_07_Infinite 2. filter

Download filter

#!/usr/bin/perl

use Stream;

# Return a stream on only the interesting elements of $arg.

sub filter {

my $stream = shift;

# Second argument is a predicate function that returns true

# only when passed an interesting element of $stream.

my $predicate = shift;

# Look for next interesting element

while (! $stream->is_empty && ! &$predicate($stream->head)) \

{

$stream = $stream->tail;

}

# If we ran out of stream, return the empty stream.

return &empty if $stream->is_empty;

# Construct new stream with the interesting element at its head

# and the rest of the stream, appropriately filtered,

# at its tail.

Stream->new($stream->head, sub { $stream->tail->filter\

($predicate) });

}

sub square { $_[0] * $_[0] }

$squares = &tabulate(\&square, 1);

sub is_multiple_of_5 { $_[0] % 5 == 0 }

$squares->filter(\&is_multiple_of_5)->show(6);

__END__

while (! $stream->is_empty && ! &$predicate($stream->head)) {

$stream = $stream->tail;

}

# If we ran out of stream, return the empty stream.

return &empty if $stream->is_empty;

# Construct new stream with the interesting element at its head

# and the rest of the stream, appropriately filtered,

# at its tail.

Stream->new($stream->head,sub { $stream->tail->filter($pre\

dicate) });

}

sub is_multiple_of_5 { $_[0] % 5 == 0 }

$squares->filter(\&is_multiple_of_5)->show(6);

sub prime_filter {

my $s = shift;

my $h = $s->head;

Stream->new($h, sub { $s->tail

->filter(sub { $_[0] % $h })

->prime_filter()

});

}

$iota2 = &tabulate(sub {$_[0]}, 2);

$primes = $iota2->prime_filter;

$primes->show;

Issue_07_Infinite 3. hamming

Download hamming

#!/usr/bin/perl

use Stream;

sub merge {

my $s1 = shift;

my $s2 = shift;

return $s2 if $s1->is_empty;

return $s1 if $s2->is_empty;

my $h1 = $s1->head;

my $h2 = $s2->head;

if ($h1 > $h2) {

Stream->new($h2, sub { &merge($s1, $s2->tail) });

} elsif ($h1 < $h2) {

Stream->new($h1, sub { &merge($s1->tail, $s2) });

} else {                        # heads are equal

Stream->new($h1, sub { &merge($s1->tail, $s2->tail) }\

);

}

}

# Multiply every number in a stream `$self' by a constant factor `$n'

sub scale {

my $self = shift;

my $n = shift;

return &empty if $self->is_empty;

Stream->new($self->head * $n,

sub { $self->tail->scale($n) });

}

# Construct the stream of Hamming's numbers.

sub hamming {

my $href = \1;           # Dummy reference

my $hamming = Stream->new(

1,

sub { &merge($$href->scale(2),

&merge($$href->scale(3),

$$href->scale(5))\

) });

$href = \$hamming;      # Reference is no longer a dummy

$hamming;

}

&hamming()->show(20);

Issue_07_Infinite 4. random

Download random

#!/usr/bin/perl

use Stream;

sub transform {

my $self = shift;

return &empty if $self->is_empty;

my $map_function = shift;

Stream->new(&$map_function($self->head),

sub { $self->tail->transform($map_function) }

);

}

# Stream of key-value pairs in a hash

sub eachpair {

my $hr = shift;

my @pair = each %$hr;

if (@pair) {

Stream->new([@pair], sub {&eachpair($hr)});

} else {   # There aren't any more

∅

}

}

# Stream of input lines from a filehandle

sub input {

my $fh = shift;

my $line = <$fh>;

if ($line eq '') {

∅

} else {

Stream->new($line, sub {&input($fh)});

}

}

# Get first 3 lines of standard input that contain `hello'

#        @hellos = &input(STDIN)->filter(sub {$_[0] =~ /hello/i})-&\

gt;take(3);

# compute n, f(n), f(f(n)), f(f(f(n))), ...

sub iterate {

my $f = shift;

my $n = shift;

Stream->new($n, sub { &iterate($f, &$f($n)) });

}

sub next_rand { int(($_[0] * 1103515245 + 12345) / 65536) % 32768 }

sub rand {

my $seed = shift;

&iterate(\&next_rand, &next_rand($seed));

}

&rand(1)->show;

&rand(1)->show;

&rand(time)->show;

sleep 1;

&rand(time)->show

Issue_07_Infinite 5. primes

Download primes

#!/usr/bin/perl

use Stream;

# Return a stream on only the interesting elements of $arg.

sub filter {

my $stream = shift;

# Second argument is a predicate function that returns true

# only when passed an interesting element of $stream.

my $predicate = shift;

# Look for next interesting element

while (! $stream->is_empty && ! &$predicate($stream->head)) \

{

$stream = $stream->tail;

}

# If we ran out of stream, return the empty stream.

return &empty if $stream->is_empty;

# Construct new stream with the interesting element at its head

# and the rest of the stream, appropriately filtered,

# at its tail.

Stream->new($stream->head, sub { $stream->tail->filter\

($predicate) });

}

sub prime_filter {

my $s = shift;

my $h = $s->head;

Stream->new($h, sub { $s->tail

->filter(sub { $_[0] % $h })

->prime_filter()

});

}

$iota2 = &tabulate(sub {$_[0]}, 2);

$primes = $iota2->prime_filter;

$primes->show;

Issue_07_Infinite 6. Stream.pm

Download Stream.pm

#!/usr/bin/perl

#

# Stream.pm

#

# Sample implementation of lazy, infinite streams with memoization

#

# Copyright 1997 M-J. Dominus (mjd@pobox.com)

#

#    This program is free software; you can redistribute it and/or mod\

ify

#    it under the terms of any of:

#       1. Version 2 of the GNU General Public License as published by

#          the Free Software Foundation;

#       2. Any later version of the GNU public license, or

#       3. The Perl `Artistic License'

#

#    This program is distributed in the hope that it will be useful,

#    but WITHOUT ANY WARRANTY; without even the implied warranty of

#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

#    GNU General Public License for more details.

#

#    You should have received a copy of the Artistic License with this

#    Kit, in the file named "Artistic".  If not, I'll be glad to provi\

de one.

#

#    You should also have received a copy of the GNU General Public Li\

cense

#    along with this program; if not, write to the Free Software

#    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

#

package Stream;

use Exporter;

@ISA = (Exporter);

@EXPORT = qw(new iterate tabulate upto iota filter

primes merge hamming stats rand list2stream

iterate_chop chop_if mingle squares_from hailstones);

### Basic functions

## Manufacture a new stream node with given head and tail.

sub new {

my $what = shift;

my $pack = ref($what) || $what;

my ($h, $t) = @_;

bless { h => $h, t => $t } => $pack;

}

## Return the head of a stream

sub head {

$_[0]{h};

}

## return the tail of a stream, collecting on a promise

## if necessary

sub tail {

my $t = $_[0]{t};

if (ref $t eq CODE) {                # It is a promise

$_[0]{t} = &$t;

}

$_[0]{t};

}

## Construct an empty stream

sub empty {

my $pack = ref(shift()) || Stream;

bless {e => q{Yes, I'm empty.}} => $pack;

}

## Is this stream the empty stream?

sub is_empty {

exists $_[0]{e};

}

### Tools

## Compute f(n), f(n+1), f(n+2) ...

sub tabulate {

my $f = shift;

my $n = shift;

Stream->new(&$f($n), sub { &tabulate($f, $n+1) });

}

## Compute i, f(i), f(f(i)), f(f(f(i))), ...

sub iterate {

my $f = shift;

my $i = shift;

Stream->new($i, sub { &iterate($f, &$f($i)) });

}

## Compute list of first n elements of stream.

sub take {

my $s = shift;

my $n = shift;

my @r;

while ($n-- && !$s->is_empty) {

push @r, $s->head;

$s = $s->tail;

}

@r;

}

## Return new stream of elements of $s with first

## $n elements skipped.

sub drop {

my $s = shift;

my $n = shift;

while ($n-- && !$s->is_empty) {

$s = $s->tail;

}

$s;

}

## Actually modify $s to discard first $n elements.

## Return undef if $s was exhausted.

sub discard {

my $s = shift;

my $n = shift;

my $d = $s->drop($n);

if ($d->is_empty) {

$s->{e} = q{Empty.};

delete $s->{h};

delete $s->{t};

} else {

$s->{h} = $d->{h};

$s->{t} = $d->{t};

}

$s;

}

## Display first few elements of a stream

$SHOWLENGTH = 10;                # Default number of elements to show

sub show {

my $s = shift;

my $len = shift;

my $showall = $len eq ALL;

$len ||= $SHOWLENGTH;

for ($n = 0; $showall || $n < $len; $n++) {

if ($s->is_empty) {

print "\n";

return;

}

print $s->head, " ";

$s = $s->tail;

}

print "\n";

}

## $f, $f+1, $f+2, ... $t-1, $t.

sub upto {

my $f = shift;

my $t = shift;

return Stream->empty if $f > $t;

Stream->new($f, sub { &upto($f+1, $t) });

}

## 1, 2, 3, 4, 5, ...

sub iota {

&tabulate(sub {$_[0]}, 1);  # Tabulate identity function

}

## Return a stream of all the elements of s for which predicate p is t\

rue.

sub filter {

my $s = shift;

# Second argument is a predicate function that returns true

# only when passed an interesting element of $s.

my $predicate = shift;

# Look for next interesting element

until ( $s->is_empty ||  &$predicate($s->head)) {

$s = $s->tail;

}

# If we ran out of stream, return the empty stream.

return $s->empty if $s->is_empty;

# Construct new stream with the interesting element at its head

# and the rest of the stream, appropriately filtered,

# at its tail.

Stream->new($s->head,

sub { $s->tail->filter($predicate) }

);

}

## Given a stream s1, s2, s3, ... return f(s1), f(s2), f(s3), ...

sub transform {

my $s = shift;

return $s->empty if $s->is_empty;

my $map_function = shift;

Stream->new(&$map_function($s->head),

sub { $s->tail->transform($map_function) }

);

}

# Emit elements of a stream s, chopping it off at the first element

# for which `$predicate' is true

sub chop_when {

my $s = shift;

my $predicate = shift;

return $s->empty if $s->is_empty || &$predicate($s->head);

Stream->new($s->head, sub {$s->tail->chop_when($predicat\

e)});

}

# Return first element $h of $s, and sieve out

# subsequent elements, discarding those that are divisible by $h.

sub prime_filter {

my $s = shift;

my $h = $s->head;

Stream->new($h, sub { $s->tail

->filter(sub { $_[0] % $h })

->prime_filter()

});

}

# Multiply every element of a stream $s by a constant $n.

sub scale {

my $s = shift;

my $n = shift;

$s->transform(sub { $_[0] * $n });

}

# Merge two streams of numbers in ascending order, discarding duplicat\

es

sub merge {

my $s1 = shift;

my $s2 = shift;

return $s2 if $s1->is_empty;

return $s1 if $s2->is_empty;

my $h1 = $s1->head;

my $h2 = $s2->head;

if ($h1 > $h2) {

Stream->new($h2, sub { &merge($s1, $s2->tail) });

} elsif ($h1 < $h2) {

Stream->new($h1, sub { &merge($s1->tail, $s2) });

} else {                        # heads are equal

Stream->new($h1, sub { &merge($s1->tail, $s2->tail) });

}

}

# Given two streams s1, s2, s3, ... and t1, t2, t3, ...

# construct s1, t1, s2, t2, s3, t3, ...

sub mingle {

my $s = shift;

my $t = shift;

return $t if $s->is_empty;

return $s if $t->is_empty;

Stream->new($s->head, sub {&mingle($t, $s->tail)});

}

# This is not a very good way to do it.

sub hamming_slow {

my $n = shift;

Stream->new($n,

sub { &merge(&hamming_slow(2*$n),

&merge(&hamming_slow(3*$n),

&hamming_slow(5*$n),

))

});

}

# This is the good one.

#

# The article says it takes a few minutes to compute 3,000 numbers on

# the dinky machine.  That turns out to be not because the dinky

# machine was slow, but because it had so little memory.  With an

# extra 24 MB of memory, computing 3,000 numbers takes just under 20

# seconds of CPU time.

#

sub hamming {

my $href = \1;                # Dummy reference

my $hamming =

Stream->new(1,

sub { &merge($$href->scale(2),

&merge($$href->scale(3),

$$href->scale(5)

))

}

);

$href = \$hamming;      # Reference is no longer a dummy

$hamming;

}

sub squares_from {

my $n = shift;

print STDERR "SQUARES_FROM($n)\n" if $DEBUG;

Stream->new($n*$n,

sub { &squares_from($n+1) });

}

# Hailstone number iterator

sub next_hail {

my $n = shift;

($n % 2 == 0) ? $n/2 : 3*$n + 1;

}

# Return the Collatz 3n+1 sequence starting from n.

sub hailstones {

my $n = shift;

&iterate(\&next_hail, $n);

}

# Example random number generator from ANSI C standard

sub next_rand { int(($_[0] * 1103515245 + 12345) / 65536) % 32768 }

# Stream of random numbers, seeded by $seed.

sub rand {

my $seed = shift;

&iterate(\&next_rand, &next_rand($seed));

}

# Auxiliary function for &iterate_chop

sub iter_pairs {

my $s = shift;

my $ss = shift;

return $s->empty if $s->is_empty;

Stream->new([$s->head, $ss->head],

sub {&iter_pairs($s->tail, $ss->tail->tail)}

);

}

# Given a stream of numbers generated by `iterate',

# chop it off before it repeats.

# Not guaranteed to do anything useful if applied to a stream that was

# not produced by `iterate'

sub iterate_chop {

my $s = shift;

return $s->empty if $s->is_empty;

&iter_pairs($s, $s->tail)

->chop_when(sub {$_[0][0] == $_[0][1]})

->transform(sub {$_[0][0]});

}

# Given a regular list of values, produce a finite stream

sub list2stream {

return Stream->empty unless @_;

my @list = @_;

my $h = shift @list;

#  print STDERR "list2stream @_\n";

return Stream->new($h, sub{&list2stream(@list)});

}

## Turn a stream into a regular Perl array

## Caution--only works on finite streams

sub stream2list {

my $s = shift;

my @r;

while (! $s->is_empty) {

push @r, $s->head;

$s = $s->tail;

}

@r;

}

## Compute length of given stream

sub length {

my $s = shift;

my $n = 0;

while (! $s->is_empty) {

$s = $s->tail;

$n++;

}

$n;

}

1

Issue_07_Infinite 7. hailstone

Download hailstone

#!/usr/bin/perl

use Stream;

# Next number in hailstone sequence

sub next_hail {

my $n = shift;

($n % 2 == 0) ? $n/2 : 3*$n + 1;

}

# Hailstone sequence starting with $n

sub hailstones {

my $n = shift;

&iterate(\&next_hail, $n);

}

&hailstones(15)->show(23);

&hailstones(15)->iterate_chop->show(ALL);

print &hailstones(15)->iterate_chop->length;

Issue_07_Infinite 8. More Samples on Infinite

• Issue_07_Infinite