Y combinator: Difference between revisions
Content added Content deleted
m (→{{header|Lambdatalk}}: improving code) |
m (Update syntax and output to new stable version of Julia.) |
||
Line 1: | Line 1: | ||
{{task|Classic CS problems and programs}} |
{{task|Classic CS problems and programs}}{{requires|First class functions}} |
||
{{requires|First class functions}} |
|||
[[Category:Recursion]] |
[[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. |
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. |
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 [http://mvanier.livejournal.com/2897.html 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 [[wp:Fixed-point combinator|fixed-point combinators]]. |
||
The Y combinator is the simplest of the class of such functions, called [[wp:Fixed-point combinator|fixed-point combinators]]. |
|||
;Task: |
|||
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. |
|||
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: |
;Cf: |
||
* [http://vimeo.com/45140590 Jim Weirich: Adventures in Functional Programming] |
* [http://vimeo.com/45140590 Jim Weirich: Adventures in Functional Programming] |
||
<br><br> |
|||
=={{header|AArch64 Assembly}}== |
|||
{{works with|as|Raspberry Pi 3B version Buster 64 bits}} |
|||
<lang AArch64 Assembly> |
|||
/* ARM assembly AARCH64 Raspberry PI 3B */ |
|||
/* program Ycombi64.s */ |
|||
/*******************************************/ |
|||
/* Constantes file */ |
|||
/*******************************************/ |
|||
/* for this file see task include a file in language AArch64 assembly*/ |
|||
.include "../includeConstantesARM64.inc" |
|||
/*******************************************/ |
|||
/* Structures */ |
|||
/********************************************/ |
|||
/* structure function*/ |
|||
.struct 0 |
|||
func_fn: // next element |
|||
.struct func_fn + 8 |
|||
func_f_: // next element |
|||
.struct func_f_ + 8 |
|||
func_num: |
|||
.struct func_num + 8 |
|||
func_fin: |
|||
/* Initialized data */ |
|||
.data |
|||
szMessStartPgm: .asciz "Program start \n" |
|||
szMessEndPgm: .asciz "Program normal end.\n" |
|||
szMessError: .asciz "\033[31mError Allocation !!!\n" |
|||
szFactorielle: .asciz "Function factorielle : \n" |
|||
szFibonacci: .asciz "Function Fibonacci : \n" |
|||
szCarriageReturn: .asciz "\n" |
|||
/* datas message display */ |
|||
szMessResult: .ascii "Result value : @ \n" |
|||
/* UnInitialized data */ |
|||
.bss |
|||
sZoneConv: .skip 100 |
|||
/* code section */ |
|||
.text |
|||
.global main |
|||
main: // program start |
|||
ldr x0,qAdrszMessStartPgm // display start message |
|||
bl affichageMess |
|||
adr x0,facFunc // function factorielle address |
|||
bl YFunc // create Ycombinator |
|||
mov x19,x0 // save Ycombinator |
|||
ldr x0,qAdrszFactorielle // display message |
|||
bl affichageMess |
|||
mov x20,#1 // loop counter |
|||
1: // start loop |
|||
mov x0,x20 |
|||
bl numFunc // create number structure |
|||
cmp x0,#-1 // allocation error ? |
|||
beq 99f |
|||
mov x1,x0 // structure number address |
|||
mov x0,x19 // Ycombinator address |
|||
bl callFunc // call |
|||
ldr x0,[x0,#func_num] // load result |
|||
ldr x1,qAdrsZoneConv // and convert ascii string |
|||
bl conversion10S // decimal conversion |
|||
ldr x0,qAdrszMessResult |
|||
ldr x1,qAdrsZoneConv |
|||
bl strInsertAtCharInc // insert result at @ character |
|||
bl affichageMess // display message final |
|||
add x20,x20,#1 // increment loop counter |
|||
cmp x20,#10 // end ? |
|||
ble 1b // no -> loop |
|||
/*********Fibonacci *************/ |
|||
adr x0,fibFunc // function fibonacci address |
|||
bl YFunc // create Ycombinator |
|||
mov x19,x0 // save Ycombinator |
|||
ldr x0,qAdrszFibonacci // display message |
|||
bl affichageMess |
|||
mov x20,#1 // loop counter |
|||
2: // start loop |
|||
mov x0,x20 |
|||
bl numFunc // create number structure |
|||
cmp x0,#-1 // allocation error ? |
|||
beq 99f |
|||
mov x1,x0 // structure number address |
|||
mov x0,x19 // Ycombinator address |
|||
bl callFunc // call |
|||
ldr x0,[x0,#func_num] // load result |
|||
ldr x1,qAdrsZoneConv // and convert ascii string |
|||
bl conversion10S |
|||
ldr x0,qAdrszMessResult |
|||
ldr x1,qAdrsZoneConv |
|||
bl strInsertAtCharInc // insert result at @ character |
|||
bl affichageMess |
|||
add x20,x20,#1 // increment loop counter |
|||
cmp x20,#10 // end ? |
|||
ble 2b // no -> loop |
|||
ldr x0,qAdrszMessEndPgm // display end message |
|||
bl affichageMess |
|||
b 100f |
|||
99: // display error message |
|||
ldr x0,qAdrszMessError |
|||
bl affichageMess |
|||
100: // standard end of the program |
|||
mov x0,0 // return code |
|||
mov x8,EXIT // request to exit program |
|||
svc 0 // perform system call |
|||
qAdrszMessStartPgm: .quad szMessStartPgm |
|||
qAdrszMessEndPgm: .quad szMessEndPgm |
|||
qAdrszFactorielle: .quad szFactorielle |
|||
qAdrszFibonacci: .quad szFibonacci |
|||
qAdrszMessError: .quad szMessError |
|||
qAdrszCarriageReturn: .quad szCarriageReturn |
|||
qAdrszMessResult: .quad szMessResult |
|||
qAdrsZoneConv: .quad sZoneConv |
|||
/******************************************************************/ |
|||
/* factorielle function */ |
|||
/******************************************************************/ |
|||
/* x0 contains the Y combinator address */ |
|||
/* x1 contains the number structure */ |
|||
facFunc: |
|||
stp x1,lr,[sp,-16]! // save registers |
|||
stp x2,x3,[sp,-16]! // save registers |
|||
mov x2,x0 // save Y combinator address |
|||
ldr x0,[x1,#func_num] // load number |
|||
cmp x0,#1 // > 1 ? |
|||
bgt 1f // yes |
|||
mov x0,#1 // create structure number value 1 |
|||
bl numFunc |
|||
b 100f |
|||
1: |
|||
mov x3,x0 // save number |
|||
sub x0,x0,#1 // decrement number |
|||
bl numFunc // and create new structure number |
|||
cmp x0,#-1 // allocation error ? |
|||
beq 100f |
|||
mov x1,x0 // new structure number -> param 1 |
|||
ldr x0,[x2,#func_f_] // load function address to execute |
|||
bl callFunc // call |
|||
ldr x1,[x0,#func_num] // load new result |
|||
mul x0,x1,x3 // and multiply by precedent |
|||
bl numFunc // and create new structure number |
|||
// and return her address in x0 |
|||
100: |
|||
ldp x2,x3,[sp],16 // restaur 2 registers |
|||
ldp x1,lr,[sp],16 // restaur 2 registers |
|||
ret // return to address lr x30 |
|||
/******************************************************************/ |
|||
/* fibonacci function */ |
|||
/******************************************************************/ |
|||
/* x0 contains the Y combinator address */ |
|||
/* x1 contains the number structure */ |
|||
fibFunc: |
|||
stp x1,lr,[sp,-16]! // save registers |
|||
stp x2,x3,[sp,-16]! // save registers |
|||
stp x4,x5,[sp,-16]! // save registers |
|||
mov x2,x0 // save Y combinator address |
|||
ldr x0,[x1,#func_num] // load number |
|||
cmp x0,#1 // > 1 ? |
|||
bgt 1f // yes |
|||
mov x0,#1 // create structure number value 1 |
|||
bl numFunc |
|||
b 100f |
|||
1: |
|||
mov x3,x0 // save number |
|||
sub x0,x0,#1 // decrement number |
|||
bl numFunc // and create new structure number |
|||
cmp x0,#-1 // allocation error ? |
|||
beq 100f |
|||
mov x1,x0 // new structure number -> param 1 |
|||
ldr x0,[x2,#func_f_] // load function address to execute |
|||
bl callFunc // call |
|||
ldr x4,[x0,#func_num] // load new result |
|||
sub x0,x3,#2 // new number - 2 |
|||
bl numFunc // and create new structure number |
|||
cmp x0,#-1 // allocation error ? |
|||
beq 100f |
|||
mov x1,x0 // new structure number -> param 1 |
|||
ldr x0,[x2,#func_f_] // load function address to execute |
|||
bl callFunc // call |
|||
ldr x1,[x0,#func_num] // load new result |
|||
add x0,x1,x4 // add two results |
|||
bl numFunc // and create new structure number |
|||
// and return her address in x0 |
|||
100: |
|||
ldp x4,x5,[sp],16 // restaur 2 registers |
|||
ldp x2,x3,[sp],16 // restaur 2 registers |
|||
ldp x1,lr,[sp],16 // restaur 2 registers |
|||
ret // return to address lr x30 |
|||
/******************************************************************/ |
|||
/* call function */ |
|||
/******************************************************************/ |
|||
/* x0 contains the address of the function */ |
|||
/* x1 contains the address of the function 1 */ |
|||
callFunc: |
|||
stp x2,lr,[sp,-16]! // save registers |
|||
ldr x2,[x0,#func_fn] // load function address to execute |
|||
blr x2 // and call it |
|||
ldp x2,lr,[sp],16 // restaur 2 registers |
|||
ret // return to address lr x30 |
|||
/******************************************************************/ |
|||
/* create Y combinator function */ |
|||
/******************************************************************/ |
|||
/* x0 contains the address of the function */ |
|||
YFunc: |
|||
stp x1,lr,[sp,-16]! // save registers |
|||
mov x1,#0 |
|||
bl newFunc |
|||
cmp x0,#-1 // allocation error ? |
|||
beq 100f |
|||
str x0,[x0,#func_f_] // store function and return in x0 |
|||
100: |
|||
ldp x1,lr,[sp],16 // restaur 2 registers |
|||
ret // return to address lr x30 |
|||
/******************************************************************/ |
|||
/* create structure number function */ |
|||
/******************************************************************/ |
|||
/* x0 contains the number */ |
|||
numFunc: |
|||
stp x1,lr,[sp,-16]! // save registers |
|||
stp x2,x3,[sp,-16]! // save registers |
|||
mov x2,x0 // save number |
|||
mov x0,#0 // function null |
|||
mov x1,#0 // function null |
|||
bl newFunc |
|||
cmp x0,#-1 // allocation error ? |
|||
beq 100f |
|||
str x2,[x0,#func_num] // store number in new structure |
|||
100: |
|||
ldp x2,x3,[sp],16 // restaur 2 registers |
|||
ldp x1,lr,[sp],16 // restaur 2 registers |
|||
ret // return to address lr x30 |
|||
/******************************************************************/ |
|||
/* new function */ |
|||
/******************************************************************/ |
|||
/* x0 contains the function address */ |
|||
/* x1 contains the function address 1 */ |
|||
newFunc: |
|||
stp x1,lr,[sp,-16]! // save registers |
|||
stp x3,x4,[sp,-16]! // save registers |
|||
stp x5,x8,[sp,-16]! // save registers |
|||
mov x4,x0 // save address |
|||
mov x5,x1 // save adresse 1 |
|||
// allocation place on the heap |
|||
mov x0,#0 // allocation place heap |
|||
mov x8,BRK // call system 'brk' |
|||
svc #0 |
|||
mov x6,x0 // save address heap for output string |
|||
add x0,x0,#func_fin // reservation place one element |
|||
mov x8,BRK // call system 'brk' |
|||
svc #0 |
|||
cmp x0,#-1 // allocation error |
|||
beq 100f |
|||
mov x0,x6 |
|||
str x4,[x0,#func_fn] // store address |
|||
str x5,[x0,#func_f_] |
|||
str xzr,[x0,#func_num] // store zero to number |
|||
100: |
|||
ldp x5,x8,[sp],16 // restaur 2 registers |
|||
ldp x3,x4,[sp],16 // restaur 2 registers |
|||
ldp x1,lr,[sp],16 // restaur 2 registers |
|||
ret // return to address lr x30 |
|||
/********************************************************/ |
|||
/* File Include fonctions */ |
|||
/********************************************************/ |
|||
/* for this file see task include a file in language AArch64 assembly */ |
|||
.include "../includeARM64.inc" |
|||
</lang> |
|||
=={{header|ALGOL 68}}== |
=={{header|ALGOL 68}}== |
||
Line 317: | Line 39: | ||
=={{header|AppleScript}}== |
=={{header|AppleScript}}== |
||
AppleScript is not |
AppleScript is not terribly "functional" friendly. However, it is capable enough to 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 ' |
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 'funcall' 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. |
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. |
The identifier used for Y uses "pipe quoting" to make it obviously distinct from the y used inside the definition. |
||
<lang AppleScript> |
<lang AppleScript>to |Y|(f) |
||
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 |
|||
on |Y|(f) |
|||
to funcall(f) |
|||
script |
script |
||
to funcall(n) |
|||
if n = 0 then return 1 |
|||
n * (f's funcall(n - 1)) |
|||
end funcall |
|||
y's |λ|(y)'s |λ|(x) |
|||
end |λ| |
|||
end script |
|||
f's |λ|(result) |
|||
end |λ| |
|||
end script |
end script |
||
end funcall |
|||
end script |
|||
result's |λ|(result) |
|||
set fact to |Y|(result) |
|||
end |Y| |
|||
script |
|||
to funcall(f) |
|||
-- TEST ----------------------------------------------------------------------- |
|||
script |
|||
on run |
|||
to funcall(n) |
|||
if n = 0 then return 0 |
|||
-- Factorial |
|||
if n = 1 then return 1 |
|||
script fact |
|||
(f's funcall(n - 2)) + (f's funcall(n - 1)) |
|||
end funcall |
|||
on |λ|(n) |
|||
if n = 0 then return 1 |
|||
n * (f's |λ|(n - 1)) |
|||
end |λ| |
|||
end script |
|||
end |λ| |
|||
end script |
end script |
||
end funcall |
|||
end script |
|||
set fib to |Y|(result) |
|||
-- 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 |
|||
set facts to {} |
|||
repeat with i from 0 to 11 |
|||
set end of facts to fact's funcall(i) |
|||
end repeat |
|||
set fibs to {} |
|||
-- GENERIC FUNCTIONS FOR TEST ------------------------------------------------- |
|||
repeat with i from 0 to 20 |
|||
set end of fibs to fib's funcall(i) |
|||
end repeat |
|||
{facts:facts, fibs:fibs} |
|||
-- map :: (a -> b) -> [a] -> [b] |
|||
(* |
|||
on map(f, xs) |
|||
{facts:{1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880, 3628800, 39916800}, |
|||
tell mReturn(f) |
|||
fibs:{0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597, 2584, 4181, 6765}} |
|||
set lng to length of xs |
|||
*)</lang> |
|||
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> |
|||
{{Out}} |
|||
<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> |
|||
=={{header|ARM Assembly}}== |
|||
{{works with|as|Raspberry Pi}} |
|||
<lang ARM Assembly> |
|||
/* ARM assembly Raspberry PI */ |
|||
/* program Ycombi.s */ |
|||
/* REMARK 1 : this program use routines in a include file |
|||
see task Include a file language arm assembly |
|||
for the routine affichageMess conversion10 |
|||
see at end of this program the instruction include */ |
|||
/* Constantes */ |
|||
.equ STDOUT, 1 @ Linux output console |
|||
.equ EXIT, 1 @ Linux syscall |
|||
.equ WRITE, 4 @ Linux syscall |
|||
/*******************************************/ |
|||
/* Structures */ |
|||
/********************************************/ |
|||
/* structure function*/ |
|||
.struct 0 |
|||
func_fn: @ next element |
|||
.struct func_fn + 4 |
|||
func_f_: @ next element |
|||
.struct func_f_ + 4 |
|||
func_num: |
|||
.struct func_num + 4 |
|||
func_fin: |
|||
/* Initialized data */ |
|||
.data |
|||
szMessStartPgm: .asciz "Program start \n" |
|||
szMessEndPgm: .asciz "Program normal end.\n" |
|||
szMessError: .asciz "\033[31mError Allocation !!!\n" |
|||
szFactorielle: .asciz "Function factorielle : \n" |
|||
szFibonacci: .asciz "Function Fibonacci : \n" |
|||
szCarriageReturn: .asciz "\n" |
|||
/* datas message display */ |
|||
szMessResult: .ascii "Result value :" |
|||
sValue: .space 12,' ' |
|||
.asciz "\n" |
|||
/* UnInitialized data */ |
|||
.bss |
|||
/* code section */ |
|||
.text |
|||
.global main |
|||
main: @ program start |
|||
ldr r0,iAdrszMessStartPgm @ display start message |
|||
bl affichageMess |
|||
adr r0,facFunc @ function factorielle address |
|||
bl YFunc @ create Ycombinator |
|||
mov r5,r0 @ save Ycombinator |
|||
ldr r0,iAdrszFactorielle @ display message |
|||
bl affichageMess |
|||
mov r4,#1 @ loop counter |
|||
1: @ start loop |
|||
mov r0,r4 |
|||
bl numFunc @ create number structure |
|||
cmp r0,#-1 @ allocation error ? |
|||
beq 99f |
|||
mov r1,r0 @ structure number address |
|||
mov r0,r5 @ Ycombinator address |
|||
bl callFunc @ call |
|||
ldr r0,[r0,#func_num] @ load result |
|||
ldr r1,iAdrsValue @ and convert ascii string |
|||
bl conversion10 |
|||
ldr r0,iAdrszMessResult @ display result message |
|||
bl affichageMess |
|||
add r4,#1 @ increment loop counter |
|||
cmp r4,#10 @ end ? |
|||
ble 1b @ no -> loop |
|||
/*********Fibonacci *************/ |
|||
adr r0,fibFunc @ function factorielle address |
|||
bl YFunc @ create Ycombinator |
|||
mov r5,r0 @ save Ycombinator |
|||
ldr r0,iAdrszFibonacci @ display message |
|||
bl affichageMess |
|||
mov r4,#1 @ loop counter |
|||
2: @ start loop |
|||
mov r0,r4 |
|||
bl numFunc @ create number structure |
|||
cmp r0,#-1 @ allocation error ? |
|||
beq 99f |
|||
mov r1,r0 @ structure number address |
|||
mov r0,r5 @ Ycombinator address |
|||
bl callFunc @ call |
|||
ldr r0,[r0,#func_num] @ load result |
|||
ldr r1,iAdrsValue @ and convert ascii string |
|||
bl conversion10 |
|||
ldr r0,iAdrszMessResult @ display result message |
|||
bl affichageMess |
|||
add r4,#1 @ increment loop counter |
|||
cmp r4,#10 @ end ? |
|||
ble 2b @ no -> loop |
|||
ldr r0,iAdrszMessEndPgm @ display end message |
|||
bl affichageMess |
|||
b 100f |
|||
99: @ display error message |
|||
ldr r0,iAdrszMessError |
|||
bl affichageMess |
|||
100: @ standard end of the program |
|||
mov r0, #0 @ return code |
|||
mov r7, #EXIT @ request to exit program |
|||
svc 0 @ perform system call |
|||
iAdrszMessStartPgm: .int szMessStartPgm |
|||
iAdrszMessEndPgm: .int szMessEndPgm |
|||
iAdrszFactorielle: .int szFactorielle |
|||
iAdrszFibonacci: .int szFibonacci |
|||
iAdrszMessError: .int szMessError |
|||
iAdrszCarriageReturn: .int szCarriageReturn |
|||
iAdrszMessResult: .int szMessResult |
|||
iAdrsValue: .int sValue |
|||
/******************************************************************/ |
|||
/* factorielle function */ |
|||
/******************************************************************/ |
|||
/* r0 contains the Y combinator address */ |
|||
/* r1 contains the number structure */ |
|||
facFunc: |
|||
push {r1-r3,lr} @ save registers |
|||
mov r2,r0 @ save Y combinator address |
|||
ldr r0,[r1,#func_num] @ load number |
|||
cmp r0,#1 @ > 1 ? |
|||
bgt 1f @ yes |
|||
mov r0,#1 @ create structure number value 1 |
|||
bl numFunc |
|||
b 100f |
|||
1: |
|||
mov r3,r0 @ save number |
|||
sub r0,#1 @ decrement number |
|||
bl numFunc @ and create new structure number |
|||
cmp r0,#-1 @ allocation error ? |
|||
beq 100f |
|||
mov r1,r0 @ new structure number -> param 1 |
|||
ldr r0,[r2,#func_f_] @ load function address to execute |
|||
bl callFunc @ call |
|||
ldr r1,[r0,#func_num] @ load new result |
|||
mul r0,r1,r3 @ and multiply by precedent |
|||
bl numFunc @ and create new structure number |
|||
@ and return her address in r0 |
|||
100: |
|||
pop {r1-r3,lr} @ restaur registers |
|||
bx lr @ return |
|||
/******************************************************************/ |
|||
/* fibonacci function */ |
|||
/******************************************************************/ |
|||
/* r0 contains the Y combinator address */ |
|||
/* r1 contains the number structure */ |
|||
fibFunc: |
|||
push {r1-r4,lr} @ save registers |
|||
mov r2,r0 @ save Y combinator address |
|||
ldr r0,[r1,#func_num] @ load number |
|||
cmp r0,#1 @ > 1 ? |
|||
bgt 1f @ yes |
|||
mov r0,#1 @ create structure number value 1 |
|||
bl numFunc |
|||
b 100f |
|||
1: |
|||
mov r3,r0 @ save number |
|||
sub r0,#1 @ decrement number |
|||
bl numFunc @ and create new structure number |
|||
cmp r0,#-1 @ allocation error ? |
|||
beq 100f |
|||
mov r1,r0 @ new structure number -> param 1 |
|||
ldr r0,[r2,#func_f_] @ load function address to execute |
|||
bl callFunc @ call |
|||
ldr r4,[r0,#func_num] @ load new result |
|||
sub r0,r3,#2 @ new number - 2 |
|||
bl numFunc @ and create new structure number |
|||
cmp r0,#-1 @ allocation error ? |
|||
beq 100f |
|||
mov r1,r0 @ new structure number -> param 1 |
|||
ldr r0,[r2,#func_f_] @ load function address to execute |
|||
bl callFunc @ call |
|||
ldr r1,[r0,#func_num] @ load new result |
|||
add r0,r1,r4 @ add two results |
|||
bl numFunc @ and create new structure number |
|||
@ and return her address in r0 |
|||
100: |
|||
pop {r1-r4,lr} @ restaur registers |
|||
bx lr @ return |
|||
/******************************************************************/ |
|||
/* call function */ |
|||
/******************************************************************/ |
|||
/* r0 contains the address of the function */ |
|||
/* r1 contains the address of the function 1 */ |
|||
callFunc: |
|||
push {r2,lr} @ save registers |
|||
ldr r2,[r0,#func_fn] @ load function address to execute |
|||
blx r2 @ and call it |
|||
pop {r2,lr} @ restaur registers |
|||
bx lr @ return |
|||
/******************************************************************/ |
|||
/* create Y combinator function */ |
|||
/******************************************************************/ |
|||
/* r0 contains the address of the function */ |
|||
YFunc: |
|||
push {r1,lr} @ save registers |
|||
mov r1,#0 |
|||
bl newFunc |
|||
cmp r0,#-1 @ allocation error ? |
|||
strne r0,[r0,#func_f_] @ store function and return in r0 |
|||
pop {r1,lr} @ restaur registers |
|||
bx lr @ return |
|||
/******************************************************************/ |
|||
/* create structure number function */ |
|||
/******************************************************************/ |
|||
/* r0 contains the number */ |
|||
numFunc: |
|||
push {r1,r2,lr} @ save registers |
|||
mov r2,r0 @ save number |
|||
mov r0,#0 @ function null |
|||
mov r1,#0 @ function null |
|||
bl newFunc |
|||
cmp r0,#-1 @ allocation error ? |
|||
strne r2,[r0,#func_num] @ store number in new structure |
|||
pop {r1,r2,lr} @ restaur registers |
|||
bx lr @ return |
|||
/******************************************************************/ |
|||
/* new function */ |
|||
/******************************************************************/ |
|||
/* r0 contains the function address */ |
|||
/* r1 contains the function address 1 */ |
|||
newFunc: |
|||
push {r2-r7,lr} @ save registers |
|||
mov r4,r0 @ save address |
|||
mov r5,r1 @ save adresse 1 |
|||
@ allocation place on the heap |
|||
mov r0,#0 @ allocation place heap |
|||
mov r7,#0x2D @ call system 'brk' |
|||
svc #0 |
|||
mov r3,r0 @ save address heap for output string |
|||
add r0,#func_fin @ reservation place one element |
|||
mov r7,#0x2D @ call system 'brk' |
|||
svc #0 |
|||
cmp r0,#-1 @ allocation error |
|||
beq 100f |
|||
mov r0,r3 |
|||
str r4,[r0,#func_fn] @ store address |
|||
str r5,[r0,#func_f_] |
|||
mov r2,#0 |
|||
str r2,[r0,#func_num] @ store zero to number |
|||
100: |
|||
pop {r2-r7,lr} @ restaur registers |
|||
bx lr @ return |
|||
/***************************************************/ |
|||
/* ROUTINES INCLUDE */ |
|||
/***************************************************/ |
|||
.include "../affichage.inc" |
|||
</lang> |
|||
{{output}} |
|||
<pre> |
|||
Program start |
|||
Function factorielle : |
|||
Result value :1 |
|||
Result value :2 |
|||
Result value :6 |
|||
Result value :24 |
|||
Result value :120 |
|||
Result value :720 |
|||
Result value :5040 |
|||
Result value :40320 |
|||
Result value :362880 |
|||
Result value :3628800 |
|||
Function Fibonacci : |
|||
Result value :1 |
|||
Result value :2 |
|||
Result value :3 |
|||
Result value :5 |
|||
Result value :8 |
|||
Result value :13 |
|||
Result value :21 |
|||
Result value :34 |
|||
Result value :55 |
|||
Result value :89 |
|||
Program normal end. |
|||
</pre> |
|||
=={{header|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> |
|||
=={{header|BlitzMax}}== |
=={{header|BlitzMax}}== |
||
Line 987: | Line 351: | ||
typedef struct func_t *func; |
typedef struct func_t *func; |
||
typedef struct func_t { |
typedef struct func_t { |
||
func (* |
func (*func) (func, func), _; |
||
func _; |
|||
int num; |
int num; |
||
} func_t; |
} func_t; |
||
Line 994: | Line 357: | ||
func new(func(*f)(func, func), func _) { |
func new(func(*f)(func, func), func _) { |
||
func x = malloc(sizeof(func_t)); |
func x = malloc(sizeof(func_t)); |
||
x-> |
x->func = f; |
||
x->_ = _; /* closure, sort of */ |
x->_ = _; /* closure, sort of */ |
||
x->num = 0; |
x->num = 0; |
||
Line 1,000: | Line 363: | ||
} |
} |
||
func call(func f, func |
func call(func f, func g) { |
||
return f-> |
return f->func(f, g); |
||
} |
} |
||
func Y(func(*f)(func, func)) { |
func Y(func(*f)(func, func)) { |
||
func |
func _(func x, func y) { return call(x->_, y); } |
||
func_t __ = { _ }; |
|||
func g = call(new(f, 0), &__); |
|||
g->_ = g; |
g->_ = g; |
||
return g; |
return g; |
||
Line 1,016: | Line 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 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 |
func fib(func f, func _null) { |
||
func _(func self, func n) { |
|||
int nn = n->num; |
|||
return nn > 1 |
|||
call(self->_, num(nn - |
? num( call(self->_, num(nn - 1))->num + |
||
call(self->_, num(nn - 2))->num ) |
|||
: num(1); |
|||
} |
|||
return new(_, f); |
|||
} |
} |
||
Line 1,048: | Line 421: | ||
return 0; |
return 0; |
||
}</lang> |
|||
} |
|||
</lang> |
|||
{{out}} |
{{out}} |
||
Line 1,055: | Line 427: | ||
fib: 1 2 3 5 8 13 21 34 55</pre> |
fib: 1 2 3 5 8 13 21 34 55</pre> |
||
=={{header|C sharp}}== |
=={{header|C sharp|C#}}== |
||
Like many other statically typed languages, this involves a recursive type, and like other strict languages, it is the Z-combinator instead. |
|||
The combinator here is expressed entirely as a lambda expression and is a static property of the generic <code>YCombinator</code> class. Both it and the <code>RecursiveFunc</code> type thus "inherit" the type parameters of the containing class—there effectively exists a separate specialized copy of both for each generic instantiation of <code>YCombinator</code>. |
|||
''Note: in the code, <code>Func<T, TResult></code> is a delegate type (the CLR equivalent of a function pointer) that has a parameter of type <code>T</code> and return type of <code>TResult</code>. See [[Higher-order functions#C#]] or [https://docs.microsoft.com/en-us/dotnet/standard/delegates-lambdas the documentation] for more information.'' |
|||
<lang csharp>using System; |
<lang csharp>using System; |
||
class Program |
|||
static class YCombinator<T, TResult> |
|||
{ |
{ |
||
delegate Func<int, int> Recursive(Recursive recursive); |
|||
// RecursiveFunc is not needed to call Fix() and so can be private. |
|||
private delegate Func<T, TResult> RecursiveFunc(RecursiveFunc r); |
|||
public static Func<Func<Func<T, TResult>, Func<T, TResult>>, Func<T, TResult>> Fix { get; } = |
|||
f => ((RecursiveFunc)(g => f(x => g(g)(x))))(g => f(x => g(g)(x))); |
|||
} |
|||
static class Program |
|||
{ |
|||
static void Main() |
static void Main() |
||
{ |
{ |
||
Func<Func<Func<int, int>, Func<int, int>>, Func<int, int>> Y = |
|||
f => ((Recursive)(g => (f(x => g(g)(x)))))((Recursive)(g => f(x => g(g)(x)))); |
|||
var fac = Y(f => x => x < 2 ? 1 : x * f(x - 1)); |
|||
var fib = Y(f => x => x < 2 ? x : f(x - 1) + f(x - 2)); |
|||
Console.WriteLine(fib(10)); |
|||
} |
|||
} |
|||
</lang> |
|||
{{out}} |
|||
<pre>3628800 |
|||
55</pre> |
|||
Alternatively, with a non-generic holder class (note that <code>Fix</code> is now a method, as properties cannot be generic): |
|||
<lang csharp>static class YCombinator |
|||
{ |
|||
private delegate Func<T, TResult> RecursiveFunc<T, TResult>(RecursiveFunc<T, TResult> r); |
|||
public static Func<T, TResult> Fix<T, TResult>(Func<Func<T, TResult>, Func<T, TResult>> f) |
|||
=> ((RecursiveFunc<T, TResult>)(g => f(x => g(g)(x))))(g => f(x => g(g)(x))); |
|||
}</lang> |
|||
Using the late-binding offered by <code>dynamic</code> to eliminate the recursive type: |
|||
<lang csharp>static class YCombinator<T, TResult> |
|||
{ |
|||
public static Func<Func<Func<T, TResult>, Func<T, TResult>>, Func<T, TResult>> Fix { get; } = |
|||
f => ((Func<dynamic, Func<T, TResult>>)(g => f(x => g(g)(x))))((Func<dynamic, Func<T, TResult>>)(g => f(x => g(g)(x)))); |
|||
}</lang> |
|||
The usual version using recursion, disallowed by the task (implemented as a generic method): |
|||
<lang csharp>static class YCombinator |
|||
{ |
|||
static Func<T, TResult> Fix<T, TResult>(Func<Func<T, TResult>, Func<T, TResult>> f) => x => f(Fix(f))(x); |
|||
}</lang> |
|||
===Translations=== |
|||
To compare differences in language and runtime instead of in approaches to the task, the following are translations of solutions from other languages. Two versions of each translation are provided, one seeking to resemble the original as closely as possible, and another that is identical in program control flow but syntactically closer to idiomatic C#. |
|||
====[http://rosettacode.org/mw/index.php?oldid=287744#C++ C++]==== |
|||
<code>std::function<TResult(T)></code> in C++ corresponds to <code>Func<T, TResult></code> in C#. |
|||
'''Verbatim''' |
|||
<lang csharp>using Func = System.Func<int, int>; |
|||
using FuncFunc = System.Func<System.Func<int, int>, System.Func<int, int>>; |
|||
Console.WriteLine(fac(6)); |
|||
static class Program { |
|||
Console.WriteLine(fib(6)); |
|||
struct RecursiveFunc<F> { |
|||
public System.Func<RecursiveFunc<F>, F> o; |
|||
} |
|||
static System.Func<A, B> Y<A, B>(System.Func<System.Func<A, B>, System.Func<A, B>> f) { |
|||
var r = new RecursiveFunc<System.Func<A, B>>() { |
|||
o = new System.Func<RecursiveFunc<System.Func<A, B>>, System.Func<A, B>>((RecursiveFunc<System.Func<A, B>> w) => { |
|||
return f(new System.Func<A, B>((A x) => { |
|||
return w.o(w)(x); |
|||
})); |
|||
}) |
|||
}; |
|||
return r.o(r); |
|||
} |
|||
static FuncFunc almost_fac = (Func f) => { |
|||
return new Func((int n) => { |
|||
if (n <= 1) return 1; |
|||
return n * f(n - 1); |
|||
}); |
|||
}; |
|||
static FuncFunc almost_fib = (Func f) => { |
|||
return new Func((int n) => { |
|||
if (n <= 2) return 1; |
|||
return f(n - 1) + f(n - 2); |
|||
}); |
|||
}; |
|||
static int Main() { |
|||
var fib = Y(almost_fib); |
|||
var fac = Y(almost_fac); |
|||
System.Console.WriteLine("fib(10) = " + fib(10)); |
|||
System.Console.WriteLine("fac(10) = " + fac(10)); |
|||
return 0; |
|||
} |
} |
||
}</lang> |
}</lang> |
||
{{out}} |
|||
<pre> |
|||
'''Semi-idiomatic''' |
|||
720 |
|||
<lang csharp>using System; |
|||
8 |
|||
</pre> |
|||
using FuncFunc = System.Func<System.Func<int, int>, System.Func<int, int>>; |
|||
static class Program { |
|||
struct RecursiveFunc<F> { |
|||
public Func<RecursiveFunc<F>, F> o; |
|||
} |
|||
static Func<A, B> Y<A, B>(Func<Func<A, B>, Func<A, B>> f) { |
|||
var r = new RecursiveFunc<Func<A, B>> { |
|||
o = w => f(x => w.o(w)(x)) |
|||
}; |
|||
return r.o(r); |
|||
} |
|||
static FuncFunc almost_fac = f => n => n <= 1 ? 1 : n * f(n - 1); |
|||
static FuncFunc almost_fib = f => n => n <= 2 ? 1 : f(n - 1) + f(n - 2); |
|||
static void Main() { |
|||
var fib = Y(almost_fib); |
|||
var fac = Y(almost_fac); |
|||
Console.WriteLine("fib(10) = " + fib(10)); |
|||
Console.WriteLine("fac(10) = " + fac(10)); |
|||
} |
|||
}</lang> |
|||
====[http://rosettacode.org/mw/index.php?oldid=287744#Ceylon Ceylon]==== |
|||
<code>TResult(T)</code> in Ceylon corresponds to <code>Func<T, TResult></code> in C#. |
|||
Since C# does not have local classes, <code>RecursiveFunc</code> and <code>y1</code> are declared in a class of their own. Moving the type parameters to the class also prevents type parameter inference. |
|||
'''Verbatim''' |
|||
<lang csharp>using System; |
|||
using System.Diagnostics; |
|||
class Program { |
|||
public delegate TResult ParamsFunc<T, TResult>(params T[] args); |
|||
static class Y<Result, Args> { |
|||
class RecursiveFunction { |
|||
public Func<RecursiveFunction, ParamsFunc<Args, Result>> o; |
|||
public RecursiveFunction(Func<RecursiveFunction, ParamsFunc<Args, Result>> o) => this.o = o; |
|||
} |
|||
public static ParamsFunc<Args, Result> y1( |
|||
Func<ParamsFunc<Args, Result>, ParamsFunc<Args, Result>> f) { |
|||
var r = new RecursiveFunction((RecursiveFunction w) |
|||
=> f((Args[] args) => w.o(w)(args))); |
|||
return r.o(r); |
|||
} |
|||
} |
|||
static ParamsFunc<Args, Result> y2<Args, Result>( |
|||
Func<ParamsFunc<Args, Result>, ParamsFunc<Args, Result>> f) { |
|||
Func<dynamic, ParamsFunc<Args, Result>> r = w => { |
|||
Debug.Assert(w is Func<dynamic, ParamsFunc<Args, Result>>); |
|||
return f((Args[] args) => w(w)(args)); |
|||
}; |
|||
return r(r); |
|||
} |
|||
static ParamsFunc<Args, Result> y3<Args, Result>( |
|||
Func<ParamsFunc<Args, Result>, ParamsFunc<Args, Result>> f) |
|||
=> (Args[] args) => f(y3(f))(args); |
|||
static void Main() { |
|||
var factorialY1 = Y<int, int>.y1((ParamsFunc<int, int> fact) => (int[] x) |
|||
=> (x[0] > 1) ? x[0] * fact(x[0] - 1) : 1); |
|||
var fibY1 = Y<int, int>.y1((ParamsFunc<int, int> fib) => (int[] x) |
|||
=> (x[0] > 2) ? fib(x[0] - 1) + fib(x[0] - 2) : 2); |
|||
Console.WriteLine(factorialY1(10)); // 362880 |
|||
Console.WriteLine(fibY1(10)); // 110 |
|||
} |
|||
}</lang> |
|||
'''Semi-idiomatic''' |
|||
<lang csharp>using System; |
|||
using System.Diagnostics; |
|||
static class Program { |
|||
delegate TResult ParamsFunc<T, TResult>(params T[] args); |
|||
static class Y<Result, Args> { |
|||
class RecursiveFunction { |
|||
public Func<RecursiveFunction, ParamsFunc<Args, Result>> o; |
|||
public RecursiveFunction(Func<RecursiveFunction, ParamsFunc<Args, Result>> o) => this.o = o; |
|||
} |
|||
public static ParamsFunc<Args, Result> y1( |
|||
Func<ParamsFunc<Args, Result>, ParamsFunc<Args, Result>> f) { |
|||
var r = new RecursiveFunction(w => f(args => w.o(w)(args))); |
|||
return r.o(r); |
|||
} |
|||
} |
|||
static ParamsFunc<Args, Result> y2<Args, Result>( |
|||
Func<ParamsFunc<Args, Result>, ParamsFunc<Args, Result>> f) { |
|||
Func<dynamic, ParamsFunc<Args, Result>> r = w => { |
|||
Debug.Assert(w is Func<dynamic, ParamsFunc<Args, Result>>); |
|||
return f(args => w(w)(args)); |
|||
}; |
|||
return r(r); |
|||
} |
|||
static ParamsFunc<Args, Result> y3<Args, Result>( |
|||
Func<ParamsFunc<Args, Result>, ParamsFunc<Args, Result>> f) |
|||
=> args => f(y3(f))(args); |
|||
static void Main() { |
|||
var factorialY1 = Y<int, int>.y1(fact => x => (x[0] > 1) ? x[0] * fact(x[0] - 1) : 1); |
|||
var fibY1 = Y<int, int>.y1(fib => x => (x[0] > 2) ? fib(x[0] - 1) + fib(x[0] - 2) : 2); |
|||
Console.WriteLine(factorialY1(10)); |
|||
Console.WriteLine(fibY1(10)); |
|||
} |
|||
}</lang> |
|||
====[http://rosettacode.org/mw/index.php?oldid=287744#Go Go]==== |
|||
<code>func(T) TResult</code> in Go corresponds to <code>Func<T, TResult></code> in C#. |
|||
'''Verbatim''' |
|||
<lang csharp>using System; |
|||
// Func and FuncFunc can be defined using using aliases and the System.Func<T, TReult> type, but RecursiveFunc must be a delegate type of its own. |
|||
using Func = System.Func<int, int>; |
|||
using FuncFunc = System.Func<System.Func<int, int>, System.Func<int, int>>; |
|||
delegate Func RecursiveFunc(RecursiveFunc f); |
|||
static class Program { |
|||
static void Main() { |
|||
var fac = Y(almost_fac); |
|||
var fib = Y(almost_fib); |
|||
Console.WriteLine("fac(10) = " + fac(10)); |
|||
Console.WriteLine("fib(10) = " + fib(10)); |
|||
} |
|||
static Func Y(FuncFunc f) { |
|||
RecursiveFunc g = delegate (RecursiveFunc r) { |
|||
return f(delegate (int x) { |
|||
return r(r)(x); |
|||
}); |
|||
}; |
|||
return g(g); |
|||
} |
|||
static Func almost_fac(Func f) { |
|||
return delegate (int x) { |
|||
if (x <= 1) { |
|||
return 1; |
|||
} |
|||
return x * f(x-1); |
|||
}; |
|||
} |
|||
static Func almost_fib(Func f) { |
|||
return delegate (int x) { |
|||
if (x <= 2) { |
|||
return 1; |
|||
} |
|||
return f(x-1)+f(x-2); |
|||
}; |
|||
} |
|||
}</lang> |
|||
Recursive: |
|||
<lang csharp> static Func Y(FuncFunc f) { |
|||
return delegate (int x) { |
|||
return f(Y(f))(x); |
|||
}; |
|||
}</lang> |
|||
'''Semi-idiomatic''' |
|||
<lang csharp>using System; |
|||
delegate int Func(int i); |
|||
delegate Func FuncFunc(Func f); |
|||
delegate Func RecursiveFunc(RecursiveFunc f); |
|||
static class Program { |
|||
static void Main() { |
|||
var fac = Y(almost_fac); |
|||
var fib = Y(almost_fib); |
|||
Console.WriteLine("fac(10) = " + fac(10)); |
|||
Console.WriteLine("fib(10) = " + fib(10)); |
|||
} |
|||
static Func Y(FuncFunc f) { |
|||
RecursiveFunc g = r => f(x => r(r)(x)); |
|||
return g(g); |
|||
} |
|||
static Func almost_fac(Func f) => x => x <= 1 ? 1 : x * f(x - 1); |
|||
static Func almost_fib(Func f) => x => x <= 2 ? 1 : f(x - 1) + f(x - 2); |
|||
}</lang> |
|||
Recursive: |
|||
<lang csharp> static Func Y(FuncFunc f) => x => f(Y(f))(x);</lang> |
|||
====[http://rosettacode.org/mw/index.php?oldid=287744#Java Java]==== |
|||
'''Verbatim''' |
|||
Since Java uses interfaces and C# uses delegates, which are the only type that the C# compiler will coerce lambda expressions to, this code declares a <code>Functions</code> class for providing a means of converting CLR delegates to objects that implement the <code>Function</code> and <code>RecursiveFunction</code> interfaces. |
|||
<lang csharp>using System; |
|||
static class Program { |
|||
interface Function<T, R> { |
|||
R apply(T t); |
|||
} |
|||
interface RecursiveFunction<F> : Function<RecursiveFunction<F>, F> { |
|||
} |
|||
static class Functions { |
|||
class Function<T, R> : Program.Function<T, R> { |
|||
readonly Func<T, R> _inner; |
|||
public Function(Func<T, R> inner) => this._inner = inner; |
|||
public R apply(T t) => this._inner(t); |
|||
} |
|||
class RecursiveFunction<F> : Function<Program.RecursiveFunction<F>, F>, Program.RecursiveFunction<F> { |
|||
public RecursiveFunction(Func<Program.RecursiveFunction<F>, F> inner) : base(inner) { |
|||
} |
|||
} |
|||
public static Program.Function<T, R> Create<T, R>(Func<T, R> inner) => new Function<T, R>(inner); |
|||
public static Program.RecursiveFunction<F> Create<F>(Func<Program.RecursiveFunction<F>, F> inner) => new RecursiveFunction<F>(inner); |
|||
} |
|||
static Function<A, B> Y<A, B>(Function<Function<A, B>, Function<A, B>> f) { |
|||
var r = Functions.Create<Function<A, B>>(w => f.apply(Functions.Create<A, B>(x => w.apply(w).apply(x)))); |
|||
return r.apply(r); |
|||
} |
|||
static void Main(params String[] arguments) { |
|||
Function<int, int> fib = Y(Functions.Create<Function<int, int>, Function<int, int>>(f => Functions.Create<int, int>(n => |
|||
(n <= 2) |
|||
? 1 |
|||
: (f.apply(n - 1) + f.apply(n - 2)))) |
|||
); |
|||
Function<int, int> fac = Y(Functions.Create<Function<int, int>, Function<int, int>>(f => Functions.Create<int, int>(n => |
|||
(n <= 1) |
|||
? 1 |
|||
: (n * f.apply(n - 1)))) |
|||
); |
|||
Console.WriteLine("fib(10) = " + fib.apply(10)); |
|||
Console.WriteLine("fac(10) = " + fac.apply(10)); |
|||
} |
|||
}</lang> |
|||
'''"Idiomatic"''' |
|||
For demonstrative purposes, to completely avoid using CLR delegates, lambda expressions can be replaced with explicit types that implement the functional interfaces. Closures are thus implemented by replacing all usages of the original local variable with a field of the type that represents the lambda expression; this process, called "hoisting" is actually how variable capturing is implemented by the C# compiler (for more information, see [https://blogs.msdn.microsoft.com/abhinaba/2005/10/18/c-anonymous-methods-are-not-closures/ this Microsoft blog post]. |
|||
<lang csharp>using System; |
|||
static class YCombinator { |
|||
interface Function<T, R> { |
|||
R apply(T t); |
|||
} |
|||
interface RecursiveFunction<F> : Function<RecursiveFunction<F>, F> { |
|||
} |
|||
static class Y<A, B> { |
|||
class __1 : RecursiveFunction<Function<A, B>> { |
|||
class __2 : Function<A, B> { |
|||
readonly RecursiveFunction<Function<A, B>> w; |
|||
public __2(RecursiveFunction<Function<A, B>> w) { |
|||
this.w = w; |
|||
} |
|||
public B apply(A x) { |
|||
return w.apply(w).apply(x); |
|||
} |
|||
} |
|||
Function<Function<A, B>, Function<A, B>> f; |
|||
public __1(Function<Function<A, B>, Function<A, B>> f) { |
|||
this.f = f; |
|||
} |
|||
public Function<A, B> apply(RecursiveFunction<Function<A, B>> w) { |
|||
return f.apply(new __2(w)); |
|||
} |
|||
} |
|||
public static Function<A, B> _(Function<Function<A, B>, Function<A, B>> f) { |
|||
var r = new __1(f); |
|||
return r.apply(r); |
|||
} |
|||
} |
|||
class __1 : Function<Function<int, int>, Function<int, int>> { |
|||
class __2 : Function<int, int> { |
|||
readonly Function<int, int> f; |
|||
public __2(Function<int, int> f) { |
|||
this.f = f; |
|||
} |
|||
public int apply(int n) { |
|||
return |
|||
(n <= 2) |
|||
? 1 |
|||
: (f.apply(n - 1) + f.apply(n - 2)); |
|||
} |
|||
} |
|||
public Function<int, int> apply(Function<int, int> f) { |
|||
return new __2(f); |
|||
} |
|||
} |
|||
class __2 : Function<Function<int, int>, Function<int, int>> { |
|||
class __3 : Function<int, int> { |
|||
readonly Function<int, int> f; |
|||
public __3(Function<int, int> f) { |
|||
this.f = f; |
|||
} |
|||
public int apply(int n) { |
|||
return |
|||
(n <= 1) |
|||
? 1 |
|||
: (n * f.apply(n - 1)); |
|||
} |
|||
} |
|||
public Function<int, int> apply(Function<int, int> f) { |
|||
return new __3(f); |
|||
} |
|||
} |
|||
static void Main(params String[] arguments) { |
|||
Function<int, int> fib = Y<int, int>._(new __1()); |
|||
Function<int, int> fac = Y<int, int>._(new __2()); |
|||
Console.WriteLine("fib(10) = " + fib.apply(10)); |
|||
Console.WriteLine("fac(10) = " + fac.apply(10)); |
|||
} |
|||
}</lang> |
|||
'''C# 1.0''' |
|||
To conclude this chain of decreasing reliance on language features, here is above code translated to C# 1.0. The largest change is the replacement of the generic interfaces with the results of manually substituting their type parameters. |
|||
<lang csharp>using System; |
|||
class Program { |
|||
interface Func { |
|||
int apply(int i); |
|||
} |
|||
interface FuncFunc { |
|||
Func apply(Func f); |
|||
} |
|||
interface RecursiveFunc { |
|||
Func apply(RecursiveFunc f); |
|||
} |
|||
class Y { |
|||
class __1 : RecursiveFunc { |
|||
class __2 : Func { |
|||
readonly RecursiveFunc w; |
|||
public __2(RecursiveFunc w) { |
|||
this.w = w; |
|||
} |
|||
public int apply(int x) { |
|||
return w.apply(w).apply(x); |
|||
} |
|||
} |
|||
readonly FuncFunc f; |
|||
public __1(FuncFunc f) { |
|||
this.f = f; |
|||
} |
|||
public Func apply(RecursiveFunc w) { |
|||
return f.apply(new __2(w)); |
|||
} |
|||
} |
|||
public static Func _(FuncFunc f) { |
|||
__1 r = new __1(f); |
|||
return r.apply(r); |
|||
} |
|||
} |
|||
class __fib : FuncFunc { |
|||
class __1 : Func { |
|||
readonly Func f; |
|||
public __1(Func f) { |
|||
this.f = f; |
|||
} |
|||
public int apply(int n) { |
|||
return |
|||
(n <= 2) |
|||
? 1 |
|||
: (f.apply(n - 1) + f.apply(n - 2)); |
|||
} |
|||
} |
|||
public Func apply(Func f) { |
|||
return new __1(f); |
|||
} |
|||
} |
|||
class __fac : FuncFunc { |
|||
class __1 : Func { |
|||
readonly Func f; |
|||
public __1(Func f) { |
|||
this.f = f; |
|||
} |
|||
public int apply(int n) { |
|||
return |
|||
(n <= 1) |
|||
? 1 |
|||
: (n * f.apply(n - 1)); |
|||
} |
|||
} |
|||
public Func apply(Func f) { |
|||
return new __1(f); |
|||
} |
|||
} |
|||
static void Main(params String[] arguments) { |
|||
Func fib = Y._(new __fib()); |
|||
Func fac = Y._(new __fac()); |
|||
Console.WriteLine("fib(10) = " + fib.apply(10)); |
|||
Console.WriteLine("fac(10) = " + fac.apply(10)); |
|||
} |
|||
}</lang> |
|||
'''Modified/varargs (the last implementation in the Java section)''' |
|||
Since C# delegates cannot declare members, extension methods are used to simulate doing so. |
|||
<lang csharp>using System; |
|||
using System.Collections.Generic; |
|||
using System.Linq; |
|||
using System.Numerics; |
|||
static class Func { |
|||
public static Func<T, TResult2> andThen<T, TResult, TResult2>( |
|||
this Func<T, TResult> @this, |
|||
Func<TResult, TResult2> after) |
|||
=> _ => after(@this(_)); |
|||
} |
|||
delegate OUTPUT SelfApplicable<OUTPUT>(SelfApplicable<OUTPUT> s); |
|||
static class SelfApplicable { |
|||
public static OUTPUT selfApply<OUTPUT>(this SelfApplicable<OUTPUT> @this) => @this(@this); |
|||
} |
|||
delegate FUNCTION FixedPoint<FUNCTION>(Func<FUNCTION, FUNCTION> f); |
|||
delegate OUTPUT VarargsFunction<INPUTS, OUTPUT>(params INPUTS[] inputs); |
|||
static class VarargsFunction { |
|||
public static VarargsFunction<INPUTS, OUTPUT> from<INPUTS, OUTPUT>( |
|||
Func<INPUTS[], OUTPUT> function) |
|||
=> function.Invoke; |
|||
public static VarargsFunction<INPUTS, OUTPUT> upgrade<INPUTS, OUTPUT>( |
|||
Func<INPUTS, OUTPUT> function) { |
|||
return inputs => function(inputs[0]); |
|||
} |
|||
public static VarargsFunction<INPUTS, OUTPUT> upgrade<INPUTS, OUTPUT>( |
|||
Func<INPUTS, INPUTS, OUTPUT> function) { |
|||
return inputs => function(inputs[0], inputs[1]); |
|||
} |
|||
public static VarargsFunction<INPUTS, POST_OUTPUT> andThen<INPUTS, OUTPUT, POST_OUTPUT>( |
|||
this VarargsFunction<INPUTS, OUTPUT> @this, |
|||
VarargsFunction<OUTPUT, POST_OUTPUT> after) { |
|||
return inputs => after(@this(inputs)); |
|||
} |
|||
public static Func<INPUTS, OUTPUT> toFunction<INPUTS, OUTPUT>( |
|||
this VarargsFunction<INPUTS, OUTPUT> @this) { |
|||
return input => @this(input); |
|||
} |
|||
public static Func<INPUTS, INPUTS, OUTPUT> toBiFunction<INPUTS, OUTPUT>( |
|||
this VarargsFunction<INPUTS, OUTPUT> @this) { |
|||
return (input, input2) => @this(input, input2); |
|||
} |
|||
public static VarargsFunction<PRE_INPUTS, OUTPUT> transformArguments<PRE_INPUTS, INPUTS, OUTPUT>( |
|||
this VarargsFunction<INPUTS, OUTPUT> @this, |
|||
Func<PRE_INPUTS, INPUTS> transformer) { |
|||
return inputs => @this(inputs.AsParallel().AsOrdered().Select(transformer).ToArray()); |
|||
} |
|||
} |
|||
delegate FixedPoint<FUNCTION> Y<FUNCTION>(SelfApplicable<FixedPoint<FUNCTION>> y); |
|||
static class Program { |
|||
static TResult Cast<TResult>(this Delegate @this) where TResult : Delegate { |
|||
return (TResult)Delegate.CreateDelegate(typeof(TResult), @this.Target, @this.Method); |
|||
} |
|||
static void Main(params String[] arguments) { |
|||
BigInteger TWO = BigInteger.One + BigInteger.One; |
|||
Func<IFormattable, long> toLong = x => long.Parse(x.ToString()); |
|||
Func<IFormattable, BigInteger> toBigInteger = x => new BigInteger(toLong(x)); |
|||
/* Based on https://gist.github.com/aruld/3965968/#comment-604392 */ |
|||
Y<VarargsFunction<IFormattable, IFormattable>> combinator = y => f => x => f(y.selfApply()(f))(x); |
|||
FixedPoint<VarargsFunction<IFormattable, IFormattable>> fixedPoint = |
|||
combinator.Cast<SelfApplicable<FixedPoint<VarargsFunction<IFormattable, IFormattable>>>>().selfApply(); |
|||
VarargsFunction<IFormattable, IFormattable> fibonacci = fixedPoint( |
|||
f => VarargsFunction.upgrade( |
|||
toBigInteger.andThen( |
|||
n => (IFormattable)( |
|||
(n.CompareTo(TWO) <= 0) |
|||
? 1 |
|||
: BigInteger.Parse(f(n - BigInteger.One).ToString()) |
|||
+ BigInteger.Parse(f(n - TWO).ToString())) |
|||
) |
|||
) |
|||
); |
|||
VarargsFunction<IFormattable, IFormattable> factorial = fixedPoint( |
|||
f => VarargsFunction.upgrade( |
|||
toBigInteger.andThen( |
|||
n => (IFormattable)((n.CompareTo(BigInteger.One) <= 0) |
|||
? 1 |
|||
: n * BigInteger.Parse(f(n - BigInteger.One).ToString())) |
|||
) |
|||
) |
|||
); |
|||
VarargsFunction<IFormattable, IFormattable> ackermann = fixedPoint( |
|||
f => VarargsFunction.upgrade( |
|||
(BigInteger m, BigInteger n) => m.Equals(BigInteger.Zero) |
|||
? n + BigInteger.One |
|||
: f( |
|||
m - BigInteger.One, |
|||
n.Equals(BigInteger.Zero) |
|||
? BigInteger.One |
|||
: f(m, n - BigInteger.One) |
|||
) |
|||
).transformArguments(toBigInteger) |
|||
); |
|||
var functions = new Dictionary<String, VarargsFunction<IFormattable, IFormattable>>(); |
|||
functions.Add("fibonacci", fibonacci); |
|||
functions.Add("factorial", factorial); |
|||
functions.Add("ackermann", ackermann); |
|||
var parameters = new Dictionary<VarargsFunction<IFormattable, IFormattable>, IFormattable[]>(); |
|||
parameters.Add(functions["fibonacci"], new IFormattable[] { 20 }); |
|||
parameters.Add(functions["factorial"], new IFormattable[] { 10 }); |
|||
parameters.Add(functions["ackermann"], new IFormattable[] { 3, 2 }); |
|||
functions.AsParallel().Select( |
|||
entry => entry.Key |
|||
+ "[" + String.Join(", ", parameters[entry.Value].Select(x => x.ToString())) + "]" |
|||
+ " = " |
|||
+ entry.Value(parameters[entry.Value]) |
|||
).ForAll(Console.WriteLine); |
|||
} |
|||
}</lang> |
|||
====[http://rosettacode.org/mw/index.php?oldid=287744#Swift Swift]==== |
|||
<code>T -> TResult</code> in Swift corresponds to <code>Func<T, TResult></code> in C#. |
|||
'''Verbatim''' |
|||
The more idiomatic version doesn't look much different. |
|||
<lang csharp>using System; |
|||
static class Program { |
|||
struct RecursiveFunc<F> { |
|||
public Func<RecursiveFunc<F>, F> o; |
|||
} |
|||
static Func<A, B> Y<A, B>(Func<Func<A, B>, Func<A, B>> f) { |
|||
var r = new RecursiveFunc<Func<A, B>> { o = w => f(_0 => w.o(w)(_0)) }; |
|||
return r.o(r); |
|||
} |
|||
static void Main() { |
|||
// C# can't infer the type arguments to Y either; either it or f must be explicitly typed. |
|||
var fac = Y((Func<int, int> f) => _0 => _0 <= 1 ? 1 : _0 * f(_0 - 1)); |
|||
var fib = Y((Func<int, int> f) => _0 => _0 <= 2 ? 1 : f(_0 - 1) + f(_0 - 2)); |
|||
Console.WriteLine($"fac(5) = {fac(5)}"); |
|||
Console.WriteLine($"fib(9) = {fib(9)}"); |
|||
} |
|||
}</lang> |
|||
Without recursive type: |
|||
<lang csharp> public static Func<A, B> Y<A, B>(Func<Func<A, B>, Func<A, B>> f) { |
|||
Func<dynamic, Func<A, B>> r = z => { var w = (Func<dynamic, Func<A, B>>)z; return f(_0 => w(w)(_0)); }; |
|||
return r(r); |
|||
}</lang> |
|||
Recursive: |
|||
<lang csharp> public static Func<In, Out> Y<In, Out>(Func<Func<In, Out>, Func<In, Out>> f) { |
|||
return x => f(Y(f))(x); |
|||
}</lang> |
|||
=={{header|C++}}== |
=={{header|C++}}== |
||
Line 1,846: | Line 500: | ||
}</lang> |
}</lang> |
||
{{out}} |
{{out}} |
||
<pre> |
|||
fib(10) = 55 |
|||
fac(10) = 3628800 |
|||
</pre> |
|||
{{works with|C++14}} |
|||
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> |
|||
{{out}} |
|||
<pre> |
<pre> |
||
fib(10) = 55 |
fib(10) = 55 |
||
Line 1,949: | Line 571: | ||
given Args satisfies Anything[] |
given Args satisfies Anything[] |
||
=> flatten((Args args) => f(y3(f))(*args));</lang> |
=> flatten((Args args) => f(y3(f))(*args));</lang> |
||
=={{header|Chapel}}== |
|||
Strict (non-lazy = non-deferred execution) languages will race with the usually defined Y combinator (call-by-name) so most implementations are the Z combinator which lack one Beta Reduction from the true Y combinator (they are call-by-value). Although one can inject laziness so as to make the true Y combinator work with strict languages, the following code implements the usual Z call-by-value combinator using records to represent closures as Chapel does not have First Class Functions that can capture bindings from outside their scope other than from global scope: |
|||
{{works with|Chapel version 1.24.1}} |
|||
<lang chapel>proc fixz(f) { |
|||
record InnerFunc { |
|||
const xi; |
|||
proc this(a) { return xi(xi)(a); } |
|||
} |
|||
record XFunc { |
|||
const fi; |
|||
proc this(x) { return fi(new InnerFunc(x)); } |
|||
} |
|||
const g = new XFunc(f); |
|||
return g(g); |
|||
} |
|||
record Facz { |
|||
record FacFunc { |
|||
const fi; |
|||
proc this(n: int): int { |
|||
return if n <= 1 then 1 else n * fi(n - 1); } |
|||
} |
|||
proc this(f) { return new FacFunc(f); } |
|||
} |
|||
record Fibz { |
|||
record FibFunc { |
|||
const fi; |
|||
proc this(n: int): int { |
|||
return if n <= 1 then n else fi(n - 2) + fi(n - 1); } |
|||
} |
|||
proc this(f) { return new FibFunc(f); } |
|||
} |
|||
const facz = fixz(new Facz()); |
|||
const fibz = fixz(new Fibz()); |
|||
writeln(facz(10)); |
|||
writeln(fibz(10));</lang> |
|||
{{out}} |
|||
<pre>3628800 |
|||
55</pre> |
|||
One can write a true call-by-name Y combinator by injecting one level of laziness or deferred execution at the defining function level as per the following code: |
|||
{{works with|Chapel version 1.24.1}} |
|||
<lang chapel>// this is the longer version... |
|||
/* |
|||
proc fixy(f) { |
|||
record InnerFunc { |
|||
const xi; |
|||
proc this() { return xi(xi); } |
|||
} |
|||
record XFunc { |
|||
const fi; |
|||
proc this(x) { return fi(new InnerFunc(x)); } |
|||
} |
|||
const g = new XFunc(f); |
|||
return g(g); |
|||
} |
|||
// */ |
|||
// short version using direct recursion as Chapel has... |
|||
// note that this version of fix uses function recursion in its own definition; |
|||
// thus its use just means that the recursion has been "pulled" into the "fix" function, |
|||
// instead of the function that uses it... |
|||
proc fixy(f) { |
|||
record InnerFunc { const fi; proc this() { return fixy(fi); } } |
|||
return f(new InnerFunc(f)); |
|||
} |
|||
record Facy { |
|||
record FacFunc { |
|||
const fi; |
|||
proc this(n: int): int { |
|||
return if n <= 1 then 1 else n * fi()(n - 1); } |
|||
} |
|||
proc this(f) { return new FacFunc(f); } |
|||
} |
|||
record Fiby { |
|||
record FibFunc { |
|||
const fi; |
|||
proc this(n: int): int { |
|||
return if n <= 1 then n else fi()(n - 2) + fi()(n - 1); } |
|||
} |
|||
proc this(f) { return new FibFunc(f); } |
|||
} |
|||
const facy = fixy(new Facy()); |
|||
const fibz = fixy(new Fiby()); |
|||
writeln(facy(10)); |
|||
writeln(fibz(10));</lang> |
|||
The output is the same as the above. |
|||
=={{header|Clojure}}== |
=={{header|Clojure}}== |
||
Line 2,079: | Line 603: | ||
<lang lisp>(defn Y [f] |
<lang lisp>(defn Y [f] |
||
(#(% %) #(f (fn [& args] (apply (% %) args)))))</lang> |
(#(% %) #(f (fn [& args] (apply (% %) args)))))</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|Common Lisp}}== |
=={{header|Common Lisp}}== |
||
<lang lisp>(defun Y (f) |
<lang lisp>(defun Y (f) |
||
((lambda ( |
((lambda (x) (funcall x x)) |
||
(lambda ( |
(lambda (y) |
||
(funcall f (lambda (&rest |
(funcall f (lambda (&rest args) |
||
(apply (funcall |
(apply (funcall y y) args)))))) |
||
(defun fac ( |
(defun fac (f) |
||
( |
(lambda (n) |
||
(if (zerop n) |
|||
1 |
|||
(lambda (n) |
|||
(* n (funcall f (1- n)))))) |
|||
1 |
|||
(* n (funcall f (1- n))))))) |
|||
n)) |
|||
(defun fib ( |
(defun fib (f) |
||
( |
(lambda (n) |
||
(case n |
|||
(0 0) |
|||
(1 1) |
|||
(otherwise (+ (funcall f (- n 1)) |
|||
(funcall f (- n 2))))))) |
|||
n 0 1)) |
|||
? (mapcar #'fac '(1 2 3 4 5 6 7 8 9 10)) |
? (mapcar (Y #'fac) '(1 2 3 4 5 6 7 8 9 10)) |
||
(1 2 6 24 120 720 5040 40320 362880 3628800)) |
(1 2 6 24 120 720 5040 40320 362880 3628800)) |
||
? (mapcar #'fib '(1 2 3 4 5 6 7 8 9 10)) |
? (mapcar (Y #'fib) '(1 2 3 4 5 6 7 8 9 10)) |
||
(1 1 2 3 5 8 13 21 34 55) |
(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}}== |
=={{header|D}}== |
||
Line 2,149: | Line 671: | ||
<pre>factorial: [1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880] |
<pre>factorial: [1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880] |
||
ackermann(3, 5): 253</pre> |
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}}== |
=={{header|Delphi}}== |
||
Line 2,222: | Line 777: | ||
Writeln ('Fac(10) = ', Fac (10)); |
Writeln ('Fac(10) = ', Fac (10)); |
||
end.</lang> |
end.</lang> |
||
=={{header|Dhall}}== |
|||
Dhall is not a turing complete language, so there's no way to implement the real Y combinator. That being said, you can replicate the effects of the Y combinator to any arbitrary but finite recursion depth using the builtin function Natural/Fold, which acts as a bounded fixed-point combinator that takes a natural argument to describe how far to recurse. |
|||
Here's an example using Natural/Fold to define recursive definitions of fibonacci and factorial: |
|||
<lang Dhall>let const |
|||
: ∀(b : Type) → ∀(a : Type) → a → b → a |
|||
= λ(r : Type) → λ(a : Type) → λ(x : a) → λ(y : r) → x |
|||
let fac |
|||
: ∀(n : Natural) → Natural |
|||
= λ(n : Natural) → |
|||
let factorial = |
|||
λ(f : Natural → Natural → Natural) → |
|||
λ(n : Natural) → |
|||
λ(i : Natural) → |
|||
if Natural/isZero i then n else f (i * n) (Natural/subtract 1 i) |
|||
in Natural/fold |
|||
n |
|||
(Natural → Natural → Natural) |
|||
factorial |
|||
(const Natural Natural) |
|||
1 |
|||
n |
|||
let fib |
|||
: ∀(n : Natural) → Natural |
|||
= λ(n : Natural) → |
|||
let fibFunc = Natural → Natural → Natural → Natural |
|||
let fibonacci = |
|||
λ(f : fibFunc) → |
|||
λ(a : Natural) → |
|||
λ(b : Natural) → |
|||
λ(i : Natural) → |
|||
if Natural/isZero i |
|||
then a |
|||
else f b (a + b) (Natural/subtract 1 i) |
|||
in Natural/fold |
|||
n |
|||
fibFunc |
|||
fibonacci |
|||
(λ(a : Natural) → λ(_ : Natural) → λ(_ : Natural) → a) |
|||
0 |
|||
1 |
|||
n |
|||
in [fac 50, fib 50]</lang> |
|||
The above dhall file gets rendered down to: |
|||
<lang Dhall>[ 30414093201713378043612608166064768844377641568960512000000000000 |
|||
, 12586269025 |
|||
]</lang> |
|||
=={{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|E}}== |
=={{header|E}}== |
||
Line 2,326: | Line 790: | ||
? accum [] for i in 0..!10 { _.with(y(fib)(i)) } |
? accum [] for i in 0..!10 { _.with(y(fib)(i)) } |
||
[0, 1, 1, 2, 3, 5, 8, 13, 21, 34]</lang> |
[0, 1, 1, 2, 3, 5, 8, 13, 21, 34]</lang> |
||
=={{header|EchoLisp}}== |
|||
<lang scheme> |
|||
;; Ref : http://www.ece.uc.edu/~franco/C511/html/Scheme/ycomb.html |
|||
(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> |
|||
=={{header|Eero}}== |
=={{header|Eero}}== |
||
Line 2,400: | Line 837: | ||
{{out}} |
{{out}} |
||
<pre>(479001600,144)</pre> |
<pre>(479001600,144)</pre> |
||
=={{header|Elena}}== |
|||
{{trans|Smalltalk}} |
|||
ELENA 4.x : |
|||
<lang elena>import extensions; |
|||
singleton YCombinator |
|||
{ |
|||
fix(func) |
|||
= (f){(x){ x(x) }((g){ f((x){ (g(g))(x) })})}(func); |
|||
} |
|||
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)); |
|||
console.printLine("fact(10)=",fact(10)); |
|||
}</lang> |
|||
{{out}} |
|||
<pre> |
|||
fib(10)=55 |
|||
fact(10)=3628800 |
|||
</pre> |
|||
=={{header|Elixir}}== |
=={{header|Elixir}}== |
||
Line 2,440: | Line 852: | ||
[0, 1, 1, 2, 3, 5, 8, 13, 21, 34] |
[0, 1, 1, 2, 3, 5, 8, 13, 21, 34] |
||
</lang> |
</lang> |
||
=={{header|Elm}}== |
|||
This is similar to the Haskell solution below, but the first `fixz` is a strict fixed-point combinator lacking one beta reduction as compared to the Y-combinator; the second `fixy` injects laziness using a "thunk" (a unit argument function whose return value is deferred until the function is called/applied). |
|||
Note: the Fibonacci sequence is defined to start with zero or one, with the first exactly the same but with a zero prepended; these Fibonacci calculations use the second definition. |
|||
<lang elm>module Main exposing ( main ) |
|||
import Html exposing ( Html, text ) |
|||
-- As with most of the strict (non-deferred or non-lazy) languages, |
|||
-- this is the Z-combinator with the additional value parameter... |
|||
-- wrap type conversion to avoid recursive type definition... |
|||
type Mu a b = Roll (Mu a b -> a -> b) |
|||
unroll : Mu a b -> (Mu a b -> a -> b) -- unwrap it... |
|||
unroll (Roll x) = x |
|||
-- note lack of beta reduction using values... |
|||
fixz : ((a -> b) -> (a -> b)) -> (a -> b) |
|||
fixz f = let g r = f (\ v -> unroll r r v) in g (Roll g) |
|||
facz : Int -> Int |
|||
-- facz = fixz <| \ f n -> if n < 2 then 1 else n * f (n - 1) -- inefficient recursion |
|||
facz = fixz (\ f n i -> if i < 2 then n else f (i * n) (i - 1)) 1 -- efficient tailcall |
|||
fibz : Int -> Int |
|||
-- fibz = fixz <| \ f n -> if n < 2 then n else f (n - 1) + f (n - 2) -- inefficient recursion |
|||
fibz = fixz (\ fn f s i -> if i < 2 then f else fn s (f + s) (i - 1)) 1 1 -- efficient tailcall |
|||
-- by injecting laziness, we can get the true Y-combinator... |
|||
-- as this includes laziness, there is no need for the type wrapper! |
|||
fixy : ((() -> a) -> a) -> a |
|||
fixy f = f <| \ () -> fixy f -- direct function recursion |
|||
-- the above is not value recursion but function recursion! |
|||
-- fixv f = let x = f x in x -- not allowed by task or by Elm! |
|||
-- we can make Elm allow it by injecting laziness... |
|||
-- fixv f = let x = f () x in x -- but now value recursion not function recursion |
|||
facy : Int -> Int |
|||
-- facy = fixy <| \ f n -> if n < 2 then 1 else n * f () (n - 1) -- inefficient recursion |
|||
facy = fixy (\ f n i -> if i < 2 then n else f () (i * n) (i - 1)) 1 -- efficient tailcall |
|||
fiby : Int -> Int |
|||
-- fiby = fixy <| \ f n -> if n < 2 then n else f () (n - 1) + f (n - 2) -- inefficient recursion |
|||
fiby = fixy (\ fn f s i -> if i < 2 then f else fn () s (f + s) (i - 1)) 1 1 -- efficient tailcall |
|||
-- something that can be done with a true Y-Combinator that |
|||
-- can't be done with the Z combinator... |
|||
-- given an infinite Co-Inductive Stream (CIS) defined as... |
|||
type CIS a = CIS a (() -> CIS a) -- infinite lazy stream! |
|||
mapCIS : (a -> b) -> CIS a -> CIS b -- uses function to map |
|||
mapCIS cf cis = |
|||
let mp (CIS head restf) = CIS (cf head) <| \ () -> mp (restf()) in mp cis |
|||
-- now we can define a Fibonacci stream as follows... |
|||
fibs : () -> CIS Int |
|||
fibs() = -- two recursive fix's, second already lazy... |
|||
let fibsgen = fixy (\ fn (CIS (f, s) restf) -> |
|||
CIS (s, f + s) (\ () -> fn () (restf()))) |
|||
in fixy (\ cisthnk -> fibsgen (CIS (0, 1) cisthnk)) |
|||
|> mapCIS (\ (v, _) -> v) |
|||
nCISs2String : Int -> CIS a -> String -- convert n CIS's to String |
|||
nCISs2String n cis = |
|||
let loop i (CIS head restf) rslt = |
|||
if i <= 0 then rslt ++ " )" else |
|||
loop (i - 1) (restf()) (rslt ++ " " ++ Debug.toString head) |
|||
in loop n cis "(" |
|||
-- unfortunately, if we need CIS memoization so as |
|||
-- to make a true lazy list, Elm doesn't support it!!! |
|||
main : Html Never |
|||
main = |
|||
String.fromInt (facz 10) ++ " " ++ String.fromInt (fibz 10) |
|||
++ " " ++ String.fromInt (facy 10) ++ " " ++ String.fromInt (fiby 10) |
|||
++ " " ++ nCISs2String 20 (fibs()) |
|||
|> text</lang> |
|||
{{out}} |
|||
<pre>3628800 55 3628800 55 ( 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765 )</pre> |
|||
=={{header|Erlang}}== |
=={{header|Erlang}}== |
||
Line 2,543: | Line 871: | ||
=={{header|F Sharp|F#}}== |
=={{header|F Sharp|F#}}== |
||
<lang fsharp>type 'a mu = Roll of ('a mu -> 'a) // |
<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) |
|||
// As with most of the strict (non-deferred or non-lazy) languages, |
|||
// this is the Z-combinator with the additional 'a' parameter... |
|||
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> |
|||
// Although true to the factorial definition, the |
|||
// recursive call is not in tail call position, so can't be optimized |
|||
// and will overflow the call stack for the recursive calls for large ranges... |
|||
//let fac = fix (fun f n -> if n < 2 then 1I else bigint n * f (n - 1)) |
|||
// val fac : (int -> BigInteger) = <fun> |
|||
// much better progressive calculation in tail call position... |
|||
let fac = fix (fun f n i -> if i < 2 then n else f (bigint i * n) (i - 1)) <| 1I |
|||
// val fac : (int -> BigInteger) = <fun> |
|||
// Although true to the definition of Fibonacci numbers, |
|||
// this can't be tail call optimized and recursively repeats calculations |
|||
// for a horrendously inefficient exponential performance fib function... |
|||
// let fib = fix (fun fnc n -> if n < 2 then n else fnc (n - 1) + fnc (n - 2)) |
|||
// val fib : (int -> BigInteger) = <fun> |
|||
// much better progressive calculation in tail call position... |
|||
let fib = fix (fun fnc f s i -> if i < 2 then f else fnc s (f + s) (i - 1)) 1I 1I |
|||
// val fib : (int -> BigInteger) = <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}} |
|||
<pre>3628800 |
|||
55</pre> |
|||
Note that the first `fac` definition isn't really very good as the recursion is not in tail call position and thus will build stack, although for these functions one will likely never use it to stack overflow as the result would be exceedingly large; it is better defined as per the second definition as a steadily increasing function controlled by an `int` indexing argument and thus be in tail call position as is done for the `fib` function. |
|||
Also note that the above isn't the true fix point Y-combinator which would race without the beta conversion to the Z-combinator with the included `a` argument; the Z-combinator can't be used in all cases that require a true Y-combinator such as in the formation of deferred execution sequences in the last example, as follows: |
|||
<lang fsharp>// same as previous... |
|||
type 'a mu = Roll of ('a mu -> 'a) // ' fixes ease syntax colouring confusion with |
|||
// same as previous... |
|||
let unroll (Roll x) = x |
let unroll (Roll x) = x |
||
// |
//val unroll : 'a mu -> 'a |
||
// break race condition with some deferred execution - laziness... |
|||
let fix f = let g = fun x -> f <| fun() -> (unroll x x) in g (Roll g) |
|||
// val fix : ((unit -> 'a) -> 'a -> 'a) = <fun> |
|||
let fix f = (fun x a -> f (unroll x x) a) (Roll (fun x a -> f (unroll x x) a)) |
|||
// same efficient version of factorial functionb with added deferred execution... |
|||
//val fix : (('a -> 'b) -> 'a -> 'b) -> 'a -> 'b = <fun> |
|||
// val fac : (int -> BigInteger) = <fun> |
|||
let fac f = function |
|||
// same efficient version of Fibonacci function with added deferred execution... |
|||
0 -> 1 |
|||
let fib = fix (fun fnc f s i -> if i < 2 then f else fnc () s (f + s) (i - 1)) 1I 1I |
|||
| n -> n * f (n-1) |
|||
//val fac : (int -> int) -> int -> int = <fun> |
|||
let fib f = function |
|||
// given the following definition for an infinite Co-Inductive Stream (CIS)... |
|||
0 -> 0 |
|||
type CIS<'a> = CIS of 'a * (unit -> CIS<'a>) // ' fix formatting |
|||
| 1 -> 1 |
|||
| n -> f (n-1) + f (n-2) |
|||
//val fib : (int -> int) -> int -> int = <fun> |
|||
fix fac 5;; |
|||
// Using a double Y-Combinator recursion... |
|||
// val it : int = 120 |
|||
// defines a continuous stream of Fibonacci numbers; there are other simpler ways, |
|||
// this way implements recursion by using the Y-combinator, although it is |
|||
// much slower than other ways due to the many additional function calls, |
|||
// it demonstrates something that can't be done with the Z-combinator... |
|||
let fibs() = |
|||
let fbsgen = fix (fun fnc (CIS((f, s), rest)) -> |
|||
CIS((s, f + s), fun() -> fnc () <| rest())) |
|||
Seq.unfold (fun (CIS((v, _), rest)) -> Some(v, rest())) |
|||
<| fix (fun cis -> fbsgen (CIS((1I, 0I), cis))) // cis is a lazy thunk! |
|||
[<EntryPoint>] |
|||
let main argv = |
|||
fac 10 |> printfn "%A" // prints 3628800 |
|||
fib 10 |> printfn "%A" // prints 55 |
|||
fibs() |> Seq.take 20 |> Seq.iter (printf "%A ") |
|||
printfn "" |
|||
0 // return an integer exit code</lang> |
|||
{{output}} |
|||
<pre>3628800 |
|||
55 |
|||
0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 </pre> |
|||
fix fib 8;; |
|||
The above would be useful if F# did not have recursive functions (functions that can call themselves in their own definition), but as for most modern languages, F# does have function recursion by the use of the `rec` keyword before the function name, thus the above `fac` and `fib` functions can be written much more simply (and to run faster using tail recursion) with a recursion definition for the `fix` Y-combinator as follows, with a simple injected deferred execution to prevent race: |
|||
// val it : int = 21</lang> |
|||
<lang fsharp>let rec fix f = f <| fun() -> fix f |
|||
// val fix : f:((unit -> 'a) -> 'a) -> 'a |
|||
// the application of this true Y-combinator is the same as for the above non function recursive version.</lang> |
|||
Using the Y-combinator (or Z-combinator) as expressed here is pointless as in unnecessary and makes the code slower due to the extra function calls through the call stack, with the first non-function recursive implementation even slower than the second function recursion one; a non Y-combinator version can use function recursion with tail call optimization to simplify looping for about 100 times the speed in the actual loop overhead; thus, this is primarily an intellectual exercise. |
|||
Also note that these Y-combinators/Z-combinator are the non sharing kind; for certain types of algorithms that require that the input and output recursive values be the same (such as the same sequence or lazy list but made reference at difference stages), these will work but may be many times slower as in over 10 times slower than using binding recursion if the language allows it; F# allows binding recursion with a warning. |
|||
=={{header|Factor}}== |
=={{header|Factor}}== |
||
Line 2,676: | Line 931: | ||
> "Factorial 10: ", YFac(10) |
> "Factorial 10: ", YFac(10) |
||
> "Fibonacci 10: ", YFib(10) |
> "Fibonacci 10: ", YFib(10) |
||
</lang> |
|||
=={{header|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> |
</lang> |
||
Line 2,843: | Line 1,074: | ||
=={{header|Haskell}}== |
=={{header|Haskell}}== |
||
The obvious definition of |
The obvious definition of Y combinator <code>(\f-> (\x -> f (x x)) (\x-> f (x x)))</code> cannot be used in Haskell because it contains an infinite recursive type (<code>a = a -> b</code>). Defining a data type (Mu) allows this recursion to be broken. |
||
<lang haskell>newtype Mu a = Roll |
<lang haskell>newtype Mu a = Roll { unroll :: Mu a -> a } |
||
{ unroll :: Mu a -> a } |
|||
fix :: (a -> a) -> a |
fix :: (a -> a) -> a |
||
fix = |
fix = \f -> (\x -> f (unroll x x)) $ Roll (\x -> f (unroll x x)) |
||
where |
|||
g = (. (>>= id) unroll) |
|||
- this version is not in tail call position... |
|||
-- fac :: Integer -> Integer |
|||
-- fac = |
|||
-- fix $ \f n -> if n <= 0 then 1 else n * f (n - 1) |
|||
-- this version builds a progression from tail call position and is more efficient... |
|||
fac :: Integer -> Integer |
fac :: Integer -> Integer |
||
fac = fix $ \f n -> if (n <= 0) then 1 else n * f (n-1) |
|||
fac = |
|||
(fix $ \f n i -> if i <= 0 then n else f (i * n) (i - 1)) 1 |
|||
-- make fibs a function, else memory leak as |
|||
-- head of the list can never be released as per: |
|||
-- https://wiki.haskell.org/Memory_leak, type 1.1 |
|||
-- overly complex version... |
|||
{-- |
|||
fibs :: () -> [Integer] |
|||
fibs() = |
|||
fix $ |
|||
(0 :) . (1 :) . |
|||
(fix |
|||
(\f (x:xs) (y:ys) -> |
|||
case x + y of n -> n `seq` n : f xs ys) <*> tail) |
|||
--} |
|||
fibs :: [Integer] |
|||
-- easier to read, simpler (faster) version... |
|||
fibs = fix $ \fbs -> 0 : 1 : fix zipP fbs (tail fbs) |
|||
fibs :: () -> [Integer] |
|||
where zipP f (x:xs) (y:ys) = x+y : f xs ys |
|||
fibs() = 0 : 1 : fix fibs_ 0 1 |
|||
where |
|||
fibs_ fnc f s = |
|||
case f + s of n -> n `seq` n : fnc s n |
|||
main :: IO () |
|||
main = |
|||
mapM_ |
|||
print |
|||
[ map fac [1 .. 20] |
|||
, take 20 $ fibs() |
|||
]</lang> |
|||
main = do |
|||
The usual version uses recursion on a binding, disallowed by the task, to define the <code>fix</code> itself; but the definitions produced by this <code>fix</code> does ''not'' use recursion on value bindings although it does use recursion when defining a function (not possible in all languages), so it can be viewed as a true Y-combinator too: |
|||
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>-- note that this version of fix uses function recursion in its own definition; |
|||
-- thus its use just means that the recursion has been "pulled" into the "fix" function, |
|||
<lang haskell>fix :: (a -> a) -> a |
|||
-- instead of the function that uses it... |
|||
fix f = f (fix f) -- _not_ the {fix f = x where x = f x} |
|||
fix :: (a -> a) -> a |
|||
fix f = f (fix f) -- _not_ the {fix f = x where x = f x} |
|||
fac :: Integer -> Integer |
fac :: Integer -> Integer |
||
fac_ f n | n <= 0 = 1 |
|||
fac = |
|||
| otherwise = n * f (n-1) |
|||
(fix $ |
|||
fac = fix fac_ -- fac_ (fac_ . fac_ . fac_ . fac_ . ...) |
|||
\f n i -> |
|||
if i <= 0 then n |
|||
-- a simple but wasteful exponential time definition: |
|||
else f (i * n) (i - 1)) 1 |
|||
fib :: Integer -> Integer |
fib :: Integer -> Integer |
||
fib_ f 0 = 0 |
|||
fib = |
|||
fib_ f 1 = 1 |
|||
(fix $ |
|||
fib_ f n = f (n-1) + f (n-2) |
|||
fib = fix fib_ |
|||
if i <= 1 then f |
|||
else case f + s of n -> n `seq` fnc s n (i - 1)) 0 1 |
|||
-- Or for far more efficiency, compute a lazy infinite list. This is |
|||
{-- |
|||
-- a Y-combinator version of: fibs = 0:1:zipWith (+) fibs (tail fibs) |
|||
-- compute a lazy infinite list. This is |
|||
fibs :: [Integer] |
|||
-- a Y-combinator version of: fibs() = 0:1:zipWith (+) fibs (tail fibs) |
|||
fibs_ a = 0:1:(fix zipP a (tail a)) |
|||
-- which is the same as the above version but easier to read... |
|||
where |
|||
fibs :: () -> [Integer] |
|||
zipP f (x:xs) (y:ys) = x+y : f xs ys |
|||
fibs() = fix fibs_ |
|||
fibs = fix fibs_ |
|||
where |
|||
zipP f (x:xs) (y:ys) = |
|||
case x + y of n -> n `seq` n : f xs ys |
|||
fibs_ a = 0 : 1 : fix zipP a (tail a) |
|||
--} |
|||
-- easier to read, simpler (faster) version... |
|||
fibs :: () -> [Integer] |
|||
fibs() = 0 : 1 : fix fibs_ 0 1 |
|||
where |
|||
fibs_ fnc f s = |
|||
case f + s of n -> n `seq` n : fnc s n |
|||
-- This code shows how the functions can be used: |
-- This code shows how the functions can be used: |
||
main |
main = do |
||
print $ map fac [1 .. 20] |
|||
main = |
|||
print $ map fib [0 .. 19] |
|||
mapM_ |
|||
print $ take 20 fibs</lang> |
|||
print |
|||
[ map fac [1 .. 20] |
|||
, map fib [1 .. 20] |
|||
, take 20 fibs() |
|||
]</lang> |
|||
Now just because something is possible using the Y-combinator doesn't mean that it is practical: the above implementations can't compute much past the 1000th number in the Fibonacci list sequence and is quite slow at doing so; using direct function recursive routines compute about 100 times faster and don't hang for large ranges, nor give problems compiling as the first version does (GHC version 8.4.3 at -O1 optimization level). |
|||
If one has recursive functions as Haskell does and as used by the second `fix`, there is no need to use `fix`/the Y-combinator at all since one may as well just write the recursion directly. The Y-combinator may be interesting mathematically, but it isn't very practical when one has any other choice. |
|||
=={{header|J}}== |
=={{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> |
|||
===Non-tacit version=== |
|||
Unfortunately, in principle, J functions cannot take functions of the same type as arguments. In other words, verbs (functions) cannot take verbs, and adverbs or conjunctions (higher-order functions) cannot take adverbs or conjunctions. This implementation uses the body, a literal (string), of an explicit adverb (a higher-order function with a left argument) as the argument for Y, to represent the adverb for which the product of Y is a fixed-point verb; Y itself is also an adverb. |
|||
<lang j>Y=. '('':''<@;(1;~":0)<@;<@((":0)&;))'(2 : 0 '') |
|||
(1 : (m,'u'))(1 : (m,'''u u`:6('',(5!:5<''u''),'')`:6 y'''))(1 :'u u`:6') |
|||
) |
|||
</lang> |
|||
This Y combinator follows the standard method: it produces a fixed-point which reproduces and transforms itself anonymously according to the adverb represented by Y's argument. All names (variables) refer to arguments of the enclosing adverbs and there are no assignments. |
|||
The factorial and Fibonacci examples follow: |
|||
<lang j> 'if. * y do. y * u <: y else. 1 end.' Y 10 NB. Factorial |
|||
3628800 |
|||
'(u@:<:@:<: + u@:<:)^:(1 < ])' Y 10 NB. Fibonacci |
|||
55</lang> |
|||
The names u, x, and y are J's standard names for arguments; the name y represents the argument of u and the name u represents the verb argument of the adverb for which Y produces a fixed-point. Any verb can also be expressed tacitly, without any reference to its argument(s), as in the Fibonacci example. |
|||
A structured derivation of a Y with states follows (the stateless version can be produced by replacing all the names by its referents): |
|||
<lang j> arb=. ':'<@;(1;~":0)<@;<@((":0)&;) NB. AR of an explicit adverb from its body |
|||
ara=. 1 :'arb u' NB. The verb arb as an adverb |
|||
srt=. 1 :'arb ''u u`:6('' , (5!:5<''u'') , '')`:6 y''' NB. AR of the self-replication and transformation adverb |
|||
gab=. 1 :'u u`:6' NB. The AR of the adverb and the adverb itself as a train |
|||
Y=. ara srt gab NB. Train of adverbs</lang> |
|||
The adverb Y, apart from using a representation as Y's argument, satisfies the task's requirements. However, it only works for monadic verbs (functions with a right argument). J's verbs can also be dyadic (functions with a left and right arguments) and ambivalent (almost all J's primitive verbs are ambivalent; for example - can be used as in - 1 and 2 - 1). The following adverb (XY) implements anonymous recursion of monadic, dyadic, and ambivalent verbs (the name x represents the left argument of u), |
|||
<lang j>XY=. (1 :'('':''<@;(1;~":0)<@;<@((":0)&;))u')(1 :'('':''<@;(1;~":0)<@;<@((":0)&;))((''u u`:6('',(5!:5<''u''),'')`:6 y''),(10{a.),'':'',(10{a.),''x(u u`:6('',(5!:5<''u''),'')`:6)y'')')(1 :'u u`:6')</lang> |
|||
The following are examples of anonymous dyadic and ambivalent recursions, |
|||
<lang j> 1 2 3 '([:`(>:@:])`(<:@:[ u 1:)`(<:@[ u [ u <:@:])@.(#.@,&*))'XY"0/ 1 2 3 4 5 NB. Ackermann function... |
|||
3 4 5 6 7 |
|||
5 7 9 11 13 |
|||
13 29 61 125 253 |
|||
'1:`(<: u <:)@.* : (+ + 2 * u@:])'XY"0/~ i.7 NB. Ambivalent recursion... |
|||
2 5 14 35 80 173 362 |
|||
3 6 15 36 81 174 363 |
|||
4 7 16 37 82 175 364 |
|||
5 8 17 38 83 176 365 |
|||
6 9 18 39 84 177 366 |
|||
7 10 19 40 85 178 367 |
|||
8 11 20 41 86 179 368 |
|||
NB. OEIS A097813 - main diagonal |
|||
NB. OEIS A050488 = A097813 - 1 - adyacent upper off-diagonal</lang> |
|||
J supports directly anonymous tacit recursion via the verb $: and for tacit recursions, XY is equivalent to the adverb, |
|||
<lang j>YX=. (1 :'('':''<@;(1;~":0)<@;<@((":0)&;))u')($:`)(`:6)</lang> |
|||
===Tacit version=== |
|||
The Y combinator can be implemented indirectly using, for example, the linear representations of verbs (Y becomes a wrapper which takes an ad hoc verb as an argument and serializes it; 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: |
The factorial and Fibonacci examples: |
||
<lang j> u=. [ NB. Function (left) |
<lang j> u=. [ NB. Function (left) |
||
n=. ] NB. Argument (right) |
n=. ] NB. Argument (right) |
||
sr=. [ |
sr=. [ 128!:2 ,&< NB. Self referring |
||
fac=. (1:`(n * u sr n - 1:)) @. (0 < n) |
fac=. (1:`(n * u sr n - 1:)) @. (0: < n) |
||
fac f. Y 10 |
fac f. Y 10 |
||
3628800 |
3628800 |
||
Fib=. ((u sr n - 2:) + u sr n - 1:) ^: (1 < n) |
Fib=. ((u sr n - 2:) + u sr n - 1:) ^: (1: < n) |
||
Fib f. Y 10 |
Fib f. Y 10 |
||
55</lang> |
55</lang> |
||
The stateless |
The functions' stateless codings are shown next: |
||
<lang j> fac f. Y NB. |
<lang j> fac f. Y NB. Showing the stateless recursive factorial function... |
||
'1:`(] * [ ([ 128!:2 ,&<) ] - 1:)@.(0 < ])&>/'&([ 128!:2 ,&<) |
'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=. [ 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 === |
|||
Fib f. Y NB. Fibonacci... |
|||
'(([ ([ 128!:2 ,&<) ] - 2:) + [ ([ 128!:2 ,&<) ] - 1:)^:(1 < ])&>/'&([ 128!:2 ,&<) |
|||
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. |
|||
Fib f. NB. 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) NB. Y with embedded states |
|||
Y=. 'Y'f. NB. Fixing it... |
|||
Y NB. ... To make it stateless (i.e., a combinator) |
|||
((((&>)/)((((^:_1)b.)(`_1))(`:6)))(&([ 128!:2 ,&<)))</lang> |
|||
(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. |
|||
===Explicit alternate implementation=== |
|||
<lang j>lambda=:3 :0 |
|||
Another approach: |
|||
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. |
|||
f=. u Defer |
|||
v |. y;_1 }. m |
|||
(5!:1<'f') f y |
|||
else. |
|||
(y;m) Defer v`'' |
|||
end. |
|||
) |
) |
||
recursivelY=: lambda 'g recur x' |
|||
Defer=: 1 :0 |
|||
(g`:6 recur`:6 recur)`:6 x |
|||
: |
|||
g=. x&(x`:6) |
|||
(5!:1<'g') u y |
|||
) |
) |
||
sivelY=: lambda 'g recur' |
|||
almost_factorial=: 4 :0 |
|||
(recursivelY`:6 g)`:6 recur |
|||
if. 0 >: y do. 1 |
|||
else. y * x`:6 y-1 end. |
|||
) |
) |
||
Y=: lambda 'g' |
|||
almost_fibonacci=: 4 :0 |
|||
recur=. sivelY`:6 g |
|||
if. 2 > y do. y |
|||
recur`:6 recur |
|||
else. (x`:6 y-1) + x`:6 y-2 end. |
|||
) |
|||
)</lang> |
|||
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: |
Example use: |
||
<lang J> |
<lang J> (Y Ev almost_factorial)Ev 9 |
||
362880 |
362880 |
||
(Y Ev almost_fibonacci)Ev 9 |
|||
almost_fibonacci Y 9 |
|||
34 |
34 |
||
(Y Ev almost_fibonacci)Ev"0 i. 10 |
|||
0 1 1 2 3 5 8 13 21 34</lang> |
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>). |
|||
Or, if you would prefer to not have a dependency on the definition of Defer, an equivalent expression would be: |
|||
<lang J>Y=:2 :0(0 :0) |
|||
NB. this block will be n in the second part |
|||
: |
|||
g=. x&(x`:6) |
|||
(5!:1<'g') u y |
|||
) |
|||
f=. u (1 :n) |
|||
(5!:1<'f') f y |
|||
)</lang> |
|||
That said, if you think of association with a name as state (because in different contexts the association may not exist, or may be different) you might also want to remove that association in the context of the Y combinator. |
|||
For example: |
|||
<lang J> almost_factorial f. Y 10 |
|||
3628800</lang> |
|||
=={{header|Java}}== |
=={{header|Java}}== |
||
Line 3,102: | Line 1,232: | ||
(n <= 1) |
(n <= 1) |
||
? 1 |
? 1 |
||
: (n * f.apply(n - 1)) |
: (n * f.apply(n - 1)); |
||
); |
); |
||
Line 3,418: | Line 1,548: | ||
fact=>(n,m=1)=>n<2?m:fact(n-1,n*m); |
fact=>(n,m=1)=>n<2?m:fact(n-1,n*m); |
||
tailfact= // Tail call version of factorial function |
tailfact= // Tail call version of factorial function |
||
Y( |
Y(parttailfact);</lang> |
||
ECMAScript 2015 (ES6) also permits a really compact polyvariadic variant for mutually recursive functions: |
ECMAScript 2015 (ES6) also permits a really compact polyvariadic variant for mutually recursive functions: |
||
<lang javascript>let |
<lang javascript>let |
||
Line 3,429: | Line 1,559: | ||
(even,odd)=>n=>(n===0)||odd(n-1), |
(even,odd)=>n=>(n===0)||odd(n-1), |
||
(even,odd)=>n=>(n!==0)&&even(n-1));</lang> |
(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> |
|||
=={{header|Joy}}== |
=={{header|Joy}}== |
||
Line 3,442: | Line 1,567: | ||
=={{header|Julia}}== |
=={{header|Julia}}== |
||
<lang julia> |
<lang julia> |
||
_ |
|||
julia> """ |
|||
_ _ _(_)_ | Documentation: https://docs.julialang.org |
|||
# Y combinator |
|||
(_) | (_) (_) | |
|||
_ _ _| |_ __ _ | 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 Combinator |
|||
$λf. (λx. f (x x)) (λx. f (x x))$ |
|||
""" -> |
|||
Y = f -> (x -> x(x))(y -> f((t...) -> y(y)(t...))) |
Y = f -> (x -> x(x))(y -> f((t...) -> y(y)(t...))) |
||
Y |
|||
</lang> |
</lang> |
||
Line 3,453: | Line 1,590: | ||
<lang julia> |
<lang julia> |
||
julia> fac = f -> (n -> n < 2 ? 1 : n * f(n - 1)) |
|||
julia> "# Factorial" |
|||
#9 (generic function with 1 method) |
|||
fac = f -> (n -> n < 2 ? 1 : n * f(n - 1)) |
|||
julia> fib = f -> (n -> n == 0 ? 0 : (n == 1 ? 1 : f(n - 1) + f(n - 2))) |
|||
julia> "# Fibonacci" |
|||
#13 (generic function with 1 method) |
|||
fib = f -> (n -> n == 0 ? 0 : (n == 1 ? 1 : f(n - 1) + f(n - 2))) |
|||
julia> |
julia> Y(fac).(1:10) |
||
10-element |
10-element Vector{Int64}: |
||
1 |
1 |
||
2 |
2 |
||
Line 3,472: | Line 1,609: | ||
3628800 |
3628800 |
||
julia> |
julia> Y(fib).(1:10) |
||
10-element |
10-element Vector{Int64}: |
||
1 |
1 |
||
1 |
1 |
||
Line 3,484: | Line 1,621: | ||
34 |
34 |
||
55 |
55 |
||
</lang> |
|||
=={{header|Kitten}}== |
|||
<lang kitten>define y<S..., T...> (S..., (S..., (S... -> T...) -> T...) -> T...): |
|||
-> f; { f y } f call |
|||
define fac (Int32, (Int32 -> Int32) -> Int32): |
|||
-> x, rec; |
|||
if (x <= 1) { 1 } else { (x - 1) rec call * x } |
|||
define fib (Int32, (Int32 -> Int32) -> Int32): |
|||
-> x, rec; |
|||
if (x <= 2): |
|||
1 |
|||
else: |
|||
(x - 1) rec call -> a; |
|||
(x - 2) rec call -> b; |
|||
a + b |
|||
5 \fac y say // 120 |
|||
10 \fib y say // 55 |
|||
</lang> |
|||
=={{header|Klingphix}}== |
|||
<lang Klingphix>:fac |
|||
dup 1 great [dup 1 sub fac mult] if |
|||
; |
|||
:fib |
|||
dup 1 great [dup 1 sub fib swap 2 sub fib add] if |
|||
; |
|||
:test |
|||
print ": " print |
|||
10 [over exec print " " print] for |
|||
nl |
|||
; |
|||
@fib "fib" test |
|||
@fac "fac" test |
|||
"End " input</lang> |
|||
{{out}} |
|||
<pre>fib: 1 1 2 3 5 8 13 21 34 55 |
|||
fac: 1 2 6 24 120 720 5040 40320 362880 3628800 |
|||
End</pre> |
|||
=={{header|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> |
|||
{{out}} |
|||
<pre> |
|||
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 |
|||
</pre> |
|||
=={{header|Lambdatalk}}== |
|||
Tested in http://lambdaway.free.fr/lambdawalks/?view=Ycombinator |
|||
<lang Scheme> |
|||
1) defining the Ycombinator |
|||
{def Y {lambda {:f} {:f :f}}} |
|||
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 |
|||
</lang> |
</lang> |
||
Line 3,609: | Line 1,637: | ||
factorial, fibs = Y(almostfactorial), Y(almostfibs) |
factorial, fibs = Y(almostfactorial), Y(almostfibs) |
||
print(factorial(7))</lang> |
print(factorial(7))</lang> |
||
=={{header|M2000 Interpreter}}== |
|||
Lambda functions in M2000 are value types. They have a list of closures, but closures are copies, except for those closures which are reference types. Lambdas can keep state in closures (they are mutable). But here we didn't do that. Y combinator is a lambda which return a lambda with a closure as f function. This function called passing as first argument itself by value. |
|||
<lang M2000 Interpreter> |
|||
Module Ycombinator { |
|||
\\ y() return value. no use of closure |
|||
y=lambda (g, x)->g(g, x) |
|||
Print y(lambda (g, n)->if(n=0->1, n*g(g, n-1)), 10) |
|||
Print y(lambda (g, n)->if(n<=1->n,g(g, n-1)+g(g, n-2)), 10) |
|||
\\ Using closure in y, y() return function |
|||
y=lambda (g)->lambda g (x) -> g(g, x) |
|||
fact=y((lambda (g, n)-> if(n=0->1, n*g(g, n-1)))) |
|||
Print fact(6), fact(24) |
|||
fib=y(lambda (g, n)->if(n<=1->n,g(g, n-1)+g(g, n-2))) |
|||
Print fib(10) |
|||
} |
|||
Ycombinator |
|||
</lang> |
|||
<lang M2000 Interpreter> |
|||
Module Checkit { |
|||
\\ all lambda arguments passed by value in this example |
|||
\\ There is no recursion in these lambdas |
|||
\\ Y combinator make argument f as closure, as a copy of f |
|||
\\ m(m, argument) pass as first argument a copy of m |
|||
\\ so never a function, here, call itself, only call a copy who get it as argument before the call. |
|||
Y=lambda (f)-> { |
|||
=lambda f (x)->f(f,x) |
|||
} |
|||
fac_step=lambda (m, n)-> { |
|||
if n<2 then { |
|||
=1 |
|||
} else { |
|||
=n*m(m, n-1) |
|||
} |
|||
} |
|||
fac=Y(fac_step) |
|||
fib_step=lambda (m, n)-> { |
|||
if n<=1 then { |
|||
=n |
|||
} else { |
|||
=m(m, n-1)+m(m, n-2) |
|||
} |
|||
} |
|||
fib=Y(fib_step) |
|||
For i=1 to 10 |
|||
Print fib(i), fac(i) |
|||
Next i |
|||
} |
|||
Checkit |
|||
Module CheckRecursion { |
|||
fac=lambda (n) -> { |
|||
if n<2 then { |
|||
=1 |
|||
} else { |
|||
=n*Lambda(n-1) |
|||
} |
|||
} |
|||
fib=lambda (n) -> { |
|||
if n<=1 then { |
|||
=n |
|||
} else { |
|||
=lambda(n-1)+lambda(n-2) |
|||
} |
|||
} |
|||
For i=1 to 10 |
|||
Print fib(i), fac(i) |
|||
Next i |
|||
} |
|||
CheckRecursion |
|||
</lang> |
|||
=={{header|MANOOL}}== |
|||
Here one additional technique is demonstrated: the Y combinator is applied to a function ''during compilation'' due to the <code>$</code> operator, which is optional: |
|||
<lang MANOOL> |
|||
{ {extern "manool.org.18/std/0.3/all"} in |
|||
: let { Y = {proc {F} as {proc {X} as X[X]}[{proc {X} with {F} as F[{proc {Y} with {X} as X[X][Y]}]}]} } in |
|||
{ for { N = Range[10] } do |
|||
: (WriteLine) Out; N "! = " |
|||
{Y: proc {Rec} as {proc {N} with {Rec} as: if N == 0 then 1 else N * Rec[N - 1]}}$[N] |
|||
} |
|||
{ for { N = Range[10] } do |
|||
: (WriteLine) Out; "Fib " N " = " |
|||
{Y: proc {Rec} as {proc {N} with {Rec} as: if N == 0 then 0 else: if N == 1 then 1 else Rec[N - 2] + Rec[N - 1]}}$[N] |
|||
} |
|||
} |
|||
</lang> |
|||
Using less syntactic sugar: |
|||
<lang MANOOL> |
|||
{ {extern "manool.org.18/std/0.3/all"} in |
|||
: let { Y = {proc {F} as {proc {X} as X[X]}[{proc {F; X} as F[{proc {X; Y} as X[X][Y]}.Bind[X]]}.Bind[F]]} } in |
|||
{ for { N = Range[10] } do |
|||
: (WriteLine) Out; N "! = " |
|||
{Y: proc {Rec} as {proc {Rec; N} as: if N == 0 then 1 else N * Rec[N - 1]}.Bind[Rec]}$[N] |
|||
} |
|||
{ for { N = Range[10] } do |
|||
: (WriteLine) Out; "Fib " N " = " |
|||
{Y: proc {Rec} as {proc {Rec; N} as: if N == 0 then 0 else: if N == 1 then 1 else Rec[N - 2] + Rec[N - 1]}.Bind[Rec]}$[N] |
|||
} |
|||
} |
|||
</lang> |
|||
{{output}} |
|||
<pre> |
|||
0! = 1 |
|||
1! = 1 |
|||
2! = 2 |
|||
3! = 6 |
|||
4! = 24 |
|||
5! = 120 |
|||
6! = 720 |
|||
7! = 5040 |
|||
8! = 40320 |
|||
9! = 362880 |
|||
Fib 0 = 0 |
|||
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 |
|||
</pre> |
|||
=={{header|Maple}}== |
=={{header|Maple}}== |
||
Line 3,749: | Line 1,652: | ||
<lang Mathematica>Y = Function[f, #[#] &[Function[g, f[g[g][##] &]]]]; |
<lang Mathematica>Y = Function[f, #[#] &[Function[g, f[g[g][##] &]]]]; |
||
factorial = Y[Function[f, If[# < 1, 1, # f[# - 1]] &]]; |
factorial = Y[Function[f, If[# < 1, 1, # f[# - 1]] &]]; |
||
fibonacci = Y[Function[f, If[# < 2, #, f[# - 1] + f[# - 2]] & |
fibonacci = Y[Function[f, If[# < 2, #, f[# - 1] + f[# - 2]] &];</lang> |
||
=={{header|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> |
|||
=={{header|Nim}}== |
|||
<lang nim># The following is implemented for a strict language as a Z-Combinator; |
|||
# Z-combinators differ from Y-combinators in lacking one Beta reduction of |
|||
# the extra `T` argument to the function to be recursed... |
|||
import sugar |
|||
proc fixz[T, TResult](f: ((T) -> TResult) -> ((T) -> TResult)): (T) -> TResult = |
|||
type RecursiveFunc = object # any entity that wraps the recursion! |
|||
recfnc: ((RecursiveFunc) -> ((T) -> TResult)) |
|||
let g = (x: RecursiveFunc) => f ((a: T) => x.recfnc(x)(a)) |
|||
g(RecursiveFunc(recfnc: g)) |
|||
let facz = fixz((f: (int) -> int) => |
|||
((n: int) => (if n <= 1: 1 else: n * f(n - 1)))) |
|||
let fibz = fixz((f: (int) -> int) => |
|||
((n: int) => (if n < 2: n else: f(n - 2) + f(n - 1)))) |
|||
echo facz(10) |
|||
echo fibz(10) |
|||
# by adding some laziness, we can get a true Y-Combinator... |
|||
# note that there is no specified parmater(s) - truly fix point!... |
|||
#[ |
|||
proc fixy[T](f: () -> T -> T): T = |
|||
type RecursiveFunc = object # any entity that wraps the recursion! |
|||
recfnc: ((RecursiveFunc) -> T) |
|||
let g = ((x: RecursiveFunc) => f(() => x.recfnc(x))) |
|||
g(RecursiveFunc(recfnc: g)) |
|||
# ]# |
|||
# same thing using direct recursion as Nim has... |
|||
# note that this version of fix uses function recursion in its own definition; |
|||
# thus its use just means that the recursion has been "pulled" into the "fix" function, |
|||
# instead of the function that uses it... |
|||
proc fixy[T](f: () -> T -> T): T = f(() => (fixy(f))) |
|||
# these are dreadfully inefficient as they becursively build stack!... |
|||
let facy = fixy((f: () -> (int -> int)) => |
|||
((n: int) => (if n <= 1: 1 else: n * f()(n - 1)))) |
|||
let fiby = fixy((f: () -> (int -> int)) => |
|||
((n: int) => (if n < 2: n else: f()(n - 2) + f()(n - 1)))) |
|||
echo facy 10 |
|||
echo fiby 10 |
|||
# something that can be done with the Y-Combinator that con't be done with the Z... |
|||
# given the following Co-Inductive Stream (CIS) definition... |
|||
type CIS[T] = object |
|||
head: T |
|||
tail: () -> CIS[T] |
|||
# Using a double Y-Combinator recursion... |
|||
# defines a continuous stream of Fibonacci numbers; there are other simpler ways, |
|||
# this way implements recursion by using the Y-combinator, although it is |
|||
# much slower than other ways due to the many additional function calls, |
|||
# it demonstrates something that can't be done with the Z-combinator... |
|||
iterator fibsy: int {.closure.} = # two recursions... |
|||
let fbsfnc: (CIS[(int, int)] -> CIS[(int, int)]) = # first one... |
|||
fixy((fnc: () -> (CIS[(int,int)] -> CIS[(int,int)])) => |
|||
((cis: CIS[(int,int)]) => ( |
|||
let (f,s) = cis.head; |
|||
CIS[(int,int)](head: (s, f + s), tail: () => fnc()(cis.tail()))))) |
|||
var fbsgen: CIS[(int, int)] = # second recursion |
|||
fixy((cis: () -> CIS[(int,int)]) => # cis is a lazy thunk used directly below! |
|||
fbsfnc(CIS[(int,int)](head: (1,0), tail: cis))) |
|||
while true: yield fbsgen.head[0]; fbsgen = fbsgen.tail() |
|||
let fibs = fibsy |
|||
for _ in 1 .. 20: stdout.write fibs(), " " |
|||
echo()</lang> |
|||
{{out}} |
|||
<pre>3628800 |
|||
55 |
|||
3628800 |
|||
55 |
|||
0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181</pre> |
|||
At least this last example version building a sequence of Fibonacci numbers doesn't build stack as it the use of CIS's means that it is a type of continuation passing/trampolining style. |
|||
Note that these would likely never be practically used in Nim as the language offers both direct variable binding recursion and recursion on proc's as well as other forms of recursion so it would never normally be necessary. Also note that these implementations not using recursive bindings on variables are "non-sharing" fix point combinators, whereas sharing is sometimes desired/required and thus recursion on variable bindings is required. |
|||
=={{header|Objective-C}}== |
=={{header|Objective-C}}== |
||
Line 3,932: | Line 1,746: | ||
With recursion into Y definition (so non stateless Y) : |
With recursion into Y definition (so non stateless Y) : |
||
<lang Oforth>: Y(f) |
<lang Oforth>: Y(f) { #[ Y(f) f perform ] }</lang> |
||
Without recursion into Y definition (stateless Y). |
Without recursion into Y definition (stateless Y). |
||
<lang Oforth>: X(me, f) |
<lang Oforth>: X(me, f) { #[ f me me perform f perform ] } |
||
: Y(f) |
: Y(f) { X(#X, f) }</lang> |
||
Usage : |
Usage : |
||
<lang Oforth>: almost-fact( |
<lang Oforth>: almost-fact(f, n) { n ifZero: [ 1 ] else: [ n n 1 - f perform * ] } |
||
#almost-fact |
: fact { Y(#almost-fact) perform } |
||
: almost-fib( |
: almost-fib(f, n) { n 1 <= ifTrue: [ n ] else: [ n 1 - f perform n 2 - f perform + ] } |
||
#almost-fib |
: fib { Y(#almost-fib) perform } |
||
: almost-Ackermann( |
: almost-Ackermann(f, m, n) |
||
{ |
|||
m 0 == ifTrue: [ n 1 + return ] |
m 0 == ifTrue: [ n 1 + return ] |
||
n 0 == ifTrue: [ 1 m 1 - f perform return ] |
n 0 == ifTrue: [ 1 m 1 - f perform return ] |
||
n 1 - m f perform m 1 - f perform |
n 1 - m f perform m 1 - f perform |
||
} |
|||
#almost-Ackermann Y => Ackermann </lang> |
|||
: Ackermann { Y(#almost-Ackermann) perform }</lang> |
|||
=={{header|Order}}== |
=={{header|Order}}== |
||
Line 4,032: | Line 1,848: | ||
}</lang> |
}</lang> |
||
=={{header| |
=={{header|Perl 6}}== |
||
<lang perl6>sub Y (&f) { { .($_) }( -> &y { f({ y(&y)(&^arg) }) } ) } |
|||
{{trans|C}} |
|||
sub fac (&f) { sub ($n) { $n < 2 ?? 1 !! $n * f($n - 1) } } |
|||
After (over) simplifying things, the Y function has become a bit of a joke, but at least the recursion has been shifted out of fib/fac |
|||
sub fib (&f) { sub ($n) { $n < 2 ?? $n !! f($n - 1) + f($n - 2) } } |
|||
say map Y($_), ^10 for &fac, &fib;</lang> |
|||
Before saying anything too derogatory about Y(f)=f, it is clearly a fixed-point combinator, and I feel compelled to quote from the Mike Vanier link above:<br> |
|||
"It doesn't matter whether you use cos or (lambda (x) (cos x)) as your cosine function; they will both do the same thing."<br> |
|||
Anyone thinking they can do better may find some inspiration at |
|||
[[Currying#Phix|Currying]], |
|||
[[Closures/Value_capture#Phix|Closures/Value_capture]], |
|||
[[Partial_function_application#Phix|Partial_function_application]], |
|||
and/or [[Function_composition#Phix|Function_composition]] |
|||
<lang Phix>function call_fn(integer f, n) |
|||
return call_func(f,{f,n}) |
|||
end function |
|||
function Y(integer f) |
|||
return f |
|||
end function |
|||
function fac(integer self, integer n) |
|||
return iff(n>1?n*call_fn(self,n-1):1) |
|||
end function |
|||
function fib(integer self, integer n) |
|||
return iff(n>1?call_fn(self,n-1)+call_fn(self,n-2):n) |
|||
end function |
|||
procedure test(string name, integer rid=routine_id(name)) |
|||
integer f = Y(rid) |
|||
printf(1,"%s: ",{name}) |
|||
for i=1 to 10 do |
|||
printf(1," %d",call_fn(f,i)) |
|||
end for |
|||
printf(1,"\n"); |
|||
end procedure |
|||
test("fac") |
|||
test("fib")</lang> |
|||
{{out}} |
{{out}} |
||
<pre>1 1 2 6 24 120 720 5040 40320 362880 |
|||
<pre> |
|||
0 1 1 2 3 5 8 13 21 34</pre> |
|||
fib: 1 1 2 3 5 8 13 21 34 55 |
|||
</pre> |
|||
Note that Perl 6 doesn't actually need a Y combinator because you can name anonymous functions from the inside: |
|||
=={{header|Phixmonti}}== |
|||
<lang Phixmonti>0 var subr |
|||
<lang perl6>say .(10) given sub (Int $x) { $x < 2 ?? 1 !! $x * &?ROUTINE($x - 1); }</lang> |
|||
def fac |
|||
dup 1 > if |
|||
dup 1 - subr exec * |
|||
endif |
|||
enddef |
|||
def fib |
|||
dup 1 > if |
|||
dup 1 - subr exec swap 2 - subr exec + |
|||
endif |
|||
enddef |
|||
def test |
|||
print ": " print |
|||
var subr |
|||
10 for |
|||
subr exec print " " print |
|||
endfor |
|||
nl |
|||
enddef |
|||
getid fac "fac" test |
|||
getid fib "fib" test</lang> |
|||
=={{header|PHP}}== |
=={{header|PHP}}== |
||
Line 4,326: | Line 2,085: | ||
$Z.InvokeReturnAsIs($fac).InvokeReturnAsIs(5) |
$Z.InvokeReturnAsIs($fac).InvokeReturnAsIs(5) |
||
$Z.InvokeReturnAsIs($fib).InvokeReturnAsIs(5)</lang> |
$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> |
|||
=={{header|Prolog}}== |
=={{header|Prolog}}== |
||
Line 4,434: | Line 2,141: | ||
The usual version using recursion, disallowed by the task: |
The usual version using recursion, disallowed by the task: |
||
<lang python>Y = lambda f: lambda *args: f(Y(f))(*args)</lang> |
<lang python>Y = lambda f: lambda *args: f(Y(f))(*args)</lang> |
||
<lang python>Y = lambda b: ((lambda f: b(lambda *x: f(f)(*x)))((lambda f: b(lambda *x: f(f)(*x)))))</lang> |
|||
=={{header|Q}}== |
|||
<lang Q>> Y: {{x x} {({y {(x x) y} x} y) x} x} |
|||
> fac: {{$[y<2; 1; y*x y-1]} x} |
|||
> (Y fac) 6 |
|||
720j |
|||
</lang> |
|||
=={{header|R}}== |
=={{header|R}}== |
||
Line 4,473: | Line 2,171: | ||
The lazy implementation |
The lazy implementation |
||
<lang racket> |
<lang racket> |
||
#lang lazy |
|||
(define Y (λ |
(define Y (λ(f)((λ(x)(f (x x)))(λ(x)(f (x x)))))) |
||
(define Fact |
(define Fact |
||
(Y (λ |
(Y (λ(fact) (λ(n) (if (zero? n) 1 (* n (fact (- n 1)))))))) |
||
(define Fib |
(define Fib |
||
(Y (λ |
(Y (λ(fib) (λ(n) (if (<= n 1) n (+ (fib (- n 1)) (fib (- n 2)))))))) |
||
</lang> |
|||
{{out}} |
{{out}} |
||
Line 4,491: | Line 2,191: | ||
Strict realization: |
Strict realization: |
||
<lang racket> |
<lang racket> |
||
#lang racket |
|||
(define Y (λ (b) ((λ (f) (b (λ (x) ((f f) x)))) |
|||
(define Y (λ(b)((λ(f)(b(λ(x)((f f) x)))) |
|||
(λ(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. |
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: |
Finally, a definition in Typed Racket is a little difficult as in other statically typed languages: |
||
<lang racket> |
<lang racket> |
||
#lang typed/racket |
|||
(: make-recursive : (All (S T) ((S -> T) -> (S -> T)) -> (S -> T))) |
(: make-recursive : (All (S T) ((S -> T) -> (S -> T)) -> (S -> T))) |
||
Line 4,514: | Line 2,217: | ||
(* n (fact (- n 1)))))))) |
(* n (fact (- n 1)))))))) |
||
(fact 5) |
(fact 5) |
||
</lang> |
|||
=={{header|Raku}}== |
|||
(formerly 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> |
|||
{{out}} |
|||
<pre>(1 1 2 6 24 120 720 5040 40320 362880) |
|||
(0 1 1 2 3 5 8 13 21 34)</pre> |
|||
Note that Raku 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|REBOL}}== |
=={{header|REBOL}}== |
||
Line 4,537: | Line 2,227: | ||
=={{header|REXX}}== |
=={{header|REXX}}== |
||
<lang rexx>/*REXX program to implement a stateless Y combinator. */ |
|||
Programming note: '''length''', '''reverse''', '''sign''', '''trunc''', '''b2x''', '''d2x''', and '''x2d''' are REXX BIFs ('''B'''uilt '''I'''n '''F'''unctions). |
|||
numeric digits 1000 /*allow big 'uns. */ |
|||
numeric digits 1000 /*allow big numbers. */ |
|||
say ' fib' |
say ' fib' Y(fib (50)) /*Fibonacci series*/ |
||
say ' fib' |
say ' fib' Y(fib (12 11 10 9 8 7 6 5 4 3 2 1 0)) /*Fibonacci series*/ |
||
say ' fact' |
say ' fact' Y(fact (60)) /*single fact. */ |
||
say ' fact' |
say ' fact' Y(fact (0 1 2 3 4 5 6 7 8 9 10 11)) /*single fact. */ |
||
say ' Dfact' |
say ' Dfact' Y(dfact (4 5 6 7 8 9 10 11 12 13)) /*double fact. */ |
||
say ' Tfact' |
say ' Tfact' Y(tfact (4 5 6 7 8 9 10 11 12 13)) /*triple fact. */ |
||
say ' Qfact' |
say ' Qfact' Y(qfact (4 5 6 7 8 40)) /*quadruple fact. */ |
||
say ' length' |
say ' length' Y(length (when for to where whenceforth)) /*lengths of words*/ |
||
say 'reverse' |
say 'reverse' Y(reverse (23 678 1007 45 MAS I MA)) /*reverses strings*/ |
||
say ' |
say ' trunc' Y(trunc (-7.0005 12 3.14159 6.4 78.999)) /*truncates numbs.*/ |
||
exit /*stick a fork in it, we're done.*/ |
|||
say ' b2x' Y(b2x (1 10 11 100 1000 10000 11111 ) ) /*converts BIN──►HEX. */ |
|||
/*──────────────────────────────────subroutines─────────────────────────*/ |
|||
say ' d2x' Y(d2x (8 9 10 11 12 88 89 90 91 6789) ) /*converts DEC──►HEX. */ |
|||
Y: lambda=; parse arg Y _; do j=1 for words(_); interpret , |
|||
'lambda=lambda' Y'('word(_,j)')'; end; return lambda |
|||
exit 0 /*stick a fork in it, we're all done. */ |
|||
fib: procedure; parse arg x; if x<2 then return x; s=0; a=0; b=1 |
|||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
|||
do j=2 to x; s=a+b; a=b; b=s; end; return s |
|||
dfact: procedure; arg x; !=1; do j=x to 2 by -2;!=!*j; end; return ! |
|||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
|||
tfact: procedure; arg x; !=1; do j=x to 2 by -3;!=!*j; end; return ! |
|||
qfact: procedure; arg x; !=1; do j=x to 2 by -4;!=!*j; end; return ! |
|||
fact: procedure; arg x; !=1; do j=2 to x ;!=!*j; end; return !</lang> |
|||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
|||
{{out}} |
|||
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> |
|||
{{out|output|text= when using the internal default input:}} |
|||
<pre> |
<pre> |
||
fib 12586269025 |
fib 12586269025 |
||
Line 4,575: | Line 2,261: | ||
Qfact 4 5 12 21 32 3805072588800 |
Qfact 4 5 12 21 32 3805072588800 |
||
length 4 3 2 5 11 |
length 4 3 2 5 11 |
||
reverse |
reverse 32 876 7001 54 SAM I AM |
||
sign -1 0 1 |
|||
trunc -7 12 3 6 78 |
trunc -7 12 3 6 78 |
||
b2x 1 2 3 4 8 10 1F |
|||
d2x 8 9 A B C 58 59 5A 5B 1A85 |
|||
x2d 8 9 16 17 18 136 137 144 145 26505 |
|||
</pre> |
</pre> |
||
Line 4,633: | Line 2,315: | ||
=={{header|Rust}}== |
=={{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; |
|||
{{works with|Rust|1.44.1 stable}} |
|||
<lang rust> |
|||
//! A simple implementation of the Y Combinator: |
|||
//! λf.(λx.xx)(λx.f(xx)) |
|||
//! <=> λf.(λx.f(xx))(λx.f(xx)) |
|||
fn fix<A, B>(f: RecFunc<A, B>) -> @fn(A) -> B { |
|||
/// A function type that takes its own type as an input is an infinite recursive type. |
|||
let g: @fn(Mu<@fn(A) -> B>) -> @fn(A) -> B = |
|||
/// We introduce the "Apply" trait, which will allow us to have an input with the same type as self, and break the recursion. |
|||
|x| |a| f(unroll(x)(x))(a); |
|||
/// The input is going to be a trait object that implements the desired function in the interface. |
|||
g(Roll(g)) |
|||
trait Apply<T, R> { |
|||
fn apply(&self, f: &dyn Apply<T, R>, t: T) -> R; |
|||
} |
} |
||
fn main() { |
|||
/// If we were to pass in self as f, we get: |
|||
let fac: RecFunc<uint, uint> = |
|||
/// λf.λt.sft |
|||
|f| |x| if (x==0) { 1 } else { f(x-1) * x }; |
|||
/// => λs.λt.sst [s/f] |
|||
let fib : RecFunc<uint, uint> = |
|||
/// => λs.ss |
|||
|f| |x| if (x<2) { 1 } else { f(x-1) + f(x-2) }; |
|||
impl<T, R, F> Apply<T, R> for F where F: Fn(&dyn Apply<T, R>, T) -> R { |
|||
fn apply(&self, f: &dyn Apply<T, R>, t: T) -> R { |
|||
self(f, t) |
|||
} |
|||
} |
|||
let ns = std::vec::from_fn(20, |i| i); |
|||
/// (λt(λx.(λy.xxy))(λx.(λy.f(λz.xxz)y)))t |
|||
println(fmt!("%?", ns.map(|&n| fix(fac)(n)))); |
|||
/// => (λx.xx)(λx.f(xx)) |
|||
println(fmt!("%?", ns.map(|&n| fix(fib)(n)))); |
|||
/// => Yf |
|||
}</lang> |
|||
fn y<T, R>(f: impl Fn(&dyn Fn(T) -> R, T) -> R) -> impl Fn(T) -> R { |
|||
move |t| (&|x: &dyn Apply<T, R>, y| x.apply(x, y)) |
|||
(&|x: &dyn Apply<T, R>, y| f(&|z| x.apply(x, z), y), t) |
|||
} |
|||
Derived from: [http://shachaf.net/curry.rs.txt] |
|||
/// Factorial of n. |
|||
fn fac(n: usize) -> usize { |
|||
let almost_fac = |f: &dyn Fn(usize) -> usize, x| if x == 0 { 1 } else { x * f(x - 1) }; |
|||
y(almost_fac)(n) |
|||
} |
|||
/// nth Fibonacci number. |
|||
fn fib(n: usize) -> usize { |
|||
let almost_fib = |f: &dyn Fn((usize, usize, usize)) -> usize, (a0, a1, x)| |
|||
match x { |
|||
0 => a0, |
|||
1 => a1, |
|||
_ => f((a1, a0 + a1, x - 1)), |
|||
}; |
|||
y(almost_fib)((1, 1, n)) |
|||
} |
|||
/// Driver function. |
|||
fn main() { |
|||
let n = 10; |
|||
println!("fac({}) = {}", n, fac(n)); |
|||
println!("fib({}) = {}", n, fib(n)); |
|||
} |
|||
</lang> |
|||
{{output}} |
|||
<pre> |
|||
fac(10) = 3628800 |
|||
fib(10) = 89 |
|||
</pre> |
|||
=={{header|Scala}}== |
=={{header|Scala}}== |
||
Credit goes to the thread in [ |
Credit goes to the thread in [http://scala-blogs.org/2008/09/y-combinator-in-scala.html scala blog] |
||
<lang scala> |
<lang scala>def Y[A,B](f: (A=>B)=>(A=>B)) = { |
||
case class W(wf: W=>A=>B) { |
|||
def apply(w: W) = wf(w) |
|||
def apply(w: W): A => B = wf(w) |
|||
} |
} |
||
val g: W |
val g: W=>A=>B = w => f(w(w))(_) |
||
g(W(g)) |
g(W(g)) |
||
}</lang> |
|||
} |
|||
</lang> |
|||
Example |
Example |
||
<lang scala>val fac = Y[Int, Int](f => i => if (i <= 0) 1 else f(i - 1) * i) |
|||
<lang scala> |
|||
val fac: Int => Int = Y[Int, Int](f => i => if (i <= 0) 1 else f(i - 1) * i) |
|||
fac(6) //> res0: Int = 720 |
fac(6) //> res0: Int = 720 |
||
val fib |
val fib = Y[Int, Int](f => i => if (i < 2) i else f(i - 1) + f(i - 2)) |
||
fib(6) //> res1: Int = 8 |
fib(6) //> res1: Int = 8</lang> |
||
</lang> |
|||
=={{header|Scheme}}== |
=={{header|Scheme}}== |
||
<lang scheme>(define Y |
<lang scheme>(define Y |
||
(lambda (h) |
|||
(lambda (f) ; (g g) = (f (lambda a (apply (g g) a))) |
|||
((lambda ( |
((lambda (x) (x x)) |
||
(lambda (g) |
(lambda (g) |
||
( |
(h (lambda args (apply (g g) args))))))) |
||
(define fac |
|||
;; head-recursive factorial |
|||
(Y |
|||
(define fac ; fac = (Y f) = (f (lambda a (apply (Y f) a))) |
|||
(lambda (f) |
|||
(Y (lambda (r) ; = (lambda (x) ... (r (- x 1)) ... ) |
|||
(lambda (x) |
|||
(if (< x 2) |
|||
1 |
|||
1 ; == (lambda (x) ... (fac (- x 1)) ... ) |
|||
(* x (f (- x 1)))))))) |
|||
;; tail-recursive factorial |
|||
(define fac2 |
|||
(lambda (x) |
|||
((Y (lambda (r) ; (Y f) == (f (lambda a (apply (Y f) a))) |
|||
(lambda (x acc) ; r == (lambda a (apply (Y f) a)) |
|||
(if (< x 2) ; (r ... ) == ((Y f) ... ) |
|||
acc |
|||
(r (- x 1) (* x acc)))))) |
|||
x 1))) |
|||
; double-recursive Fibonacci |
|||
(define fib |
(define fib |
||
(Y |
(Y |
||
(lambda (f) |
|||
(lambda (x) |
|||
(if (< x 2) |
|||
x |
|||
(+ (f (- x 1)) (f (- x 2)))))))) |
|||
; tail-recursive Fibonacci |
|||
(define fib2 |
|||
(lambda (x) |
|||
((Y (lambda (f) |
|||
(lambda (x a b) |
|||
(if (< x 1) |
|||
a |
|||
(f (- x 1) b (+ a b)))))) |
|||
x 0 1))) |
|||
(display (fac 6)) |
(display (fac 6)) |
||
(newline) |
(newline) |
||
(display ( |
(display (fib 6)) |
||
(newline)</lang> |
(newline)</lang> |
||
{{out}} |
{{out}} |
||
<pre>720 |
<pre>720 |
||
8</pre> |
|||
4517090495650391871408712937</pre> |
|||
The usual version using recursion, disallowed by the task: |
|||
If we were allowed to use recursion (with <code>Y</code> referring to itself by name in its body) we could define the equivalent to the above as |
|||
<lang scheme>(define Y |
|||
(lambda (h) |
|||
<lang scheme>(define Yr ; (Y f) == (f (lambda a (apply (Y f) a))) |
|||
(lambda ( |
(lambda args (apply (h (Y h)) args))))</lang> |
||
(f (lambda a (apply (Yr f) a)))))</lang> |
|||
And another way is: |
|||
<lang scheme>(define Y2r |
|||
(lambda (f) |
|||
(lambda a (apply (f (Y2r f)) a))))</lang> |
|||
Which, non-recursively, is |
|||
<lang scheme>(define Y2 ; (Y2 f) = (g g) where |
|||
(lambda (f) ; (g g) = (lambda a (apply (f (g g)) a)) |
|||
((lambda (g) (g g)) ; (Y2 f) == (lambda a (apply (f (Y2 f)) a)) |
|||
(lambda (g) |
|||
(lambda a (apply (f (g g)) a))))))</lang> |
|||
=={{header|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> |
|||
{{out}} |
|||
<pre>1 |
|||
120 |
|||
3628800</pre> |
|||
=={{header|Sidef}}== |
=={{header|Sidef}}== |
||
<lang ruby>var y = ->(f) {->(g) {g(g)}(->(g) { f(->(*args) {g(g)(args...)})})} |
<lang ruby>var y = ->(f) {->(g) {g(g)}(->(g) { f(->(*args) {g(g)(args...)})})}; |
||
var fac = ->(f) { ->(n) { n < 2 |
var fac = ->(f) { ->(n) { n < 2 ? 1 : (n * f(n-1)) }.copy }; |
||
say 10.of { |i| y(fac)(i) } |
say 10.of { |i| y(fac)(i) }; |
||
var fib = ->(f) { ->(n) { n < 2 |
var fib = ->(f) { ->(n) { n < 2 ? n : (f(n-2) + f(n-1)) }.copy }; |
||
say 10.of { |i| y(fib)(i) }</lang> |
say 10.of { |i| y(fib)(i) };</lang> |
||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
[ |
[1, 2, 6, 24, 120, 720, 5040, 40320, 362880, 3628800] |
||
[ |
[1, 1, 2, 3, 5, 8, 13, 21, 34, 55] |
||
</pre> |
</pre> |
||
Line 4,867: | Line 2,456: | ||
The usual version using recursion, disallowed by the task: |
The usual version using recursion, disallowed by the task: |
||
<lang sml>fun fix f x = f (fix f) x</lang> |
<lang sml>fun fix f x = f (fix f) x</lang> |
||
=={{header|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) }) |
|||
} |
|||
) |
|||
}; |
|||
) |
|||
// the same in a shorter form |
|||
( |
|||
r = { |x| x.(x) }; |
|||
z = { |f| r.({ |y| f.(r.(y).(_)) }) }; |
|||
) |
|||
// 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 ] |
|||
</lang> |
|||
=={{header|Swift}}== |
=={{header|Swift}}== |
||
Line 4,950: | Line 2,494: | ||
return { x in f(Y(f))(x) } |
return { x in f(Y(f))(x) } |
||
}</lang> |
}</lang> |
||
=={{header|Tailspin}}== |
|||
<lang tailspin> |
|||
// YCombinator is not needed since tailspin supports recursion readily, but this demonstrates passing functions as parameters |
|||
templates combinator&{stepper:} |
|||
templates makeStep&{rec:} |
|||
$ -> stepper&{next: rec&{rec: rec}} ! |
|||
end makeStep |
|||
$ -> makeStep&{rec: makeStep} ! |
|||
end combinator |
|||
templates factorial |
|||
templates seed&{next:} |
|||
<=0> 1 ! |
|||
<> |
|||
$ * ($ - 1 -> next) ! |
|||
end seed |
|||
$ -> combinator&{stepper: seed} ! |
|||
end factorial |
|||
5 -> factorial -> 'factorial 5: $; |
|||
' -> !OUT::write |
|||
templates fibonacci |
|||
templates seed&{next:} |
|||
<..1> $ ! |
|||
<> |
|||
($ - 2 -> next) + ($ - 1 -> next) ! |
|||
end seed |
|||
$ -> combinator&{stepper: seed} ! |
|||
end fibonacci |
|||
5 -> fibonacci -> 'fibonacci 5: $; |
|||
' -> !OUT::write |
|||
</lang> |
|||
{{out}} |
|||
<pre> |
|||
factorial 5: 120 |
|||
fibonacci 5: 5 |
|||
</pre> |
|||
=={{header|Tcl}}== |
=={{header|Tcl}}== |
||
Line 4,998: | Line 2,501: | ||
This prints out 24, the factorial of 4: |
This prints out 24, the factorial of 4: |
||
<lang |
<lang txr>@(do |
||
;; The Y combinator: |
|||
(defun y (f) |
|||
(defun y (f) |
|||
[(op @1 @1) |
|||
(op f (op [@@1 @@1]))]) |
|||
;; The Y-combinator-based factorial: |
;; The Y-combinator-based factorial: |
||
(defun fac (f) |
(defun fac (f) |
||
(do if (zerop @1) |
(do if (zerop @1) |
||
1 |
1 |
||
(* @1 [f (- @1 1)]))) |
(* @1 [f (- @1 1)]))) |
||
;; Test: |
;; Test: |
||
(format t "~s\n" [[y fac] 4])</lang> |
(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>. |
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>@@ |
The compounded <code>@@</code> is new in TXR 77. When the currying syntax is nested, code in an inner <code>op/do</code> can refer to numbered implicit parameters in an outer <code>op/do</code>. Each additional <code>@</code> "escapes" out one nesting level. |
||
=={{header|Ursala}}== |
=={{header|Ursala}}== |
||
Line 5,072: | Line 2,576: | ||
my_fix "h" = "h" my_fix "h"</lang> |
my_fix "h" = "h" my_fix "h"</lang> |
||
Note that this equation is solved using the next fixed point combinator in the hierarchy. |
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. |
|||
<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</lang>{{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}}== |
|||
<lang verbexx>/////// Y-combinator function (for single-argument lambdas) /////// |
|||
y @FN [f] |
|||
{ @( x -> { @f (z -> {@(@x x) z}) } ) // output of this expression is treated as a verb, due to outer @( ) |
|||
( x -> { @f (z -> {@(@x x) z}) } ) // this is the argument supplied to the above verb expression |
|||
}; |
|||
/////// Function to generate an anonymous factorial function as the return value -- (not tail-recursive) /////// |
|||
fact_gen @FN [f] |
|||
{ n -> { (n<=0) ? {1} {n * (@f n-1)} |
|||
} |
|||
}; |
|||
/////// Function to generate an anonymous fibonacci function as the return value -- (not tail-recursive) /////// |
|||
fib_gen @FN [f] |
|||
{ n -> { (n<=0) ? { 0 } |
|||
{ (n<=2) ? {1} { (@f n-1) + (@f n-2) } } |
|||
} |
|||
}; |
|||
/////// loops to test the above functions /////// |
|||
@VAR factorial = @y fact_gen; |
|||
@VAR fibonacci = @y fib_gen; |
|||
@LOOP init:{@VAR i = -1} while:(i <= 20) next:{i++} |
|||
{ @SAY i "factorial =" (@factorial i) }; |
|||
@LOOP init:{ i = -1} while:(i <= 16) next:{i++} |
|||
{ @SAY "fibonacci<" i "> =" (@fibonacci i) };</lang> |
|||
=={{header|Vim Script}}== |
=={{header|Vim Script}}== |
||
Line 5,180: | Line 2,601: | ||
echo Callx(Callx(g:Y, [g:fac]), [5]) |
echo Callx(Callx(g:Y, [g:fac]), [5]) |
||
echo map(range(10), 'Callx(Callx(Y, [fac]), [v:val])') |
echo map(range(10), 'Callx(Callx(Y, [fac]), [v:val])') |
||
</lang> |
|||
Update: since Vim 7.4.2044 (or so...), the following can be used (the feature check was added with 7.4.2121): |
|||
<lang vim> |
|||
if !has("lambda") |
|||
echoerr 'Lambda feature required' |
|||
finish |
|||
endif |
|||
let Y = {f -> {x -> x(x)}({y -> f({... -> call(y(y), a:000)})})} |
|||
let Fac = {f -> {n -> n<2 ? 1 : n * f(n-1)}} |
|||
echo Y(Fac)(5) |
|||
echo map(range(10), 'Y(Fac)(v:val)') |
|||
</lang> |
</lang> |
||
Output: |
Output: |
||
Line 5,198: | Line 2,607: | ||
=={{header|Wart}}== |
=={{header|Wart}}== |
||
<lang python>def (Y improver) |
|||
<lang python># Better names due to Jim Weirich: http://vimeo.com/45140590 |
|||
def (Y improver) |
|||
((fn(gen) gen.gen) |
((fn(gen) gen.gen) |
||
(fn(gen) |
(fn(gen) |
||
Line 5,217: | Line 2,625: | ||
{{omit from|PureBasic}} |
{{omit from|PureBasic}} |
||
{{omit from|TI-89 BASIC}} <!-- no lambdas, no first-class functions except by name string --> |
{{omit from|TI-89 BASIC}} <!-- no lambdas, no first-class functions except by name string --> |
||
=={{header|Wren}}== |
|||
{{trans|Go}} |
|||
<lang ecmascript>var y = Fn.new { |f| |
|||
var g = Fn.new { |r| f.call { |x| r.call(r).call(x) } } |
|||
return g.call(g) |
|||
} |
|||
var almostFac = Fn.new { |f| Fn.new { |x| x <= 1 ? 1 : x * f.call(x-1) } } |
|||
var almostFib = Fn.new { |f| Fn.new { |x| x <= 2 ? 1 : f.call(x-1) + f.call(x-2) } } |
|||
var fac = y.call(almostFac) |
|||
var fib = y.call(almostFib) |
|||
System.print("fac(10) = %(fac.call(10))") |
|||
System.print("fib(10) = %(fib.call(10))")</lang> |
|||
{{out}} |
|||
<pre> |
|||
fac(10) = 3628800 |
|||
fib(10) = 55 |
|||
</pre> |
|||
=={{header|XQuery}}== |
=={{header|XQuery}}== |
||
Line 5,257: | Line 2,642: | ||
{{out}} |
{{out}} |
||
<lang XQuery>720 8</lang> |
<lang XQuery>720 8</lang> |
||
=={{header|Yabasic}}== |
|||
<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")</lang> |
|||
=={{header|zkl}}== |
=={{header|zkl}}== |