aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

7
Task/Y-combinator/00-META.yaml Normal file
View file

@ -0,0 +1,7 @@
---
category:
- Recursion
from: http://rosettacode.org/wiki/Y_combinator
note: Classic CS problems and programs
requires:
- First class functions

17
Task/Y-combinator/00-TASK.txt Normal file
View file

@ -0,0 +1,17 @@
In strict [[wp:Functional programming|functional programming]] and the [[wp:lambda calculus|lambda calculus]], functions (lambda expressions) don't have state and are only allowed to refer to arguments of enclosing functions.
This rules out the usual definition of a recursive function wherein a function is associated with the state of a variable and this variable's state is used in the body of the function.
The   [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]].
;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.
;Cf:
* [http://vimeo.com/45140590 Jim Weirich: Adventures in Functional Programming]
<br><br>

264
Task/Y-combinator/AArch64-Assembly/y-combinator.aarch64 Normal file
View file

@ -0,0 +1,264 @@
/* 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"

11
Task/Y-combinator/ALGOL-68/y-combinator-1.alg Normal file
View file

@ -0,0 +1,11 @@
BEGIN
MODE F = PROC(INT)INT;
MODE Y = PROC(Y)F;
# compare python Y = lambda f: (lambda x: x(x)) (lambda y: f( lambda *args: y(y)(*args)))#
PROC y = (PROC(F)F f)F: ( (Y x)F: x(x)) ( (Y z)F: f((INT arg )INT: z(z)( arg )));
PROC fib = (F f)F: (INT n)INT: CASE n IN n,n OUT f(n-1) + f(n-2) ESAC;
FOR i TO 10 DO print(y(fib)(i)) OD
END

77
Task/Y-combinator/ALGOL-68/y-combinator-2.alg Normal file
View file

@ -0,0 +1,77 @@
BEGIN
# This version needs partial parameterisation in order to work #
# The commented code is JavaScript aka ECMAScript ES6 #
MODE F = PROC( INT ) INT ;
MODE X = PROC( X ) F ;
# Y_combinator = func_gen => ( x => x( x ) )( x => func_gen( arg => x( x )( arg ) ) ) ; #
PROC y combinator = ( PROC( F ) F func gen ) F:
( ( X x ) F: x( x ) )
(
(
( PROC( F ) F func gen , X x ) F:
func gen( ( ( X x , INT arg ) INT: x( x )( arg ) )( x , ) )
) ( func gen , )
)
;
#
factorial =
Y_combinator( fac => ( n => ( ( n === 0 ) ? 1 : n * fac( n - 1 ) ) ) )
;
#
F factorial =
y combinator(
( F fac ) F:
( ( F fac , INT n ) INT: IF n = 0 THEN 1 ELSE n * fac( n - 1 ) FI )
( fac , )
)
;
#
fibonacci =
Y_combinator(
fib => ( n => ( ( n === 0 ) ? 0 : ( n === 1 ) ? 1 : fib( n - 2 ) + fib( n - 1 ) ) )
)
;
#
F fibonacci =
y combinator(
( F fib ) F:
( ( F fib , INT n ) INT: CASE n IN 1 , 1 OUT fib( n - 2 ) + fib( n - 1 ) ESAC )
( fib , )
)
;
# for ( i = 1 ; i <= 12 ; i++) { console.log( " " + factorial( i ) ) ; } #
INT nofacs = 12 ;
print( ( "The first " , whole( nofacs , 0 ) , " factorials." , newline ) ) ;
FOR i TO nofacs
DO
print( whole( factorial( i ) , -11 ) )
OD ;
print( ( newline , newline ) ) ;
# for ( i = 1 ; i <= 12 ; i++) { console.log( " " + fibonacci( i ) ) ; } #
INT nofibs = 12 ;
print( ( "The first " , whole( nofibs , 0 ) , " fibonacci numbers." , newline ) ) ;
FOR i TO nofibs
DO
print( whole( fibonacci( i ) , -11 ) )
OD ;
print( newline )
END

250
Task/Y-combinator/ARM-Assembly/y-combinator.arm Normal file
View file

@ -0,0 +1,250 @@
/* 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"

24
Task/Y-combinator/ATS/y-combinator.ats Normal file
View file

@ -0,0 +1,24 @@
(* ****** ****** *)
//
#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))
//
(* ****** ****** *)

97
Task/Y-combinator/AppleScript/y-combinator-1.applescript Normal file
View file

@ -0,0 +1,97 @@
-- Y COMBINATOR ---------------------------------------------------------------
on |Y|(f)
script
on |λ|(y)
script
on |λ|(x)
y's |λ|(y)'s |λ|(x)
end |λ|
end script
f's |λ|(result)
end |λ|
end script
result's |λ|(result)
end |Y|
-- TEST -----------------------------------------------------------------------
on run
-- Factorial
script fact
on |λ|(f)
script
on |λ|(n)
if n = 0 then return 1
n * (f's |λ|(n - 1))
end |λ|
end script
end |λ|
end script
-- Fibonacci
script fib
on |λ|(f)
script
on |λ|(n)
if n = 0 then return 0
if n = 1 then return 1
(f's |λ|(n - 2)) + (f's |λ|(n - 1))
end |λ|
end script
end |λ|
end script
{facts:map(|Y|(fact), enumFromTo(0, 11)), fibs:map(|Y|(fib), enumFromTo(0, 20))}
--> {facts:{1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880, 3628800, 39916800},
--> fibs:{0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987,
-- 1597, 2584, 4181, 6765}}
end run
-- GENERIC FUNCTIONS FOR TEST -------------------------------------------------
-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
tell mReturn(f)
set lng to length of xs
set lst to {}
repeat with i from 1 to lng
set end of lst to |λ|(item i of xs, i, xs)
end repeat
return lst
end tell
end map
-- enumFromTo :: Int -> Int -> [Int]
on enumFromTo(m, n)
if n < m then
set d to -1
else
set d to 1
end if
set lst to {}
repeat with i from m to n by d
set end of lst to i
end repeat
return lst
end enumFromTo
-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
if class of f is script then
f
else
script
property |λ| : f
end script
end if
end mReturn

2
Task/Y-combinator/AppleScript/y-combinator-2.applescript Normal file
View file

@ -0,0 +1,2 @@
{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}}

156
Task/Y-combinator/BlitzMax/y-combinator.blitz Normal file
View file

@ -0,0 +1,156 @@
SuperStrict
'Boxed type so we can just use object arrays for argument lists
Type Integer
Field val:Int
Function Make:Integer(_val:Int)
Local i:Integer = New Integer
i.val = _val
Return i
End Function
End Type
'Higher-order function type - just a procedure attached to a scope
Type Func Abstract
Method apply:Object(args:Object[]) Abstract
End Type
'Function definitions - extend with fields as locals and implement apply as body
Type Scope Extends Func Abstract
Field env:Scope
'Constructor - bind an environment to a procedure
Function lambda:Scope(env:Scope) Abstract
Method _init:Scope(_env:Scope) 'Helper to keep constructors small
env = _env ; Return Self
End Method
End Type
'Based on the following definition:
'(define (Y f)
' (let ((_r (lambda (r) (f (lambda a (apply (r r) a))))))
' (_r _r)))
'Y (outer)
Type Y Extends Scope
Field f:Func 'Parameter - gets closed over
Function lambda:Scope(env:Scope) 'Necessary due to highly limited constructor syntax
Return (New Y)._init(env)
End Function
Method apply:Func(args:Object[])
f = Func(args[0])
Local _r:Func = YInner1.lambda(Self)
Return Func(_r.apply([_r]))
End Method
End Type
'First lambda within Y
Type YInner1 Extends Scope
Field r:Func 'Parameter - gets closed over
Function lambda:Scope(env:Scope)
Return (New YInner1)._init(env)
End Function
Method apply:Func(args:Object[])
r = Func(args[0])
Return Func(Y(env).f.apply([YInner2.lambda(Self)]))
End Method
End Type
'Second lambda within Y
Type YInner2 Extends Scope
Field a:Object[] 'Parameter - not really needed, but good for clarity
Function lambda:Scope(env:Scope)
Return (New YInner2)._init(env)
End Function
Method apply:Object(args:Object[])
a = args
Local r:Func = YInner1(env).r
Return Func(r.apply([r])).apply(a)
End Method
End Type
'Based on the following definition:
'(define fac (Y (lambda (f)
' (lambda (x)
' (if (<= x 0) 1 (* x (f (- x 1)))))))
Type FacL1 Extends Scope
Field f:Func 'Parameter - gets closed over
Function lambda:Scope(env:Scope)
Return (New FacL1)._init(env)
End Function
Method apply:Object(args:Object[])
f = Func(args[0])
Return FacL2.lambda(Self)
End Method
End Type
Type FacL2 Extends Scope
Function lambda:Scope(env:Scope)
Return (New FacL2)._init(env)
End Function
Method apply:Object(args:Object[])
Local x:Int = Integer(args[0]).val
If x <= 0 Then Return Integer.Make(1) ; Else Return Integer.Make(x * Integer(FacL1(env).f.apply([Integer.Make(x - 1)])).val)
End Method
End Type
'Based on the following definition:
'(define fib (Y (lambda (f)
' (lambda (x)
' (if (< x 2) x (+ (f (- x 1)) (f (- x 2)))))))
Type FibL1 Extends Scope
Field f:Func 'Parameter - gets closed over
Function lambda:Scope(env:Scope)
Return (New FibL1)._init(env)
End Function
Method apply:Object(args:Object[])
f = Func(args[0])
Return FibL2.lambda(Self)
End Method
End Type
Type FibL2 Extends Scope
Function lambda:Scope(env:Scope)
Return (New FibL2)._init(env)
End Function
Method apply:Object(args:Object[])
Local x:Int = Integer(args[0]).val
If x < 2
Return Integer.Make(x)
Else
Local f:Func = FibL1(env).f
Local x1:Int = Integer(f.apply([Integer.Make(x - 1)])).val
Local x2:Int = Integer(f.apply([Integer.Make(x - 2)])).val
Return Integer.Make(x1 + x2)
EndIf
End Method
End Type
'Now test
Local _Y:Func = Y.lambda(Null)
Local fac:Func = Func(_Y.apply([FacL1.lambda(Null)]))
Print Integer(fac.apply([Integer.Make(10)])).val
Local fib:Func = Func(_Y.apply([FibL1.lambda(Null)]))
Print Integer(fib.apply([Integer.Make(10)])).val

44
Task/Y-combinator/Bracmat/y-combinator.bracmat Normal file
View file

@ -0,0 +1,44 @@
( ( Y
= /(
' ( g
. /('(x.$g'($x'$x)))
$ /('(x.$g'($x'$x)))
)
)
)
& ( G
= /(
' ( r
. /(
' ( n
. $n:~>0&1
| $n*($r)$($n+-1)
)
)
)
)
)
& ( H
= /(
' ( r
. /(
' ( n
. $n:(1|2)&1
| ($r)$($n+-1)+($r)$($n+-2)
)
)
)
)
)
& 0:?i
& whl
' ( 1+!i:~>10:?i
& out$(str$(!i "!=" (!Y$!G)$!i))
)
& 0:?i
& whl
' ( 1+!i:~>10:?i
& out$(str$("fib(" !i ")=" (!Y$!H)$!i))
)
&
)

43
Task/Y-combinator/C++/y-combinator-1.cpp Normal file
View file

@ -0,0 +1,43 @@
#include <iostream>
#include <functional>
template <typename F>
struct RecursiveFunc {
std::function<F(RecursiveFunc)> o;
};
template <typename A, typename B>
std::function<B(A)> Y (std::function<std::function<B(A)>(std::function<B(A)>)> f) {
RecursiveFunc<std::function<B(A)>> r = {
std::function<std::function<B(A)>(RecursiveFunc<std::function<B(A)>>)>([f](RecursiveFunc<std::function<B(A)>> w) {
return f(std::function<B(A)>([w](A x) {
return w.o(w)(x);
}));
})
};
return r.o(r);
}
typedef std::function<int(int)> Func;
typedef std::function<Func(Func)> FuncFunc;
FuncFunc almost_fac = [](Func f) {
return Func([f](int n) {
if (n <= 1) return 1;
return n * f(n - 1);
});
};
FuncFunc almost_fib = [](Func f) {
return Func([f](int n) {
if (n <= 2) return 1;
return f(n - 1) + f(n - 2);
});
};
int main() {
auto fib = Y(almost_fib);
auto fac = Y(almost_fac);
std::cout << "fib(10) = " << fib(10) << std::endl;
std::cout << "fac(10) = " << fac(10) << std::endl;
return 0;
}

21
Task/Y-combinator/C++/y-combinator-2.cpp Normal file
View file

@ -0,0 +1,21 @@
#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? 1: 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';
}

6
Task/Y-combinator/C++/y-combinator-3.cpp Normal file
View file

@ -0,0 +1,6 @@
template <typename A, typename B>
std::function<B(A)> Y (std::function<std::function<B(A)>(std::function<B(A)>)> f) {
return [f](A x) {
return f(Y(f))(x);
};
}

13
Task/Y-combinator/C++/y-combinator-4.cpp Normal file
View file

@ -0,0 +1,13 @@
template <typename A, typename B>
struct YFunctor {
const std::function<std::function<B(A)>(std::function<B(A)>)> f;
YFunctor(std::function<std::function<B(A)>(std::function<B(A)>)> _f) : f(_f) {}
B operator()(A x) const {
return f(*this)(x);
}
};
template <typename A, typename B>
std::function<B(A)> Y (std::function<std::function<B(A)>(std::function<B(A)>)> f) {
return YFunctor<A,B>(f);
}

22
Task/Y-combinator/C-sharp/y-combinator-1.cs Normal file
View file

@ -0,0 +1,22 @@
using System;
static class YCombinator<T, TResult>
{
// 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()
{
var fac = YCombinator<int, int>.Fix(f => x => x < 2 ? 1 : x * f(x - 1));
var fib = YCombinator<int, int>.Fix(f => x => x < 2 ? x : f(x - 1) + f(x - 2));
Console.WriteLine(fac(10));
Console.WriteLine(fib(10));
}
}

5
Task/Y-combinator/C-sharp/y-combinator-10.cs Normal file
View file

@ -0,0 +1,5 @@
static Func Y(FuncFunc f) {
return delegate (int x) {
return f(Y(f))(x);
};
}

23
Task/Y-combinator/C-sharp/y-combinator-11.cs Normal file
View file

@ -0,0 +1,23 @@
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);
}

1
Task/Y-combinator/C-sharp/y-combinator-12.cs Normal file
View file

@ -0,0 +1 @@
static Func Y(FuncFunc f) => x => f(Y(f))(x);

49
Task/Y-combinator/C-sharp/y-combinator-13.cs Normal file
View file

@ -0,0 +1,49 @@
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));
}
}

91
Task/Y-combinator/C-sharp/y-combinator-14.cs Normal file
View file

@ -0,0 +1,91 @@
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));
}
}

97
Task/Y-combinator/C-sharp/y-combinator-15.cs Normal file
View file

@ -0,0 +1,97 @@
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));
}
}

129
Task/Y-combinator/C-sharp/y-combinator-16.cs Normal file
View file

@ -0,0 +1,129 @@
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);
}
}

21
Task/Y-combinator/C-sharp/y-combinator-17.cs Normal file
View file

@ -0,0 +1,21 @@
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)}");
}
}

4
Task/Y-combinator/C-sharp/y-combinator-18.cs Normal file
View file

@ -0,0 +1,4 @@
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);
}

3
Task/Y-combinator/C-sharp/y-combinator-19.cs Normal file
View file

@ -0,0 +1,3 @@
public static Func<In, Out> Y<In, Out>(Func<Func<In, Out>, Func<In, Out>> f) {
return x => f(Y(f))(x);
}

7
Task/Y-combinator/C-sharp/y-combinator-2.cs Normal file
View file

@ -0,0 +1,7 @@
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)));
}

5
Task/Y-combinator/C-sharp/y-combinator-3.cs Normal file
View file

@ -0,0 +1,5 @@
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))));
}

4
Task/Y-combinator/C-sharp/y-combinator-4.cs Normal file
View file

@ -0,0 +1,4 @@
static class YCombinator
{
static Func<T, TResult> Fix<T, TResult>(Func<Func<T, TResult>, Func<T, TResult>> f) => x => f(Fix(f))(x);
}

41
Task/Y-combinator/C-sharp/y-combinator-5.cs Normal file
View file

@ -0,0 +1,41 @@
using Func = System.Func<int, int>;
using FuncFunc = System.Func<System.Func<int, int>, System.Func<int, int>>;
static class Program {
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;
}
}

27
Task/Y-combinator/C-sharp/y-combinator-6.cs Normal file
View file

@ -0,0 +1,27 @@
using System;
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));
}
}

48
Task/Y-combinator/C-sharp/y-combinator-7.cs Normal file
View file

@ -0,0 +1,48 @@
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
}
}

44
Task/Y-combinator/C-sharp/y-combinator-8.cs Normal file
View file

@ -0,0 +1,44 @@
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));
}
}

43
Task/Y-combinator/C-sharp/y-combinator-9.cs Normal file
View file

@ -0,0 +1,43 @@
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);
};
}
}

70
Task/Y-combinator/C/y-combinator.c Normal file
View file

@ -0,0 +1,70 @@
#include <stdio.h>
#include <stdlib.h>
/* func: our one and only data type; it holds either a pointer to
a function call, or an integer. Also carry a func pointer to
a potential parameter, to simulate closure */
typedef struct func_t *func;
typedef struct func_t {
func (*fn) (func, func);
func _;
int num;
} func_t;
func new(func(*f)(func, func), func _) {
func x = malloc(sizeof(func_t));
x->fn = f;
x->_ = _; /* closure, sort of */
x->num = 0;
return x;
}
func call(func f, func n) {
return f->fn(f, n);
}
func Y(func(*f)(func, func)) {
func g = new(f, 0);
g->_ = g;
return g;
}
func num(int n) {
func x = new(0, 0);
x->num = n;
return x;
}
func fac(func self, func n) {
int nn = n->num;
return nn > 1 ? num(nn * call(self->_, num(nn - 1))->num)
: num(1);
}
func fib(func self, func n) {
int nn = n->num;
return nn > 1
? num( call(self->_, num(nn - 1))->num +
call(self->_, num(nn - 2))->num )
: num(1);
}
void show(func n) { printf(" %d", n->num); }
int main() {
int i;
func f = Y(fac);
printf("fac: ");
for (i = 1; i < 10; i++)
show( call(f, num(i)) );
printf("\n");
f = Y(fib);
printf("fib: ");
for (i = 1; i < 10; i++)
show( call(f, num(i)) );
printf("\n");
return 0;
}

22
Task/Y-combinator/Ceylon/y-combinator-1.ceylon Normal file
View file

@ -0,0 +1,22 @@
Result(*Args) y1<Result,Args>(
Result(*Args)(Result(*Args)) f)
given Args satisfies Anything[] {
class RecursiveFunction(o) {
shared Result(*Args)(RecursiveFunction) o;
}
value r = RecursiveFunction((RecursiveFunction w)
=> f(flatten((Args args) => w.o(w)(*args))));
return r.o(r);
}
value factorialY1 = y1((Integer(Integer) fact)(Integer x)
=> if (x > 1) then x * fact(x - 1) else 1);
value fibY1 = y1((Integer(Integer) fib)(Integer x)
=> if (x > 2) then fib(x - 1) + fib(x - 2) else 2);
print(factorialY1(10)); // 3628800
print(fibY1(10)); // 110

11
Task/Y-combinator/Ceylon/y-combinator-2.ceylon Normal file
View file

@ -0,0 +1,11 @@
Result(*Args) y2<Result,Args>(
Result(*Args)(Result(*Args)) f)
given Args satisfies Anything[] {
function r(Anything w) {
assert (is Result(*Args)(Anything) w);
return f(flatten((Args args) => w(w)(*args)));
}
return r(r);
}

4
Task/Y-combinator/Ceylon/y-combinator-3.ceylon Normal file
View file

@ -0,0 +1,4 @@
Result(*Args) y3<Result, Args>(
Result(*Args)(Result(*Args)) f)
given Args satisfies Anything[]
=> flatten((Args args) => f(y3(f))(*args));

36
Task/Y-combinator/Chapel/y-combinator-1.chapel Normal file
View file

@ -0,0 +1,36 @@
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));

