[Oc-pm] A derivation of the Y combinator implemented in perl
Pete Wilson
peter.t.wilson at gmail.com
Fri May 25 16:35:59 PDT 2007
#! /usr/bin/perl
use warnings;
use strict;
# This was created after reading
# http://weblog.raganwald.com/2007/02/but-y-would-i-want-to-do-thing-like.html
# which encouraged us to read "The Why of Y" by Richard Gabriel, which
# is available at http://www.dreamsongs.com/NewFiles/WhyOfY.pdf, and
# implement a Y combinator in our favorite language. I have been
# messing around with scheme for about a year now and I though I could
# translate Richard Gabriel's code to Perl. This is my attempt. It
# baby steps through the same derivation Richard uses.
# Start with the canonical recursive function, factorial.
sub fact {
my $n = shift;
return 1 if $n < 2;
return $n * fact( $n - 1 );
}
# Here is a baseline check. Hopefully the result will stay the same while
# we mess with the implementation.
print fact( 10 ), "\n";
# Here is an factorial implementation that maintains an explicit
# reference to the recursive function.
sub fact1 {
my $f = shift;
my $n = shift;
return 1 if $n < 2;
return $n * $f->( $f, $n - 1 );
}
# We have to call it with a reference to itself.
print fact1( \&fact1, 10 ), "\n"; # Result check
# We can separate the handling of the function reference from the
# arguments to the function using a technique called currying. Currying
# converts a function of two arguments into a function of one argument
# that returns a function of one argument that returns the result.
sub fact2 {
my $f = shift;
return sub {
my $n = shift;
return 1 if $n < 2;
return $n * $f->($f)->( $n - 1 );
};
}
# I still have to use a reference to the function itself.
print fact2( \&fact2 )->( 10 ), "\n"; # Result check
# Notice the in fifth line of fact2 where $f is called with $f as it's
# argument. This is why the Y combinator is call a fixed point
# operator. I don't understand all the theoretical implications of
# this, but I think it is the key to the Y combinator's theoretical
# power. Note also that this only works when we kick the whole
# process off with fact2( \&fact2 )->( * ). At this point calling the
# function and the functions implementation are tightly coupled
# together. I try to clean that up by making things more complicated.
# We create an anonymous subroutine that encapsulates most of the work
# in the inner subroutine in fact2. We name this subroutine $h
# before calling it because we will want a handle on it in a few
# steps.
sub fact3 {
my $f = shift;
return sub {
my $m = shift;
my $h = sub {
my $n = shift;
return 1 if $n < 2;
return $n * $f->($f)->( $n - 1 );
};
$h->( $m );
};
}
# The call mechanism remains the same.
print fact3( \&fact3 )->( 10 ), "\n"; # Result check
# Now we apply a transformation to $h similar to the one used to create
# fact1 from fact.
sub fact4 {
my $f = shift;
return sub {
my $m = shift;
my $h = sub {
my $q = shift;
my $n = shift;
return 1 if $n < 2;
return $n * $q->( $n - 1 );
};
$h->( $f->( $f ), $m );
}
}
# Notice that the fixed point application $f->($f) has been moved out
# of $h by the introduction of the function reference $q, which
# receives the result of $f->($f) when $h is called.
# The call mechanism remains the same.
print fact4( \&fact4 )->( 10 ), "\n"; # Result check
# Now re-apply the transformation from fact1 to fact2 on the innermost
# subroutine of fact4, i.e. separate the handling of the anonymous
# function argument from the argument to the recursive function using
# currying.
sub fact5 {
my $f = shift;
return sub {
my $n = shift;
my $h = sub {
my $q = shift;
return sub {
my $n = shift;
return 1 if $n < 2;
return $n * $q->( $n - 1 );
};
};
$h->( $f->( $f ))->( $n );
}
}
# The call mechanism remains the same.
print fact5( \&fact5 )->( 10 ), "\n";
# There are a couple of things to notice here. First, notice that the
# subroutine returned from $h contains all the "factorial logic". It
# looks almost exactly like our original factorial function except
# instead of recursing on a named function it recurses on $q which
# fact5 arranges to be the function returned from $h. Second, notice
# that $h does not have to be defined nested inside the anonymous
# function returned from fact5. fact6 moves it all the way out.
my $h = sub {
my $q = shift;
return sub {
my $n = shift;
return 1 if $n < 2;
return $n * $q->( $n - 1 );
};
};
sub fact6 {
my $f = shift;
return sub {
my $n = shift;
$h->( $f->( $f ) )->( $n );
}
}
# The same external interface.
print fact6( \&fact6 )->( 10 ), "\n";
# Now we wrap a function around fact6 and the recursive application of
# fact6 to a reference of itself, convert fact6 to an anonymous
# function which we store in a variable named $g, and voila, we end
# up with the Y combinator.
sub Y {
my $h = shift;
my $g = sub {
my $f = shift;
return sub {
my $n = shift;
$h->( $f->( $f ) )->( $n );
};
};
$g->( $g );
}
# We pass the function we used to have in $h as the argument to Y, and
# it gets bound as a function parameter.
my $fact =
Y( sub {
my $q = shift;
sub {
my $n = shift;
return 1 if $n < 2;
return $n * $q->( $n - 1 );
}
}
);
# Since $g->( $g ) is now encapsulated in Y we no longer need it in
# the calling syntax.
print $fact->( 10 ), "\n";
# While factorial is the most common recursive example it is easily
# and efficiently implemented iteratively, so it isn't the best
# demonstration of the power of recursive functions. Enumerating tree
# structure elements is a great example of a problem that recursive
# algorithms solve easily. This example shows how to use Y to
# recursively enumerate the contents of a directory tree.
my $files =
Y( sub {
my $f = shift;
sub {
my $file = shift;
return $file unless -d $file;
return () if( $file =~ qr{\.{1,2}} );
opendir DIR, $file or die "unable to open dir $file";
return $file, map { $f->( "$file\\$_" ) } readdir DIR;
}
}
);
# This requires a path to a directory with some sub directories in it.
# It recusivly lists files and directories under it.
print join "\n", $files->( 'D:\pub\src\perl\ycombinator' );
More information about the Oc-pm
mailing list