47cfd81 · laop · git.iko.soy

git.iko.soy/laop

Added branchD and ifD to Dist.

Rewrite Matrix Num instance to pattern match on the abide law (it's more efficient). Cleaned constraints on Relation module.

commit47cfd81b5b02dfea711babf227f88c0901569442 authorArmando Santos <armandoifsantos@gmail.com> dateSun 9 Feb 2020, 19:14 (7 years ago) parentbaed7ee

7 files changed+76−113

compare with master

unifiedsplit

src/LAoP/Dist.hs+2 src/LAoP/Dist/Internal.hs+38 src/LAoP/Matrix/Internal.hs+21−11 src/LAoP/Relation.hs−2 src/LAoP/Relation/Internal.hs+12−27 src/LAoP/Utils.hs+1−1 src/LAoP/Utils/Internal.hs+2−72

src/LAoP/Dist.hs+2

@@ -53,6 +53,8 @@ module LAoP.Dist

5353

5454 -- * Selective equivalent functions

5555 selectD,

56+ branchD,

57+ ifD,

5658

5759 -- * Monad equivalent functions

5860 returnD,

src/LAoP/Dist/Internal.hs+38

@@ -25,6 +25,8 @@ module LAoP.Dist.Internal

2525 unitD,

2626 multD,

2727 selectD,

28+ branchD,

29+ ifD,

2830 returnD,

2931 bindD,

3032 (??),

@@ -48,6 +50,7 @@ import GHC.TypeLits

4850import Data.Proxy

4951import Data.List (sortBy)

5052import Control.DeepSeq

53+import Data.Bool

5154

5255-- | Type synonym for probability value

5356type Prob = Double

@@ -96,6 +99,41 @@ selectD ::

9699 ) => Dist (Either a b) -> Matrix Prob a b -> Dist b

97100selectD (D d) m = D (selectM d m)

98101

102+-- | Chooses which of the two given effectful

103+-- functions to apply to a given argument;

104+branchD ::

105+ ( Num e,

106+ CountableDimensionsN a b,

107+ CountableDimensionsN c (Either b c),

108+ FromListsN c b,

109+ FromListsN a b,

110+ FromListsN a a,

111+ FromListsN b b,

112+ FromListsN c c,

113+ FromListsN b a,

114+ FromListsN b c,

115+ FromListsN (Either b c) b,

116+ FromListsN (Either b c) c

117+ )

118+ => Dist (Either a b) -> Matrix Prob a c -> Matrix Prob b c -> Dist c

119+branchD x l r = f x `selectD` g l `selectD` r

120+ where

121+ f (D m) = D (split (tr i1) (i1 `comp` tr i2) `comp` m)

122+ g m = i2 `comp` m

123+

124+-- | Branch on a Boolean value, skipping unnecessary computations.

125+ifD ::

126+ ( CountableDimensionsN a (Either () a),

127+ FromListsN a a,

128+ FromListsN a (),

129+ FromListsN () a,

130+ FromListsN (Either () a) a

131+ )

132+ => Dist Bool -> Dist a -> Dist a -> Dist a

133+ifD x (D t) (D e) = branchD x' t e

134+ where

135+ x' = bool (Right ()) (Left ()) `fmapD` x

136+

99137-- | Monad instance 'return' function

100138returnD :: forall a . (Enum a, FromListsN () a, Countable a) => a -> Dist a

101139returnD a = D (col l)

src/LAoP/Matrix/Internal.hs+21−11

@@ -238,8 +238,10 @@ instance Eq e => Eq (Matrix e cols rows) where

238238 (One a) == (One b) = a == b

239239 (Junc a b) == (Junc c d) = a == c && b == d

240240 (Split a b) == (Split c d) = a == c && b == d

241− x@(Split _ _) == y@(Junc _ _) = x == abideJS y

242− x@(Junc _ _) == y@(Split _ _) = abideJS x == y

241+ (Split (Junc a b) (Junc c d)) == (Junc (Split a' c') (Split b' d')) =

242+ (a == a') && (b == b') && (c == c') && (d == d')

243+ (Junc (Split a' c') (Split b' d')) == (Split (Junc a b) (Junc c d)) =

244+ (a == a') && (b == b') && (c == c') && (d == d')

243245

244246instance Num e => Num (Matrix e cols rows) where

245247

@@ -247,22 +249,28 @@ instance Num e => Num (Matrix e cols rows) where

247249 (One a) + (One b) = One (a + b)

