d6c0c5d · laop · git.iko.soy

git.iko.soy/laop

Small fixes. Added fromF'. Fixed mccarthys conditional

commitd6c0c5d2923d8b5abbe2fbb4ca7b7aa7f6512c6e authorArmando Santos <armandoifsantos@gmail.com> dateSat 28 Dec 2019, 16:39 (7 years ago) parent43866d4

4 files changed+115−16

compare with master

unifiedsplit

app/Main.hs+6−7 src/Dist/Internal.hs+2−2 src/Matrix/Nat.hs+31 src/Matrix/Type.hs+76−7

app/Main.hs+6−7

@@ -18,8 +18,8 @@ switch :: Outcome -> Outcome

1818switch Win = Lose

1919switch Lose = Win

2020

21−firstChoice :: Dist Outcome 2

22−firstChoice = choose (1/3)

21+firstChoice :: Dist Outcome m

22+firstChoice = col [1/3, 2/3]

2323

2424secondChoice :: Matrix Double 2 2

2525secondChoice = fromF switch

@@ -29,15 +29,14 @@ secondChoice = fromF switch

2929sumSS :: Natural 6 -> Natural 6 -> Natural 12

3030sumSS = coerceNat (+)

3131

32−sumSSM :: Matrix Double 36 12

33−sumSSM = fromF (uncurry sumSS)

32+sumSSM = fromF' (uncurry sumSS)

3433

3534die :: Dist (Natural 6) 6

36−die = uniform [(nat 1)..(nat @6 6)]

35+die = uniform [nat @6 1 .. nat 6]

3736

3837main :: IO ()

3938main = do

4039 prettyPrint (p1 @Double @1 `comp` secondChoice `comp` firstChoice)

41− prettyPrint (sumSSM `comp` (die >< die))

42− prettyPrint (bang `comp` sumSSM `comp` (die >< die))

40+ prettyPrint (sumSSM `comp` khatri die die)

41+ prettyPrint (bang `comp` sumSSM `comp` khatri die die)

4342

src/Dist/Internal.hs+2−2

@@ -1,6 +1,6 @@

11{-# LANGUAGE FlexibleContexts #-}

2−{-# LANGUAGE RankNTypes #-}

32{-# LANGUAGE DataKinds #-}

3+{-# LANGUAGE RankNTypes #-}

55module Dist.Internal

66 (

@@ -20,7 +20,7 @@ import Utils

2020type Prob = Double

2121type Dist a m = (FromLists Prob () (FromNat m)) => Matrix Prob 1 m

2222

23−choose :: Prob -> Dist a m

23+choose :: Prob -> Dist a 2

2424choose prob = col [prob, 1 - prob]

2525

2626shape :: (Prob -> Prob) -> [a] -> Dist a m

src/Matrix/Nat.hs+31

@@ -112,6 +112,7 @@ module Matrix.Nat

112112 identity,

113113 comp,

114114 fromF,

115+ fromF',

115116

116117 -- * Matrix printing

117118 pretty,

@@ -197,6 +198,22 @@ fromF ::

197198 Matrix e cols rows

198199fromF = M . I.fromF

199200

201+fromF' ::

202+ ( Bounded a,

203+ Bounded b,

204+ Enum a,

205+ Enum b,

206+ Eq b,

207+ Num e,

208+ Ord e,

209+ KnownNat (I.Count (I.Normalize a)),

210+ KnownNat (I.Count (I.Normalize b)),

211+ I.FromLists e (I.Normalize b) (I.Normalize a)

212+ ) =>

213+ (a -> b) ->

214+ Matrix e (I.Count a) (I.Count b)

215+fromF' = M . I.fromF'

216+

200217-- Conversion

201218

202219toLists :: Matrix e cols rows -> [[e]]

@@ -425,6 +442,20 @@ select (M m) y = M (I.select m y)

425442

426443-- McCarthy's Conditional

427444

445+cond ::

446+ ( I.FromNat (I.Count (I.FromNat cols)) ~ I.FromNat cols,

447+ KnownNat (I.Count (I.FromNat cols)),

448+ I.FromLists e () (I.FromNat cols),

449+ I.FromLists e (I.FromNat cols) (),

450+ I.FromLists e (I.FromNat cols) (I.FromNat cols),

451+ I.KhatriP2 e () (I.FromNat cols),

452+ Bounded a,

453+ Enum a,

454+ Num e,

455+ Ord e

456+ )

457+ =>

458+ (a -> Bool) -> Matrix e cols rows -> Matrix e cols rows -> Matrix e cols rows

428459cond p (M a) (M b) = M (I.cond p a b)

429460

430461-- Pretty print

src/Matrix/Type.hs+76−7

@@ -112,6 +112,7 @@ module Matrix.Type

112112 identity,

113113 comp,

114114 fromF,

115+ fromF',

115116

116117 -- * Matrix printing

117118 pretty,

@@ -119,6 +120,7 @@ module Matrix.Type

119120 )

120121 where

121122

123+import Utils

122124import Data.Bool

123125import Data.Kind

124126import Data.List

@@ -142,6 +144,7 @@ type family Count (d :: Type) where

142144 Count (Either a b) = (+) (Count a) (Count b)

143145 Count (a, b) = (*) (Count a) (Count b)

144146 Count (a -> b) = (^) (Count b) (Count a)

147+ Count (Natural n) = n

145148

146149-- | Type family that computes of a given type dimension from a fiven natural

147150type family FromNat (n :: Nat) where

@@ -292,6 +295,40 @@ fromF f =

292295 buildList [] _ = []

293296 buildList l r = take r l : buildList (drop r l) r

294297

298+fromF' ::

299+ forall a b cols rows e.

300+ ( Bounded a,

301+ Bounded b,

302+ Enum a,

303+ Enum b,

304+ Eq b,

305+ Num e,

306+ Ord e,

307+ KnownNat (Count (Normalize a)),

308+ KnownNat (Count (Normalize b)),

309+ FromLists e (Normalize b) (Normalize a)

310+ ) =>

311+ (a -> b) ->

312+ Matrix e (Normalize a) (Normalize b)

313+fromF' f =

314+ let minA = minBound @a

315+ maxA = maxBound @a

316+ minB = minBound @b

317+ maxB = maxBound @b

318+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))

319+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))

