Y combinator: Difference between revisions
| Line 2,689: | Line 2,689: | ||
fn main() { |
fn main() { |
||
//lists::test_list(); |
|||
println!( "{}", fac( 10 ) ); |
println!( "{}", fac( 10 ) ); |
||
println!( "{}", fib( 10 ) ); |
println!( "{}", fib( 10 ) ); |
||
Revision as of 18:16, 8 July 2017
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 rules out the usual definition of a recursive function wherein a function is associated with the state of a variable and this variable's 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.
- Task
Define the stateless Y combinator and use it to compute factorials and Fibonacci numbers from other stateless functions or lambda expressions.
- Cf
ALGOL 68
Note: This specimen retains the original Python coding style.
<lang algol68>BEGIN
MODE F = PROC(INT)INT; MODE Y = PROC(Y)F;
- compare python Y = lambda f: (lambda x: x(x)) (lambda y: f( lambda *args: y(y)(*args)))#
PROC y = (PROC(F)F f)F: ( (Y x)F: x(x)) ( (Y z)F: f((INT arg )INT: z(z)( arg )));
PROC fib = (F f)F: (INT n)INT: CASE n IN n,n OUT f(n-1) + f(n-2) ESAC;
FOR i TO 10 DO print(y(fib)(i)) OD
END</lang>
AppleScript
AppleScript is not particularly "functional" friendly. It can, however, support the Y combinator.
AppleScript does not have anonymous functions, but it does have anonymous objects. The code below implements the latter with the former (using a handler (i.e. function) named 'lambda' in each anonymous object).
Unfortunately, an anonymous object can only be created in its own statement ('script'...'end script' can not be in an expression). Thus, we have to apply Y to the automatic 'result' variable that holds the value of the previous statement.
The identifier used for Y uses "pipe quoting" to make it obviously distinct from the y used inside the definition. <lang AppleScript>-- Y COMBINATOR ---------------------------------------------------------------
on |Y|(f)
script
on |λ|(y)
script
on |λ|(x)
y's |λ|(y)'s |λ|(x)
end |λ|
end script
f's |λ|(result)
end |λ|
end script
result's |λ|(result)
end |Y|
-- TEST -----------------------------------------------------------------------
on run
-- Factorial
script fact
on |λ|(f)
script
on |λ|(n)
if n = 0 then return 1
n * (f's |λ|(n - 1))
end |λ|
end script
end |λ|
end script
-- Fibonacci
script fib
on |λ|(f)
script
on |λ|(n)
if n = 0 then return 0
if n = 1 then return 1
(f's |λ|(n - 2)) + (f's |λ|(n - 1))
end |λ|
end script
end |λ|
end script
{facts:map(|Y|(fact), enumFromTo(0, 11)), fibs:map(|Y|(fib), enumFromTo(0, 20))}
--> {facts:{1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880, 3628800, 39916800},
--> fibs:{0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987,
-- 1597, 2584, 4181, 6765}}
end run
-- GENERIC FUNCTIONS FOR TEST -------------------------------------------------
-- map :: (a -> b) -> [a] -> [b] on map(f, xs)
tell mReturn(f)
set lng to length of xs
set lst to {}
repeat with i from 1 to lng
set end of lst to |λ|(item i of xs, i, xs)
end repeat
return lst
end tell
end map
-- enumFromTo :: Int -> Int -> [Int] on enumFromTo(m, n)
if n < m then
set d to -1
else
set d to 1
end if
set lst to {}
repeat with i from m to n by d
set end of lst to i
end repeat
return lst
end enumFromTo
-- Lift 2nd class handler function into 1st class script wrapper -- mReturn :: Handler -> Script on mReturn(f)
if class of f is script then
f
else
script
property |λ| : f
end script
end if
end mReturn</lang>
- Output:
<lang AppleScript>{facts:{1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880, 3628800, 39916800}, fibs:{0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597, 2584, 4181, 6765}}</lang>
ATS
<lang ATS> (* ****** ****** *) //
- include "share/atspre_staload.hats"
// (* ****** ****** *) // fun myfix {a:type} (
f: lazy(a) -<cloref1> a
) : lazy(a) = $delay(f(myfix(f))) // val fact = myfix{int-<cloref1>int} ( lam(ff) => lam(x) => if x > 0 then x * !ff(x-1) else 1 ) (* ****** ****** *) // implement main0 () = println! ("fact(10) = ", !fact(10)) // (* ****** ****** *) </lang>
BlitzMax
BlitzMax doesn't support anonymous functions or classes, so everything needs to be explicitly named. <lang blitzmax>SuperStrict
'Boxed type so we can just use object arrays for argument lists Type Integer Field val:Int Function Make:Integer(_val:Int) Local i:Integer = New Integer i.val = _val Return i End Function End Type
'Higher-order function type - just a procedure attached to a scope
Type Func Abstract
Method apply:Object(args:Object[]) Abstract
End Type
'Function definitions - extend with fields as locals and implement apply as body Type Scope Extends Func Abstract Field env:Scope
'Constructor - bind an environment to a procedure Function lambda:Scope(env:Scope) Abstract
Method _init:Scope(_env:Scope) 'Helper to keep constructors small env = _env ; Return Self End Method End Type
'Based on the following definition:
'(define (Y f)
' (let ((_r (lambda (r) (f (lambda a (apply (r r) a))))))
' (_r _r)))
'Y (outer) Type Y Extends Scope Field f:Func 'Parameter - gets closed over
Function lambda:Scope(env:Scope) 'Necessary due to highly limited constructor syntax Return (New Y)._init(env) End Function
Method apply:Func(args:Object[]) f = Func(args[0]) Local _r:Func = YInner1.lambda(Self) Return Func(_r.apply([_r])) End Method End Type
'First lambda within Y Type YInner1 Extends Scope Field r:Func 'Parameter - gets closed over
Function lambda:Scope(env:Scope) Return (New YInner1)._init(env) End Function
Method apply:Func(args:Object[]) r = Func(args[0]) Return Func(Y(env).f.apply([YInner2.lambda(Self)])) End Method End Type
'Second lambda within Y Type YInner2 Extends Scope Field a:Object[] 'Parameter - not really needed, but good for clarity
Function lambda:Scope(env:Scope) Return (New YInner2)._init(env) End Function
Method apply:Object(args:Object[]) a = args Local r:Func = YInner1(env).r Return Func(r.apply([r])).apply(a) End Method End Type
'Based on the following definition:
'(define fac (Y (lambda (f)
' (lambda (x)
' (if (<= x 0) 1 (* x (f (- x 1)))))))
Type FacL1 Extends Scope Field f:Func 'Parameter - gets closed over
Function lambda:Scope(env:Scope) Return (New FacL1)._init(env) End Function
Method apply:Object(args:Object[]) f = Func(args[0]) Return FacL2.lambda(Self) End Method End Type
Type FacL2 Extends Scope Function lambda:Scope(env:Scope) Return (New FacL2)._init(env) End Function
Method apply:Object(args:Object[]) Local x:Int = Integer(args[0]).val If x <= 0 Then Return Integer.Make(1) ; Else Return Integer.Make(x * Integer(FacL1(env).f.apply([Integer.Make(x - 1)])).val) End Method End Type
'Based on the following definition:
'(define fib (Y (lambda (f)
' (lambda (x)
' (if (< x 2) x (+ (f (- x 1)) (f (- x 2)))))))
Type FibL1 Extends Scope Field f:Func 'Parameter - gets closed over
Function lambda:Scope(env:Scope) Return (New FibL1)._init(env) End Function
Method apply:Object(args:Object[]) f = Func(args[0]) Return FibL2.lambda(Self) End Method End Type
Type FibL2 Extends Scope Function lambda:Scope(env:Scope) Return (New FibL2)._init(env) End Function
Method apply:Object(args:Object[]) Local x:Int = Integer(args[0]).val If x < 2 Return Integer.Make(x) Else Local f:Func = FibL1(env).f Local x1:Int = Integer(f.apply([Integer.Make(x - 1)])).val Local x2:Int = Integer(f.apply([Integer.Make(x - 2)])).val Return Integer.Make(x1 + x2) EndIf End Method End Type
'Now test
Local _Y:Func = Y.lambda(Null)
Local fac:Func = Func(_Y.apply([FacL1.lambda(Null)])) Print Integer(fac.apply([Integer.Make(10)])).val
Local fib:Func = Func(_Y.apply([FibL1.lambda(Null)])) Print Integer(fib.apply([Integer.Make(10)])).val</lang>
Bracmat
The lambda abstraction
(λx.x)y
translates to
/('(x.$x))$y
in Bracmat code. Likewise, the fixed point combinator
Y := λg.(λx.g (x x)) (λx.g (x x))
the factorial
G := λr. λn.(1, if n = 0; else n × (r (n−1)))
the Fibonacci function
H := λr. λn.(1, if n = 1 or n = 2; else (r (n−1)) + (r (n−2)))
and the calls
(Y G) i
and
(Y H) i
where i varies between 1 and 10, are translated into Bracmat as shown below <lang bracmat>( ( Y
= /(
' ( g
. /('(x.$g'($x'$x)))
$ /('(x.$g'($x'$x)))
)
)
)
& ( G
= /(
' ( r
. /(
' ( n
. $n:~>0&1
| $n*($r)$($n+-1)
)
)
)
)
)
& ( H
= /(
' ( r
. /(
' ( n
. $n:(1|2)&1
| ($r)$($n+-1)+($r)$($n+-2)
)
)
)
)
)
& 0:?i
& whl
' ( 1+!i:~>10:?i
& out$(str$(!i "!=" (!Y$!G)$!i))
)
& 0:?i
& whl
' ( 1+!i:~>10:?i
& out$(str$("fib(" !i ")=" (!Y$!H)$!i))
)
&
)</lang>
- Output:
1!=1 2!=2 3!=6 4!=24 5!=120 6!=720 7!=5040 8!=40320 9!=362880 10!=3628800 fib(1)=1 fib(2)=1 fib(3)=2 fib(4)=3 fib(5)=5 fib(6)=8 fib(7)=13 fib(8)=21 fib(9)=34 fib(10)=55
C
C doesn't have first class functions, so we demote everything to second class to match.<lang C>#include <stdio.h>
- include <stdlib.h>
/* func: our one and only data type; it holds either a pointer to
a function call, or an integer. Also carry a func pointer to a potential parameter, to simulate closure */
typedef struct func_t *func; typedef struct func_t {
func (*fn) (func, func);
func _;
int num;
} func_t;
func new(func(*f)(func, func), func _) {
func x = malloc(sizeof(func_t));
x->fn = f;
x->_ = _; /* closure, sort of */
x->num = 0;
return x;
}
func call(func f, func n) {
return f->fn(f, n);
}
func Y(func(*f)(func, func)) {
func g = new(f, 0);
g->_ = g;
return g;
}
func num(int n) {
func x = new(0, 0);
x->num = n;
return x;
}
func fac(func self, func n) {
int nn = n->num;
return nn > 1 ? num(nn * call(self->_, num(nn - 1))->num)
: num(1);
}
func fib(func self, func n) {
int nn = n->num;
return nn > 1
? num( call(self->_, num(nn - 1))->num +
call(self->_, num(nn - 2))->num )
: num(1);
}
void show(func n) { printf(" %d", n->num); }
int main() {
int i;
func f = Y(fac);
printf("fac: ");
for (i = 1; i < 10; i++)
show( call(f, num(i)) );
printf("\n");
f = Y(fib);
printf("fib: ");
for (i = 1; i < 10; i++)
show( call(f, num(i)) );
printf("\n");
return 0;
} </lang>
- Output:
fac: 1 2 6 24 120 720 5040 40320 362880 fib: 1 2 3 5 8 13 21 34 55
C#
<lang csharp>using System;
static class YCombinator<T> {
delegate Func<T, T> Recursive(Recursive recursive);
public static Func<Func<Func<T, T>, Func<T, T>>, Func<T, T>> Fix =
f => ((Recursive)(g =>
(f(x => g(g)(x)))))((Recursive)(g => f(x => g(g)(x))));
}
class Program {
static Func<int, int> fac = YCombinator<int>.Fix(f => x => x < 2 ? 1 : x * f(x - 1)); static Func<int, int> fib = YCombinator<int>.Fix(f => x => x < 2 ? x : f(x - 1) + f(x - 2));
static void Main() {
Console.WriteLine(fac(10));
Console.WriteLine(fib(10));
}
}</lang>
- Output:
3628800 55
C++
Known to work with GCC 4.7.2. Compile with
g++ --std=c++11 ycomb.cc
<lang cpp>#include <iostream>
- include <functional>
template <typename F> struct RecursiveFunc { std::function<F(RecursiveFunc)> o; };
template <typename A, typename B> std::function<B(A)> Y (std::function<std::function<B(A)>(std::function<B(A)>)> f) { RecursiveFunc<std::function<B(A)>> r = { std::function<std::function<B(A)>(RecursiveFunc<std::function<B(A)>>)>([f](RecursiveFunc<std::function<B(A)>> w) { return f(std::function<B(A)>([w](A x) { return w.o(w)(x); })); }) }; return r.o(r); }
typedef std::function<int(int)> Func; typedef std::function<Func(Func)> FuncFunc; FuncFunc almost_fac = [](Func f) { return Func([f](int n) { if (n <= 1) return 1; return n * f(n - 1); }); };
FuncFunc almost_fib = [](Func f) { return Func([f](int n) { if (n <= 2) return 1; return f(n - 1) + f(n - 2); }); };
int main() { auto fib = Y(almost_fib); auto fac = Y(almost_fac); std::cout << "fib(10) = " << fib(10) << std::endl; std::cout << "fac(10) = " << fac(10) << std::endl; return 0; }</lang>
- Output:
fib(10) = 55 fac(10) = 3628800
A shorter version, taking advantage of generic lambdas. Known to work with GCC 5.2.0, but likely some earlier versions as well. Compile with
g++ --std=c++14 ycomb.cc
<lang cpp>#include <iostream>
- include <functional>
int main () {
auto y = ([] (auto f) { return
([] (auto x) { return x (x); }
([=] (auto y) -> std:: function <int (int)> { return
f ([=] (auto a) { return
(y (y)) (a) ;});}));});
auto almost_fib = [] (auto f) { return
[=] (auto n) { return
n < 2? n: f (n - 1) + f (n - 2) ;};};
auto almost_fac = [] (auto f) { return
[=] (auto n) { return
n <= 1? n: n * f (n - 1); };};
auto fib = y (almost_fib);
auto fac = y (almost_fac);
std:: cout << fib (10) << '\n'
<< fac (10) << '\n';
}</lang>
- Output:
fib(10) = 55 fac(10) = 3628800
The usual version using recursion, disallowed by the task: <lang cpp>template <typename A, typename B> std::function<B(A)> Y (std::function<std::function<B(A)>(std::function<B(A)>)> f) { return [f](A x) { return f(Y(f))(x); }; }</lang>
Another version which is disallowed because a function passes itself, which is also a kind of recursion: <lang cpp>template <typename A, typename B> struct YFunctor {
const std::function<std::function<B(A)>(std::function<B(A)>)> f;
YFunctor(std::function<std::function<B(A)>(std::function<B(A)>)> _f) : f(_f) {}
B operator()(A x) const {
return f(*this)(x);
}
};
template <typename A, typename B> std::function<B(A)> Y (std::function<std::function<B(A)>(std::function<B(A)>)> f) {
return YFunctor<A,B>(f);
}</lang>
Ceylon
Using a class for the recursive type: <lang ceylon>Result(*Args) y1<Result,Args>(
Result(*Args)(Result(*Args)) f)
given Args satisfies Anything[] {
class RecursiveFunction(o) {
shared Result(*Args)(RecursiveFunction) o;
}
value r = RecursiveFunction((RecursiveFunction w)
=> f(flatten((Args args) => w.o(w)(*args))));
return r.o(r);
}
value factorialY1 = y1((Integer(Integer) fact)(Integer x)
=> if (x > 1) then x * fact(x - 1) else 1);
value fibY1 = y1((Integer(Integer) fib)(Integer x)
=> if (x > 2) then fib(x - 1) + fib(x - 2) else 2);
print(factorialY1(10)); // 3628800 print(fibY1(10)); // 110</lang>
Using Anything to erase the function type: <lang ceylon>Result(*Args) y2<Result,Args>(
Result(*Args)(Result(*Args)) f)
given Args satisfies Anything[] {
function r(Anything w) {
assert (is Result(*Args)(Anything) w);
return f(flatten((Args args) => w(w)(*args)));
}
return r(r);
}</lang>
Using recursion, this does not satisfy the task requirements, but is included here for illustrative purposes: <lang ceylon>Result(*Args) y3<Result, Args>(
Result(*Args)(Result(*Args)) f)
given Args satisfies Anything[]
=> flatten((Args args) => f(y3(f))(*args));</lang>
Clojure
<lang lisp>(defn Y [f]
((fn [x] (x x))
(fn [x]
(f (fn [& args]
(apply (x x) args))))))
(def fac
(fn [f]
(fn [n]
(if (zero? n) 1 (* n (f (dec n)))))))
(def fib
(fn [f]
(fn [n]
(condp = n
0 0
1 1
(+ (f (dec n))
(f (dec (dec n))))))))</lang>
- Output:
user> ((Y fac) 10) 3628800 user> ((Y fib) 10) 55
Y can be written slightly more concisely via syntax sugar:
<lang lisp>(defn Y [f]
(#(% %) #(f (fn [& args] (apply (% %) args)))))</lang>
Common Lisp
<lang lisp>(defun Y (f)
((lambda (x) (funcall x x))
(lambda (y)
(funcall f (lambda (&rest args)
(apply (funcall y y) args))))))
(defun fac (f)
(lambda (n) (if (zerop n)
1 (* n (funcall f (1- n))))))
(defun fib (f)
(lambda (n)
(case n
(0 0)
(1 1)
(otherwise (+ (funcall f (- n 1))
(funcall f (- n 2)))))))
? (mapcar (Y #'fac) '(1 2 3 4 5 6 7 8 9 10)) (1 2 6 24 120 720 5040 40320 362880 3628800))
? (mapcar (Y #'fib) '(1 2 3 4 5 6 7 8 9 10)) (1 1 2 3 5 8 13 21 34 55)
</lang>
CoffeeScript
<lang coffeescript>Y = (f) -> g = f( (t...) -> g(t...) )</lang> or <lang coffeescript>Y = (f) -> ((h)->h(h))((h)->f((t...)->h(h)(t...)))</lang> <lang coffeescript>fac = Y( (f) -> (n) -> if n > 1 then n * f(n-1) else 1 ) fib = Y( (f) -> (n) -> if n > 1 then f(n-1) + f(n-2) else n ) </lang>
D
A stateless generic Y combinator: <lang d>import std.stdio, std.traits, std.algorithm, std.range;
auto Y(S, T...)(S delegate(T) delegate(S delegate(T)) f) {
static struct F {
S delegate(T) delegate(F) f;
alias f this;
}
return (x => x(x))(F(x => f((T v) => x(x)(v))));
}
void main() { // Demo code:
auto factorial = Y((int delegate(int) self) =>
(int n) => 0 == n ? 1 : n * self(n - 1)
);
auto ackermann = Y((ulong delegate(ulong, ulong) self) =>
(ulong m, ulong n) {
if (m == 0) return n + 1;
if (n == 0) return self(m - 1, 1);
return self(m - 1, self(m, n - 1));
});
writeln("factorial: ", 10.iota.map!factorial);
writeln("ackermann(3, 5): ", ackermann(3, 5));
}</lang>
- Output:
factorial: [1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880] ackermann(3, 5): 253
Déjà Vu
<lang dejavu>Y f: labda y: labda: call y @y f labda x: x @x call
labda f: labda n: if < 1 n: * n f -- n else: 1 set :fac Y
labda f: labda n: if < 1 n: + f - n 2 f -- n else: 1 set :fib Y
!. fac 6 !. fib 6</lang>
- Output:
720 13
Delphi
May work with Delphi 2009 and 2010 too.
(The translation is not literal; e.g. the function argument type is left unspecified to increase generality.) <lang delphi>program Y;
{$APPTYPE CONSOLE}
uses
SysUtils;
type
YCombinator = class sealed class function Fix<T> (F: TFunc<TFunc<T, T>, TFunc<T, T>>): TFunc<T, T>; static; end;
TRecursiveFuncWrapper<T> = record // workaround required because of QC #101272 (http://qc.embarcadero.com/wc/qcmain.aspx?d=101272) type TRecursiveFunc = reference to function (R: TRecursiveFuncWrapper<T>): TFunc<T, T>; var O: TRecursiveFunc; end;
class function YCombinator.Fix<T> (F: TFunc<TFunc<T, T>, TFunc<T, T>>): TFunc<T, T>; var
R: TRecursiveFuncWrapper<T>;
begin
R.O := function (W: TRecursiveFuncWrapper<T>): TFunc<T, T>
begin
Result := F (function (I: T): T
begin
Result := W.O (W) (I);
end);
end;
Result := R.O (R);
end;
type
IntFunc = TFunc<Integer, Integer>;
function AlmostFac (F: IntFunc): IntFunc; begin
Result := function (N: Integer): Integer
begin
if N <= 1 then
Result := 1
else
Result := N * F (N - 1);
end;
end;
function AlmostFib (F: TFunc<Integer, Integer>): TFunc<Integer, Integer>; begin
Result := function (N: Integer): Integer
begin
if N <= 2 then
Result := 1
else
Result := F (N - 1) + F (N - 2);
end;
end;
var
Fib, Fac: IntFunc;
begin
Fib := YCombinator.Fix<Integer> (AlmostFib);
Fac := YCombinator.Fix<Integer> (AlmostFac);
Writeln ('Fib(10) = ', Fib (10));
Writeln ('Fac(10) = ', Fac (10));
end.</lang>
E
<lang e>def y := fn f { fn x { x(x) }(fn y { f(fn a { y(y)(a) }) }) } def fac := fn f { fn n { if (n<2) {1} else { n*f(n-1) } }} def fib := fn f { fn n { if (n == 0) {0} else if (n == 1) {1} else { f(n-1) + f(n-2) } }}</lang>
<lang e>? pragma.enable("accumulator") ? accum [] for i in 0..!10 { _.with(y(fac)(i)) } [1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880]
? accum [] for i in 0..!10 { _.with(y(fib)(i)) } [0, 1, 1, 2, 3, 5, 8, 13, 21, 34]</lang>
EchoLisp
<lang scheme>
(define Y
(lambda (X)
((lambda (procedure)
(X (lambda (arg) ((procedure procedure) arg))))
(lambda (procedure)
(X (lambda (arg) ((procedure procedure) arg)))))))
- Fib
(define Fib* (lambda (func-arg)
(lambda (n) (if (< n 2) n (+ (func-arg (- n 1)) (func-arg (- n 2)))))))
(define fib (Y Fib*)) (fib 6)
→ 8
- Fact
(define F*
(lambda (func-arg) (lambda (n) (if (zero? n) 1 (* n (func-arg (- n 1)))))))
(define fact (Y F*))
(fact 10)
→ 3628800
</lang>
Eero
Translated from Objective-C example on this page. <lang objc>#import <Foundation/Foundation.h>
typedef int (^Func)(int) typedef Func (^FuncFunc)(Func) typedef Func (^RecursiveFunc)(id) // hide recursive typing behind dynamic typing
Func fix(FuncFunc f)
Func r(RecursiveFunc g)
int s(int x)
return g(g)(x)
return f(s)
return r(r)
int main(int argc, const char *argv[])
autoreleasepool
Func almost_fac(Func f)
return (int n | return n <= 1 ? 1 : n * f(n - 1))
Func almost_fib(Func f)
return (int n | return n <= 2 ? 1 : f(n - 1) + f(n - 2))
fib := fix(almost_fib) fac := fix(almost_fac)
Log('fib(10) = %d', fib(10))
Log('fac(10) = %d', fac(10))
return 0</lang>
Ela
<lang ela>fix = \f -> (\x -> & f (x x)) (\x -> & f (x x))
fac _ 0 = 1 fac f n = n * f (n - 1)
fib _ 0 = 0 fib _ 1 = 1 fib f n = f (n - 1) + f (n - 2)
(fix fac 12, fix fib 12)</lang>
- Output:
(479001600,144)
Elixir
<lang elixir> iex(1)> yc = fn f -> (fn x -> x.(x) end).(fn y -> f.(fn arg -> y.(y).(arg) end) end) end
- Function<6.90072148/1 in :erl_eval.expr/5>
iex(2)> fac = fn f -> fn n -> if n < 2 do 1 else n * f.(n-1) end end end
- Function<6.90072148/1 in :erl_eval.expr/5>
iex(3)> for i <- 0..9, do: yc.(fac).(i) [1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880] iex(4)> fib = fn f -> fn n -> if n == 0 do 0 else (if n == 1 do 1 else f.(n-1) + f.(n-2) end) end end end
- Function<6.90072148/1 in :erl_eval.expr/5>
iex(5)> for i <- 0..9, do: yc.(fib).(i) [0, 1, 1, 2, 3, 5, 8, 13, 21, 34] </lang>
Erlang
<lang erlang>Y = fun(M) -> (fun(X) -> X(X) end)(fun (F) -> M(fun(A) -> (F(F))(A) end) end) end.
Fac = fun (F) ->
fun (0) -> 1;
(N) -> N * F(N-1)
end
end.
Fib = fun(F) ->
fun(0) -> 0;
(1) -> 1;
(N) -> F(N-1) + F(N-2)
end
end.
(Y(Fac))(5). %% 120 (Y(Fib))(8). %% 21</lang>
F#
<lang fsharp>type 'a mu = Roll of ('a mu -> 'a) // ease syntax colouring confusion with '
let unroll (Roll x) = x // val unroll : 'a mu -> ('a mu -> 'a)
let fix f = let g = fun x a -> f (unroll x x) a in g (Roll g) // val fix : (('a -> 'b) -> 'a -> 'b) -> 'a -> 'b = <fun>
let fac = fix (fun f n -> if n < 2 then 1 else n * f (n - 1)) // val fac : (int -> int) -> int -> int = <fun>
let fib = fix (fun f n -> if n < 2 then n else f (n - 1) + f (n - 2)) // val fib : (int -> int) -> int -> int = <fun>
[<EntryPoint>] let main argv =
fac 10 |> printfn "%A" // prints 3628800 fib 10 |> printfn "%A" // prints 55 0 // return an integer exit code</lang>
- Output:
3628800 55
Factor
In rosettacode/Y.factor <lang factor>USING: fry kernel math ; IN: rosettacode.Y
- Y ( quot -- quot )
'[ [ dup call call ] curry @ ] dup call ; inline
- almost-fac ( quot -- quot )
'[ dup zero? [ drop 1 ] [ dup 1 - @ * ] if ] ;
- almost-fib ( quot -- quot )
'[ dup 2 >= [ 1 2 [ - @ ] bi-curry@ bi + ] when ] ;</lang>
In rosettacode/Y-tests.factor <lang factor>USING: kernel tools.test rosettacode.Y ; IN: rosettacode.Y.tests
[ 120 ] [ 5 [ almost-fac ] Y call ] unit-test [ 8 ] [ 6 [ almost-fib ] Y call ] unit-test</lang> running the tests :
( scratchpad - auto ) "rosettacode.Y" test
Loading resource:work/rosettacode/Y/Y-tests.factor
Unit Test: { [ 120 ] [ 5 [ almost-fac ] Y call ] }
Unit Test: { [ 8 ] [ 6 [ almost-fib ] Y call ] }
Forth
<lang Forth>\ Address of an xt. variable 'xt \ Make room for an xt.
- xt, ( -- ) here 'xt ! 1 cells allot ;
\ Store xt.
- !xt ( xt -- ) 'xt @ ! ;
\ Compile fetching the xt.
- @xt, ( -- ) 'xt @ postpone literal postpone @ ;
\ Compile the Y combinator.
- y, ( xt1 -- xt2 ) >r :noname @xt, r> compile, postpone ; ;
\ Make a new instance of the Y combinator.
- y ( xt1 -- xt2 ) xt, y, dup !xt ;</lang>
Samples: <lang Forth>\ Factorial 10 :noname ( u1 xt -- u2 ) over ?dup if 1- swap execute * else 2drop 1 then ; y execute . 3628800 ok
\ Fibonacci 10 :noname ( u1 xt -- u2 ) over 2 < if drop else >r 1- dup r@ execute swap 1- r> execute + then ; y execute . 55 ok </lang>
Falcon
<lang Falcon> Y = { f => {x=> {n => f(x(x))(n)}} ({x=> {n => f(x(x))(n)}}) } facStep = { f => {x => x < 1 ? 1 : x*f(x-1) }} fibStep = { f => {x => x == 0 ? 0 : (x == 1 ? 1 : f(x-1) + f(x-2))}}
YFac = Y(facStep) YFib = Y(fibStep)
> "Factorial 10: ", YFac(10) > "Fibonacci 10: ", YFib(10) </lang>
GAP
<lang gap>Y := function(f)
local u; u := x -> x(x); return u(y -> f(a -> y(y)(a)));
end;
fib := function(f)
local u;
u := function(n)
if n < 2 then
return n;
else
return f(n-1) + f(n-2);
fi;
end;
return u;
end;
Y(fib)(10);
- 55
fac := function(f)
local u;
u := function(n)
if n < 2 then
return 1;
else
return n*f(n-1);
fi;
end;
return u;
end;
Y(fac)(8);
- 40320</lang>
Genyris
<lang genyris>def fac (f)
function (n)
if (equal? n 0) 1
* n (f (- n 1))
def fib (f)
function (n)
cond
(equal? n 0) 0
(equal? n 1) 1
else (+ (f (- n 1)) (f (- n 2)))
def Y (f)
(function (x) (x x))
function (y)
f
function (&rest args) (apply (y y) args)
assertEqual ((Y fac) 5) 120 assertEqual ((Y fib) 8) 21</lang>
Go
<lang go>package main
import "fmt"
type Func func(int) int type FuncFunc func(Func) Func type RecursiveFunc func (RecursiveFunc) Func
func main() { fac := Y(almost_fac) fib := Y(almost_fib) fmt.Println("fac(10) = ", fac(10)) fmt.Println("fib(10) = ", fib(10)) }
func Y(f FuncFunc) Func { g := func(r RecursiveFunc) Func { return f(func(x int) int { return r(r)(x) }) } return g(g) }
func almost_fac(f Func) Func { return func(x int) int { if x <= 1 { return 1 } return x * f(x-1) } }
func almost_fib(f Func) Func { return func(x int) int { if x <= 2 { return 1 } return f(x-1)+f(x-2) } }</lang>
- Output:
fac(10) = 3628800 fib(10) = 55
The usual version using recursion, disallowed by the task: <lang go>func Y(f FuncFunc) Func { return func(x int) int { return f(Y(f))(x) } }</lang>
Groovy
Here is the simplest (unary) form of applicative order Y: <lang groovy>def Y = { le -> ({ f -> f(f) })({ f -> le { x -> f(f)(x) } }) }
def factorial = Y { fac ->
{ n -> n <= 2 ? n : n * fac(n - 1) }
}
assert 2432902008176640000 == factorial(20G)
def fib = Y { fibStar ->
{ n -> n <= 1 ? n : fibStar(n - 1) + fibStar(n - 2) }
}
assert fib(10) == 55</lang> This version was translated from the one in The Little Schemer by Friedman and Felleisen. The use of the variable name le is due to the fact that the authors derive Y from an ordinary recursive length function.
A variadic version of Y in Groovy looks like this: <lang groovy>def Y = { le -> ({ f -> f(f) })({ f -> le { Object[] args -> f(f)(*args) } }) }
def mul = Y { mulStar -> { a, b -> a ? b + mulStar(a - 1, b) : 0 } }
1.upto(10) {
assert mul(it, 10) == it * 10
}</lang>
Haskell
The obvious definition of Y combinator (\f-> (\x -> f (x x)) (\x-> f (x x))) cannot be used in Haskell because it contains an infinite recursive type (a = a -> b). Defining a data type (Mu) allows this recursion to be broken.
<lang haskell>newtype Mu a = Roll
{ unroll :: Mu a -> a }
fix :: (a -> a) -> a fix = g <*> (Roll . g)
where g = (. (>>= id) unroll)
fac :: Integer -> Integer fac =
fix $
\f n ->
(if n <= 0
then 1
else n * f (n - 1))
fibs :: [Integer] fibs =
fix $ (0 :) . (1 :) . (fix (\f (x:xs) (y:ys) -> x + y : f xs ys) <*> tail)
main :: IO () main =
mapM_ print [ map fac [1 .. 20] , take 20 fibs ]</lang>
The usual version uses recursion, disallowed by the task, to define the fix itself; but the definitions produced by this fix do not use recursion, so it can be viewed as a true Y-combinator too:
<lang haskell>fix :: (a -> a) -> a fix f = f (fix f) -- _not_ the {fix f = x where x = f x}
fac :: Integer -> Integer fac_ f n
| n <= 0 = 1 | otherwise = n * f (n - 1)
fac = fix fac_ -- fac_ (fac_ . fac_ . fac_ . 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 : IO () main =
mapM_ print [ map fac [1 .. 20] , map fib [0 .. 19] , take 20 fibs ]</lang>
J
Tacit version
In J, functions cannot take functions of the same type as arguments. In other words, verbs cannot take verbs and adverbs or conjunctions cannot take adverbs or conjunctions. However, the Y combinator can be implemented indirectly using, for example, the linear representations of verbs. (Y becomes a wrapper which takes a verb as an argument and serializes it, and the underlying self referring system interprets the serialized representation of a verb as the corresponding verb): <lang j>Y=. ((((&>)/)((((^:_1)b.)(`(<'0';_1)))(`:6)))(&([ 128!:2 ,&<)))</lang> The factorial and Fibonacci examples: <lang j> u=. [ NB. Function (left)
n=. ] NB. Argument (right) sr=. [ apply f. ,&< NB. Self referring fac=. (1:`(n * u sr n - 1:)) @. (0 < n) fac f. Y 10
3628800
Fib=. ((u sr n - 2:) + u sr n - 1:) ^: (1 < n) Fib f. Y 10
55</lang> The functions' stateless codings are shown next: <lang j> fac f. Y NB. Showing the stateless recursive factorial function... '1:`(] * [ ([ 128!:2 ,&<) ] - 1:)@.(0 < ])&>/'&([ 128!:2 ,&<)
fac f. NB. Showing the stateless factorial step...
1:`(] * [ ([ 128!:2 ,&<) ] - 1:)@.(0 < ])
Fib f. Y NB. Showing the stateless recursive Fibonacci function...
'(([ ([ 128!:2 ,&<) ] - 2:) + [ ([ 128!:2 ,&<) ] - 1:)^:(1 < ])&>/'&([ 128!:2 ,&<)
Fib f. NB. Showing the stateless Fibonacci step...
(([ ([ 128!:2 ,&<) ] - 2:) + [ ([ 128!:2 ,&<) ] - 1:)^:(1 < ])</lang> A structured derivation of Y follows: <lang j> sr=. [ apply f.,&< NB. Self referring
lv=. (((^:_1)b.)(`(<'0';_1)))(`:6) NB. Linear representation of a verb argument Y=. (&>)/lv(&sr) f. NB. Y combinator Y=. 'Y'f. NB. Fixing it</lang>
Explicit alternate implementation
Another approach uses a J gerund as a "lambda" which can accept a single argument, and `:6 to mark a value which would correspond to the first element of an evaluated list in a lisp-like language.
(Multiple argument lambdas are handled by generating and evaluating an appropriate sequence of these lambdas -- in other words, (lambda (x y z) ...) is implemented as (lambda (x) (lambda (y) (lambda (z) ...))) and that particular example would be used as (((example X) Y) Z)) -- or, using J's syntax, that particular example would be used as: ((example`:6 X)`:6 Y)`:6 Z -- but we can also define a word with the value `:6 for a hypothetical slight increase in clarity.
<lang j>lambda=:3 :0
if. 1=#;:y do.
3 :(y,'=.y',LF,0 :0)`
else.
(,<#;:y) Defer (3 :(',y,=.y',LF,0 :0))`
end.
)
Defer=:2 :0
if. (_1 {:: m) <: #m do.
v |. y;_1 }. m
else.
(y;m) Defer v`
end.
)
recursivelY=: lambda 'g recur x'
(g`:6 recur`:6 recur)`:6 x
)
sivelY=: lambda 'g recur'
(recursivelY`:6 g)`:6 recur
)
Y=: lambda 'g'
recur=. sivelY`:6 g recur`:6 recur
)
almost_factorial=: lambda 'f n'
if. 0 >: n do. 1 else. n * f`:6 n-1 end.
)
almost_fibonacci=: lambda 'f n'
if. 2 > n do. n else. (f`:6 n-1) + f`:6 n-2 end.
)
Ev=: `:6</lang>
Example use:
<lang J> (Y Ev almost_factorial)Ev 9 362880
(Y Ev almost_fibonacci)Ev 9
34
(Y Ev almost_fibonacci)Ev"0 i. 10
0 1 1 2 3 5 8 13 21 34</lang>
Note that the names f and recur will experience the same value (which will be the value produced by sivelY g).
Java
<lang java5>import java.util.function.Function;
public interface YCombinator {
interface RecursiveFunction<F> extends Function<RecursiveFunction<F>, F> { }
public static <A,B> Function<A,B> Y(Function<Function<A,B>, Function<A,B>> f) {
RecursiveFunction<Function<A,B>> r = w -> f.apply(x -> w.apply(w).apply(x));
return r.apply(r);
}
public static void main(String... arguments) {
Function<Integer,Integer> fib = Y(f -> n ->
(n <= 2)
? 1
: (f.apply(n - 1) + f.apply(n - 2))
);
Function<Integer,Integer> fac = Y(f -> n ->
(n <= 1)
? 1
: (n * f.apply(n - 1));
);
System.out.println("fib(10) = " + fib.apply(10));
System.out.println("fac(10) = " + fac.apply(10));
}
}</lang>
- Output:
fib(10) = 55 fac(10) = 3628800
The usual version using recursion, disallowed by the task: <lang java5> public static <A,B> Function<A,B> Y(Function<Function<A,B>, Function<A,B>> f) {
return x -> f.apply(Y(f)).apply(x); }</lang>
Another version which is disallowed because a function passes itself, which is also a kind of recursion: <lang java5> public static <A,B> Function<A,B> Y(Function<Function<A,B>, Function<A,B>> f) {
return new Function<A,B>() {
public B apply(A x) { return f.apply(this).apply(x); } };
}</lang>
We define a generic function interface like Java 8's Function.
<lang java5>interface Function<A, B> {
public B call(A x);
}
public class YCombinator {
interface RecursiveFunc<F> extends Function<RecursiveFunc<F>, F> { }
public static <A,B> Function<A,B> fix(final Function<Function<A,B>, Function<A,B>> f) {
RecursiveFunc<Function<A,B>> r =
new RecursiveFunc<Function<A,B>>() {
public Function<A,B> call(final RecursiveFunc<Function<A,B>> w) {
return f.call(new Function<A,B>() {
public B call(A x) {
return w.call(w).call(x);
}
});
}
};
return r.call(r);
}
public static void main(String[] args) {
Function<Function<Integer,Integer>, Function<Integer,Integer>> almost_fib =
new Function<Function<Integer,Integer>, Function<Integer,Integer>>() {
public Function<Integer,Integer> call(final Function<Integer,Integer> f) {
return new Function<Integer,Integer>() {
public Integer call(Integer n) {
if (n <= 2) return 1;
return f.call(n - 1) + f.call(n - 2);
}
};
}
};
Function<Function<Integer,Integer>, Function<Integer,Integer>> almost_fac =
new Function<Function<Integer,Integer>, Function<Integer,Integer>>() {
public Function<Integer,Integer> call(final Function<Integer,Integer> f) {
return new Function<Integer,Integer>() {
public Integer call(Integer n) {
if (n <= 1) return 1;
return n * f.call(n - 1);
}
};
}
};
Function<Integer,Integer> fib = fix(almost_fib);
Function<Integer,Integer> fac = fix(almost_fac);
System.out.println("fib(10) = " + fib.call(10));
System.out.println("fac(10) = " + fac.call(10));
}
}</lang>
The following code modifies the Function interface such that multiple parameters (via varargs) are supported, simplifies the y function considerably, and the Ackermann function has been included in this implementation (mostly because both D and PicoLisp include it in their own implementations).
<lang java5>import java.util.function.Function;
@FunctionalInterface public interface SelfApplicable<OUTPUT> extends Function<SelfApplicable<OUTPUT>, OUTPUT> {
public default OUTPUT selfApply() {
return apply(this);
}
}</lang>
<lang java5>import java.util.function.Function; import java.util.function.UnaryOperator;
@FunctionalInterface public interface FixedPoint<FUNCTION> extends Function<UnaryOperator<FUNCTION>, FUNCTION> {}</lang>
<lang java5>import java.util.Arrays; import java.util.Optional; import java.util.function.Function; import java.util.function.BiFunction;
@FunctionalInterface public interface VarargsFunction<INPUTS, OUTPUT> extends Function<INPUTS[], OUTPUT> {
@SuppressWarnings("unchecked")
public OUTPUT apply(INPUTS... inputs);
public static <INPUTS, OUTPUT> VarargsFunction<INPUTS, OUTPUT> from(Function<INPUTS[], OUTPUT> function) {
return function::apply;
}
public static <INPUTS, OUTPUT> VarargsFunction<INPUTS, OUTPUT> upgrade(Function<INPUTS, OUTPUT> function) {
return inputs -> function.apply(inputs[0]);
}
public static <INPUTS, OUTPUT> VarargsFunction<INPUTS, OUTPUT> upgrade(BiFunction<INPUTS, INPUTS, OUTPUT> function) {
return inputs -> function.apply(inputs[0], inputs[1]);
}
@SuppressWarnings("unchecked")
public default <POST_OUTPUT> VarargsFunction<INPUTS, POST_OUTPUT> andThen(
VarargsFunction<OUTPUT, POST_OUTPUT> after) {
return inputs -> after.apply(apply(inputs));
}
@SuppressWarnings("unchecked")
public default Function<INPUTS, OUTPUT> toFunction() {
return input -> apply(input);
}
@SuppressWarnings("unchecked")
public default BiFunction<INPUTS, INPUTS, OUTPUT> toBiFunction() {
return (input, input2) -> apply(input, input2);
}
@SuppressWarnings("unchecked")
public default <PRE_INPUTS> VarargsFunction<PRE_INPUTS, OUTPUT> transformArguments(Function<PRE_INPUTS, INPUTS> transformer) {
return inputs -> apply((INPUTS[]) Arrays.stream(inputs).parallel().map(transformer).toArray());
}
}</lang>
<lang java5>import java.math.BigDecimal; import java.math.BigInteger; import java.util.Arrays; import java.util.HashMap; import java.util.Map; import java.util.function.Function; import java.util.function.UnaryOperator; import java.util.stream.Collectors; import java.util.stream.LongStream;
@FunctionalInterface public interface Y<FUNCTION> extends SelfApplicable<FixedPoint<FUNCTION>> {
public static void main(String... arguments) {
BigInteger TWO = BigInteger.ONE.add(BigInteger.ONE);
Function<Number, Long> toLong = Number::longValue; Function<Number, BigInteger> toBigInteger = toLong.andThen(BigInteger::valueOf);
/* Based on https://gist.github.com/aruld/3965968/#comment-604392 */ Y<VarargsFunction<Number, Number>> combinator = y -> f -> x -> f.apply(y.selfApply().apply(f)).apply(x); FixedPoint<VarargsFunction<Number, Number>> fixedPoint = combinator.selfApply();
VarargsFunction<Number, Number> fibonacci = fixedPoint.apply(
f -> VarargsFunction.upgrade(
toBigInteger.andThen(
n -> (n.compareTo(TWO) <= 0)
? 1
: new BigInteger(f.apply(n.subtract(BigInteger.ONE)).toString())
.add(new BigInteger(f.apply(n.subtract(TWO)).toString()))
)
)
);
VarargsFunction<Number, Number> factorial = fixedPoint.apply(
f -> VarargsFunction.upgrade(
toBigInteger.andThen(
n -> (n.compareTo(BigInteger.ONE) <= 0)
? 1
: n.multiply(new BigInteger(f.apply(n.subtract(BigInteger.ONE)).toString()))
)
)
);
VarargsFunction<Number, Number> ackermann = fixedPoint.apply(
f -> VarargsFunction.upgrade(
(BigInteger m, BigInteger n) -> m.equals(BigInteger.ZERO)
? n.add(BigInteger.ONE)
: f.apply(
m.subtract(BigInteger.ONE),
n.equals(BigInteger.ZERO)
? BigInteger.ONE
: f.apply(m, n.subtract(BigInteger.ONE))
)
).transformArguments(toBigInteger)
);
Map<String, VarargsFunction<Number, Number>> functions = new HashMap<>();
functions.put("fibonacci", fibonacci);
functions.put("factorial", factorial);
functions.put("ackermann", ackermann);
Map<VarargsFunction<Number, Number>, Number[]> parameters = new HashMap<>();
parameters.put(functions.get("fibonacci"), new Number[]{20});
parameters.put(functions.get("factorial"), new Number[]{10});
parameters.put(functions.get("ackermann"), new Number[]{3, 2});
functions.entrySet().stream().parallel().map(
entry -> entry.getKey()
+ Arrays.toString(parameters.get(entry.getValue()))
+ " = "
+ entry.getValue().apply(parameters.get(entry.getValue()))
).forEach(System.out::println);
}
}</lang>
- Output:
(may depend on which function gets processed first)
<lang>factorial[10] = 3628800 ackermann[3, 2] = 29 fibonacci[20] = 6765</lang>
JavaScript
The standard version of the Y combinator does not use lexically bound local variables (or any local variables at all), which necessitates adding a wrapper function and some code duplication - the remaining locale variables are only there to make the relationship to the previous implementation more explicit: <lang javascript>function Y(f) {
var g = f((function(h) {
return function() {
var g = f(h(h));
return g.apply(this, arguments);
}
})(function(h) {
return function() {
var g = f(h(h));
return g.apply(this, arguments);
}
}));
return g;
}
var fac = Y(function(f) {
return function (n) {
return n > 1 ? n * f(n - 1) : 1;
};
});
var fib = Y(function(f) {
return function(n) {
return n > 1 ? f(n - 1) + f(n - 2) : n;
};
});</lang>
Changing the order of function application (i.e. the place where f gets called) and making use of the fact that we're generating a fixed-point, this can be reduced to
<lang javascript>function Y(f) {
return (function(h) {
return h(h);
})(function(h) {
return f(function() {
return h(h).apply(this, arguments);
});
});
}</lang>
A functionally equivalent version using the implicit this parameter is also possible:
<lang javascript>function pseudoY(f) {
return (function(h) {
return h(h);
})(function(h) {
return f.bind(function() {
return h(h).apply(null, arguments);
});
});
}
var fac = pseudoY(function(n) {
return n > 1 ? n * this(n - 1) : 1;
});
var fib = pseudoY(function(n) {
return n > 1 ? this(n - 1) + this(n - 2) : n;
});</lang>
However, pseudoY() is not a fixed-point combinator.
The usual version using recursion, disallowed by the task: <lang javascript>function Y(f) {
return function() {
return f(Y(f)).apply(this, arguments);
};
}</lang>
Another version which is disallowed because it uses arguments.callee for a function to get itself recursively:
<lang javascript>function Y(f) {
return function() {
return f(arguments.callee).apply(this, arguments);
};
}</lang>
ECMAScript 2015 (ES6) variants
Since ECMAScript 2015 (ES6) just reached final draft, there are new ways to encode the applicative order Y combinator. These use the new fat arrow function expression syntax, and are made to allow functions of more than one argument through the use of new rest parameters syntax and the corresponding new spread operator syntax. Also showcases new default parameter value syntax: <lang javascript>let
Y= // Except for the η-abstraction necessary for applicative order languages, this is the formal Y combinator.
f=>((g=>(f((...x)=>g(g)(...x))))
(g=>(f((...x)=>g(g)(...x))))),
Y2= // Using β-abstraction to eliminate code repetition.
f=>((f=>f(f))
(g=>(f((...x)=>g(g)(...x))))),
Y3= // Using β-abstraction to separate out the self application combinator δ.
((δ=>f=>δ(g=>(f((...x)=>g(g)(...x)))))
((f=>f(f)))),
fix= // β/η-equivalent fix point combinator. Easier to convert to memoise than the Y combinator.
(((f)=>(g)=>(h)=>(f(h)(g(h)))) // The Substitute combinator out of SKI calculus
((f)=>(g)=>(...x)=>(f(g(g)))(...x)) // S((S(KS)K)S(S(KS)K))(KI)
((f)=>(g)=>(...x)=>(f(g(g)))(...x))),
fix2= // β/η-converted form of fix above into a more compact form
f=>(f=>f(f))(g=>(...x)=>f(g(g))(...x)),
opentailfact= // Open version of the tail call variant of the factorial function
fact=>(n,m=1)=>n<2?m:fact(n-1,n*m);
tailfact= // Tail call version of factorial function
Y(opentailfact);</lang>
ECMAScript 2015 (ES6) also permits a really compact polyvariadic variant for mutually recursive functions: <lang javascript>let
polyfix= // A version that takes an array instead of multiple arguments would simply use l instead of (...l) for parameter
(...l)=>(
(f=>f(f))
(g=>l.map(f=>(...x)=>f(...g(g))(...x)))),
[even,odd]= // The new destructive assignment syntax for arrays
polyfix(
(even,odd)=>n=>(n===0)||odd(n-1),
(even,odd)=>n=>(n!==0)&&even(n-1));</lang>
A minimalist version:
<lang javascript>var Y = f => (x => x(x))(y => f(x => y(y)(x))); var fac = Y(f => n => n > 1 ? n * f(n-1) : 1);</lang>
Joy
<lang joy>DEFINE y == [dup cons] swap concat dup cons i;
fac == [ [pop null] [pop succ] [[dup pred] dip i *] ifte ] y.</lang>
Kotlin
<lang scala>// version 1.1.2
typealias Func<T, R> = (T) -> R
class RecursiveFunc<T, R>(val p: (RecursiveFunc<T, R>) -> Func<T, R>)
fun <T, R> y(f: (Func<T, R>) -> Func<T, R>): Func<T, R> {
val rec = RecursiveFunc<T, R> { r -> f { r.p(r)(it) } }
return rec.p(rec)
}
fun fac(f: Func<Int, Int>) = { x: Int -> if (x <= 1) 1 else x * f(x - 1) }
fun fib(f: Func<Int, Int>) = { x: Int -> if (x <= 2) 1 else f(x - 1) + f(x - 2) }
fun main(args: Array<String>) {
print("Factorial(1..10) : ")
for (i in 1..10) print("${y(::fac)(i)} ")
print("\nFibonacci(1..10) : ")
for (i in 1..10) print("${y(::fib)(i)} ")
println()
}</lang>
- Output:
Factorial(1..10) : 1 2 6 24 120 720 5040 40320 362880 3628800 Fibonacci(1..10) : 1 1 2 3 5 8 13 21 34 55
Lambdatalk
Tested in http://epsilonwiki.free.fr/lambdaway/?view=Ycombinator
<lang Scheme> 1) defining the Ycombinator {def Y
{lambda {:f :n}
{:f :f :n}}}
2) defining non recursive functions 2.1) factorial {def almost-fac
{lambda {:f :n}
{if {= :n 1}
then 1
else {* :n {:f :f {- :n 1}}}}}}
2.2) fibonacci {def almost-fibo
{lambda {:f :n}
{if {< :n 2}
then 1
else {+ {:f :f {- :n 1}} {:f :f {- :n 2}}}}}}
3) testing {Y almost-fac 6} -> 720 {Y almost-fibo 8} -> 34
We could also forget the Ycombinator and names:
1) fac: {{lambda {:f :n} {:f :f :n}}
{lambda {:f :n}
{if {= :n 1}
then 1
else {* :n {:f :f {- :n 1}}}}} 6}
-> 720
2) fibo: {{lambda {:f :n} {:f :f :n}}
{{lambda {:f :n}
{if {< :n 2} then 1
else {+ {:f :f {- :n 1}} {:f :f {- :n 2}}}}}} 8}
-> 34
</lang>
Julia
<lang julia> julia> """
# Y combinator
* `λf. (λx. f (x x)) (λx. f (x x))`
"""
Y = f -> (x -> x(x))(y -> f((t...) -> y(y)(t...)))
</lang>
Usage:
<lang julia> julia> "# Factorial"
fac = f -> (n -> n < 2 ? 1 : n * f(n - 1))
julia> "# Fibonacci"
fib = f -> (n -> n == 0 ? 0 : (n == 1 ? 1 : f(n - 1) + f(n - 2)))
julia> [Y(fac)(i) for i = 1:10] 10-element Array{Any,1}:
1
2
6
24
120
720
5040
40320
362880
3628800
julia> [Y(fib)(i) for i = 1:10] 10-element Array{Any,1}:
1 1 2 3 5 8 13 21 34 55
</lang>
Lua
<lang lua>Y = function (f)
return function(...)
return (function(x) return x(x) end)(function(x) return f(function(y) return x(x)(y) end) end)(...)
end
end </lang>
Usage:
<lang lua>almostfactorial = function(f) return function(n) return n > 0 and n * f(n-1) or 1 end end almostfibs = function(f) return function(n) return n < 2 and n or f(n-1) + f(n-2) end end factorial, fibs = Y(almostfactorial), Y(almostfibs) print(factorial(7))</lang>
Maple
<lang Maple> > Y:=f->(x->x(x))(g->f((()->g(g)(args)))): > Yfac:=Y(f->(x->`if`(x<2,1,x*f(x-1)))): > seq( Yfac( i ), i = 1 .. 10 );
1, 2, 6, 24, 120, 720, 5040, 40320, 362880, 3628800
> Yfib:=Y(f->(x->`if`(x<2,x,f(x-1)+f(x-2)))): > seq( Yfib( i ), i = 1 .. 10 );
1, 1, 2, 3, 5, 8, 13, 21, 34, 55
</lang>
Mathematica / Wolfram Language
<lang Mathematica>Y = Function[f, #[#] &[Function[g, f[g[g][##] &]]]]; factorial = Y[Function[f, If[# < 1, 1, # f[# - 1]] &]]; fibonacci = Y[Function[f, If[# < 2, #, f[# - 1] + f[# - 2]] &]];</lang>
Moonscript
<lang Moonscript>Z = (f using nil) -> ((x) -> x x) (x) -> f (...) -> (x x) ... factorial = Z (f using nil) -> (n) -> if n == 0 then 1 else n * f n - 1</lang>
Objective-C
<lang objc>#import <Foundation/Foundation.h>
typedef int (^Func)(int); typedef Func (^FuncFunc)(Func); typedef Func (^RecursiveFunc)(id); // hide recursive typing behind dynamic typing
Func Y(FuncFunc f) {
RecursiveFunc r =
^(id y) {
RecursiveFunc w = y; // cast value back into desired type
return f(^(int x) {
return w(w)(x);
});
};
return r(r);
}
int main (int argc, const char *argv[]) {
@autoreleasepool {
Func fib = Y(^Func(Func f) {
return ^(int n) {
if (n <= 2) return 1;
return f(n - 1) + f(n - 2);
};
});
Func fac = Y(^Func(Func f) {
return ^(int n) {
if (n <= 1) return 1;
return n * f(n - 1);
};
});
Func fib = fix(almost_fib); Func fac = fix(almost_fac); NSLog(@"fib(10) = %d", fib(10)); NSLog(@"fac(10) = %d", fac(10));
} return 0;
}</lang>
The usual version using recursion, disallowed by the task: <lang objc>Func Y(FuncFunc f) {
return ^(int x) {
return f(Y(f))(x);
};
}</lang>
OCaml
The Y-combinator over functions may be written directly in OCaml provided rectypes are enabled: <lang ocaml>let fix f g = (fun x a -> f (x x) a) (fun x a -> f (x x) a) g</lang> Polymorphic variants are the simplest workaround in the absence of rectypes: <lang ocaml>let fix f = (fun (`X x) -> f(x (`X x))) (`X(fun (`X x) y -> f(x (`X x)) y));;</lang> Otherwise, an ordinary variant can be defined and used: <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)
(* 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> *)
fix fac 5;; (* - : int = 120 *)
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>
Oforth
These combinators work for any number of parameters (see Ackermann usage)
With recursion into Y definition (so non stateless Y) : <lang Oforth>: Y(f) #[ f Y f perform ] ;</lang>
Without recursion into Y definition (stateless Y). <lang Oforth>: X(me, f) #[ me f me perform f perform ] ;
- Y(f) #X f X ;</lang>
Usage : <lang Oforth>: almost-fact(n, f) n ifZero: [ 1 ] else: [ n n 1 - f perform * ] ;
- almost-fact Y => fact
- almost-fib(n, f) n 1 <= ifTrue: [ n ] else: [ n 1 - f perform n 2 - f perform + ] ;
- almost-fib Y => fib
- almost-Ackermann(m, n, f)
m 0 == ifTrue: [ n 1 + return ] n 0 == ifTrue: [ 1 m 1 - f perform return ] n 1 - m f perform m 1 - f perform ;
- almost-Ackermann Y => Ackermann </lang>
Order
<lang c>#include <order/interpreter.h>
- define ORDER_PP_DEF_8y \
ORDER_PP_FN(8fn(8F, \
8let((8R, 8fn(8G, \
8ap(8F, 8fn(8A, 8ap(8ap(8G, 8G), 8A))))), \
8ap(8R, 8R))))
- define ORDER_PP_DEF_8fac \
ORDER_PP_FN(8fn(8F, 8X, \
8if(8less_eq(8X, 0), 1, 8times(8X, 8ap(8F, 8minus(8X, 1))))))
- define ORDER_PP_DEF_8fib \
ORDER_PP_FN(8fn(8F, 8X, \
8if(8less(8X, 2), 8X, 8plus(8ap(8F, 8minus(8X, 1)), \
8ap(8F, 8minus(8X, 2))))))
ORDER_PP(8to_lit(8ap(8y(8fac), 10))) // 3628800 ORDER_PP(8ap(8y(8fib), 10)) // 55</lang>
Oz
<lang oz>declare
Y = fun {$ F}
{fun {$ X} {X X} end
fun {$ X} {F fun {$ Z} {{X X} Z} end} end}
end
Fac = {Y fun {$ F}
fun {$ N}
if N == 0 then 1 else N*{F N-1} end
end
end}
Fib = {Y fun {$ F}
fun {$ N}
case N of 0 then 0
[] 1 then 1
else {F N-1} + {F N-2}
end
end
end}
in
{Show {Fac 5}}
{Show {Fib 8}}</lang>
PARI/GP
As of 2.8.0, GP cannot make general self-references in closures declared inline, so the Y combinator is required to implement these functions recursively in that environment, e.g., for use in parallel processing. <lang parigp>Y(f)=x->f(f,x); fact=Y((f,n)->if(n,n*f(f,n-1),1)); fib=Y((f,n)->if(n>1,f(f,n-1)+f(f,n-2),n)); apply(fact, [1..10]) apply(fib, [1..10])</lang>
- Output:
%1 = [1, 2, 6, 24, 120, 720, 5040, 40320, 362880, 3628800] %2 = [1, 1, 2, 3, 5, 8, 13, 21, 34, 55]
Perl
<lang perl>sub Y { my $f = shift; # λf.
sub { my $x = shift; $x->($x) }->( # (λx.x x)
sub {my $y = shift; $f->(sub {$y->($y)(@_)})} # λy.f λz.y y z
)
} my $fac = sub {my $f = shift;
sub {my $n = shift; $n < 2 ? 1 : $n * $f->($n-1)}
}; my $fib = sub {my $f = shift;
sub {my $n = shift; $n == 0 ? 0 : $n == 1 ? 1 : $f->($n-1) + $f->($n-2)}
}; for my $f ($fac, $fib) {
print join(' ', map Y($f)->($_), 0..9), "\n";
}</lang>
- Output:
1 1 2 6 24 120 720 5040 40320 362880 0 1 1 2 3 5 8 13 21 34
The usual version using recursion, disallowed by the task: <lang perl>sub Y { my $f = shift;
sub {$f->(Y($f))->(@_)}
}</lang>
Perl 6
<lang perl6>sub Y (&f) { sub (&x) { x(&x) }( sub (&y) { f(sub ($x) { y(&y)($x) }) } ) } sub fac (&f) { sub ($n) { $n < 2 ?? 1 !! $n * f($n - 1) } } sub fib (&f) { sub ($n) { $n < 2 ?? $n !! f($n - 1) + f($n - 2) } } say map Y($_), ^10 for &fac, &fib;</lang>
- Output:
(1 1 2 6 24 120 720 5040 40320 362880) (0 1 1 2 3 5 8 13 21 34)
Note that Perl 6 doesn't actually need a Y combinator because you can name anonymous functions from the inside:
<lang perl6>say .(10) given sub (Int $x) { $x < 2 ?? 1 !! $x * &?ROUTINE($x - 1); }</lang>
PHP
<lang php><?php function Y($f) {
$g = function($w) use($f) {
return $f(function() use($w) {
return call_user_func_array($w($w), func_get_args());
});
};
return $g($g);
}
$fibonacci = Y(function($f) {
return function($i) use($f) { return ($i <= 1) ? $i : ($f($i-1) + $f($i-2)); };
});
echo $fibonacci(10), "\n";
$factorial = Y(function($f) {
return function($i) use($f) { return ($i <= 1) ? 1 : ($f($i - 1) * $i); };
});
echo $factorial(10), "\n"; ?></lang> The usual version using recursion, disallowed by the task: <lang php>function Y($f) {
return function() use($f) {
return call_user_func_array($f(Y($f)), func_get_args());
};
}</lang>
with create_function instead of real closures. A little far-fetched, but... <lang php><?php function Y($f) {
$g = create_function('$w', '$f = '.var_export($f,true).';
return $f(create_function(\'\', \'$w = \'.var_export($w,true).\';
return call_user_func_array($w($w), func_get_args());
\'));
');
return $g($g);
}
function almost_fib($f) {
return create_function('$i', '$f = '.var_export($f,true).';
return ($i <= 1) ? $i : ($f($i-1) + $f($i-2));
');
}; $fibonacci = Y('almost_fib'); echo $fibonacci(10), "\n";
function almost_fac($f) {
return create_function('$i', '$f = '.var_export($f,true).';
return ($i <= 1) ? 1 : ($f($i - 1) * $i);
');
}; $factorial = Y('almost_fac'); echo $factorial(10), "\n"; ?></lang>
A functionally equivalent version using the $this parameter in closures is also possible:
<lang php><?php function pseudoY($f) {
$g = function($w) use ($f) {
return $f->bindTo(function() use ($w) {
return call_user_func_array($w($w), func_get_args());
});
};
return $g($g);
}
$factorial = pseudoY(function($n) {
return $n > 1 ? $n * $this($n - 1) : 1;
}); echo $factorial(10), "\n";
$fibonacci = pseudoY(function($n) {
return $n > 1 ? $this($n - 1) + $this($n - 2) : $n;
});
echo $fibonacci(10), "\n";
?></lang>
However, pseudoY() is not a fixed-point combinator.
PicoLisp
<lang PicoLisp>(de Y (F)
(let X (curry (F) (Y) (F (curry (Y) @ (pass (Y Y)))))
(X X) ) )</lang>
Factorial
<lang PicoLisp># Factorial (de fact (F)
(curry (F) (N)
(if (=0 N)
1
(* N (F (dec N))) ) ) )
- ((Y fact) 6)
-> 720</lang>
Fibonacci sequence
<lang PicoLisp># Fibonacci (de fibo (F)
(curry (F) (N)
(if (> 2 N)
1
(+ (F (dec N)) (F (- N 2))) ) ) )
- ((Y fibo) 22)
-> 28657</lang>
Ackermann function
<lang PicoLisp># Ackermann (de ack (F)
(curry (F) (X Y)
(cond
((=0 X) (inc Y))
((=0 Y) (F (dec X) 1))
(T (F (dec X) (F X (dec Y)))) ) ) )
- ((Y ack) 3 4)
-> 125</lang>
Pop11
<lang pop11>define Y(f);
procedure (x); x(x) endprocedure(
procedure (y);
f(procedure(z); (y(y))(z) endprocedure)
endprocedure
)
enddefine;
define fac(h);
procedure (n);
if n = 0 then 1 else n * h(n - 1) endif
endprocedure
enddefine;
define fib(h);
procedure (n);
if n < 2 then 1 else h(n - 1) + h(n - 2) endif
endprocedure
enddefine;
Y(fac)(5) => Y(fib)(5) =></lang>
- Output:
** 120 ** 8
PostScript
<lang postscript>y {
{dup cons} exch concat dup cons i
}.
/fac {
{ {pop zero?} {pop succ} {{dup pred} dip i *} ifte }
y
}.</lang>
PowerShell
PowerShell Doesn't have true closure, in order to fake it, the script-block is converted to text and inserted whole into the next function using variable expansion in double-quoted strings. For simple translation of lambda calculus, translates as param inside of a ScriptBlock, translates as Invoke-Expression "{}", invocation (written as a space) translates to InvokeReturnAsIs. <lang PowerShell>$fac = {
param([ScriptBlock] $f)
invoke-expression @"
{
param([int] `$n)
if (`$n -le 0) {1}
else {`$n * {$f}.InvokeReturnAsIs(`$n - 1)}
}
"@
}
$fib = { param([ScriptBlock] $f) invoke-expression @" { param([int] `$n) switch (`$n)
{
0 {1}
1 {1}
default {{$f}.InvokeReturnAsIs(`$n-1)+{$f}.InvokeReturnAsIs(`$n-2)}
}
} "@ }
$Z = {
param([ScriptBlock] $f)
invoke-expression @"
{
param([ScriptBlock] `$x)
{$f}.InvokeReturnAsIs(`$(invoke-expression @`"
{
param(```$y)
{`$x}.InvokeReturnAsIs({`$x}).InvokeReturnAsIs(```$y)
}
`"@))
}.InvokeReturnAsIs({
param([ScriptBlock] `$x)
{$f}.InvokeReturnAsIs(`$(invoke-expression @`"
{
param(```$y)
{`$x}.InvokeReturnAsIs({`$x}).InvokeReturnAsIs(```$y)
}
`"@))
})
"@ }
$Z.InvokeReturnAsIs($fac).InvokeReturnAsIs(5) $Z.InvokeReturnAsIs($fib).InvokeReturnAsIs(5)</lang>
GetNewClosure() was added in Powershell 2, allowing for an implementation without metaprogramming. The following was tested with Powershell 4.
<lang PowerShell>$Y = {
param ($f)
{
param ($x)
$f.InvokeReturnAsIs({
param ($y)
$x.InvokeReturnAsIs($x).InvokeReturnAsIs($y)
}.GetNewClosure())
}.InvokeReturnAsIs({
param ($x)
$f.InvokeReturnAsIs({
param ($y)
$x.InvokeReturnAsIs($x).InvokeReturnAsIs($y)
}.GetNewClosure())
}.GetNewClosure())
}
$fact = {
param ($f)
{
param ($n)
if ($n -eq 0) { 1 } else { $n * $f.InvokeReturnAsIs($n - 1) }
}.GetNewClosure()
}
$fib = {
param ($f)
{
param ($n)
if ($n -lt 2) { 1 } else { $f.InvokeReturnAsIs($n - 1) + $f.InvokeReturnAsIs($n - 2) }
}.GetNewClosure()
}
$Y.invoke($fact).invoke(5) $Y.invoke($fib).invoke(5)</lang>
Prolog
Works with SWI-Prolog and module lambda, written by Ulrich Neumerkel found there http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/lambda.pl.
The code is inspired from this page : http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/ISO-Hiord#Hiord (p 106).
Original code is from Hermenegildo and al : Hiord: A Type-Free Higher-Order Logic Programming Language with Predicate Abstraction, pdf accessible here http://www.stups.uni-duesseldorf.de/asap/?id=129.
<lang Prolog>:- use_module(lambda).
% The Y combinator y(P, Arg, R) :- Pred = P +\Nb2^F2^call(P,Nb2,F2,P), call(Pred, Arg, R).
test_y_combinator :-
% code for Fibonacci function Fib = \NFib^RFib^RFibr1^(NFib < 2 ->
RFib = NFib ; NFib1 is NFib - 1, NFib2 is NFib - 2, call(RFibr1,NFib1,RFib1,RFibr1), call(RFibr1,NFib2,RFib2,RFibr1), RFib is RFib1 + RFib2 ),
y(Fib, 10, FR), format('Fib(~w) = ~w~n', [10, FR]),
% code for Factorial function Fact = \NFact^RFact^RFactr1^(NFact = 1 ->
RFact = NFact
;
NFact1 is NFact - 1, call(RFactr1,NFact1,RFact1,RFactr1), RFact is NFact * RFact1 ),
y(Fact, 10, FF), format('Fact(~w) = ~w~n', [10, FF]).</lang>
- Output:
?- test_y_combinator. Fib(10) = 55 Fact(10) = 3628800 true.
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>
The usual version using recursion, disallowed by the task: <lang python>Y = lambda f: lambda *args: f(Y(f))(*args)</lang>
R
<lang R>Y <- function(f) {
(function(x) { (x)(x) })( function(y) { f( (function(a) {y(y)})(a) ) } )
}</lang>
<lang R>fac <- function(f) {
function(n) {
if (n<2)
1
else
n*f(n-1)
}
}
fib <- function(f) {
function(n) {
if (n <= 1)
n
else
f(n-1) + f(n-2)
}
}</lang>
<lang R>for(i in 1:9) print(Y(fac)(i)) for(i in 1:9) print(Y(fib)(i))</lang>
Racket
The lazy implementation <lang racket>
- lang lazy
(define Y (λ(f)((λ(x)(f (x x)))(λ(x)(f (x x))))))
(define Fact
(Y (λ(fact) (λ(n) (if (zero? n) 1 (* n (fact (- n 1))))))))
(define Fib
(Y (λ(fib) (λ(n) (if (<= n 1) n (+ (fib (- n 1)) (fib (- n 2))))))))
</lang>
- Output:
> (!! (map Fact '(1 2 4 8 16))) '(1 2 24 40320 20922789888000) > (!! (map Fib '(1 2 4 8 16))) '(0 1 2 13 610)
Strict realization: <lang racket>
- lang racket
(define Y (λ(b)((λ(f)(b(λ(x)((f f) x))))
(λ(f)(b(λ(x)((f f) x)))))))
</lang>
Definitions of Fact and Fib functions will be the same as in Lazy Racket.
Finally, a definition in Typed Racket is a little difficult as in other statically typed languages: <lang racket>
- lang typed/racket
(: make-recursive : (All (S T) ((S -> T) -> (S -> T)) -> (S -> T))) (define-type Tau (All (S T) (Rec this (this -> (S -> T))))) (define (make-recursive f)
((lambda: ([x : (Tau S T)]) (f (lambda (z) ((x x) z)))) (lambda: ([x : (Tau S T)]) (f (lambda (z) ((x x) z))))))
(: fact : Number -> Number) (define fact (make-recursive
(lambda: ([fact : (Number -> Number)])
(lambda: ([n : Number])
(if (zero? n)
1
(* n (fact (- n 1))))))))
(fact 5) </lang>
REBOL
<lang rebol>Y: closure [g] [do func [f] [f :f] closure [f] [g func [x] [do f :f :x]]]</lang>
- usage example
<lang rebol>fact*: closure [h] [func [n] [either n <= 1 [1] [n * h n - 1]]] fact: Y :fact*</lang>
REXX
Programming note: length, reverse, and trunc are REXX BIFs (Built In Functions). <lang rexx>/*REXX program implements and displays a stateless Y combinator. */ numeric digits 1000 /*allow big numbers. */ say ' fib' Y(fib (50)) /*Fibonacci series. */ say ' fib' Y(fib (12 11 10 9 8 7 6 5 4 3 2 1 0)) /*Fibonacci series. */ say ' fact' Y(fact (60)) /*single factorial*/ say ' fact' Y(fact (0 1 2 3 4 5 6 7 8 9 10 11)) /*single factorial*/ say ' Dfact' Y(dfact (4 5 6 7 8 9 10 11 12 13)) /*double factorial*/ say ' Tfact' Y(tfact (4 5 6 7 8 9 10 11 12 13)) /*triple factorial*/ say ' Qfact' Y(qfact (4 5 6 7 8 40)) /*quadruple factorial*/ say ' length' Y(length (when for to where whenceforth)) /*lengths of words.*/ say 'reverse' Y(reverse (23 678 1007 45 MAS I MA)) /*reverses strings. */ say ' trunc' Y(trunc (-7.0005 12 3.14159 6.4 78.999)) /*truncates numbers. */ exit /*stick a fork in it, we're all done. */ /*────────────────────────────────────────────────────────────────────────────*/
Y: parse arg Y _; $= /*the Y combinator.*/
do j=1 for words(_); interpret '$=$' Y"("word(_,j)')'; end; return $
fib: procedure; parse arg x; if x<2 then return x; s=0; a=0; b=1
s=0; a=0; b=1; do j=2 to x; s=a+b; a=b; b=s; end; return s
dfact: procedure; parse arg x; !=1; do j=x to 2 by -2; !=!*j; end; return ! tfact: procedure; parse arg x; !=1; do j=x to 2 by -3; !=!*j; end; return ! qfact: procedure; parse arg x; !=1; do j=x to 2 by -4; !=!*j; end; return !
fact: procedure; parse arg x; !=1; do j=2 to x ; !=!*j; end; return !</lang>
output
fib 12586269025
fib 144 89 55 34 21 13 8 5 3 2 1 1 0
fact 8320987112741390144276341183223364380754172606361245952449277696409600000000000000
fact 1 1 2 6 24 120 720 5040 40320 362880 3628800 39916800
Dfact 8 15 48 105 384 945 3840 10395 46080 135135
Tfact 4 10 18 28 80 162 280 880 1944 3640
Qfact 4 5 12 21 32 3805072588800
length 4 3 2 5 11
reverse 32 876 7001 54 SAM I AM
trunc -7 12 3 6 78
Ruby
Using a lambda:
<lang ruby>y = lambda do |f|
lambda {|g| g[g]}[lambda do |g|
f[lambda {|*args| g[g][*args]}]
end]
end
fac = lambda{|f| lambda{|n| n < 2 ? 1 : n * f[n-1]}} p Array.new(10) {|i| y[fac][i]} #=> [1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880]
fib = lambda{|f| lambda{|n| n < 2 ? n : f[n-1] + f[n-2]}} p Array.new(10) {|i| y[fib][i]} #=> [0, 1, 1, 2, 3, 5, 8, 13, 21, 34]</lang>
Same as the above, using the new short lambda syntax:
<lang ruby>y = ->(f) {->(g) {g.(g)}.(->(g) { f.(->(*args) {g.(g).(*args)})})}
fac = ->(f) { ->(n) { n < 2 ? 1 : n * f.(n-1) } }
p 10.times.map {|i| y.(fac).(i)}
fib = ->(f) { ->(n) { n < 2 ? n : f.(n-2) + f.(n-1) } }
p 10.times.map {|i| y.(fib).(i)}</lang>
Using a method:
<lang ruby>def y(&f)
lambda do |g|
f.call {|*args| g[g][*args]}
end.tap {|g| break g[g]}
end
fac = y {|&f| lambda {|n| n < 2 ? 1 : n * f[n - 1]}} fib = y {|&f| lambda {|n| n < 2 ? n : f[n - 1] + f[n - 2]}}
p Array.new(10) {|i| fac[i]}
- => [1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880]
p Array.new(10) {|i| fib[i]}
- => [0, 1, 1, 2, 3, 5, 8, 13, 21, 34]</lang>
The usual version using recursion, disallowed by the task: <lang ruby>y = lambda do |f|
lambda {|*args| f[y[f]][*args]}
end</lang>
Rust
<lang rust> //! A simple implementation of the Y Combinator // λf.(λx.xx)(λx.f(xx)) // <=> λf.(λx.f(xx))(λx.f(xx))
// CREDITS: A better version of the previous code that was posted here, with detailed explanation. // See <y> and also <y_apply>.
// A function type that takes its own type as an input is an infinite recursive type. // We introduce a trait that will allow us to have an input with the same type as self, and break the recursion. // The input is going to be a trait object that implements the desired function in the interface. // NOTE: We will be coercing a reference to a closure into this trait object. trait Apply<T, R> {
fn apply( &self, &Apply<T, R >, T ) -> R;
}
impl<T, R, F> Apply<T, R> for F where F: Fn( &Apply<T, R>, T ) -> R {
fn apply( &self, f: &Apply<T, R>, t: T ) -> R {
self( f, t )
// If we were to pass in self as f, we get -
// NOTE: Each letter is an individual symbol.
// λf.λt.sft
// => λs.λt.sst [s/f]
// => λs.ss
}
}
// Here you take a reference to the function you want to recurse, AND the input, and return the result. // But, you are NOT <returning> a recursive version of the given function... // You CAN, of course, wrap this in a closure. fn y_apply<T, R, F>( f: &F, t: T ) -> R where F: Fn( &Fn( T ) -> R, T ) -> R {
( &|x: &Apply<T, R>, y| x.apply( x, y ) ) .apply( &|x: &Apply<T, R>, y| f( &|z| x.apply( x, z ), y ), t )
// NOTE: Each letter is an individual symbol. // (λx.(λy.xxy))(λx.(λy.f(λz.xxz)y))t // => (λx.xx)(λx.f(xx))t // => (Yf)t
}
// The static lifetime bounds on the type parameters 'T' and 'R' guarantee that those types will not - // - contain any references that will have a lifetime less than 'static. // If the types are allowed to have references that have a lifetime shorter than 'static, those references - // - may become invalid while you still you have the returned value. // You need to have the lifetimes be 'static, because, unlike before, you RETURN a recursive version of the function... fn y<T: 'static, R: 'static>( f: Box<Fn( &Fn( T ) -> R, T ) -> R> ) -> Box<Fn( T ) -> R> {
Box::new( move |t: T| ( &|x: &Apply<T, R>, y| x.apply( x, y ) )
.apply( &|x: &Apply<T, R>, y| f( &|z| x.apply( x, z ), y ), t ) )
// NOTE: Each letter is an individual symbol.
// (λt(λx.(λy.xxy))(λx.(λy.f(λz.xxz)y)))t
// => (λx.xx)(λx.f(xx))
// => Yf
}
fn fac( n: usize ) -> usize {
let almost_fac = Box::new( |f: &Fn( usize ) -> usize, x| if x == 0 { 1 } else { x * f( x - 1 ) } );
let fac = y( almost_fac );
fac( n )
}
fn fib( n: usize ) -> usize {
let almost_fib = Box::new( |f: &Fn( usize ) -> usize, x| if x < 2 { x } else { f( x - 2 ) + f( x - 1 ) } );
let fib = y( almost_fib );
fib( n )
}
fn main() {
println!( "{}", fac( 10 ) );
println!( "{}", fib( 10 ) );
} </lang>
- Output:
3628800 55
Scala
Credit goes to the thread in scala blog <lang scala>def Y[A,B](f: (A=>B)=>(A=>B)) = {
case class W(wf: W=>A=>B) {
def apply(w: W) = wf(w)
}
val g: W=>A=>B = w => f(w(w))(_)
g(W(g))
}</lang> Example <lang scala>val fac = Y[Int, Int](f => i => if (i <= 0) 1 else f(i - 1) * i) fac(6) //> res0: Int = 720
val fib = Y[Int, Int](f => i => if (i < 2) i else f(i - 1) + f(i - 2)) fib(6) //> res1: Int = 8</lang>
Scheme
<lang scheme>(define Y
(lambda (h)
((lambda (x) (x x))
(lambda (g)
(h (lambda args (apply (g g) args)))))))
(define fac
(Y
(lambda (f)
(lambda (x)
(if (< x 2)
1
(* x (f (- x 1))))))))
(define fib
(Y
(lambda (f)
(lambda (x)
(if (< x 2)
x
(+ (f (- x 1)) (f (- x 2))))))))
(display (fac 6)) (newline)
(display (fib 6)) (newline)</lang>
- Output:
720 8
The usual version using recursion, disallowed by the task: <lang scheme>(define Y
(lambda (h) (lambda args (apply (h (Y h)) args))))</lang>
Shen
<lang shen>(define y
F -> ((/. X (X X))
(/. X (F (/. Z ((X X) Z))))))
(let Fac (y (/. F N (if (= 0 N)
1
(* N (F (- N 1))))))
(output "~A~%~A~%~A~%"
(Fac 0)
(Fac 5)
(Fac 10)))</lang>
- Output:
1 120 3628800
Sidef
<lang ruby>var y = ->(f) {->(g) {g(g)}(->(g) { f(->(*args) {g(g)(args...)})})}
var fac = ->(f) { ->(n) { n < 2 ? 1 : (n * f(n-1)) } } say 10.of { |i| y(fac)(i) }
var fib = ->(f) { ->(n) { n < 2 ? n : (f(n-2) + f(n-1)) } } say 10.of { |i| y(fib)(i) }</lang>
- Output:
[1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880] [0, 1, 1, 2, 3, 5, 8, 13, 21, 34]
Slate
The Y combinator is already defined in slate as: <lang slate>Method traits define: #Y &builder:
[[| :f | [| :x | f applyWith: (x applyWith: x)]
applyWith: [| :x | f applyWith: (x applyWith: x)]]].</lang>
Smalltalk
<lang smalltalk>Y := [:f| [:x| x value: x] value: [:g| f value: [:x| (g value: g) value: x] ] ].
fib := Y value: [:f| [:i| i <= 1 ifTrue: [i] ifFalse: [(f value: i-1) + (f value: i-2)] ] ].
(fib value: 10) displayNl.
fact := Y value: [:f| [:i| i = 0 ifTrue: [1] ifFalse: [(f value: i-1) * i] ] ].
(fact value: 10) displayNl.</lang>
- Output:
55 3628800
The usual version using recursion, disallowed by the task: <lang smalltalk>Y := [:f| [:x| (f value: (Y value: f)) value: x] ].</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>
The usual version using recursion, disallowed by the task: <lang sml>fun fix f x = f (fix f) x</lang>
SuperCollider
Like Ruby, SuperCollider needs an extra level of lambda-abstraction to implement the y-combinator. The z-combinator is straightforward: <lang SuperCollider>// z-combinator ( z = { |f| { |x| x.(x) }.( { |y| f.({ |args| y.(y).(args) }) } ) }; )
// factorial
k = { |f| { |x| if(x < 2, 1, { x * f.(x - 1) }) } };
g = z.(k);
g.(5) // 120
(1..10).collect(g) // [ 1, 2, 6, 24, 120, 720, 5040, 40320, 362880, 3628800 ]
// fibonacci
k = { |f| { |x| if(x <= 2, 1, { f.(x - 1) + f.(x - 2) }) } };
g = z.(k);
g.(3)
(1..10).collect(g) // [ 1, 1, 2, 3, 5, 8, 13, 21, 34, 55 ]
// a shorter form
( r = { |x| x.(x) }; z = { |f| r.({ |y| f.(r.(y).(_)) }) }; ) </lang>
Swift
Using a recursive type: <lang swift>struct RecursiveFunc<F> {
let o : RecursiveFunc<F> -> F
}
func Y<A, B>(f: (A -> B) -> A -> B) -> A -> B {
let r = RecursiveFunc<A -> B> { w in f { w.o(w)($0) } }
return r.o(r)
}
let fac = Y { (f: Int -> Int) in
{ $0 <= 1 ? 1 : $0 * f($0-1) }
} let fib = Y { (f: Int -> Int) in
{ $0 <= 2 ? 1 : f($0-1)+f($0-2) }
} println("fac(5) = \(fac(5))") println("fib(9) = \(fib(9))")</lang>
- Output:
fac(5) = 120 fib(9) = 34
Without a recursive type, and instead using Any to erase the type:
(for Swift 1.1 replace as! with as)
<lang swift>func Y<A, B>(f: (A -> B) -> A -> B) -> A -> B {
typealias RecursiveFunc = Any -> A -> B
let r : RecursiveFunc = { (z: Any) in let w = z as! RecursiveFunc; return f { w(w)($0) } }
return r(r)
}</lang>
The usual version using recursion, disallowed by the task: <lang swift>func Y<In, Out>( f: (In->Out) -> (In->Out) ) -> (In->Out) {
return { x in f(Y(f))(x) }
}</lang>
Tcl
Y combinator is derived in great detail here.
TXR
This prints out 24, the factorial of 4:
<lang txrlisp>;; The Y combinator: (defun y (f)
[(op @1 @1) (op f (op [@@1 @@1]))])
- The Y-combinator-based factorial
(defun fac (f)
(do if (zerop @1)
1
(* @1 [f (- @1 1)])))
- Test
(format t "~s\n" [[y fac] 4])</lang>
Both the op and do operators are a syntactic sugar for currying, in two different flavors. The forms within do that are symbols are evaluated in the normal Lisp-2 style and the first symbol can be an operator. Under op, any forms that are symbols are evaluated in the Lisp-2 style, and the first form is expected to evaluate to a function. The name do stems from the fact that the operator is used for currying over special forms like if in the above example, where there is evaluation control. Operators can have side effects: they can "do" something. Consider (do set a @1) which yields a function of one argument which assigns that argument to a.
The compounded @@... notation allows for inner functions to refer to outer parameters, when the notation is nested. Consider <lang txrlisp>(op foo @1 (op bar @2 @@2))</lang>. Here the @2 refers to the second argument of the anonymous function denoted by the inner op. The @@2 refers to the second argument of the outer op.
Ursala
The standard y combinator doesn't work in Ursala due to eager
evaluation, but an alternative is easily defined as shown
<lang Ursala>(r "f") "x" = "f"("f","x")
my_fix "h" = r ("f","x"). ("h" r "f") "x"</lang>
or by this shorter expression for the same thing in point free form.
<lang Ursala>my_fix = //~&R+ ^|H\~&+ ; //~&R</lang>
Normally you'd like to define a function recursively by writing
, where is just the body of the
function with recursive calls to in it. With a fixed point
combinator such as my_fix as defined above, you do almost the same thing, except it's my_fix
"f". ("f"), where the dot represents lambda abstraction and the
quotes signify a dummy variable. Using this
method, the definition of the factorial function becomes
<lang Ursala>#import nat
fact = my_fix "f". ~&?\1! product^/~& "f"+ predecessor</lang>
To make it easier, the compiler has a directive to let you install
your own fixed point combinator for it to use, which looks like
this,
<lang Ursala>#fix my_fix</lang>
with your choice of function to be used in place of my_fix.
Having done that, you may express recursive functions per convention by circular definitions,
as in this example of a Fibonacci function.
<lang Ursala>fib = {0,1}?</1! sum+ fib~~+ predecessor^~/~& predecessor</lang>
Note that this way is only syntactic sugar for the for explicit way
shown above. Without a fixed point combinator given in the #fix
directive, this definition of fib
would not have compiled. (Ursala allows user defined fixed point
combinators because they're good for other things besides
functions.)
To confirm that all this works, here is a test program applying
both of the functions defined above to the numbers from 1 to 8.
<lang Ursala>#cast %nLW
examples = (fact* <1,2,3,4,5,6,7,8>,fib* <1,2,3,4,5,6,7,8>)</lang>
- Output:
( <1,2,6,24,120,720,5040,40320>, <1,2,3,5,8,13,21,34>)
The fixed point combinator defined above is theoretically correct
but inefficient and limited to first order functions,
whereas the standard distribution includes a library (sol)
providing a hierarchy of fixed point combinators
suitable for production use and with higher order functions.
A more efficient alternative implementation of my_fix
would be general_function_fixer 0
(with 0 signifying the lowest order of fixed point combinators),
or if that's too easy, then by this definition.
<lang Ursala>#import sol
- fix general_function_fixer 1
my_fix "h" = "h" my_fix "h"</lang> Note that this equation is solved using the next fixed point combinator in the hierarchy.
Vim Script
There is no lambda in Vim (yet?), so here is a way to fake it using a Dictionary. This also provides garbage collection. <lang vim>" Translated from Python. Works with: Vim 7.0
func! Lambx(sig, expr, dict)
let fanon = {'d': a:dict}
exec printf("
\func fanon.f(%s) dict\n \ return %s\n \endfunc", \ a:sig, a:expr)
return fanon
endfunc
func! Callx(fanon, arglist)
return call(a:fanon.f, a:arglist, a:fanon.d)
endfunc
let g:Y = Lambx('f', 'Callx(Lambx("x", "Callx(a:x, [a:x])", {}), [Lambx("y", Callx(self.f, [Lambx("...", "Callx(Callx(self.y, [self.y]), a:000)", {"y": a:y})]), {"f": a:f})])', {})
let g:fac = Lambx('f', 'Lambx("n", "a:n<2 ? 1 : a:n * Callx(self.f, [a:n-1])", {"f": a:f})', {})
echo Callx(Callx(g:Y, [g:fac]), [5]) echo map(range(10), 'Callx(Callx(Y, [fac]), [v:val])') </lang> Output:
120 [1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880]
Wart
<lang python>def (Y improver)
((fn(gen) gen.gen)
(fn(gen)
(fn(n)
((improver gen.gen) n))))
factorial <- (Y (fn(f)
(fn(n)
(if zero?.n
1
(n * (f n-1))))))
prn factorial.5</lang>
XQuery
Version 3.0 of the XPath and XQuery specifications added support for function items.
<lang XQuery>let $Y := function($f) {
(function($x) { ($x)($x) })( function($g) { $f( (function($a) { $g($g) ($a)}) ) } )
}
let $fac := $Y(function($f) { function($n) { if($n < 2) then 1 else $n * $f($n - 1) } }) let $fib := $Y(function($f) { function($n) { if($n <= 1) then $n else $f($n - 1) + $f($n - 2) } }) return (
$fac(6), $fib(6)
) </lang>
- Output:
<lang XQuery>720 8</lang>
zkl
<lang zkl>fcn Y(f){ fcn(g){ g(g) }( 'wrap(h){ f( 'wrap(a){ h(h)(a) }) }) }</lang> Functions don't get to look outside of their scope so data in enclosing scopes needs to be bound to a function, the fp (function application/cheap currying) method does this. 'wrap is syntactic sugar for fp. <lang zkl>fcn almost_factorial(f){ fcn(n,f){ if(n<=1) 1 else n*f(n-1) }.fp1(f) } Y(almost_factorial)(6).println(); [0..10].apply(Y(almost_factorial)).println();</lang>
- Output:
720 L(1,1,2,6,24,120,720,5040,40320,362880,3628800)
<lang zkl>fcn almost_fib(f){ fcn(n,f){ if(n<2) 1 else f(n-1)+f(n-2) }.fp1(f) } Y(almost_fib)(9).println(); [0..10].apply(Y(almost_fib)).println();</lang>
- Output:
55 L(1,1,2,3,5,8,13,21,34,55,89)
- Programming Tasks
- Classic CS problems and programs
- Recursion
- ALGOL 68
- AppleScript
- ATS
- BlitzMax
- Bracmat
- C
- C sharp
- C++
- Ceylon
- Clojure
- Common Lisp
- CoffeeScript
- D
- Déjà Vu
- Delphi
- E
- EchoLisp
- Eero
- Ela
- Elixir
- Erlang
- F Sharp
- Factor
- Forth
- Falcon
- GAP
- Genyris
- Go
- Groovy
- Haskell
- J
- Java
- JavaScript
- Joy
- Kotlin
- Lambdatalk
- Julia
- Lua
- Maple
- Mathematica
- Wolfram Language
- Moonscript
- Objective-C
- OCaml
- Oforth
- Order
- Oz
- PARI/GP
- Perl
- Perl 6
- PHP
- PicoLisp
- Pop11
- PostScript
- Initlib
- PowerShell
- Prolog
- Python
- R
- Racket
- REBOL
- REXX
- Ruby
- Rust
- Scala
- Scheme
- Shen
- Sidef
- Slate
- Smalltalk
- Standard ML
- SuperCollider
- Swift
- Tcl
- TXR
- Ursala
- Vim Script
- Wart
- ACL2/Omit
- Ada/Omit
- PureBasic/Omit
- TI-89 BASIC/Omit
- XQuery
- Zkl