48
Task/Y-combinator/Chapel/y-combinator-2.chapel Normal file
View file

@ -0,0 +1,48 @@
// 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));

19
Task/Y-combinator/Clojure/y-combinator-1.clj Normal file
View file

@ -0,0 +1,19 @@
(defn Y [f]
((fn [x] (x x))
(fn [x]
(f (fn [& args]
(apply (x x) args))))))
(def fac
(fn [f]
(fn [n]
(if (zero? n) 1 (* n (f (dec n)))))))
(def fib
(fn [f]
(fn [n]
(condp = n
0 0
1 1
(+ (f (dec n))
(f (dec (dec n))))))))

2
Task/Y-combinator/Clojure/y-combinator-2.clj Normal file
View file

@ -0,0 +1,2 @@
(defn Y [f]
(#(% %) #(f (fn [& args] (apply (% %) args)))))

1
Task/Y-combinator/CoffeeScript/y-combinator-1.coffee Normal file
View file

@ -0,0 +1 @@
Y = (f) -> g = f( (t...) -> g(t...) )

1
Task/Y-combinator/CoffeeScript/y-combinator-2.coffee Normal file
View file

@ -0,0 +1 @@
Y = (f) -> ((h)->h(h))((h)->f((t...)->h(h)(t...)))

2
Task/Y-combinator/CoffeeScript/y-combinator-3.coffee Normal file
View file

@ -0,0 +1,2 @@
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 )

29
Task/Y-combinator/Common-Lisp/y-combinator.lisp Normal file
View file

@ -0,0 +1,29 @@
(defun Y (f)
((lambda (g) (funcall g g))
(lambda (g)
(funcall f (lambda (&rest a)
(apply (funcall g g) a))))))
(defun fac (n)
(funcall
(Y (lambda (f)
(lambda (n)
(if (zerop n)
1
(* n (funcall f (1- n)))))))
n))
(defun fib (n)
(funcall
(Y (lambda (f)
(lambda (n a b)
(if (< n 1)
a
(funcall f (1- n) b (+ a b))))))
n 0 1))
? (mapcar #'fac '(1 2 3 4 5 6 7 8 9 10))
(1 2 6 24 120 720 5040 40320 362880 3628800))
? (mapcar #'fib '(1 2 3 4 5 6 7 8 9 10))
(1 1 2 3 5 8 13 21 34 55)

31
Task/Y-combinator/Crystal/y-combinator-1.crystal Normal file
View file

@ -0,0 +1,31 @@
require "big"
struct RecursiveFunc(T) # a generic recursive function wrapper...
getter recfnc : RecursiveFunc(T) -> T
def initialize(@recfnc) end
end
struct YCombo(T) # a struct or class needs to be used so as to be generic...
def initialize (@fnc : Proc(T) -> T) end
def fixy
g = -> (x : RecursiveFunc(T)) {
@fnc.call(-> { x.recfnc.call(x) }) }
g.call(RecursiveFunc(T).new(g))
end
end
def fac(x) # horrendouly inefficient not using tail calls...
facp = -> (fn : Proc(BigInt -> BigInt)) {
-> (n : BigInt) { n < 2 ? n : n * fn.call.call(n - 1) } }
YCombo.new(facp).fixy.call(BigInt.new(x))
end
def fib(x) # horrendouly inefficient not using tail calls...
facp = -> (fn : Proc(BigInt -> BigInt)) {
-> (n : BigInt) {
n < 3 ? n - 1 : fn.call.call(n - 2) + fn.call.call(n - 1) } }
YCombo.new(facp).fixy.call(BigInt.new(x))
end
puts fac(10)
puts fib(11) # starts from 0 not 1!

13
Task/Y-combinator/Crystal/y-combinator-2.crystal Normal file
View file

@ -0,0 +1,13 @@
def fac(x) # the more efficient tail recursive version...
facp = -> (fn : Proc(BigInt -> (Int32 -> BigInt))) {
-> (n : BigInt) { -> (i : Int32) {
i < 2 ? n : fn.call.call(i * n).call(i - 1) } } }
YCombo.new(facp).fixy.call(BigInt.new(1)).call(x)
end
def fib(x) # the more efficient tail recursive version...
fibp = -> (fn : Proc(BigInt -> (BigInt -> (Int32 -> BigInt)))) {
-> (f : BigInt) { -> (s : BigInt) { -> (i : Int32) {
i < 2 ? f : fn.call.call(s).call(f + s).call(i - 1) } } } }
YCombo.new(fibp).fixy.call(BigInt.new).call(BigInt.new(1)).call(x)
end

17
Task/Y-combinator/Crystal/y-combinator-3.crystal Normal file
View file

@ -0,0 +1,17 @@
def ycombo(f)
f.call(-> { ycombo(f) })
end
def fac(x) # the more efficient tail recursive version...
facp = -> (fn : Proc(BigInt -> (Int32 -> BigInt))) {
-> (n : BigInt) { -> (i : Int32) {
i < 2 ? n : fn.call.call(i * n).call(i - 1) } } }
ycombo(facp).call(BigInt.new(1)).call(x)
end
def fib(x) # the more efficient tail recursive version...
fibp = -> (fn : Proc(BigInt -> (BigInt -> (Int32 -> BigInt)))) {
-> (f : BigInt) { -> (s : BigInt) { -> (i : Int32) {
i < 2 ? f : fn.call.call(s).call(f + s).call(i - 1) } } } }
ycombo(fibp).call(BigInt.new).call(BigInt.new(1)).call(x)
end

25
Task/Y-combinator/D/y-combinator.d Normal file
View file

@ -0,0 +1,25 @@
import std.stdio, std.traits, std.algorithm, std.range;
auto Y(S, T...)(S delegate(T) delegate(S delegate(T)) f) {
static struct F {
S delegate(T) delegate(F) f;
alias f this;
}
return (x => x(x))(F(x => f((T v) => x(x)(v))));
}
void main() { // Demo code:
auto factorial = Y((int delegate(int) self) =>
(int n) => 0 == n ? 1 : n * self(n - 1)
);
auto ackermann = Y((ulong delegate(ulong, ulong) self) =>
(ulong m, ulong n) {
if (m == 0) return n + 1;
if (n == 0) return self(m - 1, 1);
return self(m - 1, self(m, n - 1));
});
writeln("factorial: ", 10.iota.map!factorial);
writeln("ackermann(3, 5): ", ackermann(3, 5));
}

67
Task/Y-combinator/Delphi/y-combinator.delphi Normal file
View file

@ -0,0 +1,67 @@
program Y;
{$APPTYPE CONSOLE}
uses
SysUtils;
type
YCombinator = class sealed
class function Fix<T> (F: TFunc<TFunc<T, T>, TFunc<T, T>>): TFunc<T, T>; static;
end;
TRecursiveFuncWrapper<T> = record // workaround required because of QC #101272 (http://qc.embarcadero.com/wc/qcmain.aspx?d=101272)
type
TRecursiveFunc = reference to function (R: TRecursiveFuncWrapper<T>): TFunc<T, T>;
var
O: TRecursiveFunc;
end;
class function YCombinator.Fix<T> (F: TFunc<TFunc<T, T>, TFunc<T, T>>): TFunc<T, T>;
var
R: TRecursiveFuncWrapper<T>;
begin
R.O := function (W: TRecursiveFuncWrapper<T>): TFunc<T, T>
begin
Result := F (function (I: T): T
begin
Result := W.O (W) (I);
end);
end;
Result := R.O (R);
end;
type
IntFunc = TFunc<Integer, Integer>;
function AlmostFac (F: IntFunc): IntFunc;
begin
Result := function (N: Integer): Integer
begin
if N <= 1 then
Result := 1
else
Result := N * F (N - 1);
end;
end;
function AlmostFib (F: TFunc<Integer, Integer>): TFunc<Integer, Integer>;
begin
Result := function (N: Integer): Integer
begin
if N <= 2 then
Result := 1
else
Result := F (N - 1) + F (N - 2);
end;
end;
var
Fib, Fac: IntFunc;
begin
Fib := YCombinator.Fix<Integer> (AlmostFib);
Fac := YCombinator.Fix<Integer> (AlmostFac);
Writeln ('Fib(10) = ', Fib (10));
Writeln ('Fac(10) = ', Fac (10));
end.

3
Task/Y-combinator/E/y-combinator-1.e Normal file
View file

@ -0,0 +1,3 @@
def y := fn f { fn x { x(x) }(fn y { f(fn a { y(y)(a) }) }) }
def fac := fn f { fn n { if (n<2) {1} else { n*f(n-1) } }}
def fib := fn f { fn n { if (n == 0) {0} else if (n == 1) {1} else { f(n-1) + f(n-2) } }}

6
Task/Y-combinator/E/y-combinator-2.e Normal file
View file

@ -0,0 +1,6 @@
? pragma.enable("accumulator")
? accum [] for i in 0..!10 { _.with(y(fac)(i)) }
[1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880]
? accum [] for i in 0..!10 { _.with(y(fib)(i)) }
[0, 1, 1, 2, 3, 5, 8, 13, 21, 34]

23
Task/Y-combinator/EchoLisp/y-combinator.l Normal file
View file

@ -0,0 +1,23 @@
;; 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

29
Task/Y-combinator/Eero/y-combinator.eero Normal file
View file

@ -0,0 +1,29 @@
#import <Foundation/Foundation.h>
typedef int (^Func)(int)
typedef Func (^FuncFunc)(Func)
typedef Func (^RecursiveFunc)(id) // hide recursive typing behind dynamic typing
Func fix(FuncFunc f)
Func r(RecursiveFunc g)
int s(int x)
return g(g)(x)
return f(s)
return r(r)
int main(int argc, const char *argv[])
autoreleasepool
Func almost_fac(Func f)
return (int n | return n <= 1 ? 1 : n * f(n - 1))
Func almost_fib(Func f)
return (int n | return n <= 2 ? 1 : f(n - 1) + f(n - 2))
fib := fix(almost_fib)
fac := fix(almost_fac)
Log('fib(10) = %d', fib(10))
Log('fac(10) = %d', fac(10))
return 0

10
Task/Y-combinator/Ela/y-combinator.ela Normal file
View file

@ -0,0 +1,10 @@
fix = \f -> (\x -> & f (x x)) (\x -> & f (x x))
fac _ 0 = 1
fac f n = n * f (n - 1)
fib _ 0 = 0
fib _ 1 = 1
fib f n = f (n - 1) + f (n - 2)
(fix fac 12, fix fib 12)

16
Task/Y-combinator/Elena/y-combinator.elena Normal file
View file

@ -0,0 +1,16 @@
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));
}

