I'm working with the lambda calculus implemented in haskell. Expressions:
%x.e -- lambda abstraction, like \x->e in Haskell
e e' -- application
x,y,z -- variables
succ, pred, ifzero, 0, 1, 2....
Syntax:
type Id = String
-- The "builtin" functions.
data Op = Succ | Pred | IfZero
deriving (Show, Ord, Eq)
-- Expressions of L
data Exp = Var Id
| Nat Integer
| Op Op
| Lam Id Exp
| App Exp Exp
deriving (Ord, Eq, Show)
There's also a function that converts the usual representation into Exp:
parse "%f. f 1 2" = Lam "f" App (App (Var "f") (Nat 1)) (Nat 2)`
And I have to write the function subst x e e' that will substitute e for all "free" occurrences of (Var x) in e'. "Free" means that the variable it is not declared by a surrounding %. For example, in the expression
x (%x. x (%y.xz)) (%y.x)
there are 5 occurrences of x. The first is "free". The second is the parameter for the % expression and is never substituted for. The third and fourth occurrences refer to the parameter of the enclosing % expression. The fifth is free. Therefore if we substitute 0 for x we get 0 (%x. x (%y.xz)) (%y.0).
All I need to use is pattern-matching and recursion. All I was able to write is the function prototype as
subst :: Id -> Exp -> Exp -> Exp
subst x (App z z') (App e e') =
If somebody could give me a hint how to implement the function it would be great. Any help is highly appreciated
I'd like to first point out that the pattern matching (subst x (App z z') (App e e')) is non-exhaustive. (Most of) the other patterns are trivial, so it's easy to forget them. I'd suggest against pattern matching the third argument, because if all you're doing is subsituting it into the second argument, you don't care if it's an Application or Natural.
The first step in most recursive functions is to consider cases. What's the base case? In this situation, it's where the second argument is equal to Var x:
-- Replace x with y in a Var. If the Var is equal to x, replace
-- otherwise, leave alone.
subst x (Var a) y
| a == x = y
| otherwise = (Var a)
Then we need to consider the step cases, what if it's an application, and what if it's a lambda abstraction?
-- Replace x with y in an application. We just need to replace
-- x with y in z and in z', because an application doesn't
-- bind x (x stays free in z and z').
subst x (App z z') y = (App new_z new_z')
where new_z = -- Recursively call subst here.
new_z' = -- And recursively call subst here, too.
-- Replace x with y in a lambda abstraction. We *do* need to
-- check to make sure that the lambda doesn't bind x. If the
-- lambda does bind x, then there's no possibility of x being
-- free in e, and we can leave the whole lambda as-is.
subst x (Lam z e) y
| z == x = (Lam z e)
| otherwise = (Lam z new_e)
where new_e = -- Recursively call subst here.
Finally, all the trivial cases are the same (we leave alone both Nat and Op, since there's no chance we would be substituting them):
subst :: Id -> Exp -> Exp -> Exp
subst _ nat_or_op _ = nat_or_op
Related
I want to return the left association of an expression given (haskell), so if we have a + (b + c) the function has to return (a + b) + c, this also applies for the multiplication since these 2 operations are associative. taking onto consideration the other operations that are not associative therefor I have to put a condition to not left associate those expressions.
so the leftAssociate function turns every expression given into an equivalent left-associated one with the same constants
the function is defined as follow :
data Expr = Val Int | App Op Expr Expr
leftAssociate :: Expr -> Expr
leftAssociate (App Add (Val a) (App Add (Val b) (Val c))) = App Add (App Add (Val a) (Val b)) (Val c)
I have tried pattern matching but it's too overwhelming as there is a lot of possibilities and also I cannot specify the number of operations given as input as it's not limited.
You say
we consider it left-balances [sic] if it has no subexpressions of shape App Op x ( App Op y z) and that's only when the operation is Addition or Multiplication
I therefore propose that you structure your function for fixing this defect in the way you described:
leftAssociate (App Add x (App Add y z)) = -- ...
leftAssociate (App Mul x (App Mul y z)) = -- ...
leftAssociate (App op x y) = -- ...
leftAssociate (Val n) = -- ...
Presumably in the first three cases you will make recursive calls at some point to make sure that the x, y, and z subterms are also left-associated. This recursion will be the mechanism that allows you to handle arbitrarily large expressions.
I find it easiest to conceptualize this like so: for each subtree rooted at an App op _ _ node with an op you want to re-associate, you can collect all the terms at the top of the subtree being combined with that same App op into a flattened list, and then create a left associated tree with a foldl1 from that list. This gives the following solution:
data Expr = Val Int | App Op Expr Expr deriving (Show)
data Op = Add | Mul | Sub deriving (Show, Eq)
-- Identify which operators should be re-associated
isAssoc :: Op -> Bool
isAssoc Add = True
isAssoc Mul = True
isAssoc _ = False
leftAssociate :: Expr -> Expr
leftAssociate a#(App op _ _)
| isAssoc op = foldl1 (App op) $ opTerms a
where opTerms :: Expr -> [Expr]
opTerms (App op' x' y') | op' == op = opTerms x' ++ opTerms y'
opTerms e = [leftAssociate e]
leftAssociate (App op x y) = App op (leftAssociate x) (leftAssociate y)
leftAssociate e = e
You can technically get rid of the intermediate flattened list by constructing the left associated tree directly and defining a concatenation function for left associated trees, and I think that would give you the sort of direct recursive solution being discussed in the other answer, but I found this version easier to write.
Here's a test case:
mul = App Mul
add = App Add
sub = App Sub
ex1 = leftAssociate (add (Val 1) (sub (mul (Val 2) (mul (Val 3) (Val 4)))
(add (add (Val 5) (Val 6)) (add (Val 7) (Val 8)))))
main = print $ leftAssociate ex1
TL;DR:
instead of turning:
+
/ \
/ \
a +
/ \
/ \
b c
into
+
/ \
/ \
+ c
/ \
/ \
a b
I'd suggest to alter the tree to be non-binary:
+
/|\
/ | \
a b c
Longer Explanation
if we have a + (b + c) the function has to return (a + b) + c
I would not do that. I would choose a different representation than Expr = Val Int | App Op Expr Expr. Expr as binary tree is not associative. How about
data AssocExpr = AVal Int | AApp Op [Expr]
Lists are associative by design. You can keep both data structures around and convert to AssocExpr when you need the associativity. And if you really need it, you can still convert back and thereby achieve the initial goal.
To transform from Expr to AssocExpr, you can modify leftAssociate from K. A. Buhr's answer and eliminate the foldl1:
associate :: Expr -> AssocExpr
associate a#(App op _ _)
| isAssoc op = AApp op $ opTerms a
...
Related Codereview (from myself):
https://codereview.stackexchange.com/questions/254288/parametrize-by-type-constructor/254572#254572
If I have a datatype representing a subset of propositional logic such as
data Prop = Lit String
| Neg Prop
| And Prop Prop
| Or Prop Prop
Are there then easy ways to do generic transformations on [[Prop]]? E.g.
replace [[And a b, c]] with [[a, b, c]]
replace [[Or a b, c]] with [[a], [b], [c]], or
removing occurrences of sublists containing both Neg a and a, e.g. turning [[Neg a, x, a], [b]] into [[b]]
This feels like something close to what e.g. uniplate does, but “two levels up”.
I assume that your second rule is wrong, and you really meant to say either:
replace [[Or a b],[c]] with [[a],[b],[c]]
or else:
replace [[Or a b, c]] with [[a,c],[b,c]]
In other words, I assume you're trying to convert a Prop into an alternate representation [[Prop]] where the first-level list is an "or" and the second-level lists are "and"s, with all terms being either literals or Neg-literals. So, you're trying to imagine how you could apply a bunch of generic structural rules to make transformations like:
[[And a (Or b c)]]
[[a, Or b c]] -- apply "And" rule
[[a,b],[a,c]] -- apply some kind of "Or" distribution rule
If so, having generic transformations isn't much use. With your current datatype, you can only apply these transformations to top-level expressions anyway. For example, there's no obvious way to apply an Or rule here:
[[And a (And b (Or c d))]]
without first applying And rules a couple of times. If you change your data type to add, say, an L2 [[Prop]] constructor, so you can transform the above expression to:
[[And a (And b (L2 [[c],[d]]))]] -- apply "Or" rule
it's not clear what that buys you.
Ultimately, I don't think this is the right approach...
You have a perfectly adequate representation of your prepositional logic in the Prop data type; and you have a desired final representation. Instead of trying to translate your Prop representation into the final representation using piecemeal generic transformations, transform your Prop representation using standard recursive Prop-to-Prop transformations into a canonical Prop form, and do the translation as the final step.
Here, a reasonable canonical form is:
Or e1 (Or e2 (... (Or e3 e4)))
where each ek is of form:
And t1 (And t2 (... (And t3 t4)))
and each tk is either a Lit _ or a Neg (Lit _). Obviously, this canonical form can be translated pretty easily into the desired final representation as a [[Prop]].
I've included a possible solution below. I don't see that much opportunity for simplifying things via generic transformations. Most of the pattern matching seems to be doing non-trivial work.
Possible Solution
After a bit of preamble:
import Data.List
data Prop = Lit String
| Neg Prop
| And Prop Prop
| Or Prop Prop
deriving (Eq)
then one way to translate an arbitrary Prop into this canonical form is to first push all the Negs down to the literal terms:
pushNeg :: Prop -> Prop
pushNeg = push False
where
-- de Morgan's laws
push neg (And x y) = (if neg then Or else And) (push neg x) (push neg y)
push neg (Or x y) = (if neg then And else Or) (push neg x) (push neg y)
-- handle Neg and Lit
push neg (Neg y) = push (not neg) y
push neg (Lit l) = if neg then Neg (Lit l) else Lit l
then push all the Ands down on top of them. This is tougher to get right, but I think the following is correct, even though it does a bit of unnecessary work in some cases:
pushAnd :: Prop -> Prop
pushAnd (Or x y) = Or (pushAnd x) (pushAnd y)
pushAnd (And x y)
= let x' = pushAnd x
in case x' of
Or u v -> Or (pushAnd (And u y)) (pushAnd (And v y))
_ -> let y' = pushAnd y
in case y' of
Or u v -> Or (pushAnd (And x' u)) (pushAnd (And x' v))
_ -> And x' y'
pushAnd x = x
and then recursively make all the And and Or clauses right-associative:
rassoc :: Prop -> Prop
rassoc (Or (Or x y) z) = rassoc (Or x (Or y z))
rassoc (Or x z) = Or (rassoc x) (rassoc z)
rassoc (And (And x y) z) = rassoc (And x (And y z))
rassoc (And x z) = And x (rassoc z)
rassoc x = x
and finally convert the canonical form to its final representation (dropping the inconsistent clauses and duplicate terms while we're at it):
translate :: Prop -> [[Prop]]
translate = nub . map nub . filter consistent . doOr
where
doOr x = case x of
Or x y -> doAnd x : doOr y
x -> doAnd x : []
doAnd x = case x of
And x y -> x : doAnd y
x -> x : []
consistent lits =
let (falses, trues) = partition isNeg lits
falses' = map (\(Neg (Lit l)) -> l) falses
trues' = map (\ (Lit l) -> l) trues
in null (intersect falses' trues')
isNeg (Neg x) = True
isNeg _ = False
The whole pipeline is:
final :: Prop -> [[Prop]]
final = translate . rassoc . pushAnd . pushNeg
and here's some test code:
a = Lit "a"
b = Lit "b"
c = Lit "c"
d = Lit "d"
e = Lit "e"
-- Show instance, but only for `final` forms
instance Show Prop where
show (Lit x) = x
show (Neg (Lit x)) = '~':x
main :: IO ()
main = do print $ final (Neg a)
print $ final (Or a b)
print $ final (Or a a)
print $ final (And a b)
print $ final (And (Or (And (Or a b) c) d) e)
print $ final (And (Or (Or a b) c) (Neg (And a (Or b d))))
which outputs:
[[~a]]
[[a],[b]]
[[a]]
[[a,b]]
[[a,c,e],[b,c,e],[d,e]]
[[a,~b,~d],[b,~a],[c,~a],[c,~b,~d]]
There's still some opportunity for further simplification, as:
final (And a (Or a b))
gives final form [[a],[a,b]] instead of just [[a]].
There is GenProg (http://hackage.haskell.org/package/genprog) for example, but that only deals with numerical optimization, in this case finding an equation that describes the data.
But I require for loops, if statements, when statements, Boolean checks etc. I need to be able to generate imperative structures. Any thought on this? My best options so far seem to be husk-scheme where I can run Scheme code as a DSL in Haskell. Surely there must be better ways?
If you're looking for something akin to S-expressions, this is fairly easily modeled in Haskell. Say, for example, we want to represent simple algebraic equations with variables, such as
x + 5 / (y * 2 - z)
This can be represented by a simple AST in Haskell, in particular we can implement it as
data Expr
= Lit Double -- Literal numbers
| Var Char -- Variables have single letter names
| Add Expr Expr -- We can add things together
| Sub Expr Expr -- And subtract them
| Mul Expr Expr -- Why not multiply, too?
| Div Expr Expr -- And divide
deriving (Eq)
This would let us express the equation above as
Add (Var 'x') (Div (Lit 5) (Sub (Mul (Var 'y') (Lit 2)) (Var 'z')))
But this is rather clunky to write and difficult to read. Let's start by working some Show magic so that it gets pretty printed:
instance Show Expr where
showsPrec n (Lit x) = showParen (n > 10) $ showsPrec 11 x
showsPrec n (Var x) = showParen (n > 10) $ showChar x
showsPrec n (Add x y) = showParen (n > 6) $ showsPrec 7 x . showString " + " . showsPrec 7 y
showsPrec n (Sub x y) = showParen (n > 6) $ showsPrec 7 x . showString " - " . showsPrec 7 y
showsPrec n (Mul x y) = showParen (n > 7) $ showsPrec 8 x . showString " * " . showsPrec 8 y
showsPrec n (Div x y) = showParen (n > 7) $ showsPrec 8 x . showString " / " . showsPrec 8 y
If you don't understand everything going on here, that's ok, it's a lot of complication made easy by some built in functions for efficiently building strings with parentheses in them properly and all that fun stuff. It's pretty much copied out of the docs in Text.Show. Now if we print out our expression from above, it'll look like
x + 5.0 / (y * 2.0 - z)
Now for simplifying building these expressions. Since they're pretty much numeric, we can implement Num (except for abs and signum) and Fractional:
instance Num Expr where
fromInteger = Lit . fromInteger
(+) = Add
(-) = Sub
(*) = Mul
abs = undefined
signum = undefined
instance Fractional Expr where
(/) = Div
fromRational = Lit . fromRational
Now we can input out expression from above as
Var 'x' + 5 / (Var 'y' * 2 - Var 'z')
This is at least much easier to visually parse, even if we have to specify the variables manually.
Now that we have pretty input and output, let's focus on evaluating these expressions. Since we have variables in here, we'll need some sort of environment that associates a variable with a value
import Data.Map (Map)
import qualified Data.Map as M
type Env = Map Char Double
And now it's just basic pattern matching (along with a helper function)
import Control.Applicative
binOp :: (Double -> Double -> Double) -> Expr -> Expr -> Env -> Maybe Double
binOp op x y vars = op <$> evalExpr x vars <*> evalExpr y vars
evalExpr :: Expr -> Env -> Maybe Double
evalExpr (Lit x) = const $ Just x
evalExpr (Var x) = M.lookup x
evalExpr (Add x y) = binOp (+) x y
evalExpr (Sub x y) = binOp (-) x y
evalExpr (Mul x y) = binOp (*) x y
evalExpr (Div x y) = binOp (/) x y
Now we can use evalExpr to evaluate an expression in our mini-language with variable substitution. All the error handling if there's an undefined variable is done by the Maybe monad, and we were even able to cut down on repetition by making the environment argument implicit. This is all pretty standard for a simple expression DSL.
So for the fun bit, generating random expressions and (eventually) mutations. For this, we'll need System.Random. We want to be able to generate expressions of varying complexity, so we'll express it in rough depth. Since it's random, there is a chance that we'll get shorter or deeper trees than specified. This will probably be something that you'll want to tweak and tune to get your desired results. First, because I have the foresight of having written this code already, let's define two helpers for generating a random literal and a random variable:
randomLit, randomVar :: IO Expr
randomLit = Lit <$> randomRIO (-100, 100)
randomVar = Var <$> randomRIO ('x', 'z')
Nothing exciting here, we get doubles between -100 and 100, and up to 3 variables. Now we can generate large expression trees.
generateExpr :: Int -> IO Expr
-- When the depth is 1, return a literal or a variable randomly
generateExpr 1 = do
isLit <- randomIO
if isLit
then randomLit
else randomVar
-- Otherwise, generate a tree using helper
generateExpr n = randomRIO (0, 100) >>= helper
where
helper :: Int -> IO Expr
helper prob
-- 20% chance that it's a literal
| prob < 20 = randomLit
-- 10% chance that it's a variable
| prob < 30 = randomVar
-- 15% chance of Add
| prob < 45 = (+) <$> generateExpr (n - 1) <*> generateExpr (n - 1)
-- 15% chance of Sub
| prob < 60 = (-) <$> generateExpr (n - 1) <*> generateExpr (n - 1)
-- 15% chance of Mul
| prob < 75 = (*) <$> generateExpr (n - 1) <*> generateExpr (n - 1)
-- 15% chance of Div
| prob < 90 = (/) <$> generateExpr (n - 1) <*> generateExpr (n - 1)
-- 10% chance that we generate a possibly taller tree
| otherwise = generateExpr (n + 1)
The bulk of this function is just specifying the probabilities that a given node will be generated, and then generating the left and right nodes for each operator. We even got to use the normal arithmetic operators since we overloaded Num, how handy!
Now, remember that we can still pattern match on the constructors of this Expr type for other operations, such as replacing nodes, swapping them, or measuring the depth. For this, you just have to treat it as any other binary tree type in Haskell, except it has 2 leaf constructors and 4 node constructors. As for mutations, you'll have to write code that traverses this structure and chooses when to swap out nodes and what to swap them out with. It'll live within the IO monad since you'll be generating random values, but it shouldn't be too difficult. This structure should be pretty easy to extend as need be, such as if you wanted to add trig functions and exponentiation, you'd just need more constructors, more expressions in evalExpr, and the appropriate clauses in helper, along with some probability adjustments.
You can get the full code for this example here. Hope this helps you see how to formulate something like S-expressions in Haskell.
I'm trying to implement with Haskell an algorithm to manipulate mathematical expressions.
I have this data type :
data Exp = Var String | IVal Int | Add Exp Exp
This will be enough for my question.
Given a set of expression transformations, for example :
(Add a b) => (Add b a)
(Add (Add a b) c) => (Add a (Add b c))
And an expression, for example : x = (Add (Add x y) (Add z t)), I want to find all expressions in the neighborhood of x. Given that neighborhood of x is defined as: y in Neighborhood(x) if y can be reached from x within a single transformation.
I am new to Haskell. I am not even sure Haskell is the right tool for this job.
The final goal is to get a function : equivalent x which returns a set of all expressions that are equivalent to x. In other words, the set of all expressions that are in the closure of the neighborhood of x (given a set of transformations).
Right now, I have the following :
import Data.List(nub)
import Data.Set
data Exp = IVal Int
| Scalar String
| Add Exp Exp
deriving (Show, Eq, Ord)
commu (Add a b) = (Add b a)
commu x = x
assoc (Add (Add a b) c) = (Add a (Add b c))
assoc (Add a (Add b c)) = (Add (Add a b) c)
assoc x = x
neighbors x = [commu x, assoc x]
equiv :: [Exp] -> [Exp]
equiv closure
| closure == closureUntilNow = closure
| otherwise = equiv closureUntilNow
where closureUntilNow = nub $ closure ++ concat [neighbors x|x<-closure]
But It's probably slower than needed (nub is O(n^2)) and some terms are missing.
For example, if you have f = (x+y)+z, then, you will not get (x+z)+y, and some others.
Imports, etc. below. I'll be using the multiset package.
import Control.Monad
import Data.MultiSet as M
data Exp = Var String | IVal Int | Add Exp Exp deriving (Eq, Ord, Show, Read)
A bit of paper-and-pencil work shows the following fact: expressions e1 and e2 are in the congruence closure of your relation iff the multiset of leaves are equal. By leaves, I mean the Var and IVal values, e.g. the output of the following function:
leaves :: Exp -> MultiSet Exp
leaves (Add a b) = leaves a `union` leaves b
leaves e = singleton e
So this suggests a nice clean way to generate all the elements in a particular value's neighborhood (without attempting to generate any duplicates in the first place). First, generate the multiset of leaves; then nondeterministically choose a partition of the multiset and recurse. The code to generate partitions might look like this:
partitions :: Ord k => MultiSet k -> [(MultiSet k, MultiSet k)]
partitions = go . toOccurList where
go [] = [(empty, empty)]
go ((k, n):bag) = do
n' <- [0..n]
(left, right) <- go bag
return (insertMany k n' left, insertMany k (n-n') right)
Actually, we only want partitions where both the left and right part are non-empty. But we'll check that after we've generated them all; it's cheap, as there's only two that aren't like that per invocation of partitions. So now we can generate the whole neighborhood in one fell swoop:
neighborhood :: Exp -> [Exp]
neighborhood = go . leaves where
full = guard . not . M.null
go m
| size m == 1 = toList m
| otherwise = do
(leftBag, rightBag) <- partitions m
full leftBag
full rightBag
left <- go leftBag
right <- go rightBag
return (Add left right)
By the way, the reason you're not getting all the terms is because you're generating the reflexive, transitive closure but not the congruence closure: you need to apply your rewrite rules deep in the term, not just at the top level.
Reading through Why It’s Nice to be Quoted, in section 3 there's an example of splicing a variable identifier in a quasiquote.
subst [:lam | $exp:e1 $exp:e2 |] x y =
let e1' = subst e1 x y
e2' = subst e2 x y
in
[:lam | $exp:e1' $exp:e2' |]
I see why the recursive calls to subst are done outside the [:lam| ... |], it's because the function antiVarE in section 3.2 builds a TH.varE out of the variable name.
My question is how much work would be required to support arbitrary expression splices beyond just a variable name?
For example:
subst [:lam | $exp:e1 $exp:e2 |] x y =
[:lam | $exp:(subst e1 x y) $exp:(subst e2 x y) |]
Answering my own question for posterity.
Turns out it was quite simple. Using the parseExp function in haskell-src-meta package I was able to easily convert a string to AST fragment.
In the original paper, aside from the parser changes required to capture an expression string between parentheses, the antiExpE function could be rewritten as such.
antiExpE :: Exp -> Maybe TH.ExpQ
antiExpE (AE v) =
case parseExp v of
Right exp -> Just . return $ exp
Left _ -> Nothing
antiExpE = Nothing