Y combinator

Y combinator
You are encouraged to solve this task according to the task description, using any language you may know.

In strict Functional Programming and the lambda calculus, functions, (lambda expressions) don't have state and are only allowed to refer to arguments of enclosing functions. This would rule out the more 'normal' definition of a recursive function where a function is associated with the state of a variable and this variables state is used in the body of the function.

The Y combinator is itself a stateless function, that when applied to another stateless function, returns a recursive version of the function. The Y combinator is the simplest of the class of such functions, called fixed point combinators.

The task is to define the stateless Y combinator and use it to compute factorials and Fibonacci numbers from other stateless functions or lambda expressions.

Note: The Python example shows one way to complete the task.

D

This is D 2.0 code.

Current state of the language doesn't allow to make //stateless// Y-combinator, where statless is defined as above.

However here are some proposals, how to make Y-combinator in D (though it it statically typed language), and what are the problems with creating //stateless// one.

The easies way to create Y-combinator looks probably like this:

<lang D> import std.stdio;

alias ulong delegate(ulong) delSigRec1; alias delSigRec1 delegate(delSigRec1) delSigAlmost; alias delSigRec1 delegate(delSigAlmost, void*) delSigPf;

void main() {

   delSigRec1 almostFac(delSigRec1 f) {
       return delegate ulong(ulong n) {
           return (n == 0 || n == 1) ? 1Lu : n * f(n-1);
       };
   };

   delSigRec1 almostFib(delSigRec1 f) {
       return delegate ulong(ulong n) {
           return (n == 0 || n == 1) ? 1Lu : f(n-2) + f(n-1);
       };
   };

   auto pf2 = delegate delSigRec1(delSigAlmost almost, void *x) {
       return delegate ulong(ulong n) {
           return ( (almost( (*cast(delSigPf*)x)(almost, x) )) ( n ) );
       };
   };

   delSigRec1 Ycomb(delSigAlmost almost) {
       return pf2(almost, &pf2);
   };

   auto fact = Ycomb(&almostFac);
   foreach (i; 1..15) writef(fact(i), ", "); writefln("");

   auto fibo = Ycomb(&almostFib);
   foreach (i; 1..20) writef(fibo(i), ", "); writefln("");

} </lang>

In D there's no way to create a function or delegate which would take as one of arguments, function or delegate with the same signature. This would probably require some recursive types.

• Because of that there is casting from void* to delSigPf delegate alias.

Delegates in d consist of a pair of pointers, so the other solution would be to pass pair of pointers, like in example below, but because of usage of a helper function toDel (which converts the two pointers back to delegate) I don't consider this as stateless Y-combinator. <lang D> alias delSigRec1 delegate(void*, void*) delSigPf; // we need to alter this alias

// simplified templates just for this example, can be found // in tango.core.Traits template TypeRet( Fn ) {

   static if( is( Fn Ret == return ) ) alias Ret TypeRet;
   else static assert(false);

}

template TypeParams( Fn ) {

   static if( is( Fn Params == delegate ) ) alias TypeParams!(Params) TypeParams;
   else static if( is( Fn Params == function ) ) alias Params TypeParams;
   else static assert( false );

}

auto toDel(T)(void *a, void *b) {

   T f; 
   f.ptr = a; 
   f.funcptr = cast(TypeRet!(T) function (TypeParams!(T)))b;
   return f;

}

...

   delSigRec1 Ycomb(delSigAlmost almost) {
       return delegate delSigRec1(delSigPf wrap) {
           return wrap(wrap.ptr, wrap.funcptr);
       }( delegate delSigRec1 (void *self_a, void *self_b) {
               return delegate ulong(ulong n) {
                   return ( (almost( 
                       toDel!(delSigPf)(self_a, self_b)(self_a, self_b)
                   )) ( n ) );
               };
           }
       );
   };

</lang>

This seems much better, but as mentioned needs the helper function (or declaration of variable inside the delegate that takes self_a and self_b).

The proper solution should probably look like that: <lang D> alias delSigRec1 delegate(void*) delSigPf; ...

   delSigRec1 Ycomb(delSigAlmost almost) {
       return delegate delSigRec1(delSigPf wrap) {
           return wrap(&wrap);
       }(  delegate delSigRec1(void *x) {
               return delegate ulong(ulong n) {
                   return ( (almost( (*cast(delSigPf*)x)(x) )) ( n ) );
               };
           }
       );
   };

</lang>

This will compile, but will fail when computing values. This happens probably because x inside most inner delegate points to a frame that no longer contains proper data during the call.

Haskell

<lang haskell>newtype Mu a = Roll { unroll :: Mu a -> a }

fix :: (a -> a) -> a fix = \f -> (\x -> f (unroll x x)) $ Roll (\x -> f (unroll x x))

fac :: Integer -> Integer fac = fix $ \f n -> if (n <= 0) then 1 else n * f (n-1)

fibs :: [Integer] fibs = fix $ \fbs -> 0 : 1 : fix zipP fbs (tail fbs)

 where zipP f (x:xs) (y:ys) = x+y : f xs ys

main = do

 print $ map fac [1 .. 20]
 print $ take 20 fibs</lang>

The usual version using recursion, disallowed by the task:

<lang haskell> fix :: (a -> a) -> a fix f = f (fix f)

fac :: Integer -> Integer fac' f n | n <= 0 = 1

        | otherwise = n * f (n-1)

fac = fix fac'