10
Task/Y-combinator/Elixir/y-combinator.elixir Normal file
View file

@ -0,0 +1,10 @@
iex(1)> yc = fn f -> (fn x -> x.(x) end).(fn y -> f.(fn arg -> y.(y).(arg) end) end) end
#Function<6.90072148/1 in :erl_eval.expr/5>
iex(2)> fac = fn f -> fn n -> if n < 2 do 1 else n * f.(n-1) end end end
#Function<6.90072148/1 in :erl_eval.expr/5>
iex(3)> for i <- 0..9, do: yc.(fac).(i)
[1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880]
iex(4)> fib = fn f -> fn n -> if n == 0 do 0 else (if n == 1 do 1 else f.(n-1) + f.(n-2) end) end end end
#Function<6.90072148/1 in :erl_eval.expr/5>
iex(5)> for i <- 0..9, do: yc.(fib).(i)
[0, 1, 1, 2, 3, 5, 8, 13, 21, 34]

75
Task/Y-combinator/Elm/y-combinator.elm Normal file
View file

@ -0,0 +1,75 @@
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

15
Task/Y-combinator/Erlang/y-combinator.erl Normal file
View file

@ -0,0 +1,15 @@
Y = fun(M) -> (fun(X) -> X(X) end)(fun (F) -> M(fun(A) -> (F(F))(A) end) end) end.
Fac = fun (F) ->
fun (0) -> 1;
(N) -> N * F(N-1)
end
end.
Fib = fun(F) ->
fun(0) -> 0;
(1) -> 1;
(N) -> F(N-1) + F(N-2)
end
end.
(Y(Fac))(5). %% 120
(Y(Fib))(8). %% 21

