Y combinator: Difference between revisions

m
m (syntax highlighting fixup automation)
 
(22 intermediate revisions by 12 users not shown)
Line 317:
 
 
 
The version below works with Algol 68 Genie 3.0.3 tested with Linux kernel release 5.18.5-200.fc36.x86_64.
The version below works with [[ALGOL 68 Genie]] 3.5.0 tested with Linux kernel release 6.7.4-200.fc39.x86_64
 
N.B. 4 warnings are issued of the form
Line 325 ⟶ 326:
These could easily be fixed by changing names, but I believe that doing so would make the code harder to follow.
 
<syntaxhighlight lang="algol68">BEGIN
 
# This version needs partial parameterisation in order to work #
Line 335 ⟶ 336:
 
 
#
# Y_combinator = func_gen => ( x => x( x ) )( x => func_gen( arg => x( x )( arg ) ) ) ; #
Y_combinator =
func_gen => ( x => x( x ) )( x => func_gen( arg => x( x )( arg ) ) )
#
 
PROC y combinator = ( PROC( F ) F func gen ) F:
( ( X x ) F: x( x ) )
(
(
( PROC( F ) F func gen , X x ) F:
func gen( ( ( X x , INT arg ) INT: x( x )( arg ) )( x , ) )
) ( func gen , )
)
;
 
 
#
fac_gen = fac => (n => ( ( n === 0 ) ? 1 : n * fac( n - 1 ) ) )
factorial =
Y_combinator( fac => ( n => ( ( n === 0 ) ? 1 : n * fac( n - 1 ) ) ) )
;
#
 
PROC fac gen = ( F fac ) F:
F factorial =
( ( F fac , INT n ) INT: IF n = 0 THEN 1 ELSE n * fac( n - 1 ) FI )( fac , )
y combinator(
( F fac ) F:
( ( F fac , INT n ) INT: IF n = 0 THEN 1 ELSE n * fac( n - 1 ) FI )
( fac , )
)
;
 
 
#
factorial = Y_combinator( fac_gen )
fibonacci =
Y_combinator(
fib => ( n => ( ( n === 0 ) ? 0 : ( n === 1 ) ? 1 : fib( n - 2 ) + fib( n - 1 ) ) )
)
;
#
 
F factorial = y combinator( fac gen ) ;
F fibonacci =
 
y combinator(
 
( F fib ) F:
#
( ( F fib , INT n ) INT: CASE n IN 1 , 1 OUT fib( n - 2 ) + fib( n - 1 ) ESAC )
fib_gen =
( fib , )
fib =>
)
( n => ( ( n === 0 ) ? 0 : ( n === 1 ) ? 1 : fib( n - 2 ) + fib( n - 1 ) ) )
#
 
PROC fib gen = ( F fib ) F:
(
( F fib , INT n ) INT:
CASE n + 1 IN 0 , 1 OUT fib( n - 2 ) + fib( n - 1 ) ESAC
)( fib , )
;
 
 
#
# for ( i = 1 ; i <= 12 ; i++) { console.log( " " + factorial( i ) ) ; } #
fibonacci = Y_combinator( fib_gen )
#
 
F fibonacci = y combinator( fib gen ) ;
 
 
#
for ( i = 1 ; i <= 12 ; i++) { process.stdout.write( " " + factorial( i ) ) }
#
 
INT nofacs = 12 ;
printprintf( ( $ l , "TheHere are the first " , wholeg( nofacs , 0 ) , " factorials." , newlinel $ , nofacs ) ) ;
FOR i TO nofacs
DO
printprintf( whole( factorial$ " " , g( i0 ) $ , -11factorial( i ) ) )
OD ;
print( newline ) ;
 
print( ( newline , newline ) ) ;
 
#
# for ( i = 1 ; i <= 12 ; i++) { console.log( " " + fibonacci( i ) ) ; } #
for ( i = 1 ; i <= 12 ; i++) { process.stdout.write( " " + fibonacci( i ) ) }
#
 
INT nofibs = 12 ;
printf( (
print( ( "The first " , whole( nofibs , 0 ) , " fibonacci numbers." , newline ) ) ;
$ l , "Here are the first " , g( 0 ) , " fibonacci numbers." , l $
, nofibs
) )
;
FOR i TO nofibs
DO
printprintf( whole( fibonacci$ " " , g( i0 ) $ , -11fibonacci( i ) ) )
OD ;
print( newline )
Line 823 ⟶ 840:
(* ****** ****** *)
</syntaxhighlight>
 
