Data update
This commit is contained in:
Ingy döt Net
parent
72eb4943cb
commit
4d5544505c
2347 changed files with 62432 additions and 16731 deletions
|
|
@ -2,18 +2,14 @@ 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...
|
||||
-- Recursive wrapper Type required for statically-typed languages...
|
||||
type Mu a = Roll (Mu a -> a)
|
||||
unroll : Mu a -> (Mu a -> a)
|
||||
unroll (Roll v) = v
|
||||
|
||||
-- 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...
|
||||
-- the non-sharing non-recursive implementation of the Z-Combinator...
|
||||
fixz : ((a -> b) -> (a -> b)) -> (a -> b)
|
||||
fixz f = let g r = f (\ v -> unroll r r v) in g (Roll g)
|
||||
fixz f = let g = \ x v -> f (unroll x x) v in g (Roll g)
|
||||
|
||||
facz : Int -> Int
|
||||
-- facz = fixz <| \ f n -> if n < 2 then 1 else n * f (n - 1) -- inefficient recursion
|
||||
|
|
@ -23,20 +19,18 @@ 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!
|
||||
-- the non-sharing non-recursive implementation of fixy with injected laziness...
|
||||
-- this works for languages that are "strict" = non-lazy by default...
|
||||
fixy : ((() -> a) -> a) -> a
|
||||
fixy f = f <| \ () -> fixy f -- direct function recursion
|
||||
-- the above is not value recursion but function recursion!
|
||||
-- the below is an attempt at value recursion, but...
|
||||
-- fixv f = let x = f x in x -- not allowed by task or by Elm!
|
||||
-- we can make Elm allow it by injecting laziness but...
|
||||
fix : ((() -> a) -> a) -> a
|
||||
fix f = let xf() = f xf in xf() -- this is just another form of function recursion...
|
||||
-- the above is what the Haskell `fix` non-sharing fix point combinator actually is
|
||||
-- because all values are actually non-strict/lazy, meaning they require a "thunk" as
|
||||
-- above to be evaluated to their actual value, which is equivalent to `xf() ==> x` above!
|
||||
-- thus, in Haskell, all "boxed" values such as this actually represent function applications!
|
||||
fixy f = let g x = f <| \ () -> (unroll x) x in g (Roll g)
|
||||
|
||||
{-- } --as Elm allows function recursion, the above is equivalent to the following:
|
||||
fixy f = f <| \ () -> fixy f
|
||||
--}
|
||||
|
||||
-- sharing version if `(() -> a)` is lazy memoizing value of `a` - Elm doesn't have memoization!
|
||||
fix : ((() -> a) -> a) -> a -- however, it works as a Y Combinator...
|
||||
fix f = let x() = f x in x()
|
||||
|
||||
facy : Int -> Int
|
||||
-- facy = fixy <| \ f n -> if n < 2 then 1 else n * f () (n - 1) -- inefficient recursion
|
||||
|
|
@ -46,22 +40,24 @@ 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!
|
||||
-- Something that can be done with the true Y-Combinator that can't be done with Z-Combinator...
|
||||
|
||||
-- defines a Co-Inductive Lazy (non-memoizing, just deferred) Stream...
|
||||
type CIS a = CIS a (() -> CIS a)
|
||||
|
||||
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)
|
||||
iterateCISWithFrom : (CIS a -> CIS a) -> a -> CIS a
|
||||
iterateCISWithFrom f v = fixy (\ dfn -> f (CIS v dfn))
|
||||
|
||||
fibsfunc : CIS (Int, Int) -> CIS (Int, Int)
|
||||
fibsfunc = fixy (\ dfn -> \ (CIS ((cur, nxt) as hd) tlf) ->
|
||||
CIS hd <| \ () -> dfn () (CIS (nxt, (cur + nxt)) tlf))
|
||||
|
||||
fibs : CIS Int
|
||||
fibs = iterateCISWithFrom fibsfunc (1, 1) |> mapCIS (\ (v, _) -> v)
|
||||
|
||||
nCISs2String : Int -> CIS a -> String -- convert n CIS's to String
|
||||
nCISs2String n cis =
|
||||
|
|
@ -70,12 +66,9 @@ nCISs2String n cis =
|
|||
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())
|
||||
++ " " ++ nCISs2String 20 fibs
|
||||
|> text
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
// 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)
|
||||
// Z combinator. Nigel Galloway: March 5th., 2024
|
||||
type Mu<'T> = { eval: Mu<'T> -> ('T -> 'T) }
|
||||
let Z f = let g = { eval = fun x -> fun v -> (f (x.eval x)) v } in (g.eval g)
|
||||
let fibonacci=function 0->1 |x->let fibonacci f= function 0->0 |1->1 |x->f(x - 1) + f(x - 2) in Z fibonacci x
|
||||
let factorial n=let factorial f=function 0->1 |x->x*f(x-1) in Z factorial n
|
||||
printfn "fibonacci 10 = %d\nfactorial 5 = %d" (fibonacci 10) (factorial 5)
|
||||
|
|
|
|||
|
|
@ -1,35 +1,7 @@
|
|||
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 with injected laziness. GordonBGood : April 18, 2025
|
||||
type 'T Mu = { eval: 'T Mu -> 'T }
|
||||
let Y f = let g = fun x -> f <| fun() -> (x.eval x) in g { eval = g }
|
||||
let fibonacci n = Y (fun fn f s i -> if i >= n then f else fn () s (f + s) (i + 1)) 1I 1I 1
|
||||
let factorial n = Y (fun f p x -> if x > n then p else f () (x * p) (x + 1I)) 1I 1I
|
||||
printfn "fibonacci 10 = %A\r\nfactorial 5 = %A" (fibonacci 10) (factorial 5I)
|
||||
printfn "fibonacci 1000 = %A" (fibonacci 1000)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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-5.fs
Normal file
4
Task/Y-combinator/F-Sharp/y-combinator-5.fs
Normal 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.
|
||||
|
|
@ -1,3 +1,3 @@
|
|||
Y=. {{x&(x`:6)`'' u y}} {{u`''&u}}
|
||||
Y =. {{x&(x`:6)`'' u y}} {{u`''&u}}
|
||||
fac=. 1:`{{(* x`:6@<:)y}}@.(0 < ])
|
||||
fib=. {{(-&1 +&(x`:6) -&2)y}}^:(1 < ])
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
Y=. ]:&>/]:^:_1 b.]:`(<'0';_1)`:6&([ 128!:2 ,&<)
|
||||
sr=. [ apply f. ,&< NB. Self referring
|
||||
Y =. ]:&>/]:^:_1 b.]:`(<'0';_1)`:6&([ 128!:2 ,&<)
|
||||
sr =. [ apply f. ,&< NB. Self referring
|
||||
fac=. 1:`(] * [ sr ] - 1:)@.(0 < ])
|
||||
fib=. (([ sr ] - 2:) + [ sr ] - 1:)^:(1 < ])
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
sr=. [ apply f. ,&< NB. Self referring
|
||||
lv=. ]:^:_1 b.]:`(<'0';_1)`:6 NB. Linear representation of a verb operand
|
||||
Y=. ]:&>/lv&sr NB. Y with embedded states
|
||||
Y=. 'Y' f. NB. Fixing it...
|
||||
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. ]:) ` (<'0';_1)) `: 6)) & ([ 128!:2 ,&<)
|
||||
|
|
|
|||
71
Task/Y-combinator/Zig/y-combinator.zig
Normal file
71
Task/Y-combinator/Zig/y-combinator.zig
Normal file
|
|
@ -0,0 +1,71 @@
|
|||
//! A simple implementation of the Y Combinator:
|
||||
//! λf.(λx.xx)(λx.f(xx))
|
||||
//! <=> λf.(λx.f(xx))(λx.f(xx))
|
||||
|
||||
const std = @import("std");
|
||||
const debug = std.debug;
|
||||
const mem = std.mem;
|
||||
const Allocator = mem.Allocator;
|
||||
|
||||
// In Zig we can use function pointers and closures
|
||||
// to implement the Y combinator without needing traits
|
||||
|
||||
// Generic Y combinator implementation
|
||||
fn Y(comptime T: type, comptime R: type, f: fn (fn (T) R, T) R) fn (T) R {
|
||||
const Closure = struct {
|
||||
fn call(t: T) R {
|
||||
const applySelf = struct {
|
||||
fn apply(x: fn (fn (T) R, T) R, y: T) R {
|
||||
const innerApply = struct {
|
||||
fn inner(z: T) R {
|
||||
return apply(x, z);
|
||||
}
|
||||
}.inner;
|
||||
return x(innerApply, y);
|
||||
}
|
||||
}.apply;
|
||||
return applySelf(f, t);
|
||||
}
|
||||
};
|
||||
return Closure.call;
|
||||
}
|
||||
|
||||
// Factorial function using Y combinator
|
||||
fn fac(n: usize) usize {
|
||||
const almostFac = struct {
|
||||
fn call(f: fn (usize) usize, x: usize) usize {
|
||||
if (x == 0) return 1 else return x * f(x - 1);
|
||||
}
|
||||
}.call;
|
||||
|
||||
return Y(usize, usize, almostFac)(n);
|
||||
}
|
||||
|
||||
// Fibonacci function using Y combinator
|
||||
fn fib(n: usize) usize {
|
||||
const FibTuple = struct { a0: usize, a1: usize, x: usize };
|
||||
|
||||
const almostFib = struct {
|
||||
fn call(f: fn (FibTuple) usize, tuple: FibTuple) usize {
|
||||
const a0 = tuple.a0;
|
||||
const a1 = tuple.a1;
|
||||
const x = tuple.x;
|
||||
|
||||
return switch (x) {
|
||||
0 => a0,
|
||||
1 => a1,
|
||||
else => f(.{ .a0 = a1, .a1 = a0 + a1, .x = x - 1 }),
|
||||
};
|
||||
}
|
||||
}.call;
|
||||
|
||||
return Y(FibTuple, usize, almostFib)(.{ .a0 = 1, .a1 = 1, .x = n });
|
||||
}
|
||||
|
||||
// Driver function
|
||||
pub fn main() !void {
|
||||
const n: usize = 10;
|
||||
const stdout = std.io.getStdOut().writer();
|
||||
try stdout.print("fac({}) = {}\n", .{ n, fac(n) });
|
||||
try stdout.print("fib({}) = {}\n", .{ n, fib(n) });
|
||||
}
|
||||
Loading…
Add table
Add a link
Reference in a new issue