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.

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>