I have a type that looks like this, and I would like the compare function to only take into account the size of the integer.
data Cell = FromLeft Coordinate Int
| FromTop Coordinate Int
| FromDiagonal Coordinate Int
| Empty Coordinate
deriving (Eq, Read, Show)
The following code works, but I would prefer something more elegant
instance Ord Cell where
compare (FromLeft _ x) (FromLeft _ y) = compare x y
compare (FromRight _ x) (FromLeft _ y) = compare x y
[...]
You could define an auxiliary function:
extractInt :: Cell -> Int
extractInt (FromLeft _ x) = x
extractInt (FromTop _ x) = x
extractInt (FromDiagonal _ x) = x
extractInt Empty = ???
and then
instance Ord Cell where
compare c1 c2 = compare (extractInt c1) (extractInt c2)
But be carefull: The above instance violates the antisymmetry law that states that if x<=y and y<=x then x==y. So it is not really defining an order but rather a preorder.
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
I made the pattern where if you give it only a number it's gonna return the Value. I would just add deriving (Show) to Val as well but that doesn't work because of (Val->Val) (that's what I understood from the error messages). Anyone know what I could do ?
import GHC.Show (Show)
type Var = String
-- Expressions of source code in the form of a Abstract syntax tree
data Exp = Enum Int -- constant
|Evar Var -- variable
|Elet Var Exp Exp -- expr "let x = e1 in e2"
|Ecall Exp Exp -- Function call
deriving (Show)
-- returned values
data Val = Vnum Int -- Whole number
|Vprim (Val->Val) -- A primitive
mkPrim::(Int->Int->Int)->Val
mkPrim f = Vprim(\(Vnum x) -> Vprim (\(Vnum y) -> Vnum (f x y)))
-- Initial environement that contains all primitives
type Env = [(Var, Val)]
pervasive::Env
pervasive = [("+", mkPrim (+)), ("-", mkPrim (-)),("*", mkPrim (*)), ("/", mkPrim div)]
eval::Env->Exp->Val
eval pervasive (Enum n) = Vnum n
sampleExp = Elet "x" (Enum 3) (Ecall (Ecall (Evar "+") (Evar "x")) (Enum 4))
main = do print(eval pervasive (Enum 4))
Consider implementing a custom Show instance:
instance Show Val where
show (Vnum n) = show n
show (Vprim _) = "<prim>"
This however shall make printed primitives indistinguishable. It might be convenient to equip prims with names:
data Val = Vnum Int | Vprim String (Val -> Val)
instance Show Val where
show (Vnum n) = show n
show (Vprim name _) = name
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]].
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.
I'm fairly new to Haskell and have a question about pattern-matching.
Here is a heavily simplified version of the code:
data Value = MyBool Bool | MyInt Integer
codeDuplicate1 :: Value -> Value -> IO Value
codeDuplicate1 = generalFunction True
codeDuplicate2 :: Value -> Value -> IO Value
codeDuplicate2 = generalFunction False
generalFunction :: Bool -> Value -> Value -> IO Value
generalFunction b x1 x2 = do result <- eval x1
case result of
MyBool b -> do putStrLn $ show b
return (MyBool b)
_ -> eval x2
eval :: Value -> IO Value
eval (MyInt x) | x > 10 = return (MyInt 10)
| x > 5 = return (MyBool True)
| otherwise = return (MyBool False)
Now, I realize that the argument b in generalFunction is not the same as the b in the case part, and therefore, this code will print b regardless of the input. I used the same name just to show my intentions. So my question is:
Is there a way to match the first b with the second, so that if the bs are the same it will print, otherwise it will evaluate x2? And, if there isn't, is there another good way to get the intended result?
I almost found the answer in this question, but I think this situation is slightly different.
You can use a guarded pattern. The first alternative will be executed if MyBool is matched and b == b2; otherwise the second alternative will be executed.
case result of
MyBool b2 | b == b2 -> do {print b; return $ MyBool b}
_ -> eval x2