Anonymous user
Y combinator: Difference between revisions
m
Update syntax and output to new stable version of Julia.
m (→{{header|Lambdatalk}}: improving code) |
m (Update syntax and output to new stable version of Julia.) |
||
Line 1:
{{task|Classic CS problems and programs}}{{requires|First class functions}}
[[Category:Recursion]]
In strict [[wp:Functional programming|functional programming]] and the [[wp:lambda calculus|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
The task is to define the stateless Y combinator and use it to compute [[wp:Factorial|factorials]] and [[wp:Fibonacci number|Fibonacci numbers]] from other stateless functions or lambda expressions.
;Cf:
* [http://vimeo.com/45140590 Jim Weirich: Adventures in Functional Programming]
=={{header|ALGOL 68}}==
Line 317 ⟶ 39:
=={{header|AppleScript}}==
AppleScript is not
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 '
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>
script x
to funcall(y)
script
to funcall(arg)
y's funcall(y)'s funcall(arg)
end funcall
end script
f's funcall(result)
end funcall
end script
x's funcall(x)
end |Y|
script
to funcall(f)
script
to
if n = 0
n * (f's funcall(n -
end funcall
end script
end
end script
set fact to |Y|(result)
script
to funcall(f)
script
to funcall(n)
if n = 0 then return 0
if n = 1 then return 1
end
end script
end
end script
set fib to |Y|(result)
set facts to {}
repeat with i from 0 to 11
set end of facts to fact's funcall(i)
end repeat
set fibs to {}
repeat with i from 0 to 20
set end of fibs to fib's funcall(i)
end repeat
{facts:facts, fibs:fibs}
(*
{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>
=={{header|BlitzMax}}==
Line 987 ⟶ 351:
typedef struct func_t *func;
typedef struct func_t {
func (*
int num;
} func_t;
Line 994 ⟶ 357:
func new(func(*f)(func, func), func _) {
func x = malloc(sizeof(func_t));
x->
x->_ = _; /* closure, sort of */
x->num = 0;
Line 1,000 ⟶ 363:
}
func call(func f, func
return f->
}
func Y(func(*f)(func, func)) {
func
func_t __ = { _ };
func g = call(new(f, 0), &__);
g->_ = g;
return g;
Line 1,016 ⟶ 382:
}
func fac(func f, func _null) {
func _(func self, func n) {
int nn = n->num;
return nn > 1 ? num(nn * call(self->_, num(nn - 1))->num)
: num(1);
}
return new(_, f);
}
func fib(func
? num( call(self->_, num(nn -
: num(1);
}
return new(_, f);
}
Line 1,048 ⟶ 421:
return 0;
}</lang>
{{out}}
Line 1,055 ⟶ 427:
fib: 1 2 3 5 8 13 21 34 55</pre>
=={{header|C sharp|C#}}==
<lang csharp>using System;
class Program
{
delegate Func<int, int> Recursive(Recursive recursive);
static void Main()
{
var fib = Y(f => x => x < 2 ? x : f(x - 1) + f(x - 2));
Console.WriteLine(fac(6));
Console.WriteLine(fib(6));
}
}</lang>
{{out}}
<pre>
720
8
</pre>
=={{header|C++}}==
Line 1,846 ⟶ 500:
}</lang>
{{out}}
<pre>
fib(10) = 55
Line 1,949 ⟶ 571:
given Args satisfies Anything[]
=> flatten((Args args) => f(y3(f))(*args));</lang>
=={{header|Clojure}}==
Line 2,079 ⟶ 603:
<lang lisp>(defn Y [f]
(#(% %) #(f (fn [& args] (apply (% %) args)))))</lang>
=={{header|Common Lisp}}==
<lang lisp>(defun Y (f)
((lambda (
(lambda (
(funcall f (lambda (&rest
(apply (funcall
(defun fac (
(
1
(* n (funcall
(defun fib (
(
(otherwise (+ (funcall f (-
? (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>
=={{header|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>
=={{header|D}}==
Line 2,149 ⟶ 671:
<pre>factorial: [1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880]
ackermann(3, 5): 253</pre>
=={{header|Déjà Vu}}==
{{trans|Python}}
<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>
{{out}}
<pre>720
13</pre>
=={{header|Delphi}}==
Line 2,222 ⟶ 777:
Writeln ('Fac(10) = ', Fac (10));
end.</lang>
=={{header|E}}==
Line 2,326 ⟶ 790:
? accum [] for i in 0..!10 { _.with(y(fib)(i)) }
[0, 1, 1, 2, 3, 5, 8, 13, 21, 34]</lang>
=={{header|Eero}}==
Line 2,400 ⟶ 837:
{{out}}
<pre>(479001600,144)</pre>
=={{header|Elixir}}==
Line 2,440 ⟶ 852:
[0, 1, 1, 2, 3, 5, 8, 13, 21, 34]
</lang>
=={{header|Erlang}}==
Line 2,543 ⟶ 871:
=={{header|F Sharp|F#}}==
<lang fsharp>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
//val fac : (int -> int) -> int -> int = <fun>
let fib f = function
0 -> 0
| 1 -> 1
| n -> f (n-1) + f (n-2)
//val fib : (int -> int) -> int -> int = <fun>
fix fac 5;;
// val it : int = 120
fix fib 8;;
// val it : int = 21</lang>
=={{header|Factor}}==
Line 2,676 ⟶ 931:
> "Factorial 10: ", YFac(10)
> "Fibonacci 10: ", YFib(10)
</lang>
Line 2,843 ⟶ 1,074:
=={{header|Haskell}}==
The obvious definition of
<lang haskell>newtype Mu a = Roll { unroll :: Mu a -> a }
fix :: (a -> a) -> a
fix =
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 uses recursion, disallowed by the task, to define the <code>fix</code> itself; but the definitions produced by this <code>fix</code> 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
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
print $ map fac [1 .. 20]
print $ map fib [0 .. 19]
print $ take 20 fibs</lang>
=={{header|J}}==
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 : '(5!:5)<''x'''))(&([ 128!:2 ,&<)))f.</lang>
The factorial and Fibonacci examples:
<lang j> u=. [ NB. Function (left)
n=. ] NB. Argument (right)
sr=. [
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
<lang j> fac f. Y NB.
'1:`(] * [ ([ 128!:2 ,&<) ] - 1:)@.(0: < ])&>/'&([ 128!:2 ,&<)
fac f. NB. Showing the stateless factorial step...
1:`(] * [ ([ 128!:2 ,&<) ] - 1:)@.(0: < ])
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=. [ 128!:2 ,&< NB. Self referring
lw=. '(5!:5)<''x''' (1 :) NB. Linear representation of a word
Y=. (&>)/lw(&sr) f.
Y=. 'Y'f. NB. Fixing it</lang>
=== 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.
)
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>
362880
(Y Ev almost_fibonacci)Ev 9
34
0 1 1 2 3 5 8 13 21 34</lang>
Note that the names <code>f</code> and <code>recur</code> will experience the same value (which will be the value produced by <code>sivelY g</code>).
=={{header|Java}}==
Line 3,102 ⟶ 1,232:
(n <= 1)
? 1
: (n * f.apply(n - 1));
);
Line 3,418 ⟶ 1,548:
fact=>(n,m=1)=>n<2?m:fact(n-1,n*m);
tailfact= // Tail call version of factorial function
Y(
ECMAScript 2015 (ES6) also permits a really compact polyvariadic variant for mutually recursive functions:
<lang javascript>let
Line 3,429 ⟶ 1,559:
(even,odd)=>n=>(n===0)||odd(n-1),
(even,odd)=>n=>(n!==0)&&even(n-1));</lang>
=={{header|Joy}}==
Line 3,442 ⟶ 1,567:
=={{header|Julia}}==
<lang julia>
_
_ _ _(_)_ | Documentation: https://docs.julialang.org
(_) | (_) (_) |
_ _ _| |_ __ _ | Type "?" for help, "]?" for Pkg help.
| | | | | | |/ _` | |
| | |_| | | | (_| | | Version 1.6.3 (2021-09-23)
_/ |\__'_|_|_|\__'_| | Official https://julialang.org/ release
|__/ |
julia> using Markdown
julia> @doc md"""
$λf. (λx. f (x x)) (λx. f (x x))$
""" ->
Y = f -> (x -> x(x))(y -> f((t...) -> y(y)(t...)))
Y
</lang>
Line 3,453 ⟶ 1,590:
<lang julia>
julia> fac = f -> (n -> n < 2 ? 1 : n * f(n - 1))
#9 (generic function with 1 method)
julia> fib = f -> (n -> n == 0 ? 0 : (n == 1 ? 1 : f(n - 1) + f(n - 2)))
#13 (generic function with 1 method)
julia>
10-element
1
2
Line 3,472 ⟶ 1,609:
3628800
julia>
10-element
1
1
Line 3,484 ⟶ 1,621:
34
55
</lang>
Line 3,609 ⟶ 1,637:
factorial, fibs = Y(almostfactorial), Y(almostfibs)
print(factorial(7))</lang>
=={{header|Maple}}==
Line 3,749 ⟶ 1,652:
<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]] &
=={{header|Objective-C}}==
Line 3,932 ⟶ 1,746:
With recursion into Y definition (so non stateless Y) :
<lang Oforth>: Y(f)
Without recursion into Y definition (stateless Y).
<lang Oforth>: X(me, f)
: Y(f) {
Usage :
<lang Oforth>: almost-fact(
: fact { Y(#almost-fact)
: almost-fib(
: fib { Y(#almost-fib)
: almost-Ackermann(
{
m 0 == ifTrue: [ n 1 + return ]
n 0 == ifTrue: [ 1 m 1 - f perform return ]
n 1 - m f perform m 1 - f perform
}
: Ackermann { Y(#almost-Ackermann) perform }</lang>
=={{header|Order}}==
Line 4,032 ⟶ 1,848:
}</lang>
=={{header|
<lang perl6>sub Y (&f) { { .($_) }( -> &y { f({ y(&y)(&^arg) }) } ) }
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>
{{out}}
<pre>1 1 2 6 24 120 720 5040 40320 362880
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>
=={{header|PHP}}==
Line 4,326 ⟶ 2,085:
$Z.InvokeReturnAsIs($fac).InvokeReturnAsIs(5)
$Z.InvokeReturnAsIs($fib).InvokeReturnAsIs(5)</lang>
=={{header|Prolog}}==
Line 4,434 ⟶ 2,141:
The usual version using recursion, disallowed by the task:
<lang python>Y = lambda f: lambda *args: f(Y(f))(*args)</lang>
=={{header|R}}==
Line 4,473 ⟶ 2,171:
The lazy implementation
<lang racket>
#lang lazy
(define Y (λ
(define Fact
(Y (λ
(define Fib
(Y (λ
</lang>
{{out}}
Line 4,491 ⟶ 2,191:
Strict realization:
<lang racket>
#lang racket
(define
(λ(f)(b(λ(x)((f f) x)))))))
</lang>
Definitions of <tt>Fact</tt> and <tt>Fib</tt> 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)))
Line 4,514 ⟶ 2,217:
(* n (fact (- n 1))))))))
(fact 5)
</lang>
=={{header|REBOL}}==
Line 4,537 ⟶ 2,227:
=={{header|REXX}}==
<lang rexx>/*REXX program to implement a stateless Y combinator. */
say ' fib'
say ' fib'
say ' fact'
say ' fact'
say ' Dfact'
say ' Tfact'
say ' Qfact'
say ' length'
say 'reverse'
say '
/*──────────────────────────────────subroutines─────────────────────────*/
'lambda=lambda' Y'('word(_,j)')'; end; return lambda
fib: procedure; parse arg x; if x<2 then return x; s=0; a=0; b=1
dfact: procedure; arg x; !=1; do j=x to 2 by -2;!=!*j; end; return !
qfact: procedure; arg x;
fact: procedure; arg x; !=1; do j=2 to x ;!=!*j; end; return !</lang>
{{out}}
<pre>
fib 12586269025
Line 4,575 ⟶ 2,261:
Qfact 4 5 12 21 32 3805072588800
length 4 3 2 5 11
reverse
trunc -7 12 3 6 78
</pre>
Line 4,633 ⟶ 2,315:
=={{header|Rust}}==
{{works with|Rust|0.7}}
<lang rust>enum Mu<T> { Roll(@fn(Mu<T>) -> T) }
fn unroll<T>(Roll(f): Mu<T>) -> @fn(Mu<T>) -> T { f }
type RecFunc<A, B> = @fn(@fn(A) -> B) -> @fn(A) -> B;
fn fix<A, B>(f: RecFunc<A, B>) -> @fn(A) -> B {
let g: @fn(Mu<@fn(A) -> B>) -> @fn(A) -> B =
|x| |a| f(unroll(x)(x))(a);
g(Roll(g))
}
fn main() {
let fac: RecFunc<uint, uint> =
|f| |x| if (x==0) { 1 } else { f(x-1) * x };
let fib : RecFunc<uint, uint> =
|f| |x| if (x<2) { 1 } else { f(x-1) + f(x-2) };
let ns = std::vec::from_fn(20, |i| i);
println(fmt!("%?", ns.map(|&n| fix(fac)(n))));
println(fmt!("%?", ns.map(|&n| fix(fib)(n))));
}</lang>
Derived from: [http://shachaf.net/curry.rs.txt]
=={{header|Scala}}==
Credit goes to the thread in [
<lang scala>def Y[A,B](f: (A=>B)=>(A=>B)) = {
}
val g: 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
fib(6) //> res1: Int = 8</lang>
=={{header|Scheme}}==
<lang scheme>(define Y
(lambda (h)
((lambda (
(lambda (g)
(
(define fac
(Y
(lambda (f)
1
(define fib
(Y
(if (< x
(+ (f (- x 1)) (f (- x 2))))))))
(display (fac 6))
(newline)
(display (
(newline)</lang>
{{out}}
<pre>720
8</pre>
The usual version using recursion, disallowed by the task:
<lang scheme>(define Y
(lambda (h)
(lambda args (
=={{header|Sidef}}==
<lang ruby>var y = ->(f) {->(g) {g(g)}(->(g) { f(->(*args) {g(g)(args...)})})};
var fac = ->(f) { ->(n) { n < 2
say 10.of { |i| y(fac)(i) };
var fib = ->(f) { ->(n) { n < 2
say 10.of { |i| y(fib)(i) };</lang>
{{out}}
<pre>
[
[
</pre>
Line 4,867 ⟶ 2,456:
The usual version using recursion, disallowed by the task:
<lang sml>fun fix f x = f (fix f) x</lang>
=={{header|Swift}}==
Line 4,950 ⟶ 2,494:
return { x in f(Y(f))(x) }
}</lang>
=={{header|Tcl}}==
Line 4,998 ⟶ 2,501:
This prints out 24, the factorial of 4:
<lang
;; The Y combinator:
(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 <code>op</code> and <code>do</code> operators are a syntactic sugar for currying, in two different flavors. The forms within <code>do</code> that are symbols are evaluated in the normal Lisp-2 style and the first symbol can be an operator. Under <code>op</code>, 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 <code>do</code> stems from the fact that the operator is used for currying over special forms like <code>if</code> in the above example, where there is evaluation control. Operators can have side effects: they can "do" something. Consider <code>(do set a @1)</code> which yields a function of one argument which assigns that argument to <code>a</code>.
The compounded <code>@@
=={{header|Ursala}}==
Line 5,072 ⟶ 2,576:
my_fix "h" = "h" my_fix "h"</lang>
Note that this equation is solved using the next fixed point combinator in the hierarchy.
=={{header|Vim Script}}==
Line 5,180 ⟶ 2,601:
echo Callx(Callx(g:Y, [g:fac]), [5])
echo map(range(10), 'Callx(Callx(Y, [fac]), [v:val])')
</lang>
Output:
Line 5,198 ⟶ 2,607:
=={{header|Wart}}==
<lang python>def (Y improver)
((fn(gen) gen.gen)
(fn(gen)
Line 5,217 ⟶ 2,625:
{{omit from|PureBasic}}
{{omit from|TI-89 BASIC}} <!-- no lambdas, no first-class functions except by name string -->
=={{header|XQuery}}==
Line 5,257 ⟶ 2,642:
{{out}}
<lang XQuery>720 8</lang>
=={{header|zkl}}==
|