=={{header|BASIC}}==
==={{header|FreeBASIC}}===
FreeBASIC does not support nested functions, lambda expressions or functions inside nested types
<syntaxhighlight lang="freebasic">Function Y(f As String) As String
Y = f
End Function
 
Function fib(n As Long) As Long
Dim As Long n1 = 0, n2 = 1, k, sum
For k = 1 To Abs(n)
sum = n1 + n2
n1 = n2
n2 = sum
Next k
Return Iif(n < 0, (n1 * ((-1) ^ ((-n)+1))), n1)
End Function
 
Function fac(n As Long) As Long
Dim As Long r = 1, i
For i = 2 To n
r *= i
Next i
Return r
End Function
 
Function execute(s As String, n As Integer) As Long
Return Iif (s = "fac", fac(n), fib(n))
End Function
 
Sub test(nombre As String)
Dim f As String: f = Y(nombre)
Print !"\n"; f; ":";
For i As Integer = 1 To 10
Print execute(f, i);
Next i
End Sub
 
test("fac")
test("fib")
Sleep</syntaxhighlight>
{{out}}
<pre>fac: 1 2 6 24 120 720 5040 40320 362880 3628800
fib: 1 1 2 3 5 8 13 21 34 55</pre>
 
==={{header|VBA}}===
{{trans|Phix}}
The IIf as translation of Iff can not be used as IIf executes both true and false parts and will cause a stack overflow.
<syntaxhighlight lang="vb">Private Function call_fn(f As String, n As Long) As Long
call_fn = Application.Run(f, f, n)
End Function
Private Function Y(f As String) As String
Y = f
End Function
Private Function fac(self As String, n As Long) As Long
If n > 1 Then
fac = n * call_fn(self, n - 1)
Else
fac = 1
End If
End Function
Private Function fib(self As String, n As Long) As Long
If n > 1 Then
fib = call_fn(self, n - 1) + call_fn(self, n - 2)
Else
fib = n
End If
End Function
Private Sub test(name As String)
Dim f As String: f = Y(name)
Dim i As Long
Debug.Print name
For i = 1 To 10
Debug.Print call_fn(f, i);
Next i
Debug.Print
End Sub
 
Public Sub main()
test "fac"
test "fib"
End Sub</syntaxhighlight>{{out}}
<pre>fac
1 2 6 24 120 720 5040 40320 362880 3628800
fib
1 1 2 3 5 8 13 21 34 55 </pre>
 
==={{header|uBasic/4tH}}===
{{Trans|Yabasic}}
<syntaxhighlight lang="basic">Proc _Test("fac")
Proc _Test("fib")
End
 
_fac
Param (2)
If b@ > 1 Then Return (b@ * FUNC (a@ (a@, b@-1)))
Return (1)
 
_fib
Param (2)
If b@ > 1 Then Return (FUNC (a@ (a@, b@-1)) + FUNC (a@ (a@, b@-2)))
Return (b@)
_Test
Param (1)
Local (1)
Print Show (a@), ": "; : a@ = Name (a@)
For b@ = 1 to 10 : Print FUNC (a@ (a@, b@)), : Next : Print
Return</syntaxhighlight>
{{Out}}
<pre>fac : 1 2 6 24 120 720 5040 40320 362880 3628800
fib : 1 1 2 3 5 8 13 21 34 55
 
0 OK, 0:39 </pre>
==={{header|Yabasic}}===
<syntaxhighlight lang="yabasic">sub fac(self$, n)
if n > 1 then
return n * execute(self$, self$, n - 1)
else
return 1
end if
end sub
sub fib(self$, n)
if n > 1 then
return execute(self$, self$, n - 1) + execute(self$, self$, n - 2)
else
return n
end if
end sub
sub test(name$)
local i
print name$, ": ";
for i = 1 to 10
print execute(name$, name$, i);
next
print
end sub
 
test("fac")
test("fib")</syntaxhighlight>
 
