RippleDownRuleto Ergo Sum

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
module Control.Logic.Rule.RippleDown where

import Control.Arrow
import Control.Monad
import Control.Monad.Writer

import Analytics.Theory.Number     -- http://lpaste.net/107480

-- A solution to the problem posted at http://lpaste.net/109350
-- Here we add a new rule when we can't find a soluntion in the ruleset.

type Name = String
data Pred a = P { name :: Name, is :: (a -> Bool) }

instance Show (Pred a) where
   show (P name _) = "Pred " ++ name

data Rule a = Top (Rule a) | R (Pred a) (Rule a) (Rule a) | Terminal

instance Show (Rule a) where
   show (Top _) = "⟙"
   show (R p _ _) = "Rule " ++ name p
   show Terminal = "⟘"

children :: Rule a -> [Rule a]
children (Top r) = [r]
children (R p l r) = [l, r]
children Terminal = []

-- a rule is either proves the value or ripples down to a (child) rule that
-- does ... or not. Then you need to add a rule for that case.

data RDR a = RippleDownRuleSet (Rule a)

instance Show a => Show (RDR a) where
   show (RippleDownRuleSet rule) = 
      "RDR " ++ showRule rule

showRule :: Rule a -> String
showRule rule = show rule ++ showChildren (children rule)

showChildren :: [Rule a] -> String
showChildren [] = ""
showChildren (h:t) = " { " ++ showRule h ++ " " ++ concatMap showRule t ++ " } "

-- our path through the RDR accumulates the proofs (those rules that fired)
-- and has the most recent rule that fired (even if 'most recent' is ⟙)

data Way a = Tau { prev :: Rule a, reasons :: [Rule a] }

-- The τ that can be told is not the eternal τ. ... Geddit?

fnord :: a -> RDR a -> Writer [Rule a] (Maybe (Rule a)) -- so Writer == Way
fnord fivish (RippleDownRuleSet rules) = flow fivish rules

flow :: a -> Rule a -> Writer [Rule a] (Maybe (Rule a))
flow x top@(Top rule) = tell [top] >> flow x rule >>= accum top True
flow x rule@(R p t f) =
   let fired = is p x
   in  when fired (tell [rule]) >>
       flow x (if fired then t else f) >>= accum rule fired
flow x Terminal = return Nothing -- and we're done!

fire :: MonadPlus m => Bool -> (a -> m a)
fire True = return
fire False = const mzero

accum :: (Monad n, MonadPlus m) => Rule a -> Bool
         -> (m (Rule a) -> n (m (Rule a)))
accum rule fired = return . (flip mplus (fire fired rule))

oneRule :: (Integral a, Num a, Eq a) => RDR a
oneRule = RippleDownRuleSet (Top divisible)

divisible :: (Eq a, Num a, Integral a) => Rule a
divisible = R (P "divisible by 5" ((== 0) . (flip mod 5))) fiver Terminal

fiver :: (Num a, Eq a) => Rule a
fiver = R (P "it's 5" (== 5)) Terminal Terminal

insertRule :: Pred a -> Writer [Rule a] (RDR a) -> Writer [Rule a] (RDR a)
insertRule fromPred = censor (modifyRuleset fromPred)

addRule :: a -> Pred a -> RDR a -> RDR a
addRule num p ruleset =
   let (_, answerSet) =
         runWriter (insertRule p (fnord num ruleset >> return ruleset))
   in  RippleDownRuleSet $ head answerSet

modifyRuleset :: Pred a -> [Rule a] -> [Rule a]
modifyRuleset p rules = reverse $ m' (reverse rules)
   where m' [Top rule] = [Top (mkRule p rule rule)] -- go either way from Top
         m' (R q s f:rest) = (R q s (mkRule p s f):rest)
         mkRule p r1 r2 = R p r1 r2