-- a simple but wasteful exponential time definition: fib :: Integer -> Integer fib' f 0 = 0 fib' f 1 = 1 fib' f n = f (n-1) + f (n-2) fib = fix fib'

-- Or for far more efficiency, compute a lazy infinite list. This is -- a Y-combinator version of: fibs = 0:1:zipWith (+) fibs (tail fibs) fibs :: [Integer] fibs' a = 0:1:(fix zipP a (tail a))

   where
     zipP f (x:xs) (y:ys) = x+y : f xs ys

fibs = fix fibs'

-- This code shows how the functions can be used: main = do

 print $ map fac [1 .. 20]
 print $ map fib [0 .. 19]
 print $ take 20 fibs</lang>

Joy

y   ==  [dup cons]  swap  concat  dup  cons  i

fac == [ [pop null]  [pop succ]  [[dup pred] dip i  *]  ifte ]  y

OCaml

<lang ocaml># type 'a mu = Roll of ('a mu -> 'a)

 let unroll (Roll x) = x
 
 let fix f = (fun x a -> f (unroll x x) a) (Roll (fun x a -> f (unroll x x) a))
 
 let fac f = function
     0 -> 1
   | n -> n * f (n-1)
 
 let fib f = function
     0 -> 0
   | 1 -> 1
   | n -> f (n-1) + f (n-2)

type 'a mu = Roll of ('a mu -> 'a) val unroll : 'a mu -> 'a mu -> 'a = <fun> val fix : (('a -> 'b) -> 'a -> 'b) -> 'a -> 'b = <fun> val fac : (int -> int) -> int -> int = <fun> val fib : (int -> int) -> int -> int = <fun>

1. fix fac 5;;

- : int = 120

1. fix fib 8;;

- : int = 21</lang>

The usual version using recursion, disallowed by the task:

<lang ocaml>let rec fix f x = f (fix f) x</lang>

Perl

<lang perl>my $Y = sub { my ($f) = @_; sub {my ($x) = @_; $x->($x)}->(sub {my ($y) = @_; $f->(sub {$y->($y)->(@_)})})}; my $fac = sub {my ($f) = @_; sub {my ($n) = @_; $n < 2 ? 1 : $n * $f->($n-1)}}; print join(' ', map {$Y->($fac)->($_)} 0..9), "\n"; my $fib = sub {my ($f) = @_; sub {my ($n) = @_; $n == 0 ? 0 : $n == 1 ? 1 : $f->($n-1) + $f->($n-2)}}; print join(' ', map {$Y->($fib)->($_)} 0..9), "\n";</lang>

Python

<lang python>>>> Y = lambda f: (lambda x: x(x))(lambda y: f(lambda *args: y(y)(*args))) >>> fac = lambda f: lambda n: (1 if n<2 else n*f(n-1)) >>> [ Y(fac)(i) for i in range(10) ] [1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880] >>> fib = lambda f: lambda n: 0 if n == 0 else (1 if n == 1 else f(n-1) + f(n-2)) >>> [ Y(fib)(i) for i in range(10) ] [0, 1, 1, 2, 3, 5, 8, 13, 21, 34]</lang>

Ruby

<lang ruby>irb(main):001:0> Y = lambda {|f| lambda {|x| x[x]}[lambda {|y| f[lambda {|*args| y[y][*args]}]}]} => #<Proc:0xb7d3cae0@(irb):1> irb(main):002:0> fac = lambda {|f| lambda {|n| n<2 ? 1 : n*f[n-1]}} => #<Proc:0xb7d2b330@(irb):2> irb(main):003:0> Array.new(10) {|i| Y[fac][i]} => [1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880] irb(main):004:0> fib = lambda {|f| lambda {|n| n == 0 ? 0 : n == 1 ? 1 : f[n-1] + f[n-2]}} => #<Proc:0xb7d0a1f8@(irb):4> irb(main):005:0> Array.new(10) {|i| Y[fib][i]} => [0, 1, 1, 2, 3, 5, 8, 13, 21, 34]</lang>

Scheme

Translation of: Python

<lang scheme>> (define (Y f) ((lambda (x) (x x)) (lambda (y) (f (lambda args (apply (y y) args)))))) > (define (fac f) (lambda (n) (if (= n 0) 1 (* n (f (- n 1)))))) > ((Y fac) 5) 120 > (define (fib f) (lambda (n) (cond ((= n 0) 0) ((= n 1) 1) (else (+ (f (- n 1)) (f (- n 2))))))) > ((Y fib) 8) 21</lang>

Standard ML

<lang sml>- datatype 'a mu = Roll of ('a mu -> 'a)

 fun unroll (Roll x) = x
 
 fun fix f = (fn x => fn a => f (unroll x x) a) (Roll (fn x => fn a => f (unroll x x) a))
 
 fun fac f 0 = 1
   | fac f n = n * f (n-1)
 
 fun fib f 0 = 0
   | fib f 1 = 1
   | fib f n = f (n-1) + f (n-2)

datatype 'a mu = Roll of 'a mu -> 'a val unroll = fn : 'a mu -> 'a mu -> 'a val fix = fn : (('a -> 'b) -> 'a -> 'b) -> 'a -> 'b val fac = fn : (int -> int) -> int -> int val fib = fn : (int -> int) -> int -> int - List.tabulate (10, fix fac); val it = [1,1,2,6,24,120,720,5040,40320,362880] : int list - List.tabulate (10, fix fib); val it = [0,1,1,2,3,5,8,13,21,34] : int list</lang>