Initial data commit

Task/Y-combinator/Elm/y-combinator.elm

@@ -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