0991ecc · laop · git.iko.soy

git.iko.soy/laop

Refactored Dist module - the package now compiles

commit0991ecc8ecb5e577b84519b74a132cbe9265c075 authorArmando Santos <armandoifsantos@gmail.com> dateSun 1 Mar 2020, 17:28 (7 years ago) parentd2fbcb5

5 files changed+73−85

compare with master

unifiedsplit

app/Benchmarks.hs+8−5 app/Examples.hs+4−4 src/LAoP/Dist/Internal.hs+26−45 src/LAoP/Matrix/Alternative.hs+2 src/LAoP/Matrix/Type.hs+33−31

app/Benchmarks.hs+8−5

@@ -24,16 +24,19 @@ import GHC.TypeLits

2424import Data.Proxy

2525import Prelude hiding (id, (.))

2626

27−selectM2 ::

27+selectM2 ::

2828 ( Num e,

29− T.FromListsN e b b,

30− CountableN b

29+ EqN b,

30+ ConstructN b,

31+ EnumerableN b

3132 ) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b

3233selectM2 m y = join y iden `comp` m

3334

3435selectD2 ::

35− ( FromListsN b b,

36− CountableN b

36+ ( Num e,

37+ EqN b,

38+ ConstructN b,

39+ EnumerableN b

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

3841selectD2 (D d) m = D (join m iden `comp` d)

3942

app/Examples.hs+4−4

@@ -28,7 +28,7 @@ switch Win = Lose

2828switch Lose = Win

2929

3030firstChoice :: Matrix Double () Outcome

31−firstChoice = col [1/3, 2/3]

31+firstChoice = colL [1/3, 2/3]

3232

3333secondChoice :: Matrix Double Outcome Outcome

3434secondChoice = fromF switch

@@ -53,7 +53,7 @@ conditionSS = coerceNat2 condition

5353conditionalThrows = fromF (uncurry conditionSS) . kr (kr die die) die

5454

5555die :: Matrix Double () SS

56−die = col $ map (const (1/6)) [nat @1 @6 1 .. nat 6]

56+die = colL $ map (const (1/6)) [nat @1 @6 1 .. nat 6]

5757

5858-- Sprinkler

5959data G = Dry | Wet

@@ -96,10 +96,10 @@ tag f = kr f id

9696state g s r = tag g . tag s . r

9797

9898grass_wet :: Matrix Double () (G, (S, R)) -> Matrix Double One One

99−grass_wet state = row [0,1] . fstM . state

99+grass_wet state = rowL [0,1] . fstM . state

100100

101101rainning :: Matrix Double (G, (S, R)) One

102−rainning = row [0,1] . sndM . sndM

102+rainning = rowL [0,1] . sndM . sndM

103103

104104-- Alcuin Puzzle

105105

src/LAoP/Dist/Internal.hs+26−45

@@ -43,9 +43,9 @@ module LAoP.Dist.Internal

4343 )

4444 where

4545

46−import LAoP.Matrix.Type hiding (TrivialP, Countable, CountableDimensions, CountableN, CountableDimensionsN, Liftable, FromListsN)

46+import LAoP.Matrix.Type hiding (TrivialP, Countable, CountableDimensions, CountableN, CountableDimensionsN, FromListsN)

4747import Prelude hiding (id, (.))

48−import qualified LAoP.Matrix.Internal as I

48+import qualified LAoP.Matrix.Alternative as I

4949import LAoP.Utils

5050import GHC.TypeLits

5151import Data.Proxy

@@ -66,37 +66,26 @@ type Countable a = KnownNat (I.Count a)

6666type CountableN a = KnownNat (I.Count (I.Normalize a))

6767type CountableDimensionsN a b = (CountableN a, CountableN b)

6868type FromListsN a b = I.FromLists Prob (I.Normalize a) (I.Normalize b)

69−type Liftable a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num Prob, Ord Prob)

7069type TrivialP a b = Normalize (a, b) ~ Normalize (Normalize a, Normalize b)

7170

7271-- | Functor instance

73−fmapD ::

74− ( Liftable a b,

75− CountableDimensionsN a b,

76− FromListsN b a

77− )

78− =>

79− (a -> b) -> Dist a -> Dist b