35
Task/Y-combinator/F-Sharp/y-combinator-1.fs Normal file
View file

@ -0,0 +1,35 @@
type 'a mu = Roll of ('a mu -> 'a) // ' fixes 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

40
Task/Y-combinator/F-Sharp/y-combinator-2.fs Normal file
View file

@ -0,0 +1,40 @@
// 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
// val unroll : 'a mu -> ('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>
// same efficient version of factorial functionb with added deferred execution...
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>
// same efficient version of Fibonacci function with added deferred execution...
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>
// given the following definition for an infinite Co-Inductive Stream (CIS)...
type CIS<'a> = CIS of 'a * (unit -> CIS<'a>) // ' fix formatting
// 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...
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

4
Task/Y-combinator/F-Sharp/y-combinator-3.fs Normal file
View file

@ -0,0 +1,4 @@
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.

10
Task/Y-combinator/Factor/y-combinator-1.factor Normal file
View file

@ -0,0 +1,10 @@
USING: fry kernel math ;
IN: rosettacode.Y
: Y ( quot -- quot )
'[ [ dup call call ] curry @ ] dup call ; inline
: almost-fac ( quot -- quot )
'[ dup zero? [ drop 1 ] [ dup 1 - @ * ] if ] ;
: almost-fib ( quot -- quot )
'[ dup 2 >= [ 1 2 [ - @ ] bi-curry@ bi + ] when ] ;

5
Task/Y-combinator/Factor/y-combinator-2.factor Normal file
View file

@ -0,0 +1,5 @@
USING: kernel tools.test rosettacode.Y ;
IN: rosettacode.Y.tests
[ 120 ] [ 5 [ almost-fac ] Y call ] unit-test
[ 8 ] [ 6 [ almost-fib ] Y call ] unit-test

9
Task/Y-combinator/Falcon/y-combinator.falcon Normal file
View file

@ -0,0 +1,9 @@
Y = { f => {x=> {n => f(x(x))(n)}} ({x=> {n => f(x(x))(n)}}) }
facStep = { f => {x => x < 1 ? 1 : x*f(x-1) }}
fibStep = { f => {x => x == 0 ? 0 : (x == 1 ? 1 : f(x-1) + f(x-2))}}
YFac = Y(facStep)
YFib = Y(fibStep)
> "Factorial 10: ", YFac(10)
> "Fibonacci 10: ", YFib(10)

12
Task/Y-combinator/Forth/y-combinator-1.fth Normal file
View file

@ -0,0 +1,12 @@
\ 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 ;

7
Task/Y-combinator/Forth/y-combinator-2.fth Normal file
View file

@ -0,0 +1,7 @@
\ 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

37
Task/Y-combinator/FreeBASIC/y-combinator.basic Normal file
View file

@ -0,0 +1,37 @@
Function Y(f As String) As String
Y = f
End Function
Function fib(n As Long) As Long
Dim As Long n1 = 0, n2 = 1, k, sum
For k = 1 To Abs(n)
sum = n1 + n2
n1 = n2
n2 = sum
Next k
Return Iif(n < 0, (n1 * ((-1) ^ ((-n)+1))), n1)
End Function
Function fac(n As Long) As Long
Dim As Long r = 1, i
For i = 2 To n
r *= i
Next i
Return r
End Function
Function execute(s As String, n As Integer) As Long
Return Iif (s = "fac", fac(n), fib(n))
End Function
Sub test(nombre As String)
Dim f As String: f = Y(nombre)
Print !"\n"; f; ":";
For i As Integer = 1 To 10
Print execute(f, i);
Next i
End Sub
test("fac")
test("fib")
Sleep

35
Task/Y-combinator/GAP/y-combinator.gap Normal file
View file

@ -0,0 +1,35 @@
Y := function(f)
local u;
u := x -> x(x);
return u(y -> f(a -> y(y)(a)));
end;
fib := function(f)
local u;
u := function(n)
if n < 2 then
return n;
else
return f(n-1) + f(n-2);
fi;
end;
return u;
end;
Y(fib)(10);
# 55
fac := function(f)
local u;
u := function(n)
if n < 2 then
return 1;
else
return n*f(n-1);
fi;
end;
return u;
end;
Y(fac)(8);
# 40320

19
Task/Y-combinator/Genyris/y-combinator.genyris Normal file
View file

@ -0,0 +1,19 @@
def fac (f)
function (n)
if (equal? n 0) 1
* n (f (- n 1))
def fib (f)
function (n)
cond
(equal? n 0) 0
(equal? n 1) 1
else (+ (f (- n 1)) (f (- n 2)))
def Y (f)
(function (x) (x x))
function (y)
f
function (&rest args) (apply (y y) args)
assertEqual ((Y fac) 5) 120
assertEqual ((Y fib) 8) 21

41
Task/Y-combinator/Go/y-combinator-1.go Normal file
View file

@ -0,0 +1,41 @@
package main
import "fmt"
type Func func(int) int
type FuncFunc func(Func) Func
type RecursiveFunc func (RecursiveFunc) Func
func main() {
fac := Y(almost_fac)
fib := Y(almost_fib)
fmt.Println("fac(10) = ", fac(10))
fmt.Println("fib(10) = ", fib(10))
}
func Y(f FuncFunc) Func {
g := func(r RecursiveFunc) Func {
return f(func(x int) int {
return r(r)(x)
})
}
return g(g)
}
func almost_fac(f Func) Func {
return func(x int) int {
if x <= 1 {
return 1
}
return x * f(x-1)
}
}
func almost_fib(f Func) Func {
return func(x int) int {
if x <= 2 {
return 1
}
return f(x-1)+f(x-2)
}
}

5
Task/Y-combinator/Go/y-combinator-2.go Normal file
View file

@ -0,0 +1,5 @@
func Y(f FuncFunc) Func {
return func(x int) int {
return f(Y(f))(x)
}
}

13
Task/Y-combinator/Groovy/y-combinator-1.groovy Normal file
View file

@ -0,0 +1,13 @@
def Y = { le -> ({ f -> f(f) })({ f -> le { x -> f(f)(x) } }) }
def factorial = Y { fac ->
{ n -> n <= 2 ? n : n * fac(n - 1) }
}
assert 2432902008176640000 == factorial(20G)
def fib = Y { fibStar ->
{ n -> n <= 1 ? n : fibStar(n - 1) + fibStar(n - 2) }
}
assert fib(10) == 55

7
Task/Y-combinator/Groovy/y-combinator-2.groovy Normal file
View file

@ -0,0 +1,7 @@
def Y = { le -> ({ f -> f(f) })({ f -> le { Object[] args -> f(f)(*args) } }) }
def mul = Y { mulStar -> { a, b -> a ? b + mulStar(a - 1, b) : 0 } }
1.upto(10) {
assert mul(it, 10) == it * 10
}

46
Task/Y-combinator/Haskell/y-combinator-1.hs Normal file
View file

@ -0,0 +1,46 @@
newtype Mu a = Roll
{ unroll :: Mu a -> a }
fix :: (a -> a) -> a
fix = g <*> (Roll . g)
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 =
(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)
--}
-- 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
main :: IO ()
main =
mapM_
print
[ map fac [1 .. 20]
, take 20 $ fibs()
]

