Hi I need help with calculating a type. The whole program is suppose to take a string, parse it, and at the end, calculate a value. The string I start with can be like this: "let X = + 1 2 in * X 2 - X". When I parse it, I will get this: "Let (Vari X) (Sum (Lit 1) (Lit 2)) (Mul (Vari X) (Lit 2)))". At this moment, I can parse expressions like this "* + 2 3 * 2 + 6 - 2" and the previous. But I can not calculate the previous expression, "let X = + 1 2 in * X 2 - X". If someone could point me in the the right direction I would be happy, cause right now, I really don't know how I would make this work. Thanks
Code:
data Chara = A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P | Q | R | S | T | U | V | W | X | Y | Z deriving (Eq, Show)
data Number = Single Int | Many Int Number deriving (Eq, Show)
data Expr = Lit Int | Sub Expr | Sum Expr Expr | Mul Expr Expr | Vari Chara | Let Expr Expr Expr
deriving Show
--Want to calculate this
--Let (Vari X) (Sum (Lit 1) (Lit 2)) (Mul (Vari X) (Lit 2)))
calculate :: Expr -> Int
calculate (Sub a) = let e = calculate a in (-e)
calculate (Sum a b) = let e = calculate a
r = calculate b
in (e+r)
calculate (Mul a b) = let e = calculate a
r = calculate b
in (e*r)
calculate (Lit a) = a
You'll need to perform variable substitution in your AST. I.e. you need a function
substitute :: (Chara, Expr) -> Expr -> Expr
which, given a pair of variable to substitute and expression to substitute it with will traverse the tree and perform that substitution. That basically means: if you find a Vari, just replace it with the substitution. If you find anything with subexpressions like Sum a b, recurse down into those subexpressions and then rebuild the operator with the results, i.e.
Sum (substitute s a) (substitute s b)
Then the calculate (Let var subst expr) = ... is a pretty straightforward invocation of the substitute function.
Works like a charm
calculate :: Expr -> Int
calculate (Sub a) = let e = calculate a in (-e)
calculate (Sum a b) = let e = calculate a
r = calculate b
in (e+r)
calculate (Mul a b) = let e = calculate a
r = calculate b
in (e*r)
calculate (Let a b c) = calculate (substitute (getCharaFromExpr a) b c)
calculate (Lit a) = a
substitute :: Chara -> Expr -> Expr -> Expr
substitute x y (Lit a) = Lit a
substitute x y (Vari a) | x == a = y
| otherwise = Vari a
substitute x y (Sum a b) = Sum (substitute x y a) (substitute x y b)
substitute x y (Mul a b) = Mul (substitute x y a) (substitute x y b)
substitute x y (Sub a) = Sub (substitute x y a)
substitute x y (Let a b c) = Let (substitute x y a) (substitute x y b) (substitute x y c)
Related
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.
This question already has answers here:
Haskell ranges and floats
(2 answers)
Is floating point math broken?
(31 answers)
Closed 4 years ago.
If i want to generate a list with the input:
[3.1,5.1..8.1]
GHC 8.6.3 returns:
[3.1,5.1,7.1,9.099999999999998]
My problem here isn't the approximation of 9.1, but why the list made by GHC has one element more than the following solution.
In the documentation I found in GHC.Enum, that enumFromThenTo translates this to something similar to the following:
-- | Used in Haskell's translation of #[n,n'..m]# with
-- #[n,n'..m] = enumFromThenTo n n' m#, a possible implementation
-- being #enumFromThenTo n n' m = worker (f x) (c x) n m#,
-- #x = fromEnum n' - fromEnum n#, #c x = bool (>=) (<=) (x > 0)#
-- #f n y
-- | n > 0 = f (n - 1) (succ y)
-- | n < 0 = f (n + 1) (pred y)
-- | otherwise = y# and
-- #worker s c v m
-- | c v m = v : worker s c (s v) m
-- | otherwise = []#
So the following code:
import Data.Bool
eftt n s m = worker (f x) (c x) n m
where x = (fromEnum s) - (fromEnum n)
c x = bool (>=) (<=) (x > 0)
f n y
| n > 0 = f (n-1) (succ y)
| n < 0 = f (n+1) (pred y)
| otherwise = y
worker s c v m
| c v m = v: worker s c (s v) m
| otherwise = []
On the same input as before, this however returns this list:
[3.1,5.1,7.1]
The real implementation defined in GHC.Enum is the following:
enumFromThenTo x1 x2 y = map toEnum [fromEnum x1, fromEnum x2 .. fromEnum y]
But there is no instantiation of Enum Double or Enum Float in GHC.Enum
So when I tried to reproduce this with the following code:
import Prelude(putStrLn,show)
import GHC.Enum(toEnum,fromEnum,Enum,enumFromThenTo)
import GHC.Base(map)
main = putStrLn (show (_enumFromThenTo 3.1 5.1 8.1))
_enumFromThenTo :: (Enum a) => a -> a -> a -> [a]
_enumFromThenTo x1 x2 y = map toEnum [fromEnum x1, fromEnum x2 .. fromEnum y]
I compiled with:
$ ghc -package ghc -package base <file.hs>
The result was again:
[3.0,5.0,7.0]
What is happening here, such that the output becomes:
[3.1,5.1,7.1,9.099999999999998]
?
Well, this is instance Enum Double
instance Enum Double where
enumFromThenTo = numericEnumThenFromTo
The implementation is here
numericEnumFromThenTo :: (Ord a, Fractional a) => a -> a -> a -> [a]
numericEnumFromThenTo e1 e2 e3
= takeWhile predicate (numericEnumFromThen e1 e2)
where
mid = (e2 - e1) / 2
predicate | e2 >= e1 = (<= e3 + mid)
| otherwise = (>= e3 + mid)
More important than the implementation is the note above it:
-- These 'numeric' enumerations come straight from the Report
Which refers to this passage in the (2010) Report:
For Float and Double, the semantics of the enumFrom family is given by the rules for Int above, except that the list terminates when the elements become greater than e3 + i∕2 for positive increment i, or when they become less than e3 + i∕2 for negative i.
(Where e3 refers to the upper bound, and i the increment.)
The comment you found on Enum and the implementation in class Enum are both irrelevant. The comment is just example code detailing how an instance might be implemented, and the implementation given is inside a class, and thus may be overridden with anything.
I have many methods that have boilerplate code in their definition, look at the example above.
replace:: Term -> Term -> Formula -> Formula
replace x y (Not f) = Not $ replace x y f
replace x y (And f g) = And (replace x y f) (replace x y g)
replace x y (Or f g) = Or (replace x y f) (replace x y g)
replace x y (Biimp f g) = Biimp (replace x y f) (replace x y g)
replace x y (Imp f g) = Imp (replace x y f) (replace x y g)
replace x y (Forall z f) = Forall z (replace x y f)
replace x y (Exists z f) = Exists z (replace x y f)
replace x y (Pred idx ts) = Pred idx (replace_ x y ts)
As you can see, the definitions for replace function follows a pattern. I want to have the same behavior of the function, simplifying his definition, probably using some pattern matching, maybe with a wildcard _ or X over the arguments, something like:
replace x y (X f g) = X (replace x y f) (replace x y g)
For avoiding the following definitions:
replace x y (And f g) = And (replace x y f) (replace x y g)
replace x y (Or f g) = Or (replace x y f) (replace x y g)
replace x y (Biimp f g) = Biimp (replace x y f) (replace x y g)
replace x y (Imp f g) = Imp (replace x y f) (replace x y g)
Is there some way? Forget about the purpose of the function, it could be whatever.
If you have many constructors that should be treated in a uniform way, you should make your data type reflect that.
data BinOp = BinAnd | BinOr | BinBiimp | BinImp
data Quantifier = QForall | QExists
data Formula = Not Formula
| Binary BinOp Formula Formula -- key change here
| Quantified Quantifier Formula
| Pred Index [Formula]
Now the pattern match for all binary operators is much easier:
replace x y (Binary op f g) = Binary op (replace x y f) (replace x y g)
To preserve existing code, you can turn on PatternSynonyms and define the old versions of And, Or, and so on back into existence:
pattern And x y = Binary BinAnd x y
pattern Forall f = Quantified QForall f
I'm not entirely sure this is what you are looking for but you could do the following. The idea is that you can consider a formula to be abstracted over another type (usually a Term in your case). Then, you can define what it means to map over a formula. I tried to replicate your data definitions, although I have some problems with Formula - namely that all the constructors seem to require another Formula...
{-# LANGUAGE DeriveFunctor #-}
data Formula a
= Not (Formula a)
| And (Formula a) (Formula a)
| Or (Formula a) (Formula a)
| Biimp (Formula a) (Formula a)
| Imp (Formula a) (Formula a)
| Forall a (Formula a)
| Exists a (Formula a)
| Pred a (Formula a)
deriving (Functor)
data Term = Term String {- However you define it, doesn't matter -} deriving (Eq)
replace :: (Functor f, Eq a) => a -> a -> f a -> f a
replace x y = fmap (\z -> if x == z then y else z)
The interesting thing to note is that now the replace function can be applied to anything that is a functor - it even serves as replace for a list!
replace 3 9 [1..6] = [1,2,9,4,5,6]
EDIT As an afterthought, if you are implementing a substitution style replace where terms in formulas can be shadowed (the usual scoping rules), you will probably end up doing something like this:
replace' :: (Eq a) => a -> a -> Formula a -> Formula a
replace' x y f#(Forall z _) | x == z = f
replace' x y f#(Exists z _) | x == z = f
replace' x y f#(Pred z _) | x == z = f
replace' x y formula = fmap (replace' x y) formula
Which isn't as cute, but also isn't as straightforward pf a problem.
Data.Functor.Foldable abstracts the pattern of recursive data structures:
import Data.Functor.Foldable
data FormulaF t
= Not t
| And t t
| Or t t
| Biimp t t
| Imp t t
| Forall A t
| Exists A t
| Pred B C
deriving (Functor, Foldable, Traversable)
type Formula = Fix FormulaF
replace :: Term -> Term -> Formula -> Formula
replace x y = cata $ \case ->
Pred idx ts -> Pred idx (replace_ x y ts)
f -> f
By the way, beware of replace x y (Forall x (f x)) = Forall x (f y): Substitution is the process of replacing all free occurences of a variable in an expression with an expression.
Data type for arithmetic expressions with let bindings in haskell
Here's a variant of the original Expr type that adds variables (V) and let bindings (Let).
data Expr = C Float | V String
| Let [(String, Expr)] Expr
| Expr :+ Expr | Expr :- Expr
| Expr :* Expr | Expr :/ Expr
To help write evaluate, you may want to start with a function that does variable substitution:
data Expr = C Float | V String
| Let [(String, Expr)] Expr
| Expr :+ Expr | Expr :- Expr
| Expr :* Expr | Expr :/ Expr
deriving Show
-- | #sub var value e# replaces variables named #var# with the value #value#
-- wherever anywhere that variable occurs in expression #e#.
sub :: String -> Expr -> Expr -> Expr
-- "let x = y in x" = y
sub v1 value (V v2) | v1 == v2 = value
-- "let x = y in z" = z
sub _ _ e#(V _) = e
-- Constants are unaffected
sub _ _ c#(C _) = c
-- For operators, apply #sub a b# recursively to the operands.
sub a b (e1 :+ e2) = (sub a b e1) :+ (sub a b e2)
sub a b (e1 :- e2) = (sub a b e1) :- (sub a b e2)
sub a b (e1 :* e2) = (sub a b e1) :* (sub a b e2)
sub a b (e1 :/ e2) = (sub a b e1) :/ (sub a b e2)
-- The variable is shadowed by a let binding, so only substitute
-- into the bindings, and leave the body expression unmodified.
sub a b (Let bindings e) | bindingsContains a bindings =
Let (subIntoBindings a b bindings) e
-- Apply #sub a b# recursively to the body of the let expression.
sub a b (Let bindings body) =
Let (subIntoBindings a b bindings) (sub a b body)
bindingsContains :: String -> [(String, Expr)] -> Bool
bindingsContains x bindings =
Data.Maybe.isJust $ Data.List.find ((== x) . fst) bindings
subIntoBindings :: String -> Expr -> [(a, Expr)] -> [(a, Expr)]
subIntoBindings a b bindings = (fmap . fmap) (sub a b) bindings
Learning Haskell and I am not sure why I don't get the expected result, given these definitions:
instance Ring Integer where
addId = 0
addInv = negate
mulId = 1
add = (+)
mul = (*)
class Ring a where
addId :: a -- additive identity
addInv :: a -> a -- additive inverse
mulId :: a -- multiplicative identity
add :: a -> a -> a -- addition
mul :: a -> a -> a -- multiplication
I wrote this function
squashMul :: (Ring a) => RingExpr a -> RingExpr a -> RingExpr a
squashMul x y
| (Lit mulId) <- x = y
| (Lit mulId) <- y = x
squashMul x y = Mul x y
However:
*HW05> squashMul (Lit 5) (Lit 1)
Lit 1
If I write one version specifically for Integer:
squashMulInt :: RingExpr Integer -> RingExpr Integer -> RingExpr Integer
squashMulInt x y
| (Lit 1) <- x = y
| (Lit 1) <- y = x
squashMulInt x y = Mul x y
Then I get the expected result.
Why does (Lit mulId) <- x match even when x is not (Lit 1) ?
Variables used in pattern matching are considered to be local variables. Consider this definition for computing the length of a list:
len (x:xs) = 1 + len xs
len _ = 0
Variables x and xs are local variables to this definition. In particular, if we add a definition for a top-level variable, as in
x = 10
len (x:xs) = 1 + len xs
len _ = 0
this does not affect the meaning for len. More in detail, the first pattern (x:xs) is not equivalent to (10:xs). If it were interpreted in that way, we would now have len [5,6] == 0, breaking the previous code! Fortunately, the semantics of pattern matching is robust to such new declarations as x=10.
Your code
squashMul :: (Ring a) => RingExpr a -> RingExpr a -> RingExpr a
squashMul x y
| (Lit mulId) <- x = y
| (Lit mulId) <- y = x
squashMul x y = Mul x y
actually means
squashMul :: (Ring a) => RingExpr a -> RingExpr a -> RingExpr a
squashMul x y
| (Lit w) <- x = y
| (Lit w) <- y = x
squashMul x y = Mul x y
which is wrong, since w can be arbitrary. What you want is probably:
squashMul :: (Eq a, Ring a) => RingExpr a -> RingExpr a -> RingExpr a
squashMul x y
| (Lit w) <- x , w == mulId = y
| (Lit w) <- y , w == mulId = x
squashMul x y = Mul x y
(The Eq a constraint may depend on the definition of RingExpr, which was not posted)
You can also simplify everything to:
squashMul :: (Eq a, Ring a) => RingExpr a -> RingExpr a -> RingExpr a
squashMul x#(Lit w) y | w == mulId = y
squashMul x y#(Lit w) | w == mulId = x
squashMul x y = Mul x y
or even to:
squashMul :: (Eq a, Ring a) => RingExpr a -> RingExpr a -> RingExpr a
squashMul (Lit w) y | w == mulId = y
squashMul x (Lit w) | w == mulId = x
squashMul x y = Mul x y
This version does not even use pattern guards, since there's no need to.