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

Data update

Browse source
This commit is contained in:
Ingy döt Net 2024-03-06 22:25:12 -08:00
parent ed705008a8
commit 0df55f9f24
2196 changed files with 32999 additions and 3075 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -8,69 +8,85 @@ MODE F = PROC( INT ) INT ;
MODE X = PROC( X ) F ;
# Y_combinator = func_gen => ( x => x( x ) )( x => func_gen( arg => x( x )( arg ) ) ) ; #
#
Y_combinator =
func_gen => ( x => x( x ) )( x => func_gen( arg => x( x )( arg ) ) )
#
PROC y combinator = ( PROC( F ) F func gen ) F:
( ( X x ) F: x( x ) )
( ( 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 , )
)
( 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 ) ) ) )
;
fac_gen = 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 , )
)
PROC fac gen = ( 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 ) ) )
)
;
factorial = Y_combinator( fac_gen )
#
F fibonacci =
y combinator(
( F fib ) F:
( ( F fib , INT n ) INT: CASE n IN 1 , 1 OUT fib( n - 2 ) + fib( n - 1 ) ESAC )
( fib , )
)
F factorial = y combinator( fac gen ) ;
#
fib_gen =
fib =>
( n => ( ( n === 0 ) ? 0 : ( n === 1 ) ? 1 : fib( n - 2 ) + fib( n - 1 ) ) )
#
PROC fib gen = ( F fib ) F:
(
( F fib , INT n ) INT:
CASE n + 1 IN 0 , 1 OUT fib( n - 2 ) + fib( n - 1 ) ESAC
)( fib , )
;
# for ( i = 1 ; i <= 12 ; i++) { console.log( " " + factorial( i ) ) ; } #
#
fibonacci = Y_combinator( fib_gen )
#
F fibonacci = y combinator( fib gen ) ;
#
for ( i = 1 ; i <= 12 ; i++) { process.stdout.write( " " + factorial( i ) ) }
#
INT nofacs = 12 ;
print( ( "The first " , whole( nofacs , 0 ) , " factorials." , newline ) ) ;
printf( ( $ l , "Here are the first " , g( 0 ) , " factorials." , l $ , nofacs ) ) ;
FOR i TO nofacs
DO
print( whole( factorial( i ) , -11 ) )
printf( ( $ " " , g( 0 ) $ , factorial( i ) ) )
OD ;
print( newline ) ;
print( ( newline , newline ) ) ;
# for ( i = 1 ; i <= 12 ; i++) { console.log( " " + fibonacci( i ) ) ; } #
#
for ( i = 1 ; i <= 12 ; i++) { process.stdout.write( " " + fibonacci( i ) ) }
#
INT nofibs = 12 ;
print( ( "The first " , whole( nofibs , 0 ) , " fibonacci numbers." , newline ) ) ;
printf( (
$ l , "Here are the first " , g( 0 ) , " fibonacci numbers." , l $
, nofibs
) )
;
FOR i TO nofibs
DO
print( whole( fibonacci( i ) , -11 ) )
printf( ( $ " " , g( 0 ) $ , fibonacci( i ) ) )
OD ;
print( newline )

15
Task/Y-combinator/Bruijn/y-combinator.bruijn Normal file
View file

@ -0,0 +1,15 @@
:import std/Number .
# sage bird combinator
y [[1 (0 0)] [1 (0 0)]]
# factorial using y
factorial y [[=?0 (+1) (0 ⋅ (1 --0))]]
:test ((factorial (+6)) =? (+720)) ([[1]])
# (very slow) fibonacci using y
fibonacci y [[0 <? (+1) (+0) (0 <? (+2) (+1) rec)]]
rec (1 --0) + (1 --(--0))
:test ((fibonacci (+6)) =? (+8)) ([[1]])

4
Task/Y-combinator/Elena/y-combinator.elena
View file

@ -8,8 +8,8 @@ singleton YCombinator
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) ));
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));

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

