#!/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 modify
#    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 provide one.
#
#    You should also have received a copy of the GNU General Public License
#    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 true.
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($predicate)});
}

# 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 duplicates
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;
}

# Rujith S. de Silva points out that the `dummy reference' hack 
# is unneccesary.  This version is easier to understand and probably
# faster than the `hamming' above:
#
sub hamming_r {
  my $hamming;
  $hamming =
      Stream->new(1, 
	  sub { &merge($hamming_r->scale(2),
		&merge($hamming_r->scale(3),
		       $hamming_r->scale(5)
		       ))
		  }
      );
}

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;