248250 (Junc a b) + (Junc c d) = Junc (a + c) (b + d)

249251 (Split a b) + (Split c d) = Split (a + c) (b + d)

250− x@(Split _ _) + y@(Junc _ _) = x + abideJS y

251− x@(Junc _ _) + y@(Split _ _) = abideJS x + y

252+ (Split (Junc a b) (Junc c d)) + (Junc (Split a' c') (Split b' d')) =

253+ Split (Junc (a + a') (b + b')) (Junc (c + c') (d + d'))

254+ (Junc (Split a' c') (Split b' d')) + (Split (Junc a b) (Junc c d)) =

255+ Split (Junc (a + a') (b + b')) (Junc (c + c') (d + d'))

252256

253257 Empty - Empty = Empty

254258 (One a) - (One b) = One (a - b)

255259 (Junc a b) - (Junc c d) = Junc (a - c) (b - d)

256260 (Split a b) - (Split c d) = Split (a - c) (b - d)

257− x@(Split _ _) - y@(Junc _ _) = x - abideJS y

258− x@(Junc _ _) - y@(Split _ _) = abideJS x - y

261+ (Split (Junc a b) (Junc c d)) - (Junc (Split a' c') (Split b' d')) =

262+ Split (Junc (a - a') (b - b')) (Junc (c - c') (d - d'))

263+ (Junc (Split a' c') (Split b' d')) - (Split (Junc a b) (Junc c d)) =

264+ Split (Junc (a - a') (b - b')) (Junc (c - c') (d - d'))

259265

260266 Empty * Empty = Empty

261267 (One a) * (One b) = One (a * b)

262268 (Junc a b) * (Junc c d) = Junc (a * c) (b * d)

263269 (Split a b) * (Split c d) = Split (a * c) (b * d)

264− x@(Split _ _) * y@(Junc _ _) = x * abideJS y

265− x@(Junc _ _) * y@(Split _ _) = abideJS x * y

270+ (Split (Junc a b) (Junc c d)) * (Junc (Split a' c') (Split b' d')) =

271+ Split (Junc (a * a') (b * b')) (Junc (c * c') (d * d'))

272+ (Junc (Split a' c') (Split b' d')) * (Split (Junc a b) (Junc c d)) =

273+ Split (Junc (a * a') (b * b')) (Junc (c * c') (d * d'))

266274

267275 abs Empty = Empty

268276 abs (One a) = One (abs a)

@@ -279,8 +287,10 @@ instance Ord e => Ord (Matrix e cols rows) where

279287 (One a) <= (One b) = a <= b

280288 (Junc a b) <= (Junc c d) = (a <= c) && (b <= d)

281289 (Split a b) <= (Split c d) = (a <= c) && (b <= d)

282− x@(Split _ _) <= y@(Junc _ _) = x <= abideJS y

283− x@(Junc _ _) <= y@(Split _ _) = abideJS x <= y

290+ (Split (Junc a b) (Junc c d)) <= (Junc (Split a' c') (Split b' d')) =

291+ (a <= a') && (b <= b') && (c <= c') && (d <= d')

292+ (Junc (Split a' c') (Split b' d')) <= (Split (Junc a b) (Junc c d)) =

293+ (a <= a') && (b <= b') && (c <= c') && (d <= d')

284294

285295-- Primitives

286296

@@ -703,7 +713,7 @@ select (Split a b) y = y . a + b -- Divid

703713select (Junc (Split a c) (Split b d)) y = junc (y . a + c) (y . b + d) -- Pattern matching + DnC law

704714select m y = junc y identity . m

705715

706−branch ::

716+branch ::

707717 ( Num e,

708718 CountableDimensions a b,

709719 CountableDimensions c (Either b c),

src/LAoP/Relation.hs−2

@@ -38,9 +38,7 @@ module LAoP.Relation

3838 FromListsN,

3939 Liftable,

4040 Trivial,

41− TrivialE,

4241 TrivialP,

43− TrivialP2,

4442

4543 -- * Primitives

4644 empty,

src/LAoP/Relation/Internal.hs+12−27

@@ -48,9 +48,7 @@ module LAoP.Relation.Internal

4848 FromListsN,

4949 Liftable,

5050 Trivial,

51− TrivialE,

5251 TrivialP,

53− TrivialP2,

5452

5553 -- * Primitives

5654 empty,

@@ -201,9 +199,7 @@ type CountableDimensionsN a b = (CountableN a, CountableN b)

201199type FromListsN a b = I.FromLists Boolean (I.Normalize a) (I.Normalize b)

202200type Liftable a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num Boolean, Ord Boolean)