80−fmapD f (D m) = D (fromF' f `comp` m)

72+fmapD :: Liftable a b => (a -> b) -> Dist a -> Dist b

73+fmapD f (D m) = D (fromF f `comp` m)

8174

8275-- | Applicative/Monoidal instance 'unit' function

8376unitD :: Dist ()

8477unitD = D (one 1)

8578

8679-- | Applicative/Monoidal instance 'mult' function

87−multD ::

88− ( CountableDimensionsN a b,

89− CountableN (a, b),

90− FromListsN (a, b) a,

91− FromListsN (a, b) b,

92− TrivialP a b

93− ) => Dist a -> Dist b -> Dist (a, b)

80+multD :: (FstM a b, SndM a b) => Dist a -> Dist b -> Dist (a, b)

9481multD (D a) (D b) = D (kr a b)

9582

9683-- | Selective instance function

97−selectD ::

98− ( FromListsN b b,

99− CountableN b

84+selectD ::

85+ ( EqN a,

86+ EqN b,

87+ EnumerableN b,

88+ ConstructN b

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

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

10291

@@ -104,17 +93,14 @@ selectD (D d) m = D (selectM d m)

10493-- functions to apply to a given argument;

10594branchD ::

10695 ( Num e,

107− CountableDimensionsN a b,

108− CountableDimensionsN c (Either b c),

109− FromListsN c b,

110− FromListsN a b,

111− FromListsN a a,

112− FromListsN b b,

113− FromListsN c c,

114− FromListsN b a,

115− FromListsN b c,

116− FromListsN (Either b c) b,

117− FromListsN (Either b c) c

96+ EqN a,

97+ EqN b,

98+ EqN c,

99+ ConstructableN a b,

100+ ConstructN c,

101+ EnumerableN a,

102+ EnumerableN b,

103+ EnumerableN c

118104 )

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

120106branchD x l r = f x `selectD` g l `selectD` r

@@ -124,11 +110,10 @@ branchD x l r = f x `selectD` g l `selectD` r

124110

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

126112ifD ::

127− ( CountableDimensionsN a (Either () a),

128− FromListsN a a,

129− FromListsN a (),

130− FromListsN () a,

131− FromListsN (Either () a) a

113+ ( Num e,

114+ EqN a,

115+ ConstructN a,

116+ EnumerableN a

132117 )

133118 => Dist Bool -> Dist a -> Dist a -> Dist a

134119ifD x (D t) (D e) = branchD x' t e

@@ -136,12 +121,8 @@ ifD x (D t) (D e) = branchD x' t e

136121 x' = bool (Right ()) (Left ()) `fmapD` x

137122

138123-- | Monad instance 'return' function

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

140−returnD a = D (col l)

141− where

142− i = fromInteger $ natVal (Proxy :: Proxy (Count a))

143− x = fromEnum a

144− l = take x [0,0..] ++ [1] ++ take (i - x - 1) [0,0..]

124+returnD :: Liftable () a => a -> Dist a

125+returnD = D . returnM

145126

146127-- | Monad instance '(>>=)' function

147128bindD :: Dist a -> Matrix Prob a b -> Dist b

@@ -162,7 +143,7 @@ bindD (D d) m = D (m `comp` d)

162143

163144-- | Constructs a Bernoulli distribution

164145choose :: (FromListsN () a) => Prob -> Dist a

165−choose prob = D (col [prob, 1 - prob])

146+choose prob = D (colL [prob, 1 - prob])

166147

167148-- | Creates a distribution given a shape function

168149shape :: (FromListsN () a) => (Prob -> Prob) -> [a] -> Dist a

@@ -215,7 +196,7 @@ prettyPrintDist = putStrLn . prettyDist @a

215196-- Auxiliary functions

216197

217198fromFreqs :: (FromListsN () a) => [(a,Prob)] -> Dist a

218−fromFreqs xs = D (col (map (\(x,p) -> p/q) xs))

199+fromFreqs xs = D (colL (map (\(x,p) -> p/q) xs))

219200 where q = sum $ map snd xs

220201

221202normalCurve :: Prob -> Prob -> Prob -> Prob

src/LAoP/Matrix/Alternative.hs+2

@@ -160,6 +160,8 @@ module LAoP.Matrix.Alternative

160160 subM,

161161

162162 -- * Semantics

163+ Vector(..),

164+ LinearMap,

163165 Construct

164166 )

165167 where

src/LAoP/Matrix/Type.hs+33−31

@@ -6,7 +6,6 @@

66{-# LANGUAGE FlexibleContexts #-}

77{-# LANGUAGE FlexibleInstances #-}

88{-# LANGUAGE GADTs #-}

9−{-# LANGUAGE KindSignatures #-}

109{-# LANGUAGE MultiParamTypeClasses #-}

1110{-# LANGUAGE NoStarIsType #-}

1211{-# LANGUAGE RankNTypes #-}

@@ -65,7 +64,18 @@ module LAoP.Matrix.Type

6564 FromListsN,

6665 Liftable,

6766 Trivial,

67+ Trivial2,

6868 TrivialP,

69+ EqN,

70+ EnumN,

71+ Enumerable,

72+ EnumerableN,

73+ ConstructNorm,

74+ ConstructN,

75+ ConstructableN,

76+ FstM,

77+ SndM,

78+ Kronecker,

6979

7080 -- * Type aliases

7181 Zero,

@@ -89,7 +99,9 @@ module LAoP.Matrix.Type

8999 toList,

90100 matrixBuilder,

91101 rowL,

102+ row,

92103 colL,

104+ col,

93105 zeros,

94106 ones,

95107 bang,

@@ -180,7 +192,7 @@ where

180192

181193import Data.Void

182194import Data.Kind

183−import GHC.TypeLits

195+import GHC.TypeLits

184196import Control.DeepSeq

185197import LAoP.Utils

186198import qualified LAoP.Matrix.Alternative as I

@@ -271,42 +283,30 @@ infixl 2 ===

271283-- Functor hierarchy

272284

273285-- | Functor instance equivalent function

274−fmapM ::

275− ( Num e,

276− Liftable a b

277− )

278− =>

279− (a -> b) -> Matrix e c a -> Matrix e c b

286+fmapM :: (Num e, Liftable a b) => (a -> b) -> Matrix e c a -> Matrix e c b

280287fmapM f m = fromF f . m

281288

282289-- | Applicative instance equivalent 'unit' function,

283−unitM :: (Num e) => Matrix e () ()

290+unitM :: Num e => Matrix e () ()

284291unitM = one 1

285292

286293-- | Applicative instance equivalent 'unit' function,

287−multM ::

288− ( Num e,

289− FstM a b,

290− SndM a b

291− ) => Matrix e c a -> Matrix e c b -> Matrix e c (a, b)

294+multM :: (Num e, FstM a b, SndM a b) => Matrix e c a -> Matrix e c b -> Matrix e c (a, b)

292295multM = kr

293296

294297-- | Monad instance equivalent 'return' function,

295−returnM ::

296− ( Num e,

297− Liftable () a

298− ) => a -> Matrix e One a

298+returnM :: (Num e, Liftable () a) => a -> Matrix e One a

299299returnM = point

300300

301301-- | Monad instance equivalent '(>>=)' function,

302−bindM :: (Num e) => Matrix e a b -> Matrix e b c -> Matrix e a c

302+bindM :: Num e => Matrix e a b -> Matrix e b c -> Matrix e a c

303303bindM = flip comp

304304

305305-- Construction

306306

307307-- | Build a matrix out of a list of list of elements. Throws a runtime

308308-- error if the dimensions do not match.

309−fromLists :: (FromListsN e cols rows) => [[e]] -> Matrix e cols rows

309+fromLists :: FromListsN e cols rows => [[e]] -> Matrix e cols rows

310310fromLists = M . I.fromLists

311311

312312-- | Matrix builder function. Constructs a matrix provided with

@@ -323,19 +323,24 @@ matrixBuilder ::

323323matrixBuilder = M . I.matrixBuilderN

324324

325325-- | Constructs a column vector matrix

326−colL :: (FromListsN e () rows) => [e] -> Matrix e One rows

326+colL :: FromListsN e () rows => [e] -> Matrix e One rows

327327colL = M . I.colL

328328

329+-- | Constructs a column vector matrix

330+col :: (Num e, Enum a, EnumN a, ConstructN a) => (a -> e) -> Matrix e One a

331+col = M . I.colN . I.Vector

332+

329333-- | Constructs a row vector matrix

330−rowL :: (FromListsN e cols ()) => [e] -> Matrix e cols One

334+rowL :: FromListsN e cols () => [e] -> Matrix e cols One

331335rowL = M . I.rowL

332336

337+-- | Constructs a row vector matrix

338+row :: (Num e, Enum a, EnumN a, ConstructN a) => (a -> e) -> Matrix e a One

339+row = M . I.rowN . I.Vector

340+

333341-- | Lifts functions to matrices with dimensions matching @a@ and @b@

334342-- cardinality's.

335−fromF ::

336− ( Num e,

337− Liftable a b

338− )

343+fromF :: (Num e, Liftable a b)

339344 => (a -> b) -> Matrix e a b

340345fromF = M . I.fromFN

341346

@@ -401,10 +406,7 @@ bang ::

401406bang = ones

402407

403408-- | Point constant matrix

404−point ::

405− ( Num e,

406− Liftable () a

407− ) => a -> Matrix e One a

409+point :: (Num e, Liftable () a) => a -> Matrix e One a

408410point = fromF . const

409411

410412-- iden Matrix

@@ -426,7 +428,7 @@ iden = M I.iden

426428--

427429-- This definition takes advantage of divide-and-conquer and fusion laws

428430-- from LAoP.

429−comp :: (Num e) => Matrix e cr rows -> Matrix e cols cr -> Matrix e cols rows

431+comp :: Num e => Matrix e cr rows -> Matrix e cols cr -> Matrix e cols rows

430432comp (M a) (M b) = M (I.comp a b)

431433{-# NOINLINE comp #-}

432434{-# RULES