320+ elementsA = take ccols [minA .. maxA]

321+ elementsB = take rrows [minB .. maxB]

322+ combinations = (,) <$> elementsA <*> elementsB

323+ combAp = map snd . sort . map (\(a, b) -> if f a == b

324+ then ((fromEnum a, fromEnum b), 1)

325+ else ((fromEnum a, fromEnum b), 0)) $ combinations

326+ mList = buildList combAp rrows

327+ in tr $ fromLists mList

328+ where

329+ buildList [] _ = []

330+ buildList l r = take r l : buildList (drop r l) r

331+

295332-- Conversion

296333

297334toLists :: Matrix e cols rows -> [[e]]

@@ -495,22 +532,54 @@ select m y = (junc (fromF y) identity) `comp` m

495532

496533-- McCarthy's Conditional

497534

498−cond p f g = junc f g `comp` split (corr p) (corr (not . p))

535+cond ::

536+ ( cols ~ FromNat (Count cols),

537+ KnownNat (Count cols),

538+ FromLists e () cols,

539+ FromLists e cols (),

540+ FromLists e cols cols,

541+ KhatriP2 e () cols,

542+ Bounded a,

543+ Enum a,

544+ Num e,

545+ Ord e

546+ )

547+ =>

548+ (a -> Bool) -> Matrix e cols rows -> Matrix e cols rows -> Matrix e cols rows

549+cond p f g = junc f g `comp` grd p

550+

551+grd ::

552+ ( q ~ FromNat (Count q),

553+ KnownNat (Count q),

554+ FromLists e () q,

555+ FromLists e q (),

556+ FromLists e q q,

557+ KhatriP2 e () q,

558+ Bounded a,

559+ Enum a,

560+ Num e,

561+ Ord e

562+ )

563+ =>

564+ (a -> Bool) -> Matrix e q (Either q q)

565+grd f = split (corr f) (corr (not . f))

499566

500567corr ::

501568 forall e a q .

502− ( KhatriP1 e q q,

503− KhatriP2 e q q,

504− FromLists e q q,

569+ ( q ~ FromNat (Count q),

505570 KnownNat (Count q),

571+ FromLists e () q,

572+ FromLists e q (),

573+ FromLists e q q,

574+ KhatriP2 e () q,

506575 Bounded a,

507576 Enum a,

508577 Num e,

509578 Ord e

510579 )

511− => (a -> Bool) -> Matrix e (Normalize (q, q)) (Normalize (q, q))

512−corr p = let f = fromF p :: Matrix e q q

513− in f >< (identity :: Matrix e q q)

580+ => (a -> Bool) -> Matrix e q q

581+corr p = let f = fromF p :: Matrix e q ()

582+ in khatri f (identity :: Matrix e q q)

514583

515584-- Pretty print

516585