203201type Trivial a = I.Normalize a ~ I.Normalize (I.Normalize a)

204−type TrivialE a b = I.Normalize (Either a b) ~ Either (I.Normalize a) (I.Normalize b)

205202type TrivialP a b = I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)

206−type TrivialP2 a b = I.Normalize (I.Normalize a, I.Normalize b) ~ I.Normalize (I.Normalize (a, b))

207203

208204-- | It isn't possible to implement the 'id' function so it's

209205-- implementation is 'undefined'. However 'comp' can be and this partial

@@ -244,8 +240,7 @@ one = R . I.One

244240-- | Boolean Matrix 'Junc' constructor, also known as relational coproduct.

245241--

246242-- See 'eitherR'.

247−junc :: (TrivialE a b)

248− => Relation a c -> Relation b c -> Relation (Either a b) c

243+junc :: Relation a c -> Relation b c -> Relation (Either a b) c

249244junc (R a) (R b) = R (I.Junc a b)

250245

251246infixl 3 |||

@@ -253,21 +248,18 @@ infixl 3 |||

253248--

254249-- See 'eitherR'.

255250(|||) ::

256− (TrivialE a b) =>

257251 Relation a c ->

258252 Relation b c ->

259253 Relation (Either a b) c

260254(|||) = junc

261255

262256-- | Boolean Matrix 'Split' constructor, also known as relational product.

263−split :: (TrivialE a b)

264− => Relation c a -> Relation c b -> Relation c (Either a b)

257+split :: Relation c a -> Relation c b -> Relation c (Either a b)

265258split (R a) (R b) = R (I.Split a b)

266259

267260infixl 2 ===

268261-- | Boolean Matrix 'Split' constructor

269262(===) ::

270− (TrivialE a b) =>

271263 Relation c a ->

272264 Relation c b ->

273265 Relation c (Either a b)

@@ -822,8 +814,7 @@ infixl 4 ><

822814-- @

823815-- 'eitherR' ('splitR' r s) ('splitR' t v) == 'splitR' ('eitherR' r t) ('eitherR' s v)

824816-- @

825−eitherR :: (TrivialE a b)

826− => Relation a c -> Relation b c -> Relation (Either a b) c

817+eitherR :: Relation a c -> Relation b c -> Relation (Either a b) c

827818eitherR = junc

828819

829820-- | Relational coproduct first component injection

@@ -835,8 +826,7 @@ eitherR = junc

835826i1 ::

836827 ( CountableDimensionsN a b,

837828 FromListsN b a,

838− FromListsN a a,

839− TrivialE a b

829+ FromListsN a a

840830 )

841831 => Relation a (Either a b)

842832i1 = R I.i1

@@ -850,8 +840,7 @@ i1 = R I.i1

850840i2 ::

851841 ( CountableDimensionsN a b,

852842 FromListsN a b,

853− FromListsN b b,

854− TrivialE a b

843+ FromListsN b b

855844 )

856845 => Relation b (Either a b)

857846i2 = R I.i2

@@ -868,9 +857,7 @@ infixl 5 -|-

868857 FromListsN b b,

869858 FromListsN d b,

870859 FromListsN b d,

871− FromListsN d d,

872− TrivialE a c,

873− TrivialE b d

860+ FromListsN d d

874861 )

875862 => Relation a b -> Relation c d -> Relation (Either a c) (Either b d)

876863(-|-) (R a) (R b) = R ((I.-|-) a b)

@@ -892,8 +879,8 @@ trans ::

892879 FromListsN (a, b) b,

893880 Trivial (a, b),

894881 Trivial (c, b),

895− TrivialP2 a b,

896− TrivialP2 c b

882+ TrivialP a b,

883+ TrivialP c b

897884 )

898885 => Relation (a, b) c -> Relation a (c, b)

899886trans r = splitR r p2 `comp` conv p1

@@ -913,8 +900,8 @@ untrans ::

913900 FromListsN (a, b) a,

914901 Trivial (a, b),

915902 Trivial (c, b),

916− TrivialP2 a b,

917− TrivialP2 c b

903+ TrivialP a b,

904+ TrivialP c b

918905 )

919906 => Relation a (c, b) -> Relation (a, b) c

920907untrans s = p1 `comp` conv (splitR (conv s) p2)