=={{header|Binary Lambda Calculus}}==
This BLC program outputs 6!, as computed with the Y combinator, in unary (generated from https://github.com/tromp/AIT/blob/master/rosetta/facY.lam) :
 
<pre>11 c2 a3 40 b0 bf 65 ee 05 7c 0c ef 18 89 70 39 d0 39 ce 81 6e c0 3c e8 31</pre>
 
=={{header|BlitzMax}}==
Line 1,064 ⟶ 1,234:
fib(9)=34
fib(10)=55</pre>
 
=={{header|Bruijn}}==
As defined in <code>std/Combinator</code>:
<syntaxhighlight lang="bruijn">
:import std/Number .
 
# sage bird combinator
y [[1 (0 0)] [1 (0 0)]]
 
# factorial using y
factorial y [[=?0 (+1) (0 ⋅ (1 --0))]]
 
:test ((factorial (+6)) =? (+720)) ([[1]])
 
# (very slow) fibonacci using y
fibonacci y [[0 <? (+1) (+0) (0 <? (+2) (+1) rec)]]
rec (1 --0) + (1 --(--0))
 
:test ((fibonacci (+6)) =? (+8)) ([[1]])
</syntaxhighlight>
 
=={{header|C}}==
Line 2,569 ⟶ 2,759:
=={{header|Elena}}==
{{trans|Smalltalk}}
ELENA 46.x :
<syntaxhighlight lang="elena">import extensions;
Line 2,580 ⟶ 2,770:
public program()
{
var fib := YCombinator.fix::(f => (i => (i <= 1) ? i : (f(i-1) + f(i-2)) ));
var fact := YCombinator.fix::(f => (i => (i == 0) ? 1 : (f(i-1) * i) ));
console.printLine("fib(10)=",fib(10));
Line 2,709 ⟶ 2,899:
 
=={{header|F Sharp|F#}}==
===March 2024===
In spite of everything that follows I am going to go with this.
<syntaxhighlight lang="fsharp">
// Y combinator. Nigel Galloway: March 5th., 2024
type Y<'T> = { eval: Y<'T> -> ('T -> 'T) }
let Y n g=let l = { eval = fun l -> fun x -> (n (l.eval l)) x } in (l.eval l) g
let fibonacci=function 0->1 |x->let fibonacci f= function 0->0 |1->1 |x->f(x - 1) + f(x - 2) in Y fibonacci x
let factorial n=let factorial f=function 0->1 |x->x*f(x-1) in Y factorial n
printfn "fibonacci 10=%d\nfactorial 5=%d" (fibonacci 10) (factorial 5)
</syntaxhighlight>
{{output}}
<pre>
fibonacci 10=55
factorial 5=120
</pre>
===Pre March 2024===
<syntaxhighlight lang="fsharp">type 'a mu = Roll of ('a mu -> 'a) // ' fixes ease syntax colouring confusion with
Line 2,845 ⟶ 3,051:
 
=={{header|Forth}}==
<syntaxhighlight lang="forth">\ Address of an xt.
\ Begin of approach. Depends on 'latestxt' word of GForth implementation.
 
: self-parameter ( xt -- xt' )
>r :noname latestxt postpone literal r> compile, postpone ;
;
: Y ( xt -- xt' )
dup self-parameter 2>r
:noname 2r> postpone literal compile, postpone ;
;
</syntaxhighlight>Usage:<syntaxhighlight lang="forth">
\ Fibonnacci test
10 :noname ( u xt -- u' ) over 2 < if drop exit then >r 1- dup r@ execute swap 1- r> execute + ; Y execute . 55 ok
\ Factorial test
10 :noname ( u xt -- u' ) over 2 < if 2drop 1 exit then over 1- swap execute * ; Y execute . 3628800 ok
 
\ End of approach.
</syntaxhighlight><syntaxhighlight lang="forth">\ Address of an xt.
variable 'xt
\ Make room for an xt.
Line 2,867 ⟶ 3,090:
y execute . 55 ok
</syntaxhighlight>
 
=={{header|FreeBASIC}}==
FreeBASIC does not support nested functions, lambda expressions or functions inside nested types
<syntaxhighlight lang="freebasic">Function Y(f As String) As String
Y = f
End Function
 
Function fib(n As Long) As Long
Dim As Long n1 = 0, n2 = 1, k, sum
For k = 1 To Abs(n)
sum = n1 + n2
n1 = n2
n2 = sum
Next k
Return Iif(n < 0, (n1 * ((-1) ^ ((-n)+1))), n1)
End Function
 
Function fac(n As Long) As Long
Dim As Long r = 1, i
For i = 2 To n
r *= i
Next i
Return r
End Function
 
Function execute(s As String, n As Integer) As Long
Return Iif (s = "fac", fac(n), fib(n))
End Function
 
Sub test(nombre As String)
Dim f As String: f = Y(nombre)
Print !"\n"; f; ":";
For i As Integer = 1 To 10
Print execute(f, i);
Next i
End Sub
 
test("fac")
test("fib")
Sleep</syntaxhighlight>
{{out}}
<pre>fac: 1 2 6 24 120 720 5040 40320 362880 3628800
fib: 1 1 2 3 5 8 13 21 34 55</pre>
 
 
=={{header|GAP}}==
Line 3,815 ⟶ 3,994:
-> 34
 
</syntaxhighlight>
 
=={{header|Lang}}==
Y combinator function:
<syntaxhighlight lang="lang">
# Disable warning for shadowing of predefined function
lang.errorOutput = -1
 
fp.combY = (fp.f) -> {
# fp.f must be provided by the function with a partially called combinator function, because fp.f will not be available in the callee scope
fp.func = (fp.f, fp.x) -> {
fp.callFunc = (fp.f, fp.x, &args...) -> return fp.f(fp.x(fp.x))(&args...)
return fn.combAN(fp.callFunc, fp.f, fp.x)
}
return fn.combM(fn.combA2(fp.func, fp.f))
}
 
# Re-enable warning output
lang.errorOutput = 1
</syntaxhighlight>
 
Usage (Factorial):
<syntaxhighlight lang="lang">
fp.fac = (fp.func) -> {
fp.retFunc = (fp.func, $n) -> {
return parser.op($n < 2?1:$n * fp.func($n - 1))
}
return fn.combAN(fp.retFunc, fp.func)
}
 
# Apply Y combinator
fp.facY = fp.combY(fp.fac)
 
# Use function
fn.println(fp.facY(10))
</syntaxhighlight>
 
Usage (Fibonacci):
<syntaxhighlight lang="lang">
fp.fib = (fp.func) -> {
fp.retFunc = (fp.func, $x) -> {
return parser.op($x < 2?1:fp.func($x - 2) + fp.func($x - 1))
}
return fn.combAN(fp.retFunc, fp.func)
}
 
fp.fibY = fp.combY(fp.fib)
 
fn.println(fp.fibY(10))
</syntaxhighlight>
 
Line 4,691 ⟶ 4,923:
 
=={{header|R}}==
<syntaxhighlight lang="r">Y <- function(f) {
#' Y = λf.(λs.ss)(λx.f(xx))
(function(x) { (x)(x) })( function(y) { f( (function(a) {y(y)})(a) ) } )
#' Z = λf.(λs.ss)(λx.f(λz.(xx)z))
}</syntaxhighlight>
#'
 
fixp.Y <- \ (f) (\ (x) (x) (x)) (\ (y) (f) ((y) (y))) # y-combinator
<syntaxhighlight lang="r">fac <- function(f) {
fixp.Z <- \ (f) (\ (x) (x) (x)) (\ (y) (f) (\ (...) (y) (y) (...))) # z-combinator
function(n) {
</syntaxhighlight>
if (n<2)
1
else
n*f(n-1)
}
}
 
Y-combinator test:
fib <- function(f) {
 
function(n) {
<syntaxhighlight lang="r">
if (n <= 1)
fac.y <- fixp.Y (\ (f) \ (n) if (n<2) 1 else n*f(n-1))
n
fac.y(9) # [1] 362880
else
 
f(n-1) + f(n-2)
fib.y <- fixp.Y (\ (f) \ (n) if (n <= 1) n else f(n-1) + f(n-2))
}
fib.y(9) # [1] 34
}</syntaxhighlight>
</syntaxhighlight>
 
Z-combinator test:
 
<syntaxhighlight lang="r">
fac.z <- fixp.Z (\ (f) \ (n) if (n<2) 1 else n*f(n-1))
fac.z(9) # [1] 362880
 
fib.z <- fixp.Z (\ (f) \ (n) if (n <= 1) n else f(n-1) + f(n-2))
fib.z(9) # [1] 34
</syntaxhighlight>
 
You can verify these codes by [https://shinylive.io/r/editor/#code=NobwRAdghgtgpmAXGAZgSwB5wCYAcD2aEALgHQBOYANGAMb4lwlJgDEA5AAQCanAvJ0DdwClIAKQQGdSEiQEpxGUilEYMs2QB0IHTgC1+QkeKkz5gxcsEAvMatlX1WnVq3oMuUrwA8AWk4aNTlEUWSCAoLUI0JV1MMDRAE9okKDE6KTY1k4En3oYACMiKGJ8cldMD31ff3iU0XCYqKjohqSguobSLvSeoK7SdVCsq1z8AqKSsognLgBXCTgXCBQoWlIEzmq3D1562tCGiFC0FCCILwAmUIBGTjgAGwXOCAAqZQgfa8dl1fXRAE4hpxgNcALqcADMADYLgAOWEABiW6Hy602fm2nji7QO8SOnBOZ02Ai+zzujzgnHen1CAGoqaIPldNMs0KiEgCgSDwRCACxLVy-KzoqkVUj6PY4mpnY6nRmXG7kp6valfFkrNZWTmcLLcyEw+FI6as1HCrZiiUNFKHWVErwk0IQJWU1V0hlM74o0hawE64FgyH8iBgAC+oKAA here]
<syntaxhighlight lang="r">for(i in 1:9) print(Y(fac)(i))
for(i in 1:9) print(Y(fib)(i))</syntaxhighlight>
 
=={{header|Racket}}==
Line 5,115 ⟶ 5,353:
 
=={{header|SuperCollider}}==
 
Like Ruby, SuperCollider needs an extra level of lambda-abstraction to implement the y-combinator. The z-combinator is straightforward:
The direct implementation will not work, because SuperCollider evaluates x.(x) before calling f.
<syntaxhighlight lang="supercollider">
y = { |f| { |x| f.(x.(x)) }.({ |x| f.(x.(x)) }) };
</syntaxhighlight>
 
For lazy evaluation, this call needs to be postponed by passing a function to f that makes this call (this is what is called the z-combinator):
<syntaxhighlight lang="supercollider">// z-combinator
 
z = { |f| { |x| f.({ |args| x.(x).(args) }) }.({ |x| f.({ |args| x.(x).(args) }) }) };
 
// this can be also factored differently
(
zy = { |f|
{ |xr| xr.(xr) }.(
{ |x| f.({ |args| x.(x).(args) }) }
{ |y|
f.({ |args| y.(y).(args) })
}
)
};
)
 
// the same in a shorterreduced form
 
(
Line 5,318 ⟶ 5,564:
my_fix "h" = "h" my_fix "h"</syntaxhighlight>
Note that this equation is solved using the next fixed point combinator in the hierarchy.
 
=={{header|VBA}}==
{{trans|Phix}}
The IIf as translation of Iff can not be used as IIf executes both true and false parts and will cause a stack overflow.
<syntaxhighlight lang="vb">Private Function call_fn(f As String, n As Long) As Long
call_fn = Application.Run(f, f, n)
End Function
Private Function Y(f As String) As String
Y = f
End Function
Private Function fac(self As String, n As Long) As Long
If n > 1 Then
fac = n * call_fn(self, n - 1)
Else
fac = 1
End If
End Function
Private Function fib(self As String, n As Long) As Long
If n > 1 Then
fib = call_fn(self, n - 1) + call_fn(self, n - 2)
Else
fib = n
End If
End Function
Private Sub test(name As String)
Dim f As String: f = Y(name)
Dim i As Long
Debug.Print name
For i = 1 To 10
Debug.Print call_fn(f, i);
Next i
Debug.Print
End Sub
 
Public Sub main()
test "fac"
test "fib"
End Sub</syntaxhighlight>{{out}}
<pre>fac
1 2 6 24 120 720 5040 40320 362880 3628800
fib
1 1 2 3 5 8 13 21 34 55 </pre>
 
=={{header|Verbexx}}==
Line 5,466 ⟶ 5,666:
=={{header|Wren}}==
{{trans|Go}}
<syntaxhighlight lang="ecmascriptwren">var y = Fn.new { |f|
var g = Fn.new { |r| f.call { |x| r.call(r).call(x) } }
return g.call(g)
Line 5,503 ⟶ 5,703:
{{out}}
<syntaxhighlight lang="xquery">720 8</syntaxhighlight>
 
=={{header|Yabasic}}==
<syntaxhighlight lang="yabasic">sub fac(self$, n)
if n > 1 then
return n * execute(self$, self$, n - 1)
else
return 1
end if
end sub
sub fib(self$, n)
if n > 1 then
return execute(self$, self$, n - 1) + execute(self$, self$, n - 2)
else
return n
end if
end sub
sub test(name$)
local i
print name$, ": ";
for i = 1 to 10
print execute(name$, name$, i);
next
print
end sub
 
test("fac")
test("fib")</syntaxhighlight>
 
=={{header|zkl}}==
2,171

edits