ArchiveOrangemail archive

Orange County Perl Mongers


oc-pm.pm.org
(List home) (Recent threads) (144 other Perl Mongers lists)

Subscription Options

  • RSS or Atom: Read-only subscription using a browser or aggregator. This is the recommended way if you don't need to send messages to the list. You can learn more about feed syndication and clients here.
  • Conventional: All messages are delivered to your mail address, and you can reply. To subscribe, send an email to the list's subscribe address with "subscribe" in the subject line, or visit the list's homepage here.
  • Low traffic list: less than 3 messages per day
  • This list contains about 345 messages, beginning Aug 2004
  • 0 messages added yesterday
Report the Spam
This button sends a spam report to the moderator. Please use it sparingly. For other removal requests, read this.
Are you sure? yes no

A derivation of the Y combinator implemented in perl

Ad
Pete Wilson 1180136159Fri, 25 May 2007 23:35:59 +0000 (UTC)
#! /usr/bin/perl
use warnings;
use strict;

# This was created after reading
# http://weblog.raganwald.com/2007/02/but-y-wou...
# 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' );
Home | About | Privacy