@@ -964,8 +951,7 @@ guard ::

964951 Enum b,

965952 CountableN b,

966953 FromListsN b b,

967− FromListsN Bool b,

968− TrivialE b b

954+ FromListsN Bool b

969955 ) => Relation b Bool -> Relation b (Either b b)

970956guard p = conv (eitherR (predR p) (predR (negate p)))

971957

@@ -975,8 +961,7 @@ cond ::

975961 Enum b,

976962 CountableN b,

977963 FromListsN b b,

978− FromListsN Bool b,

979− TrivialE b b

964+ FromListsN Bool b

980965 )

981966 => Relation b Bool -> Relation b c -> Relation b c -> Relation b c

982967cond p r s = eitherR r s `comp` guard p

src/LAoP/Utils.hs+1−1

@@ -95,7 +95,7 @@ module LAoP.Utils

9595 coerceNat2,

9696 coerceNat3,

9797

98− -- * Powerset data type

98+ -- * List data type

9999 List (..)

100100 )

101101where

src/LAoP/Utils/Internal.hs+2−72

@@ -7,77 +7,7 @@

77{-# LANGUAGE ScopedTypeVariables #-}

99module LAoP.Utils.Internal

10− ( -- | This is an internal module and it is not meant to be imported.

11− --

12− -- Utility module that provides the 'Natural' data type.

13− -- The semantic associated with this data type is that

14− -- it's meant to be a restricted 'Int' value. For example

15− -- the type @Natural 6@ can only be instanciated with @Nat n@

16− -- where @0 <= n <= 6@. Why, You might ask, because with normal

17− -- 'Int's it is not possible to have a decent @Enum (Int, Int)@

18− -- instance. See the following probabilistic programming model as and

19− -- example:

20− --

21− -- We want to calculate the probability of the sum of two dice throws.

22− -- To do this we start by defining the sample space:

23− --

24− -- @

25− -- type SampleSpace = Int -- We think 'Int' are enough

26− --

27− -- die :: Dist Int 6

28− -- die = unifrom [1..6]

29− --

30− -- -- Promote 'Int' addition to a matrix

31− -- addM = fromF (uncurry (+)) -- Impossible

32− -- @

33− --

34− -- The last line is impossible because @(Int, Int)@ does not have

35− -- a good 'Enum' instance: @[(0, 1), (0, 2), .. (0, maxBound), (1, 0),

36− -- ..]@. And we'd like the addition matrix to be of 36 columns by 12

37− -- rows but limited to integers up to @6@!

38− --

39− -- One way to solve this issue is by defining and auxilary data type to

40− -- represent the sample space:

41− --

42− -- @

43− -- data SampleSpace = S1 | S2 | S3 | S4 | S5 | S6

44− -- deriving (Show, Eq, Enum, Bounded) -- Enum and Bounded are

45− -- important

46− -- @

47− --

48− -- And write the sample space addition function:

49− --

50− -- @

51− -- ssAdd :: SampleSpace -> SampleSpace -> Int

52− -- ssAdd a b = (fromEnum a + 1) + (fromEnum b + 1)

53− -- @

54− --

55− -- And then promote that function to matrix and everything is alright:

56− --

57− -- @

58− -- ssAddM = fromF' (uncurry ssAdd)

59− --

60− -- dieSumProb = ssAddM `comp` (khatri die die)

61− -- @

62− --

63− -- This is a nice solution for small sample spaces. But for larger ones

64− -- it is not feasible to write a data type with hundreds of constructors

65− -- and then write manipulation functions that need to deal with them.

66− -- To mitigate this limitation the 'Natural' type comes a long way and

67− -- allows one to model the sample in an easier way. See for instance:

68− --

69− -- @

70− -- ssAdd :: Natural 6 -> Natural 6 -> Natural 12

71− -- ssAdd = coerceNat (+)

72− --

73− -- ssAddM = fromF' (uncurry sumSS)

74− --

75− -- die :: Dist (Natural 6) 6

76− -- die = uniform [nat @6 1 .. nat 6]

77− --

78− -- dieSumProb = ssAddM `comp` (khatri die die)

79− -- @

80− --

10+ (

8111 -- * 'Natural' data type

8212 Natural(..),

8313 nat,

@@ -88,7 +18,7 @@ module LAoP.Utils.Internal

8818 coerceNat2,

8919 coerceNat3,

9020

91− -- * Powerset data type

21+ -- * 'List' data type

9222 List (..)

9323 )

9424where