module FeatureTrace where
import Feature
import Tree
import AST
import Grammar
import Logic
import Propositions
import NullPropositions
import Data.Set
import Simplify ( removeRedundancy )
import Util ( nothingIf )
type FeatureTrace g a = Node g a -> FeatureFormula
emptyTrace :: FeatureTrace g a
emptyTrace :: FeatureTrace g a
emptyTrace _ = Maybe (PropositionalFormula Feature)
forall a. Maybe a
Nothing
simplifyFeatureTrace :: (Grammar g, Show a, Eq a) => FeatureTrace g a -> AST g a -> FeatureTrace g a
simplifyFeatureTrace :: FeatureTrace g a -> AST g a -> FeatureTrace g a
simplifyFeatureTrace f :: FeatureTrace g a
f t :: AST g a
t v :: Node g a
v = case (AST g a -> FeatureTrace g a -> FeatureTrace g a
forall g a.
(Grammar g, Show a, Eq a) =>
AST g a -> FeatureTrace g a -> FeatureTrace g a
pc_parentpart AST g a
t FeatureTrace g a
f Node g a
v, FeatureTrace g a
f Node g a
v) of
(Just p :: PropositionalFormula Feature
p, Just f' :: PropositionalFormula Feature
f') -> (PropositionalFormula Feature -> Bool)
-> PropositionalFormula Feature
-> Maybe (PropositionalFormula Feature)
forall a. (a -> Bool) -> a -> Maybe a
nothingIf (PropositionalFormula Feature
-> PropositionalFormula Feature -> Bool
forall a. Eq a => a -> a -> Bool
==PropositionalFormula Feature
forall a. PropositionalFormula a
PTrue) (PropositionalFormula Feature
-> PropositionalFormula Feature -> PropositionalFormula Feature
forall a.
(Ord a, Show a) =>
PropositionalFormula a
-> PropositionalFormula a -> PropositionalFormula a
removeRedundancy PropositionalFormula Feature
p PropositionalFormula Feature
f')
_ -> PropositionalFormula Feature -> PropositionalFormula Feature
forall a. PropositionalFormula a -> PropositionalFormula a
Propositions.simplify (PropositionalFormula Feature -> PropositionalFormula Feature)
-> Maybe (PropositionalFormula Feature)
-> Maybe (PropositionalFormula Feature)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FeatureTrace g a
f Node g a
v
simplifyFeatureTraceOfNodes :: (Grammar g, Show a, Eq a) => FeatureTrace g a -> AST g a -> Set (Node g a) -> FeatureTrace g a
simplifyFeatureTraceOfNodes :: FeatureTrace g a -> AST g a -> Set (Node g a) -> FeatureTrace g a
simplifyFeatureTraceOfNodes f :: FeatureTrace g a
f t :: AST g a
t d :: Set (Node g a)
d = \v :: Node g a
v -> if Node g a -> Set (Node g a) -> Bool
forall a. Ord a => a -> Set a -> Bool
member Node g a
v Set (Node g a)
d then FeatureTrace g a -> AST g a -> FeatureTrace g a
forall g a.
(Grammar g, Show a, Eq a) =>
FeatureTrace g a -> AST g a -> FeatureTrace g a
simplifyFeatureTrace FeatureTrace g a
f AST g a
t Node g a
v else FeatureTrace g a
f Node g a
v
pc :: (Grammar g, Show a, Eq a) => AST g a -> FeatureTrace g a -> Node g a -> FeatureFormula
pc :: AST g a -> FeatureTrace g a -> FeatureTrace g a
pc root :: AST g a
root trace :: FeatureTrace g a
trace node :: Node g a
node = [Maybe (PropositionalFormula Feature)]
-> Maybe (PropositionalFormula Feature)
forall l. Logic l => [l] -> l
land [FeatureTrace g a
trace Node g a
node, AST g a -> FeatureTrace g a -> FeatureTrace g a
forall g a.
(Grammar g, Show a, Eq a) =>
AST g a -> FeatureTrace g a -> FeatureTrace g a
pc_parentpart AST g a
root FeatureTrace g a
trace Node g a
node]
pc_parentpart :: (Grammar g, Show a, Eq a) => AST g a -> FeatureTrace g a -> Node g a -> FeatureFormula
pc_parentpart :: AST g a -> FeatureTrace g a -> FeatureTrace g a
pc_parentpart root :: AST g a
root trace :: FeatureTrace g a
trace v :: Node g a
v
| Node g a -> NodeType
forall g a. Grammar g => Node g a -> NodeType
optionaltype Node g a
v NodeType -> NodeType -> Bool
forall a. Eq a => a -> a -> Bool
== NodeType
Mandatory = AST g a -> AST g a -> Maybe (AST g a)
forall a. Eq a => Tree a -> Tree a -> Maybe (Tree a)
parent AST g a
root AST g a
t Maybe (AST g a)
-> (AST g a -> Maybe (PropositionalFormula Feature))
-> Maybe (PropositionalFormula Feature)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= AST g a -> FeatureTrace g a -> FeatureTrace g a
forall g a.
(Grammar g, Show a, Eq a) =>
AST g a -> FeatureTrace g a -> FeatureTrace g a
pc AST g a
root FeatureTrace g a
trace FeatureTrace g a
-> (AST g a -> Node g a)
-> AST g a
-> Maybe (PropositionalFormula Feature)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AST g a -> Node g a
forall a. Tree a -> a
element
| Bool
otherwise = [Maybe (PropositionalFormula Feature)]
-> Maybe (PropositionalFormula Feature)
forall l. Logic l => [l] -> l
land ([Maybe (PropositionalFormula Feature)]
-> Maybe (PropositionalFormula Feature))
-> [Maybe (PropositionalFormula Feature)]
-> Maybe (PropositionalFormula Feature)
forall a b. (a -> b) -> a -> b
$ FeatureTrace g a
traceFeatureTrace g a
-> (AST g a -> Node g a)
-> AST g a
-> Maybe (PropositionalFormula Feature)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AST g a -> Node g a
forall a. Tree a -> a
element (AST g a -> Maybe (PropositionalFormula Feature))
-> [AST g a] -> [Maybe (PropositionalFormula Feature)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AST g a -> AST g a -> [AST g a]
forall a g. (Eq a, Grammar g) => AST g a -> AST g a -> [AST g a]
optionalAncestors AST g a
root AST g a
t)
where t :: AST g a
t = AST g a -> Node g a -> AST g a
forall a. (Eq a, Show a) => Tree a -> a -> Tree a
tree AST g a
root Node g a
v
prettyPrint :: (Grammar g, Show a) => FeatureTrace g a -> AST g a -> String
prettyPrint :: FeatureTrace g a -> AST g a -> Feature
prettyPrint trace :: FeatureTrace g a
trace = Int
-> (Feature -> Feature)
-> (Node g a -> Feature)
-> AST g a
-> Feature
forall a b.
(Show a, Monoid b) =>
Int -> (Feature -> b) -> (a -> b) -> Tree a -> b
Tree.prettyPrint 0 Feature -> Feature
forall a. a -> a
id (\node :: Node g a
node -> "<"Feature -> Feature -> Feature
forall a. [a] -> [a] -> [a]
++(Maybe (PropositionalFormula Feature) -> Feature
forall a. Show a => Maybe a -> Feature
NullPropositions.prettyPrint (Maybe (PropositionalFormula Feature) -> Feature)
-> Maybe (PropositionalFormula Feature) -> Feature
forall a b. (a -> b) -> a -> b
$ FeatureTrace g a
trace Node g a
node)Feature -> Feature -> Feature
forall a. [a] -> [a] -> [a]
++">"Feature -> Feature -> Feature
forall a. [a] -> [a] -> [a]
++(Node g a -> Feature
forall a. Show a => a -> Feature
show Node g a
node))