I'm currently trying to implement beta reduction in Haskell, and I'm having a small problem. I've managed to figure out the majority of it, however as it is now I'm getting one small error when I test and I can't figure out how to fix it.
The code uses a custom datatype, Term and a substitution function which I defined beforehand, both of these will be below.
--Term datatype
data Term = Variable Var | Lambda Var Term | Apply Term Term
--Substitution function
substitute :: Var -> Term -> Term -> Term
substitute x n (Variable m)
|(m == x) = n
|otherwise = (Variable m)
substitute x n (Lambda m y)
|(m == x) = (Lambda m y)
|otherwise = (Lambda z (substitute x n (rename m z y)))
where z = fresh (merge(merge(used y) (used n)) ([x]))
substitute x n (Apply m y) = Apply (substitute x n m) (substitute x n y)
--Beta reduction
beta :: Term -> [Term]
beta (Variable x) = []
beta (Lambda x y) = map (Lambda x) (beta y)
beta (Apply (Lambda x m) n) = [(substitute x n m)] ++ [(Apply (Lambda x n) m) | m <- beta m] ++ [(Apply (Lambda x z) m) | z <- beta n]
beta (Apply x y) = [Apply x' y | x' <- beta x] ++ (map (Apply x) (beta y))
The expected outcome is as follows:
*Main> Apply example (numeral 1)
(\a. \x. (\y. a) x b) (\f. \x. \f. x)
*Main> beta it
[\c. (\b. \f. \x. \f. x) c b,(\a. \x. a b) (\f. \x. f x)]
However this is my outcome:
*Main> Apply example (numeral 1)
(\a. \x. (\y. a) x b) (\f. \x. \f. x)
*Main> beta it
[\c. (\b. \f. \x. \f. x) c b,(\a. \f. \x. \f. x) (\x. a b)]
Any help would be much appreciated.
Think you've also got your church numeral encoded wrong, numeral 1 should return
\f. \x. f x
rather than
\f. \x. \f. x.
Related
So I got below substitute function with which I'm trying to replace b for Church numeral 0 in
example term:
\a. \x. (\y. a) x b
*Main> substitute "b" (numeral 0) example
which is currently giving me:
\c. \a. (\b. c) a (\f. \x. x)
however I was expecting answer to be :
\c. \a. (\a. c) a (\f. \x. x)
Could you advise me what I am getting wrong here, is that the use of fresh ?? Substitute function here seems to be not considering 'a' here as a fresh variable as it's already used as a replacement to what was previously x? Is there any way to get around this ?
substitute :: Var -> Term -> Term -> Term
substitute x n (Variable y)| y == x = n
| otherwise = (Variable y)
substitute x n (Lambda y m)| y == x = (Lambda y m)
| otherwise = (Lambda new_z m')
where
new_z = fresh([x] `merge` (used m) `merge`(used n))
m' = substitute x n (substitute y (Variable new_z) m)
substitute x n (Apply m1 m2) = (Apply new_m1 new_m2)
where new_m1 = substitute x n m1
new_m2 = substitute x n m2
where
used :: Term -> [Var]
used (Variable z) = [z]
used (Lambda z n) = merge [z](used n)
used (Apply n m) = merge (used n)(used m)
and
fresh :: [Var] -> Var
fresh st = head (filterVariables variables st)
variables :: [Var]
variables = [s:[]| s <- ['a'..'z']] ++ [s: show t | t <- [1..],s <- ['a'..'z'] ]
filterVariables :: [Var] -> [Var] -> [Var]
filterVariables s t = filter (`notElem` t) s
and
merge :: Ord a => [a] -> [a] -> [a]
merge xs [] = xs
merge [] ys = ys
merge (x:xs) (y:ys)
| x == y = x : merge xs ys
| x <= y = x : merge xs (y:ys)
| otherwise = y : merge (x:xs) ys
From the lambda calculus perspective, b is free in \a. \x. (\y. a) x b, so substituting 0 for b gives \a. \x. (\y. a) x 0, and if 0 = \f. \x. x then it is
\a. \x. (\y. a) x (\f. \x. x)
===
\c. \x. (\y. c) x (\f. \x. x)
===
\c. \x. (\b. c) x (\f. \x. x)
and you apparently get
\c. \a. (\b. c) a (\f. \x. x)
which is the same lambda term, up to alpha-conversion (consistent capture-avoiding renaming of variables).
So there is no error.
Your new_z is chosen to be fresh in a rather conservative way, in the sense that you always generate a completely new variable name, and never reuse a variable that already occurs in the term, even when that variable could be reused without causing unwanted captures.
More in details, when you substitute something inside \y. a you will change y into something else, even if there are no clashes.
Now, due to how your Lambda case works, you perform multiple substitutions (note the nested substitute x n (substitute y (Variable new_z) m)).
So, I guess that when you rename a to c, your \y. a is first alpha-converted to \a. c as you expect. However, the second substitution you apply to that will again change a to something else (b, in your case) so you end up to \b. c.
Probably, your code performs an overall even number of substitutions there, which makes the variable change as follows \y, \a, \b, \a, \b, ... the last being \b since it's the last after an even number of changes.
Anyway, it does not matter which name you use as long as you are consistent with your variable renaming. The final result will be correct anyway.
Personally, I like to be more conservative and to avoid alpha-converting variables unless there's a need to do so, which avoids that ping-pong effect, but that's only a matter of taste.
I am trying to write a function that performs capture-avoiding substitution in Lambda calculus. The code compiles but does not spit out the correct answer. I've written what I expect the code to do, is my comprehension correct?
For example, I should get the following output for this input (numeral 0 is the Church numeral 0)
*Main> substitute "b" (numeral 0) example -- \a. \x. ((\y. a) x) b
\c. \a. (\a. c) a (\f. \x. x)
-- The incorrect result I actually got
\c. \c. (\f. \x. x) (x (\b. a))
NB \y is renamed to \a due to the substitution (\y.a)[N/b] (I think I have this covered in the code I have written, but please let me know if I am wrong.)
import Data.Char
import Data.List
type Var = String
data Term =
Variable Var
| Lambda Var Term
| Apply Term Term
-- deriving Show
instance Show Term where
show = pretty
example :: Term -- \a. \x. ((\y. a) x) b
example = Lambda "a"
(Lambda "x" (Apply (Apply (Lambda "y" (Variable "a"))
(Variable "x"))
(Variable "b")))
pretty :: Term -> String
pretty = f 0
where
f i (Variable x) = x
f i (Lambda x m) = if i /= 0 then "(" ++ s ++ ")" else s
where s = "\\" ++ x ++ ". " ++ f 0 m
f i (Apply n m) = if i == 2 then "(" ++ s ++ ")" else s
where s = f 1 n ++ " " ++ f 2 m
substitute :: Var -> Term -> Term -> Term
substitute x n (Variable y)
--if y = x, then leave n alone
| y == x = n
-- otherwise change to y
| otherwise = Variable y
substitute x n (Lambda y m)
--(\y.M)[N/x] = \y.M if y = x
| y == x = Lambda y m
--otherwise \z.(M[z/y][N/x]), where `z` is a fresh variable name
--generated by the `fresh` function, `z` must not be used in M or N,
--and `z` cannot be equal `x`. The `used` function checks if a
--variable name has been used in `Lambda y m`
| otherwise = Lambda newZ newM
where newZ = fresh(used(Lambda y m))
newM = substitute x n m
substitute x n (Apply m2 m1) = Apply newM2 newM1
where newM1 = substitute x n m2
newM2 = substitute x n m1
used :: Term -> [Var]
used (Variable n) = [n]
used (Lambda n t) = merge [n] (used t)
used (Apply t1 t2) = merge (used t1) (used t2)
variables :: [Var]
variables = [l:[] | l <- ['a'..'z']] ++
[l:show x | x <- [1..], l <- ['a'..'z']]
filterFreshVariables :: [Var] -> [Var] -> [Var]
filterFreshVariables lst = filter ( `notElem` lst)
fresh :: [Var] -> Var
fresh lst = head (filterFreshVariables lst variables)
recursiveNumeral :: Int -> Term
recursiveNumeral i
| i == 0 = Variable "x"
| i > 0 = Apply(Variable "f")(recursiveNumeral(i-1))
numeral :: Int -> Term
numeral i = Lambda "f" (Lambda "x" (recursiveNumeral i))
merge :: Ord a => [a] -> [a] -> [a]
merge (x : xs) (y : ys)
| x < y = x : merge xs (y : ys)
| otherwise = y : merge (x : xs) ys
merge xs [] = xs
merge [] ys = ys
This part in substitute x n (Lambda y m) is not correct:
the comment says "z must not be used in M or N", but there is nothing preventing that. newZ could be a variable in n, which leads to a problematic capture
the substitution z/y has not been done
| otherwise = Lambda newZ newM
where newZ = fresh(used(Lambda y m))
newM = substitute x n m
Fix:
"z must not be used in M or N":
newZ = fresh(used m `merge` used n)
"M[z/y][N/x]":
newM = substitute x n (substitute y (Variable newZ) m)
Put together:
| otherwise = Lambda newZ newM
where
newZ = fresh(used m `merge` used n)
newM = substitute x n (substitute y (Variable newZ) m)
Note that refreshing all bindings as done above makes it difficult to understand the result and to debug substitution. Actually y only needs to be refreshed if y is in n. Otherwise you can keep y, adding this clause:
| y `notElem` used n = Lambda y (substitute x n m)
Another idea would be to modify fresh to pick a name similar to the old one, e.g., by appending numbers until one doesn't clash.
There is still a bug I missed: newZ should also not be equal to x (the variable originally being substituted).
-- substitute [a -> \f. \x. x] in (\g. g), should be (\g. g)
ghci> substitute "a" (numeral 0) (Lambda "g" (Variable "g"))
\a. \g. \x. x
Two ways to address this:
add x to the set of variables to exclude newZ from:
newZ = fresh ([x] `merge` used m `merge` used n)
if you think about it, this bug only manifests itself when x is not in m, in which case there is nothing to substitute, so another way is to add one more branch skipping the work:
| x `notElem` used m = Lambda y m
Put together:
substitute x n (Lambda y m)
--(\y.M)[N/x] = \y.M if y = x
| y == x = Lambda y m
| x `notElem` used m = Lambda y m
| y `notElem` used n = Lambda y (substitute x n m)
| otherwise = Lambda newZ newM
where newZ = fresh(used m `merge` used n)
newM = substitute x n (substitute y (Variable newZ) m)
Output
ghci> example
\a. \x. (\y. a) x b
ghci> numeral 0
\f. \x. x
ghci> substitute "b" (numeral 0) example
\a. \c. (\y. a) c (\f. \x. x)
Note: I haven't tried to prove this code correct (exercise for the reader: define "correct"), there may still be bugs I missed. There must be some course about lambda calculus that has all the details and pitfalls but I haven't bothered to look.
How to rewrite the following function in point-free style, removing the parameter x from the definition completely (the other two may stay):
between min max x = (min < x) && (x < max)
This is not an assignment, just a question. I don't know how to proceed. I can turn it into a lambda function
between min max = \x -> (min < x) && (x < max)
but this is not point-free, as x is still there. Please help.
It can be done using the Reader applicative:
between min max = \x. (min < x) && (x < max)
{ Convert infix comparisons to sections }
= \x. ((min <) x) && ((< max) x)
{ Move infix (&&) to applicative style }
= \x. (&&) ((min <) x) ((< max) x)
{ Lift to applicative style using the applicative instance of `(->) a` }
= \x. (pure (&&) <*> (min <) <*> (< max)) x
{ Eta-reduce }
= pure (&&) <*> (min <) <*> (< max)
{ Optionally simplify for idiomatic style }
= (&&) <$> (min <) <*> (< max)
Another solution (needs import of Control.Applicative):
between min max = liftA2 (&&) (min <) (max >)
Using Control.Arrow we can reach this nearly obfuscated code:
(min <) &&& (< max) >>> uncurry (&&)
This relies on the predefined >>> for left-to-right composition, f &&& g = \x -> (f x, g x), and uncurrying.
pointfree.io also suggests the following unreadable code:
between = (. flip (<)) . ap . ((&&) .) . (<)
By operator sections transformation,
between min max x = (min < x) && (x < max)
= ((&&) . (min <)) x ((< max) x)
Now this fits a pattern for S-combinator, S f g x = (f x) (g x). There are many ways of encoding it in Haskell, but the main two are via Applicative and via Arrows:
_S f g x = (f x) (g x)
= (f <*> g) x
= uncurry id . (f &&& g) $ x
The second gives us
between a z = uncurry (&&) . ((a <) &&& (< z))
And the first, even more fitting
between a z = (&&) <$> (a <) <*> (< z)
= liftA2 (&&) (a <) (< z)
= (a <) <^(&&)^> (< z) -- nice and visual
(<^) = flip (<$>)
(^>) = (<*>)
But we could also fiddle with other combinators, with much less satisfactory results though,
_S f g x = f x (g x)
= flip f (g x) x
= (flip f . g) x x
= join (flip f <$> g) x
= (flip f =<< g) x
or
= (f x . g) x
= (. g) (f x) x
= ((. g) =<< f) x
which illustrates nicely the dangers of pointlessness in the pursuit of the pointfree.
There's one more possibility that makes sense (syntactically), which is
_S f g x = (f x) (g x)
-- = foldr1 ($) . sequence [f,g] $ x -- not valid Haskell
-- sequence [f,g] x = [f x,g x]
This is not a valid Haskell in general because of the typing issues, but in our specific case it does give rise to one more valid definition, which also does seem to follow the inner logic of it nicely,
between a z = -- foldr1 ($) . sequence [(&&).(a <), (< z)] -- not OK
= foldr1 (&&) . sequence [(a <), (< z)] -- OK
= and . sequence [(a <), (> z)]
because (a <) and (> z) have the same type.
Following terminology from this excellent series, let's represent an expression such as (1 + x^2 - 3x)^3 by a Term Expr, where the data types are the following:
data Expr a =
Var
| Const Int
| Plus a a
| Mul a a
| Pow a Int
deriving (Functor, Show, Eq)
data Term f = In { out :: f (Term f) }
Is there a recursion scheme suitable for performing symbolic differentiation? I feel like it's almost a Futumorphism specialized to Term Expr, i.e. futu deriveFutu for an appropriate function deriveFutu:
data CoAttr f a
= Automatic a
| Manual (f (CoAttr f a))
futu :: Functor f => (a -> f (CoAttr f a)) -> a -> Term f
futu f = In <<< fmap worker <<< f where
worker (Automatic a) = futu f a
worker (Manual g) = In (fmap worker g)
This looks pretty good, except that the underscored variables are Terms instead of CoAttrs:
deriveFutu :: Term Expr -> Expr (CoAttr Expr (Term Expr))
deriveFutu (In (Var)) = (Const 1)
deriveFutu (In (Const _)) = (Const 0)
deriveFutu (In (Plus x y)) = (Plus (Automatic x) (Automatic y))
deriveFutu (In (Mul x y)) = (Plus (Manual (Mul (Automatic x) (Manual _y)))
(Manual (Mul (Manual _x) (Automatic y)))
)
deriveFutu (In (Pow x c)) = (Mul (Manual (Const c)) (Manual (Mul (Manual (Pow _x (c-1))) (Automatic x))))
The version without recursion schemes looks like this:
derive :: Term Expr -> Term Expr
derive (In (Var)) = In (Const 1)
derive (In (Const _)) = In (Const 0)
derive (In (Plus x y)) = In (Plus (derive x) (derive y))
derive (In (Mul x y)) = In (Plus (In (Mul (derive x) y)) (In (Mul x (derive y))))
derive (In (Pow x c)) = In (Mul (In (Const c)) (In (Mul (In (Pow x (c-1))) (derive x))))
As an extension to this question, is there a recursion scheme for differentiating and eliminating "empty" Exprs such as Plus (Const 0) x that arise as a result of differentiation -- in one pass over the data?
Look at the differentiation rule for product:
(u v)' = u' v + v' u
What do you need to know to differentiate a product? You need to know the derivatives of the subterms (u', v'), as well as their values (u, v).
This is exactly what a paramorphism gives you.
para
:: Functor f
=> (f (b, Term f) -> b)
-> Term f -> b
para g (In a) = g $ (para g &&& id) <$> a
derivePara :: Term Expr -> Term Expr
derivePara = para $ In . \case
Var -> Const 1
Const _ -> Const 0
Plus x y -> Plus (fst x) (fst y)
Mul x y -> Plus
(In $ Mul (fst x) (snd y))
(In $ Mul (snd x) (fst y))
Pow x c -> Mul
(In (Const c))
(In (Mul
(In (Pow (snd x) (c-1)))
(fst x)))
Inside the paramorphism, fst gives you access to the derivative of a subterm, while snd gives you the term itself.
As an extension to this question, is there a recursion scheme for differentiating and eliminating "empty" Exprs such as Plus (Const 0) x that arise as a result of differentiation -- in one pass over the data?
Yes, it's still a paramorphism. The easiest way to see this is to have smart constructors such as
plus :: Term Expr -> Term Expr -> Expr (Term Expr)
plus (In (Const 0)) (In x) = x
plus (In x) (In (Const 0)) = x
plus x y = Plus x y
and use them when defining the algebra. You could probably express this as some kind of para-cata fusion, too.
An n-tuple on the lambda calculus is usually defined as:
1-tuple: λ a t . t a
1-tuple-fst: λ t . t (λ a . a)
2-tuple: λ a b t . t a b
2-tuple-fst: λ t . t (λ a b . a)
2-tuple-snd: λ t . t (λ a b . b)
3-tuple: λ a b c t . t a b c
3-tuple-fst: λ t . t (λ a b c . a)
3-tuple-snd: λ t . t (λ a b c . b)
3-tuple-trd: λ t . t (λ a b c . c)
... and so on.
My question is: is it possible to implement a function that receives a church number N and returns the corresponding N-tuple for any N? Also, is it possible to extend this function so it also returns the corresponding accessors? The algorithm can't use any form of recursion, including fixed-point combinators.
~
Edit: as requested, elaborating on what I've tried.
I want that function not to depend on recursion / fixed point combinators, so, the obvious way to do it would be using church-numbers for repetition. Said that, I have tried randomly testing many expressions, in order to learn how they grow. For example:
church_4 (λ a b c . a (b c))
Reduces to:
(λ a b c d e f . a ((((e d) c) b) a)))))
I've compared the reduction of many similar combinations church_4 (λ a b c . (a (b c))) to my desired results and noticed that I could implement the accessors as:
firstOf = (λ max n . (firstOf (sub max n) (firstOf n)))
access = (λ max idx t . (t (firstOf (sub max idx) (firstOf idx))))
Where sub is the subtraction operator and access church_5 church_2 means accessing the 3rd (because 2 is the 3rd natural) element of a 6-tuple.
Now, on the tuples. Notice that the problem is finding a term my_term such that, for example:
church_3 my_term
had the following normal form:
(λ a b c d t . ((((t a) b) c) d))
As you can see, I've almost found it, since:
church_3 (λ a b c . a (b c)) (λ a . a)
Reduces to:
(λ a b c d . (((a b) c) d))
Which is almost the result I need, except thatt is missing.
That is what I've tried so far.
Let's try to implement the n-ary tuple constructor. I shall also aim for a simple implementation, meaning that I try sticking to the elimination of natural numbers and tuples, and try to avoid using other (Church encoded) data structures.
My strategy is as follows:
Write a well-typed version of the function in a dependent language.
Translate it to untyped lambda calculus.
The reason for this is that I quickly get lost in untyped lambda calculus and I'm bound to make quite a few mistakes along the way, while the dependently typed environment puts me on rails. Also, proof assistants are just great help for writing any kind of code.
Step one
I use Agda. I cheat a bit with type-in-type. It makes Agda inconsistent, but for this problem proper type universes would be a huge pain, and it's very unlikely that we actually run into an inconsistency here anyway.
{-# OPTIONS --type-in-type #-}
open import Data.Nat
open import Data.Vec
We need a notion of n-ary polymorphic functions. We store the argument types in a vector of length n:
NFun : ∀ {n} → Vec Set n → Set → Set
NFun [] r = r
NFun (x ∷ ts) r = x → NFun ts r
-- for example, NFun (Nat ∷ Nat ∷ []) = λ r → Nat → Nat → r
We have the usual Church encoding for tuples. The constructors for n-ary tuples are n-ary functions returning a tuple.
NTup : ∀ {n} → Vec Set n → Set
NTup ts = ∀ {r} → NFun ts r → r
NTupCons : ℕ → Set
NTupCons n = ∀ ts → NFun {n} ts (NTup ts)
We'd like to have a function with type ∀ {n} → NTupCons n. We recurse on the Vec Set n parameter for the tuple constructor. The empty case is simple enough, but the cons case is a bit trickier:
nTupCons : ∀ {n} → NTupCons n
nTupCons [] x = x
nTupCons (t ∷ ts) x = ?
We need a NFun ts (NTup (t ∷ ts)) in place of the question mark. We know that nTupCons ts has type NFun ts (NTup ts), so we need to somehow get the former from the latter. We notice that what we need is just n-ary function composition, or in other words a functorial map over the return type of NFun:
compN : ∀ {n A B} (ts : Vec Set n) → (A → B) → NFun ts A → NFun ts B
compN [] f = f
compN (t ∷ ts) f g x = compN ts f (g x)
Now, we only need to get an NTup (t ∷ ts) from an NTup ts, and since we already have x with type t in scope, that's pretty easy:
nTupCons : ∀ {n} → NTupCons n
nTupCons [] x = x
nTupCons (t ∷ ts) x = compN ts consTup (nTupCons ts)
where
consTup : NTup ts → NTup (t ∷ ts)
consTup tup con = tup (con x)
Step two
We shall get rid of the Vec Set n-s and rewrite the functions so they iterate on the n parameters. However, simple iteration is not good for nTupCons, since that only provides us the recursive result (nTupCons ts), but we also need the current n index for compN (since we implement compN by iterating on n). So we write a helper that's a bit like a paramorphism. We also need Church encoded pairs here to pass up the Nat-s through the iteration:
zero = λ z s. z
suc = λ n z s. s (n z s)
fst = λ p. p (λ a b. a)
snd = λ p. p (λ a b. b)
-- Simple iteration has type
-- ∀ {A} → A → (A → A) → Nat → A
-- In contrast, we may imagine rec-with-n having the following type
-- ∀ {A} → A → (A → Nat → A) → Nat → A
-- We also pass the Nat index of the hypothesis to the "cons" case
rec-with-n = λ z f n .
fst (
n
(λ p. p z zero)
(λ hyp p. p (f (fst hyp) (snd hyp)) (suc (snd hyp))))
-- Note: I use "hyp" for "hypothesis".
The rest is straightforward to translate:
compN = λ n. n (λ f. f) (λ hyp f g x. hyp f (g x))
nTupCon =
rec-with-n
(λ x. x)
(λ hyp n. λ x. compN n (λ f g. f (g x)) hyp)
Let's test it for simple cases:
nTupCon zero =
(λ t. t)
nTupCon (suc zero) =
(λ hyp n. λ x. compN n (λ f g. f (g x)) hyp) (nTupCon zero) zero =
λ x. compN zero (λ f g. f (g x)) (λ t. t) =
λ x. (λ f g. f (g x)) (λ t. t) =
λ x. λ g. (λ t. t) (g x) =
λ x . λ g. g x =
λ x g . g x
nTupCon (suc (suc zero)) =
(λ hyp n. λ x. compN n (λ f g. f (g x)) hyp) (nTupCon (suc zero)) (suc zero) =
λ x. compN (suc zero) (λ f g. f (g x)) (λ a t. t a) =
λ x a. (λ f g. f (g x)) ((λ y t. t y) a) =
λ x a. (λ f g. f (g x)) (λ t. t a) =
λ x a g. (λ t. t a) (g x) =
λ x a g. g x a
It seems to work.
Let
foldargs = λ t n f z . (IsZero n) (t z) (λ a . foldargs t (pred n) f (f a z))
Then function
listofargs = λ n . foldargs id n pair null
returns reversed list of its args:
listofargs 5 a b c d e --> (e . (d . (c . (b . (a . null))))) or [e d c b a]
Function
apply = λ f l . (isnil l) f (apply (f (head l)) (tail l))
applies first argument (n-ary function) to arguments taken from the second argument (a list of length n):
apply f [a b c d e] --> f a b c d e
The rest is easy:
n-tuple = λ n . foldargs n-tuple' (Succ n) pair null
where
n-tuple' = λ l . apply (head l) (reverse (tail l))
Implementation of the other functions can be taken from wikipedia.
Recursion can be eliminated by Y-combinator.
reverse is simple.
UPD: Nonrecursive versions of the functions:
foldargs = Y (λ c t n f z . (IsZero n) (t z) (λ a . c t (pred n) f (f a z)))
apply = Y (λ c f l . (isnil l) f (c (f (head l)) (tail l)))
Y = λ f (λ x . f x x) (λ x . f x x)


I found it! There you go:
nTup = (λ n . (n (λ f t k . (f (λ e . (t (e k))))) (λ x . x) (λ x . x)))
Testing:
nTup n1 → (λ (λ (0 1)))
nTup n2 → (λ (λ (λ ((0 1) 2))))
nTup n3 → (λ (λ (λ (λ (((0 1) 2) 3)))))
nTup n4 → (λ (λ (λ (λ (λ ((((0 1) 2) 3) 4))))))
And so on. It stores the elements backwards but I don't think I'm gonna fix that - it looks more natural like so. The challenge was getting that 0 on the leftmost innermost paren. As I said, I could easily get both (0 (1 (2 (3 4)))) and ((((4 3) 2) 1) 0), but those don't work as tuples because that 0 is what holds the elements there.
Thank you all!
Edit: I've actually settled with this one:
nTup = (λ a . (a (λ b c d . (b (λ b . (c b d)))) (λ x . x) (λ x . x)))
Which preserves the correct order.
nTup n4 → (λ (λ (λ (λ (λ ((((0 4) 3) 2) 1))))))
If you can construct the n-tuples, you can easily access the ith index.
First, we need a type for the otherwise infinite untyped lambda functions. The extra X constructor allows us to inspect these functions by executing them.
import Prelude hiding (succ, pred)
data Value x = X x | F (Value x -> Value x)
instance (Show x) => Show (Value x) where
show (X x) = "X " ++ show x
show _ = "F"
It's convenient to be able to apply functions to each other.
ap :: Value x -> Value x -> Value x
ap (F f) = f
ap _ = error "Attempt to apply Value"
infixl 1 `ap`
If you are going to encode numbers with Church numerals you need some church numerals. We will also need subtraction to figure out how many additional arguments to skip when indexing into an n tuple.
idF = F $ \x -> x
zero = F $ \f -> idF
succ = F $ \n -> F $ \f -> F $ \x -> f `ap` (n `ap` f `ap` x)
one = succ `ap` zero
two = succ `ap` one
three = succ `ap` two
four = succ `ap` three
pred = F $ \n -> F $ \f -> F $ \x -> n `ap` (F $ \g -> F $ \h -> h `ap` (g `ap` f)) `ap` (F $ \u -> x) `ap` idF
subtractF = F $ \n -> (n `ap` pred)
The constant function drops its first argument. If we iterate the constant function some numeral number of times, it drops that many first arguments.
--drops the first argument
constF = F $ \f -> F $ \x -> f
-- drops i first arguments
constN = F $ \i -> i `ap` constF
We can make another constant function that drops its second argument. If we iterate it some numeral number of times, it drops that many second arguments.
-- drops the second argument
constF' = F $ \f -> F $ \a -> F $ \b -> f `ap` a
-- drops n second arguments
constN' = F $ \n -> n `ap` constF'
To index into an n tuple's ith index (starting at zero for the first index), we need to drop n-i-1 arguments off the end and drop i arguments off the start.
-- drops (n-i-1) last arguments and i first arguments
access = F $ \n -> F $ \i -> constN `ap` i `ap` (constN' `ap` (subtractF `ap` (succ `ap` i) `ap` n) `ap` idF)
We'll define few example tuples of fixed size
tuple1 = F $ \a -> F $ \t -> t `ap` a
tuple2 = F $ \a -> F $ \b -> F $ \t -> t `ap` a `ap` b
tuple3 = F $ \a -> F $ \b -> F $ \c -> F $ \t -> t `ap` a `ap` b `ap` c
which we can use to demonstrate that it is possible to generate the corresponding accessors.
main = do
print $ tuple1 `ap` (X "Example") `ap` (access `ap` one `ap` zero)
print $ tuple2 `ap` (X "Hello") `ap` (X "World") `ap` (access `ap` two `ap` zero)
print $ tuple2 `ap` (X "Hello") `ap` (X "World") `ap` (access `ap` two `ap` one)
print $ tuple3 `ap` (X "Goodbye") `ap` (X "Cruel") `ap` (X "World") `ap` (access `ap` three `ap` zero)
print $ tuple3 `ap` (X "Goodbye") `ap` (X "Cruel") `ap` (X "World") `ap` (access `ap` three `ap` one)
print $ tuple3 `ap` (X "Goodbye") `ap` (X "Cruel") `ap` (X "World") `ap` (access `ap` three `ap` two)
Running this outputs
X "Example"
X "Hello"
X "World"
X "Goodbye"
X "Cruel"
X "World"
To construct tuples you will need to iterate some function that adds arguments to a function instead of dropping them.