@ -1,35 +1,6 @@
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
// Y combinator. Nigel Galloway: March 5th., 2024
type Y<'T> = { eval: Y<'T> -> ('T -> 'T) }
let Y n g=let l = { eval = fun l -> fun x -> (n (l.eval l)) x } in (l.eval l) g
let fibonacci=function 0->1 |x->let fibonacci f= function 0->0 |1->1 |x->f(x - 1) + f(x - 2) in Y fibonacci x
let factorial n=let factorial f=function 0->1 |x->x*f(x-1) in Y factorial n
printfn "fibonacci 10=%d\nfactorial 5=%d" (fibonacci 10) (factorial 5)

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

@ -1,40 +1,35 @@
// 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>
// 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>
// 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
// 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>
// 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
// 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>
// 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!
// 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
fibs() |> Seq.take 20 |> Seq.iter (printf "%A ")
printfn ""
0 // return an integer exit code

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

@ -1,4 +1,40 @@
let rec fix f = f <| fun() -> fix f
// val fix : f:((unit -> 'a) -> 'a) -> 'a
// same as previous...
type 'a mu = Roll of ('a mu -> 'a) // ' fixes ease syntax colouring confusion with
// the application of this true Y-combinator is the same as for the above non function recursive version.
// 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-4.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.

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

@ -1,12 +1,9 @@
\ 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 ;
\ Begin of approach. Depends on 'latestxt' word of GForth implementation.
: self-parameter ( xt -- xt' )
>r :noname latestxt postpone literal r> compile, postpone ;
;
: Y ( xt -- xt' )
dup self-parameter 2>r
:noname 2r> postpone literal compile, postpone ;
;

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

@ -1,7 +1,6 @@
\ Factorial
10 :noname ( u1 xt -- u2 ) over ?dup if 1- swap execute * else 2drop 1 then ;
y execute . 3628800 ok
\ Fibonnacci test
10 :noname ( u xt -- u' ) over 2 < if drop exit then >r 1- dup r@ execute swap 1- r> execute + ; Y execute . 55 ok
\ Factorial test
10 :noname ( u xt -- u' ) over 2 < if 2drop 1 exit then over 1- swap execute * ; Y execute . 3628800 ok
\ 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
\ End of approach.

12
Task/Y-combinator/Forth/y-combinator-3.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-4.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

9
Task/Y-combinator/R/y-combinator-1.r
View file

@ -1,3 +1,6 @@
Y <- function(f) {
(function(x) { (x)(x) })( function(y) { f( (function(a) {y(y)})(a) ) } )
}
#' Y = λf.(λs.ss)(λx.f(xx))
#' Z = λf.(λs.ss)(λx.f(λz.(xx)z))
#'
fixp.Y <- \ (f) (\ (x) (x) (x)) (\ (y) (f) ((y) (y))) # y-combinator
fixp.Z <- \ (f) (\ (x) (x) (x)) (\ (y) (f) (\ (...) (y) (y) (...))) # z-combinator

20
Task/Y-combinator/R/y-combinator-2.r
View file

@ -1,17 +1,5 @@
fac <- function(f) {
function(n) {
if (n<2)
1
else
n*f(n-1)
}
}
fac.y <- fixp.Y (\ (f) \ (n) if (n<2) 1 else n*f(n-1))
fac.y(9) # [1] 362880
fib <- function(f) {
function(n) {
if (n <= 1)
n
else
f(n-1) + f(n-2)
}
}
fib.y <- fixp.Y (\ (f) \ (n) if (n <= 1) n else f(n-1) + f(n-2))
fib.y(9) # [1] 34

7
Task/Y-combinator/R/y-combinator-3.r
View file

@ -1,2 +1,5 @@
for(i in 1:9) print(Y(fac)(i))
for(i in 1:9) print(Y(fib)(i))
fac.z <- fixp.Z (\ (f) \ (n) if (n<2) 1 else n*f(n-1))
fac.z(9) # [1] 362880
fib.z <- fixp.Z (\ (f) \ (n) if (n <= 1) n else f(n-1) + f(n-2))
fib.z(9) # [1] 34