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 ]

Friday September 16, 2005
06:26 PM

unfold

[ #26747 ]
I came across Limbic~Region's article on iterators and thought I write up some quick perl examples using the more generic unfold (code reuse in action). Fold is the list deconstructor, while unfold is its dual, the list generator.

#!/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;
}

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.
  • I just finished another mini-tutorial on how a regular function may become Higher Order

    http://www.perlmonks.org/?node_id=492651 [perlmonks.org]

    Even if we remove the veil of mystery from Higher Order functions (by calling them factories, callbacks, and function returning subs), I find that the general masses still are on unsure footing when it comes to using them

    It was well received so perhaps I will write some more.

    Cheers,
    Limbic~Region