{-- ... and our adder run:

*Control.Logic.Rule.RippleDown> oneRule
RDR ⟙ { Rule divisible by 5 { Rule it's 5 { ⟘ ⟘ }  ⟘ }   } 
*Control.Logic.Rule.RippleDown> runWriter (fnord 23 oneRule )
(Just ⟙,[⟙]) -- no answer for 23, and that's just wrong!
*Control.Logic.Rule.RippleDown> 
addRule 23 (P "digits sum to 5" ((== 5) . blackAdder)) oneRule 
RDR ⟙ { Rule digits sum to 5 { ⟘ 
             Rule divisible by 5 { Rule it's 5 { ⟘ ⟘ }  ⟘ }  }   }
-- so we now have a ruleset where the digits sum to 5. Let's try it out!
*Control.Logic.Rule.RippleDown> let sumRule = it
*Control.Logic.Rule.RippleDown> runWriter (fnord 23 sumRule )
(Just Rule digits sum to 5,[⟙,Rule digits sum to 5])
-- yup that worked for 23 ... do 10 and 5 still work?
*Control.Logic.Rule.RippleDown> runWriter (fnord 10 sumRule )
(Just Rule divisible by 5,[⟙,Rule divisible by 5]) -- 10 works ...
*Control.Logic.Rule.RippleDown> runWriter (fnord 5 sumRule )
(Just Rule digits sum to 5,[⟙,Rule digits sum to 5]) -- but 5 didn't :(

... the issue here is how I add in the rule, if I add it to ⟙ and then
append the whole ruleset to the else-branch, then if the digits sum to 5,
the other rules don't get tried.

But then, if I append the whole ruleset to the then-branch, then they
don't get executed if the digits don't sum to five (such as 10).

So then we run into the whole big problem of ripple down rules where
child branches of similar classes mirror each other in some regards.

RDR is an interesting concept, and have been used to some effect. 

An airline uses it to distribute parts: millions of parts, thousands of kinds
their RDR system has 2.5 MILLION rules in their set. WOWsers! They've
come across this problem and have solved it or inbred it.

Okay. RDR. That was fun!

 --}

{--

Epilogue:

So you see the NOW working code above. Whereas before, when I inserted a new
rule into the ruleset, I terminated it at that rule with the continuation
branch to either the left (the then-branch) OR to the right (the else-branch).

NOW what I do is to loop in both branches so that the newly interposed rule
flows down to the left and to the right and we continue testing on it,
depending on how its (last successfully-fired) parent behaved.

Simple, simple fix that gets us the desired results:

*Control.Logic.Rule.RippleDown> oneRule
RDR ⟙ { Rule divisible by 5 { Rule it's 5 { ⟘ ⟘ }  ⟘ }   } 
*Control.Logic.Rule.RippleDown> runWriter (fnord 23 oneRule )
(Just ⟙,[⟙])
*Control.Logic.Rule.RippleDown> 
addRule 23 (P "digits sum to 5" ((== 5) . blackAdder )) oneRule
RDR ⟙ { Rule digits sum to 5 {  -- newly inserted rule
             Rule divisible by 5 {  -- now branches to the left
                  Rule it's 5 { ⟘ ⟘ }  ⟘ }  
             Rule divisible by 5 { Rule it's 5 { ⟘ ⟘ }  ⟘ }  }   }
                                    -- AND to the right! YAY!

*Control.Logic.Rule.RippleDown> let sumRule = it
*Control.Logic.Rule.RippleDown> runWriter (fnord 23 sumRule)
(Just Rule digits sum to 5,[⟙,Rule digits sum to 5])
*Control.Logic.Rule.RippleDown> runWriter (fnord 10 sumRule)
(Just Rule divisible by 5,[⟙,Rule divisible by 5])
*Control.Logic.Rule.RippleDown> runWriter (fnord 5 sumRule)
(Just Rule it's 5,[⟙,Rule digits sum to 5,Rule divisible by 5,Rule it's 5])
-- the 5-rule now works as desired. YAY!

 --}

-- so let's add that to the rule set, and two other rules 'discovered'
-- by my daughters, Isabel and Elena Marie.

sumRule :: Integral a => RDR a
sumRule = addRule 23 addidible oneRule

-- here's our 'digits add up to 5' predicate:

addidible :: (Eq a, Num a, Integral a) => Pred a
addidible = P "digits sum to 5" ((== 5) . blackAdder)

blackAdder :: (Eq n, Num n, Integral n) => n -> n
blackAdder 0 = 0
blackAdder n = let (a, b) = n `divMod` 10
               in  b + blackAdder a

-- Now let's add Isabel's and Elena Marie's rules: ---------------------

-- Here's Isabel's rule: 27, or, as Elena Marie explained: there are 2
-- '5's (5 x 5), and you add 2 to that, or (2, 2) or exponent == remainder

isIsabel :: (Eq a, Num a, Integral a) => Pred a
isIsabel = P "There's x 5's as a multiple with remainder x"
             ((\(a, b) -> a == b) . twentySeven)

twentySeven :: (Eq a, Num a, Integral a) => a -> (a, a)
twentySeven x = let (a, b) = x `divMod` 5
                in  if a >= 5 && b /= 0
                    then (\(p, q) -> (1 + p, b + q)) (twentySeven a)
                    else (a, b)

-- there's an arrow for the above application above, I'm sure ... :/

-- so, 6, 27, 128, 629, ... all work with rule 27

-- runWriter (fnord 27 sumRule) ~> (Just ⟙,[⟙])

bunsoh :: Integral a => RDR a
bunsoh = addRule 27 isIsabel sumRule

-- runWriter (fnord 27 bunsoh) ~>
--     (Just Rule There's x 5's as a multiple with remainder x, ...)

-- Now, Elena Marie's rule (after I got her to stop naming out multiples of
-- 5's as she rolled her eyes, being the sophisticated teen that she is)

isElena :: (Eq a, Num a, Integral a) => Pred a
isElena = P "The number is coprime to 5" (isLeft . coprime 5)

isLeft :: Either a b -> Bool
isLeft (Left _) = True
isLeft _        = False

-- pretty clever. "2, Papa!" she exclaimed finally. "Why?" I demanded.
-- "Because they both are divisible by 1 at most."

-- My daughter just 'discovered' coprimality. *Proud*

-- Okay, let's add this new rule

-- runWriter (fnord 2 bunsoh) ~> (Just ⟙,[⟙])

até :: Integral a => RDR a
até = addRule 2 isElena summer

-- runWriter (fnord 2 até) ~> (Just Rule The number is coprime to 5, ...)

-- and it, of course, works with any coprime number of 5:

-- runWriter (fnord 622 até) ~> (Just Rule The number is coprime to 5,[⟙, ...])

{--

até ~>

RDR ⟙ { 
Rule The number is coprime to 5 { 
     Rule There's x 5's as a multiple with remainder x { 
          Rule digits sum to 5 { 
               Rule divisible by 5 { Rule it's 5 { ⟘ ⟘ }  ⟘ }  
               Rule divisible by 5 { Rule it's 5 { ⟘ ⟘ }  ⟘ }  }  
          Rule digits sum to 5 { 
               Rule divisible by 5 { Rule it's 5 { ⟘ ⟘ }  ⟘ }  
               Rule divisible by 5 { Rule it's 5 { ⟘ ⟘ }  ⟘ }  }  }  
     Rule There's x 5's as a multiple with remainder x { 
          Rule digits sum to 5 {
               Rule divisible by 5 { Rule it's 5 { ⟘ ⟘ }  ⟘ } 
               Rule divisible by 5 { Rule it's 5 { ⟘ ⟘ }  ⟘ }  }  
          Rule digits sum to 5 {
               Rule divisible by 5 { Rule it's 5 { ⟘ ⟘ }  ⟘ } 
               Rule divisible by 5 { Rule it's 5 { ⟘ ⟘ }  ⟘ }  }  }  }   } 

And just one more. How come 622 didn't fire the summer rule? Because the
summer rule applies only when the sum IS 5, not when it's a multiple of 5.

So, two ways to change this. We change the predicate so that it checks for
multiples, or we add a rule. --}

summer :: Integral a => RDR a
summer = addRule 622 (P "digits sum to a multiple of 5" 
                        ((== 0) . (flip mod 5) . blackAdder)) bunsoh
13:33: Warning: Redundant bracket
Found:
is :: (a -> Bool)
Why not:
is :: a -> Bool
64:24: Warning: Redundant bracket
Found:
Bool -> (a -> m a)
Why not:
Bool -> a -> m a
68:46: Warning: Redundant bracket
Found:
Bool -> (m (Rule a) -> n (m (Rule a)))
Why not:
Bool -> m (Rule a) -> n (m (Rule a))
70:20: Warning: Redundant bracket
Found:
return . (flip mplus (fire fired rule))
Why not:
return . flip mplus (fire fired rule)
70:29: Warning: Use section
Found:
(flip mplus (fire fired rule))
Why not:
(`mplus` (fire fired rule))
76:36: Warning: Redundant bracket
Found:
(== 0) . (flip mod 5)
Why not:
(== 0) . flip mod 5
76:45: Warning: Use section
Found:
(flip mod 5)
Why not:
(`mod` 5)
93:30: Warning: Redundant bracket
Found:
(R q s (mkRule p s f) : rest)
Why not:
R q s (mkRule p s f) : rest
94:10: Error: Eta reduce
Found:
mkRule p r1 r2 = R p r1 r2
Why not:
mkRule = R
196:16: Warning: Use uncurry
Found:
\ (a, b) -> a == b
Why not:
uncurry (==)
Note: increases laziness
201:27: Warning: Use ***
Found:
\ (p, q) -> (1 + p, b + q)
Why not:
(+) 1 *** (+) b
273:35: Warning: Use section
Found:
(flip mod 5)
Why not:
(`mod` 5)
273:35: Warning: Redundant bracket
Found:
(flip mod 5) . blackAdder
Why not:
flip mod 5 . blackAdder