In the last entry, we introduced what RDR (ripple-down rules) are and reviewed the types that comprise an example system. This entry will show how those types are used to implement such a system.
This module scans the RDR tree in context to give BOTH the best-fitting conclusion AND the final Branch that led to the ultimate conclusion (in the form of a zipper so that the branch may be replace in place using standard operations on the zipper).
> module RDRFinding where
You have already encountered the above imported modules, but the next two modules need an introduction. The first> import RDRTypes
> import Data.Transitive
> import Data.Zipper
> import Data.BinaryTree
> import Data.Map (Map)
> import qualified Data.Map as Map
> import Control.Monad.State
> import Data.Maybe
contains my weird and wonderful syntax when I'm using monads for parsing or logic tasks. The parsing syntax you've seen before (see the critique), but I do add one new syntactic construct:
> import Control.Monad.Utils
because I'm always doing "
(>>|) :: m a → (a → b) → m b
m >>= return . f", and
liftMseems to feel oddly backwards when I'm visualizing data flow. The next
provides a generic operation for changing a data structure:
> import Data.Mutable
So, what's the game? We have an Environment (a set of attributed values) combined with a RuleTree into the State Monad. What we do is guide the values in the environment through the rule tree (where a successful Condition chooses theclass Mutable t dir val | t → dir, t → val where
mutate :: dir → val → t → Maybe t
EXCEPTbranch and displaces the currently saved Conclusion with the one associated with this Rule, and conversely if the Condition fails, the
ELSEbranch is selected, without displacing the currently saved Conclusion). When we reach a Leaf, we return our current position in the tree (the current state of the Zipper) along with the last valid Conclusion. All this is done by
Whew! This is a mouthful in the number of functions it introduces, but conceptually,> runRule :: RuleFinding a b c k v
> runRule = get >>= λ (RuleEnv root env) . runRule' root env
> runRule' :: RuleTree a b c k v → Environment k v b c
> → RuleFinding a b c k v
> runRule' tree env@(Env ks curr)
> = branch tree >>: λ (cond, conc) .
> let (dir, concl) = liftZdir (testCond cond env conc)
> in advance dir tree >>: λ path .
> put (RuleEnv path (Env ks concl)) >> runRule
> where x >>: f = tryS curr x f
runRuleis rather straightforward. Let's break it down.
runRule, itself, merely destructures the RuleTreeEnv term, passing that information to
runRule', so let's move right on to that worker function. First, let's examine the funny syntactic construct,
(>>:)— what is this monadic operator doing? We see from its definition that it calls
So,> tryS :: a → Maybe b → (b → State c a) → State c a
> tryS x may f = maybe (return x) f may
trySlifts the State Monad into semideterminism (using the Maybe Monad). As an aside, perhaps, then,
runRule'could be rewritten as a StateT over the Maybe Monad ... perhaps an intrepid reader will gain a ⊥-trophy for an implementation and explanation?
Using that monadic operator,
(>>:), we get the current
branchin focus (bailing if the focus is on a Leaf) ...
... then we test the condition at that Branch ...> branch :: RuleTree a b c k v
> → Maybe (Condition a (Knowledge k v),
> Conclusion b c (Knowledge k v))
> branch (Zip _ (Branch (Rule cond conc) _ _)) = Just (cond, conc)
> branch (Zip _ Leaf) = Nothing
I do this little pas de deux between> testCond :: Condition a (Knowledge k v)
> → Environment k v ca cb
> → Conclusion ca cb (Knowledge k v)
> → Either (Environment k v ca cb)
> (Environment k v ca cb)
> testCond (Cond _ test) env@(Env kb _) conc1
> | test kb = Left $ Env kb conc1
> | otherwise = Right env
> liftZdir :: Either (Environment k v ca cb)
> (Environment k v ca cb)
> → (BinDir, Conclusion ca cb (Knowledge k v))
> liftZdir test = either (λ (Env _ c) . (L, c))
> (λ (Env _ c) . (R, c))
liftZdirbecause somehow it just feels right to use the Either type here. Perhaps, sometime later Arrows will come into play. At any rate,
liftZdir . testCondcan be considered one function that returns the appropriate leg of the branch to continue finding the best viable Conclusion, as well as the best current Conclusion reached from applying the Environment to the Condition.
Given that information, we now
path, updating the state, and continue to test recursively, until we reach a Leaf, at which point we have our answer (the ultimate viable Conclusion).
If we're happy with that answer, we call
runRulewith a new transaction (in other words, a fresh Environment), and the Zipper pointing back at the top of the RuleTree. If we're not happy, then we're given the ability to add a new Rule to the RuleTree. We do this with
The above functions are the meat of the implementation for this simple RDR system. There are a few conveniences that the following functions provide. The first one is> addRule :: BinDir → Rule a b c (Knowledge k v)
> → RuleTree a b c k v → RuleTree a b c k v
> addRule dir rule (Zip hist branch)
> = let ruleB = Branch rule Leaf Leaf
> in Zip hist (mutate dir ruleB branch)
answerthat scans the rule tree, making the best conclusion, and then backs up one step to provide the user access to the branch in case the precipitating rule finding wasn't exactly giving the desired result.
The next three functions help to automate the creation of the rule parts, Conditions and Conclusions. The function> answer :: RuleTreeEnv a b c k v → RuleTreeEnv a b c k v
> answer rule = let RuleEnv z ans = execState runRule rule
> in RuleEnv (fromJust $ withdraw z) ans
mkCondcreates a test function with the assumption that the knowledge store contains a
(k,v)pair. It does the lookup in the knowledge store and passes the extracted values to the test function (which, as with any good predicate, returns either True or False). If we can't find the key, I guess, for now, we'll assume the returned value is False:
This completes the implementation of this RDR system. The next entry will create a small RDR system, based on the game Animal, to demonstrate how the system works.> mkCond :: Ord k ⇒ k → (v → Bool) → Condition k (Knowledge k v)
> mkCond key fn = Cond key $ λ ks . maybe False fn (Map.lookup key ks)
> present :: Ord k ⇒ k → Condition k (Knowledge k v)
> present = flip mkCond (const True)
> assume :: k → Conclusion k k env
> assume key = Concl key (const key)