Added support for negation in logical expressions and tidied up some other little bits of the code
This commit is contained in:
parent
6818cdc114
commit
33d18f07c2
|
@ -162,11 +162,29 @@ addBK mp mp2 g nid n = fmap ((,) $ followBK (map keepDefined joined')) n
|
||||||
| op == A.NotEq = noAnd (Or [LessThanOrEqual (addOne lhs) rhs
|
| op == A.NotEq = noAnd (Or [LessThanOrEqual (addOne lhs) rhs
|
||||||
,LessThanOrEqual (addOne rhs) lhs])
|
,LessThanOrEqual (addOne rhs) lhs])
|
||||||
g (A.Monadic _ A.MonadicNot rhs)
|
g (A.Monadic _ A.MonadicNot rhs)
|
||||||
= mempty -- TODO
|
= g $ negateExpr rhs
|
||||||
g _ = mempty
|
where
|
||||||
|
-- It is much easier (and clearer) to do the negation in the AST rather
|
||||||
|
-- than play around with De Morgan's laws and so on to figure out how
|
||||||
|
-- to invert the conjunction of disjunctions
|
||||||
|
negateExpr (A.Monadic _ A.MonadicNot rhs) = rhs
|
||||||
|
negateExpr (A.Dyadic m op lhs rhs)
|
||||||
|
| op == A.And = A.Dyadic m A.Or (negateExpr lhs) (negateExpr rhs)
|
||||||
|
| op == A.Or = A.Dyadic m A.And (negateExpr lhs) (negateExpr rhs)
|
||||||
|
| otherwise = case revOp op of
|
||||||
|
Just op' -> A.Dyadic m op' lhs rhs
|
||||||
|
Nothing -> -- Leave as is, because it won't be used anyway:
|
||||||
|
A.Dyadic m op lhs rhs
|
||||||
|
negateExpr e = e -- As above, leave as is
|
||||||
|
|
||||||
-- conBK :: Or (Var, And BackgroundKnowledge)
|
revOp A.NotEq = Just A.Eq
|
||||||
-- conBK = [zip (repeat v) (snd conInterMed) | v <- fst conInterMed]
|
revOp A.Eq = Just A.NotEq
|
||||||
|
revOp A.LessEq = Just A.More
|
||||||
|
revOp A.MoreEq = Just A.Less
|
||||||
|
revOp A.Less = Just A.MoreEq
|
||||||
|
revOp A.More = Just A.LessEq
|
||||||
|
revOp _ = Nothing
|
||||||
|
g _ = mempty
|
||||||
|
|
||||||
values :: And (Var, Or BackgroundKnowledge)
|
values :: And (Var, Or BackgroundKnowledge)
|
||||||
values = And [
|
values = And [
|
||||||
|
@ -201,6 +219,8 @@ addBK mp mp2 g nid n = fmap ((,) $ followBK (map keepDefined joined')) n
|
||||||
, possCon <- makeNonEmpty (And []) $ deOr convCon
|
, possCon <- makeNonEmpty (And []) $ deOr convCon
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
|
union :: Map.Map Var (And BackgroundKnowledge) -> Map.Map Var (And BackgroundKnowledge)
|
||||||
|
-> Map.Map Var (And BackgroundKnowledge)
|
||||||
union = Map.unionWith mappend
|
union = Map.unionWith mappend
|
||||||
|
|
||||||
makeNonEmpty :: a -> [a] -> [a]
|
makeNonEmpty :: a -> [a] -> [a]
|
||||||
|
|
Loading…
Reference in New Issue
Block a user