Converting numerical expressions to lambda calculus in Haskell - haskell

Trying to make a function that converts any given numerical expression to its lambda calculus equivalent.
To do this, I've made two functions; an encode function and subst. Below are the relevant bits of my code. However, when I run my encode function, it doesn't encode multiplication expressions properly; i.e I think I've written my Add/Mul lines of code in the encode function wrong. However, I can't work out how to fix this. When I run encode (ArithmeticNum 2) and encode (SecApp (Section (ArithmeticNum 1)) (ArithmeticNum 1)) , it produces the expected output, however. Can someone help me on fixing the Add/Mul bits of the encode function so it works in all cases?
I know the multiplication syntax for encoding would look like mul n m = \s -> \z -> n (m s) z,
but I'm not sure how I would write this in my encode function. Could someone help me with this bit? Thanks.
data Lambda = LamdaApp Lambda Lambda | LambdaAbs Int Lambda | LambdaVar Int deriving (Show,Eq)
data ArithmeticExpr = Add ArithmeticExpr ArithmeticExpr | Mul ArithmeticExpr ArithmeticExpr | Section ArithmeticExpr | SecApp ArithmeticExpr ArithmeticExpr | ArithmeticNum Int deriving (Show, Eq,Read)
subst :: LambdaExpr -> Int -> LambdaExpr -> LambdaExpr
subst (LambdaVar x) y e | x == y = e
subst (LambdaVar x) y e | x /= y = LambdaVar x
subst (LambdaAbs x e1) y e |
x /= y && not (free x e) = LambdaAbs x (subst e1 y e)
subst (LambdaAbs x e1) y e |
x /=y && (free x e) = let x' = rename x y in
subst (LambdaAbs x' (subst e1 x (LambdaVar x'))) y e
subst (LambdaAbs x e1) y e | x == y = LambdaAbs x e1
subst (LambdaApp e1 e2) y e = LambdaApp (subst e1 y e) (subst e2 y e)
free :: Int -> LambdaExpr -> Bool
free x (LambdaVar y) = x == y
free x (LambdaAbs y e) | x == y = False
free x (LambdaAbs y e) | x /= y = free x e
free x (LambdaApp e1 e2) = (free x e1) || (free x e2)
rename :: Int -> Int -> Int
rename x y = (max x y) + 1
encode:: ArithmeticExpr -> LambdaExpr
encode(ArithmeticNum 0) = LambdaAbs 0 (LambdaAbs 1 (LambdaVar 1))
encode(ArithmeticNum n) = LambdaAbs 0 (LambdaAbs 1 (helper n 0 1))
where helper :: Int -> Int -> Int -> LambdaExpr
helper 0 _ _ = LambdaVar 1
helper n f x = LambdaApp (LambdaVar f) (helper (n - 1) f x)
encode (Add e1 e2) = LambdaAbs 0 (LambdaAbs 1 ( LambdaApp (LambdaApp (encode e1) (LambdaVar 0)) (LambdaApp (LambdaApp (encode e2) (LambdaVar 0)) (LambdaVar 1))))
encode (Mul e1 e2) = LambdaAbs 0 (LambdaAbs 1 (LambdaAbs 2 (LambdaAbs 3 (LambdaApp (LambdaApp (LambdaVar 0) (encode e1)) (LambdaApp (LambdaVar 1) (encode e2))))))
encode (SecApp (Section op) e1) = LambdaApp (LambdaApp (encode op) (encode e1)) (encode (ArithmeticNum 1))
encode (Section (ArithmeticNum n)) = LambdaAbs 0 (LambdaAbs 1 (LambdaApp (LambdaVar 0) (encode (ArithmeticNum n))))