48
Task/Y-combinator/Haskell/y-combinator-2.hs Normal file
View file

@ -0,0 +1,48 @@
-- 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...
fix :: (a -> a) -> a
fix f = f (fix f) -- _not_ the {fix f = x where x = f x}
fac :: Integer -> Integer
fac =
(fix $
\f n i ->
if i <= 0 then n
else f (i * n) (i - 1)) 1
fib :: Integer -> Integer
fib =
(fix $
\fnc f s i ->
if i <= 1 then f
else case f + s of n -> n `seq` fnc s n (i - 1)) 0 1
{--
-- compute a lazy infinite list. This is
-- a Y-combinator version of: fibs() = 0:1:zipWith (+) fibs (tail fibs)
-- which is the same as the above version but easier to read...
fibs :: () -> [Integer]
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:
main :: IO ()
main =
mapM_
print
[ map fac [1 .. 20]
, map fib [1 .. 20]
, take 20 fibs()
]

3
Task/Y-combinator/J/y-combinator-1.j Normal file
View file

@ -0,0 +1,3 @@
Y=. '('':''<@;(1;~":0)<@;<@((":0)&;))'(2 : 0 '')
(1 : (m,'u'))(1 : (m,'''u u`:6('',(5!:5<''u''),'')`:6 y'''))(1 :'u u`:6')
)

