use Perl

#!/usr/bin/perl -w

use strict;

#Demonstrations of iterators using 'unfold'

#the natural numbers 1,2,3...
my $nats = unfold(\&false,      #loop forever
                  \&id,         #identity function
                  sub{$_[0]+1}, #increment value
                  1 );          #initial seed

# 0,2,4,6,8
my $evens_5 = unfold( sub{$_[0]>8}, \&id, sub{$_[0]+2}, 0);

#Factorials
my $facs = unfold(\&false,
                  \&fst,
                  sub{[fst($_[0])*snd($_[0]),snd($_[0])+1]},
                  [1,1]);

#Fibonacci's famous sequence
my $fibs = unfold(\&false, \&fst, sub{[snd($_[0]),fst($_[0])+snd($_[0])]},[0,1]);

#Enumeration of DNA sequences from...
#  http://www.perl.com/pub/a/2005/06/16/iterators.html
#
my $dna = unfold(sub{toDNA($_[0]) eq "CTTTT"},
                 sub{my $x = toDNA($_[0]); $x=~s/^.(.*)$/$1/; $x},
                 sub{$_[0]+1},
                 fromDNA("CAAAA"));

#print out some samples...
my (@n, @e, @a, @f);
push @n, $nats->() for (1..10);
push @e, $evens_5->() for (1..5);
push @a, $facs->() for (1..10);
push @f, $fibs->() for (1..10);
print "@n\n@e\n@a\n@f\n";

print $dna->() ."\n" for (1..10);

# --Haskell version of unfold...
#
# unfold p f g x =
#   if p x
#      then []
#      else f x : unfold p f g (g x)

sub unfold
{   # function $p is a predicate to indicate when to stop iterator
    # function $f takes the seed ($x) and formats it before returning it
    # function $g massages $x for the next iteration
    # $x is the initial value

    my ($p, $f, $g, $x) = @_;
    sub{ ($p->($x)) ? undef : do{my $val = $f->($x); $x=$g->($x); $val}}
}

#Helper functions
sub fst   { $_[0]->[0] }
sub snd   { $_[0]->[1] }
sub false { 0 }
sub id    { $_[0] }

# These subs convert back and forth between strings of "ACGT" and
# integers, using base-4 arithmetic.  Something with pack/unpack
# might be cleaner.

sub fromDNA
{
    my $s = shift;
    $s =~ tr/ACGT/0-3/;

    my $n=0;
    $n = $n*4+$_ for (split(//, $s));

    return $n;
}

sub toDNA
{
    my $n = shift;
    my $acc = "";

    while($n)
    {
        my $d = $n % 4;
        $n = int($n/4);
        $acc = "$d" . $acc;
    }

    ($acc="$acc") =~ tr/0-3/ACGT/;

    return $acc;
}