As you say, multiplication in the Church Encoding (there are other encodings) is done as follows:
mul n m = \s -> \z -> n (m s) z
Just taking this line:
encode (Mul e1 e2) = LambdaAbs 0 (LambdaAbs 1 (LambdaAbs 2 (LambdaAbs 3 (LambdaApp (LambdaApp (LambdaVar 0) (encode e1)) (LambdaApp (LambdaVar 1) (encode e2))))))
I'd say it corresponds to this in the more direct notation (assuming numbers are valid variable names):
mul e1 e2 = \0 -> \1 -> \2 -> \3 -> (0 e1) (1 e2)
So, I'd say one mistake is to have the encoded multiplication take four arguments where it should only take two. Multiplication on its own should indeed take four arguments, but in this case you are translating a multiplication that is already applied to the arguments e1 and e2, so there are only two left. And the inner body of the lambda is also incorrect. You'd want this:
mul e1 e2 = \0 -> \1 -> e1 (e2 0) 1
Which is equivalant to the equation at the top of this answer.

Related

Implementing a catamorphism for Expression Trees

I am trying to implement an expression tree in Haskell as follows:
data ExprTr a b =
Variable a
| Constant b
| Add (ExprTr a b) (ExprTr a b)
| Mul (ExprTr a b) (ExprTr a b)
deriving (Eq, Show)
And I would like to be able to implement operations on it using a catamorphism.
Currently, this is the function I got:
cataTr f _ _ _ (Variable i) = f i
cataTr f g _ _ (Constant i) = g i
cataTr f g h i (Add e1 e2) = g (cataTr f g h i e1) (cataTr f g h i e2)
cataTr f g h i (Mul e1 e2) = h (cataTr f g h i e1) (cataTr f g h i e2)
However, whenever I try to use it with an expresion of type ExprTr String Integer I get compiler errors. For example, running cataTr id id id id (Var "X") returns the following compiler error instead of (Var "X").
Couldn't match type 'Integer' with '[Char]'
Expected type: 'ExprTr String String'
Actual type: 'ExprTr String Integer'
I am not sure how to proceed. Furthermore, I would appreciate some suggestions on how to type such a function as cataTr to make it easier to debug later.
As I am fairly new to Haskell, I would like to understand how to approach such situations from 'first principles' instead of using a library to generate the catamorphism for myself.
This is expected behavior.
You made a typo in the question I guess, since you should use h and i as functions:
cataTr f _ _ _ (Variable i) = f i
cataTr f g _ _ (Constant i) = g i
cataTr f g h i (Add e1 e2) = h (cataTr f g h i e1) (cataTr f g h i e2)
cataTr f g h i (Mul e1 e2) = i (cataTr f g h i e1) (cataTr f g h i e2)
or likely more elegant:
cataTr f g h i = go
where go (Variable i) = f i
go (Constant i) = g i
go (Add e1 e2) = h (go e1) (go e2)
go (Mul e1 e2) = i (go e1) (go e2)
or as #DanielWagner suggests, with a case expression:
cataTr f g h i = go
where go v = case v of
Variable i -> f i
Constant i -> g i
Add e1 e2 -> h (go e1) (go e2)
Mul e1 e2 -> i (go e1) (go e2)
Nevertheless, you can not call the function cataTr with id as third and fourth parameter. These functions require two parameters. Furthermore if a and b are different the two first parameters can not be both id, since your f maps an a to the result type, and the g maps a b to the result type.
You can for example pass the data constructor to construct an identity function with:
cataTr Variable Constant Add Mul (Variable "X")
this will thus yield Variable "X" again, or you can for example map all Variables to 0 with const 0, and use id, (+) and (*) to evaluate an expression:
cataTr (const 0) id (+) (*) (Variable "X")

Capture-avoiding substitution function -- Lambda calculus

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.

Maybe Int expression using unique data type