6
Task/Y-combinator/J/y-combinator-10.j Normal file
View file

@ -0,0 +1,6 @@
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 ,&<)))

20
Task/Y-combinator/J/y-combinator-11.j Normal file
View file

@ -0,0 +1,20 @@
Y=:1 :0
f=. u Defer
(5!:1<'f') f y
)
Defer=: 1 :0
:
g=. x&(x`:6)
(5!:1<'g') u y
)
almost_factorial=: 4 :0
if. 0 >: y do. 1
else. y * x`:6 y-1 end.
)
almost_fibonacci=: 4 :0
if. 2 > y do. y
else. (x`:6 y-1) + x`:6 y-2 end.
)

6
Task/Y-combinator/J/y-combinator-12.j Normal file
View file

@ -0,0 +1,6 @@
almost_factorial Y 9
362880
almost_fibonacci Y 9
34
almost_fibonacci Y"0 i. 10
0 1 1 2 3 5 8 13 21 34

9
Task/Y-combinator/J/y-combinator-13.j Normal file
View file

@ -0,0 +1,9 @@
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
)

2
Task/Y-combinator/J/y-combinator-14.j Normal file
View file

@ -0,0 +1,2 @@
almost_factorial f. Y 10
3628800

4
Task/Y-combinator/J/y-combinator-2.j Normal file
View file

@ -0,0 +1,4 @@
'if. * y do. y * u <: y else. 1 end.' Y 10 NB. Factorial
3628800
'(u@:<:@:<: + u@:<:)^:(1 < ])' Y 10 NB. Fibonacci
55

7
Task/Y-combinator/J/y-combinator-3.j Normal file
View file

@ -0,0 +1,7 @@
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

1
Task/Y-combinator/J/y-combinator-4.j Normal file
View file

@ -0,0 +1 @@
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')

14
Task/Y-combinator/J/y-combinator-5.j Normal file
View file

@ -0,0 +1,14 @@
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

1
Task/Y-combinator/J/y-combinator-6.j Normal file
View file

@ -0,0 +1 @@
YX=. (1 :'('':''<@;(1;~":0)<@;<@((":0)&;))u')($:`)(`:6)

1
Task/Y-combinator/J/y-combinator-7.j Normal file
View file

@ -0,0 +1 @@
Y=. ((((&>)/)((((^:_1)b.)(`(<'0';_1)))(`:6)))(&([ 128!:2 ,&<)))

11
Task/Y-combinator/J/y-combinator-8.j Normal file
View file

@ -0,0 +1,11 @@
u=. [ NB. Function (left)
n=. ] NB. Argument (right)
sr=. [ apply f. ,&< NB. Self referring
fac=. (1:`(n * u sr n - 1:)) @. (0 < n)
fac f. Y 10
3628800
Fib=. ((u sr n - 2:) + u sr n - 1:) ^: (1 < n)
Fib f. Y 10
55

12
Task/Y-combinator/J/y-combinator-9.j Normal file
View file

@ -0,0 +1,12 @@
fac f. Y NB. Factorial...
'1:`(] * [ ([ 128!:2 ,&<) ] - 1:)@.(0 < ])&>/'&([ 128!:2 ,&<)
fac f. NB. Factorial step...
1:`(] * [ ([ 128!:2 ,&<) ] - 1:)@.(0 < ])
Fib f. Y NB. Fibonacci...
'(([ ([ 128!:2 ,&<) ] - 2:) + [ ([ 128!:2 ,&<) ] - 1:)^:(1 < ])&>/'&([ 128!:2 ,&<)
Fib f. NB. Fibonacci step...
(([ ([ 128!:2 ,&<) ] - 2:) + [ ([ 128!:2 ,&<) ] - 1:)^:(1 < ])

25
Task/Y-combinator/Java/y-combinator-1.java Normal file
View file

@ -0,0 +1,25 @@
import java.util.function.Function;
public interface YCombinator {
interface RecursiveFunction<F> extends Function<RecursiveFunction<F>, F> { }
public static <A,B> Function<A,B> Y(Function<Function<A,B>, Function<A,B>> f) {
RecursiveFunction<Function<A,B>> r = w -> f.apply(x -> w.apply(w).apply(x));
return r.apply(r);
}
public static void main(String... arguments) {
Function<Integer,Integer> fib = Y(f -> n ->
(n <= 2)
? 1
: (f.apply(n - 1) + f.apply(n - 2))
);
Function<Integer,Integer> fac = Y(f -> n ->
(n <= 1)
? 1
: (n * f.apply(n - 1))
);
System.out.println("fib(10) = " + fib.apply(10));
System.out.println("fac(10) = " + fac.apply(10));
}
}

3
Task/Y-combinator/Java/y-combinator-2.java Normal file
View file

@ -0,0 +1,3 @@
public static <A,B> Function<A,B> Y(Function<Function<A,B>, Function<A,B>> f) {
return x -> f.apply(Y(f)).apply(x);
}

7
Task/Y-combinator/Java/y-combinator-3.java Normal file
View file

@ -0,0 +1,7 @@
public static <A,B> Function<A,B> Y(Function<Function<A,B>, Function<A,B>> f) {
return new Function<A,B>() {
public B apply(A x) {
return f.apply(this).apply(x);
}
};
}

53
Task/Y-combinator/Java/y-combinator-4.java Normal file
View file

@ -0,0 +1,53 @@
interface Function<A, B> {
public B call(A x);
}
public class YCombinator {
interface RecursiveFunc<F> extends Function<RecursiveFunc<F>, F> { }
public static <A,B> Function<A,B> fix(final Function<Function<A,B>, Function<A,B>> f) {
RecursiveFunc<Function<A,B>> r =
new RecursiveFunc<Function<A,B>>() {
public Function<A,B> call(final RecursiveFunc<Function<A,B>> w) {
return f.call(new Function<A,B>() {
public B call(A x) {
return w.call(w).call(x);
}
});
}
};
return r.call(r);
}
public static void main(String[] args) {
Function<Function<Integer,Integer>, Function<Integer,Integer>> almost_fib =
new Function<Function<Integer,Integer>, Function<Integer,Integer>>() {
public Function<Integer,Integer> call(final Function<Integer,Integer> f) {
return new Function<Integer,Integer>() {
public Integer call(Integer n) {
if (n <= 2) return 1;
return f.call(n - 1) + f.call(n - 2);
}
};
}
};
Function<Function<Integer,Integer>, Function<Integer,Integer>> almost_fac =
new Function<Function<Integer,Integer>, Function<Integer,Integer>>() {
public Function<Integer,Integer> call(final Function<Integer,Integer> f) {
return new Function<Integer,Integer>() {
public Integer call(Integer n) {
if (n <= 1) return 1;
return n * f.call(n - 1);
}
};
}
};
Function<Integer,Integer> fib = fix(almost_fib);
Function<Integer,Integer> fac = fix(almost_fac);
System.out.println("fib(10) = " + fib.call(10));
System.out.println("fac(10) = " + fac.call(10));
}
}

8
Task/Y-combinator/Java/y-combinator-5.java Normal file
View file

@ -0,0 +1,8 @@
import java.util.function.Function;
@FunctionalInterface
public interface SelfApplicable<OUTPUT> extends Function<SelfApplicable<OUTPUT>, OUTPUT> {
public default OUTPUT selfApply() {
return apply(this);
}
}

5
Task/Y-combinator/Java/y-combinator-6.java Normal file
View file

@ -0,0 +1,5 @@
import java.util.function.Function;
import java.util.function.UnaryOperator;
@FunctionalInterface
public interface FixedPoint<FUNCTION> extends Function<UnaryOperator<FUNCTION>, FUNCTION> {}

43
Task/Y-combinator/Java/y-combinator-7.java Normal file
View file

@ -0,0 +1,43 @@
import java.util.Arrays;
import java.util.Optional;
import java.util.function.Function;
import java.util.function.BiFunction;
@FunctionalInterface
public interface VarargsFunction<INPUTS, OUTPUT> extends Function<INPUTS[], OUTPUT> {
@SuppressWarnings("unchecked")
public OUTPUT apply(INPUTS... inputs);
public static <INPUTS, OUTPUT> VarargsFunction<INPUTS, OUTPUT> from(Function<INPUTS[], OUTPUT> function) {
return function::apply;
}
public static <INPUTS, OUTPUT> VarargsFunction<INPUTS, OUTPUT> upgrade(Function<INPUTS, OUTPUT> function) {
return inputs -> function.apply(inputs[0]);
}
public static <INPUTS, OUTPUT> VarargsFunction<INPUTS, OUTPUT> upgrade(BiFunction<INPUTS, INPUTS, OUTPUT> function) {
return inputs -> function.apply(inputs[0], inputs[1]);
}
@SuppressWarnings("unchecked")
public default <POST_OUTPUT> VarargsFunction<INPUTS, POST_OUTPUT> andThen(
VarargsFunction<OUTPUT, POST_OUTPUT> after) {
return inputs -> after.apply(apply(inputs));
}
@SuppressWarnings("unchecked")
public default Function<INPUTS, OUTPUT> toFunction() {
return input -> apply(input);
}
@SuppressWarnings("unchecked")
public default BiFunction<INPUTS, INPUTS, OUTPUT> toBiFunction() {
return (input, input2) -> apply(input, input2);
}
@SuppressWarnings("unchecked")
public default <PRE_INPUTS> VarargsFunction<PRE_INPUTS, OUTPUT> transformArguments(Function<PRE_INPUTS, INPUTS> transformer) {
return inputs -> apply((INPUTS[]) Arrays.stream(inputs).parallel().map(transformer).toArray());
}
}

74
Task/Y-combinator/Java/y-combinator-8.java Normal file
View file

@ -0,0 +1,74 @@
import java.math.BigDecimal;
import java.math.BigInteger;
import java.util.Arrays;
import java.util.HashMap;
import java.util.Map;
import java.util.function.Function;
import java.util.function.UnaryOperator;
import java.util.stream.Collectors;
import java.util.stream.LongStream;
@FunctionalInterface
public interface Y<FUNCTION> extends SelfApplicable<FixedPoint<FUNCTION>> {
public static void main(String... arguments) {
BigInteger TWO = BigInteger.ONE.add(BigInteger.ONE);
Function<Number, Long> toLong = Number::longValue;
Function<Number, BigInteger> toBigInteger = toLong.andThen(BigInteger::valueOf);
/* Based on https://gist.github.com/aruld/3965968/#comment-604392 */
Y<VarargsFunction<Number, Number>> combinator = y -> f -> x -> f.apply(y.selfApply().apply(f)).apply(x);
FixedPoint<VarargsFunction<Number, Number>> fixedPoint = combinator.selfApply();
VarargsFunction<Number, Number> fibonacci = fixedPoint.apply(
f -> VarargsFunction.upgrade(
toBigInteger.andThen(
n -> (n.compareTo(TWO) <= 0)
? 1
: new BigInteger(f.apply(n.subtract(BigInteger.ONE)).toString())
.add(new BigInteger(f.apply(n.subtract(TWO)).toString()))
)
)
);
VarargsFunction<Number, Number> factorial = fixedPoint.apply(
f -> VarargsFunction.upgrade(
toBigInteger.andThen(
n -> (n.compareTo(BigInteger.ONE) <= 0)
? 1
: n.multiply(new BigInteger(f.apply(n.subtract(BigInteger.ONE)).toString()))
)
)
);
VarargsFunction<Number, Number> ackermann = fixedPoint.apply(
f -> VarargsFunction.upgrade(
(BigInteger m, BigInteger n) -> m.equals(BigInteger.ZERO)
? n.add(BigInteger.ONE)
: f.apply(
m.subtract(BigInteger.ONE),
n.equals(BigInteger.ZERO)
? BigInteger.ONE
: f.apply(m, n.subtract(BigInteger.ONE))
)
).transformArguments(toBigInteger)
);
Map<String, VarargsFunction<Number, Number>> functions = new HashMap<>();
functions.put("fibonacci", fibonacci);
functions.put("factorial", factorial);
functions.put("ackermann", ackermann);
Map<VarargsFunction<Number, Number>, Number[]> parameters = new HashMap<>();
parameters.put(functions.get("fibonacci"), new Number[]{20});
parameters.put(functions.get("factorial"), new Number[]{10});
parameters.put(functions.get("ackermann"), new Number[]{3, 2});
functions.entrySet().stream().parallel().map(
entry -> entry.getKey()
+ Arrays.toString(parameters.get(entry.getValue()))
+ " = "
+ entry.getValue().apply(parameters.get(entry.getValue()))
).forEach(System.out::println);
}
}

3
Task/Y-combinator/Java/y-combinator-9.java Normal file
View file

@ -0,0 +1,3 @@
factorial[10] = 3628800
ackermann[3, 2] = 29
fibonacci[20] = 6765

Some files were not shown because too many files have changed in this diff Show more