I'm wrote a unique data type to express basic math (addition, mult, etc.) and it works - however, when I try to turn it into a Maybe statement, none of the math works. I believe it's a syntax error but I've tried extra parenthesis and so on and I can't figure it out. Usually Maybe statements are easy but I don't understand why it keeps throwing an issue.
This is the data type I created (with examples):
data Math = Val Int
| Add Math Math
| Sub Math Math
| Mult Math Math
| Div Math Math
deriving Show
ex1 :: Math
ex1 = Add1 (Val1 2) (Val1 3)
ex2 :: Math
ex2 = Mult (Val 2) (Val 3)
ex3 :: Math
ex3 = Div (Val 3) (Val 0)
Here is the code. The only Nothing return should be a division by zero.
expression :: Math -> Maybe Int
expression (Val n) = Just n
expression (Add e1 e2) = Just (expression e1) + (expression e2)
expression (Sub e1 e2) = Just (expression e1) - (expression e2)
expression (Mult e1 e2) = Just (expression e1) * (expression e2)
expression (Div e1 e2)
| e2 /= 0 = Just (expression e1) `div` (expression e2)
| otherwise = Nothing
I get the same error for every individual mathematical equation, even if I delete the others, so I'm certain it's syntax. The error makes it seem like a Maybe within a Maybe but when I do that e1 /= 0 && e2 /= 0 = Just (Just (expression e1)div(expression e2)), I get the same error:
* Couldn't match type `Int' with `Maybe Int'
Expected type: Maybe (Maybe Int)
Actual type: Maybe Int
* In the second argument of `div', namely `(expression e2)'
In the expression: Just (expression e1) `div` (expression e2)
In an equation for `expression':
expression (Div e1 e2)
| e1 /= 0 && e2 /= 0 = Just (expression e1) `div` (expression e2)
| otherwise = Nothing
|
56 | | e1 /= 0 && e2 /= 0 = Just (expression e1) `div` (expression e2)
| ^^^^^^^^^
What am I missing? It's driving me crazy.
So the first issue is precedence. Instead of writing:
Just (expression e1) * (expression e2)
You probably want:
Just (expression e1 * expression e2)
The second issue is the types. Take a look at the type of (*), for instance:
>>> :t (*)
(*) :: Num a => a -> a -> a
It says, for some type a that is a Num, it takes two as and returns one a. Specialised to Int, that would be:
(*) :: Int -> Int -> Int
But expression returns a Maybe Int! So we need some way to multiply with Maybes. Let's write the function ourselves:
multMaybes :: Maybe Int -> Maybe Int -> Maybe Int
multMaybes Nothing _ = Nothing
multMaybes _ Nothing = Nothing
multMaybes (Just x) (Just y) = Just (x * y)
So if either side of the multiplication has failed (i.e. you found a divide-by-zero), the whole thing will fail. Now, we need to do this once for every operator:
addMaybes Nothing _ = Nothing
addMaybes _ Nothing = Nothing
addMaybes (Just x) (Just y) = Just (x + y)
subMaybes Nothing _ = Nothing
subMaybes _ Nothing = Nothing
subMaybes (Just x) (Just y) = Just (x - y)
And so on. But we can see there's a lot of repetition here. Luckily, there's a function that does this pattern already: liftA2.
multMaybes = liftA2 (*)
addMaybes = liftA2 (+)
subMaybes = liftA2 (-)
Finally, there are two more small problems. First, you say:
expression (Div e1 e2)
| e2 /= 0 = Just (expression e1) `div` (expression e2)
But e2 isn't an Int! It's the expression type. You probably want to check if the result of the recursive call is 0.
The second problem is that you're unnecessarily wrapping things in Just: we can remove one layer.
After all of that, we can write your function like this:
expression :: Math -> Maybe Int
expression (Val n) = Just n
expression (Add e1 e2) = liftA2 (+) (expression e1) (expression e2)
expression (Sub e1 e2) = liftA2 (-) (expression e1) (expression e2)
expression (Mult e1 e2) = liftA2 (*) (expression e1) (expression e2)
expression (Div e1 e2)
| r2 /= Just 0 = liftA2 div (expression e1) r2
| otherwise = Nothing
where r2 = expression e2
There are two problems here:
Just (expression e1) + (expression e2)
is interpreted as:
(Just (expression e1)) + (expression e2)
So that means that you have wrapped the left value in a Just, whereas the other one is not, and this will not make much sense.
Secondly, both expression e1 and expression e2 have type Maybe Int, hence that means that you can not add these two together. We can perform pattern matching.
Fortunately there is a more elegant solution: we can make use of liftM2 :: Monad m => (a -> b -> c) -> m a -> m b -> m c for most of the patterns. For Maybe the liftM2 will take a function f :: a -> b -> c and two Maybes, and if both are Justs it will call the function on the values that are wrapped in the Justs and then wrap the result in a Just as well.
As for the division case, we will first have to obtain the result of the denominator with the expression function, and if that is a Just that is not equal to zero, then we can fmap :: Functor f => (a -> b) -> f a -> f b function to map a value in a Just (that of the numerator) given of course the numerator is a Just:
import Control.Monad(liftM2)
expression :: Math -> Maybe Int
expression (Val n) = Just n
expression (Add e1 e2) = liftM2 (+) (expression e1) (expression e2)
expression (Sub e1 e2) = liftM2 (-) (expression e1) (expression e2)
expression (Mult e1 e2) = liftM2 (*) (expression e1) (expression e2)
expression (Div e1 e2) | Just v2 <- expression e2, v2 /= 0 = fmap (`div` v2) (expression e1)
| otherwise = Nothing
or we can, like #RobinZigmond says, use (<$>) :: Functor f => (a -> b) -> f a -> f b and (<*>) :: Applicative f => f (a -> b) -> f a -> f b:
expression :: Math -> Maybe Int
expression (Val n) = Just n
expression (Add e1 e2) = (+) <$> expression e1 <*> expression e2
expression (Sub e1 e2) = (-) <$> expression e1 <*> expression e2
expression (Mult e1 e2) = (*) <$> expression e1 <*> expression e2
expression (Div e1 e2) | Just v2 <- expression e2, v2 /= 0 = (`div` v2) <$> expression e1
| otherwise = Nothing

Unable to get a fully complete beta reduction in Haskell

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.

Haskell Monad equivalent

Are both functions equivalent if we choose them at monadPlusSDif, Maybe as the data type for MonadPlus?
tdif :: Int -> Int -> Maybe Int
tdif x y
| y == 0 = Nothing
| otherwise = Just (div x y)
monadPlusSDif :: MonadPlus m => Int -> Int -> m Int
monadPlusSDif x y = guard (y /= 0) >> return (div x y)
Well, for Maybe the MonadPlus instance is
instance MonadPlus Maybe where
mempty = Nothing
and guard is implemented as
guard b = if b then return () else mempty
-- = if b then Just () else Nothing
With that knowledge, you can use equational reasoning to deduce that, when m is Maybe, you can replace the original code
monadPlusSDif x y = guard (y /= 0) >> return (div x y)
with
monadPlusSDif x y = (if y /= 0
then Just ()
else Nothing) >> Just (div x y)
or
monadPlusSDif x y
| y /= 0 = Just () >>= \_ -> Just (div x y)
| otherwise = Nothing >>= \_ -> Just (div x y)
or
monadPlusSDif x y
| y /= 0 = Just (div x y)
| otherwise = Nothing
or
monadPlusSDif x y
| y == 0 = Nothing
| otherwise = Just (div x y)
so you see that the functions are identical.
These functions will have equivalent behavior if m ~ Maybe, but their compiled byte-code representation will likely be different. You could also implement it with actual guards for general MonadPlus monads as
monadPlusSDif :: MonadPlus m => Int -> Int -> m Int
monadPlusSDif x y
| y == 0 = mzero
| otherwise = return $ x `div` y
Then you could use it as
bigEquation :: Int -> Int -> Maybe Int
bigEquation x y = do
z1 <- monadPlusSDif x y
z2 <- monadPlusSDif (x + y) (x - y)
z3 <- monadPlusSDif y x
return $ z1 + z2 * z3
and the compiler would be able to figure out that in that context, it should use Maybe for m.

Resources