1dab2f7 · laop · git.iko.soy

git.iko.soy/laop

Added zipWithM; Refactored Num instance and Spreadsheet example

commit1dab2f77fac95596fbf2fd5c7e4ebb359ca5ff2b authorArmando Santos <armandoifsantos@gmail.com> dateMon 17 Feb 2020, 10:49 (7 years ago) parent28f7b16

6 files changed+57−47

compare with master

unifiedsplit

app/Examples.hs+23−13 app/Spreadsheets.hs+3−14 laop-0.1.0.0-docs.tar.gz src/LAoP/Matrix/Internal.hs+17−20 src/LAoP/Matrix/Nat.hs+7 src/LAoP/Matrix/Type.hs+7

app/Examples.hs+23−13

@@ -1,3 +1,4 @@

1+{-# LANGUAGE GADTs #-}

12{-# LANGUAGE DeriveGeneric #-}

23{-# LANGUAGE FlexibleContexts #-}

34{-# LANGUAGE TypeOperators #-}

@@ -15,13 +16,13 @@ import LAoP.Utils

1516import LAoP.Dist

1617import GHC.TypeLits

1718import Data.Coerce

18−import GHC.Generics

19+import qualified GHC.Generics as G

1920import Control.Category hiding (id)

2021import Prelude hiding ((.))

2122

2223-- Monty Hall Problem

2324data Outcome = Win | Lose

24− deriving (Bounded, Enum, Eq, Show, Generic)

25+ deriving (Bounded, Enum, Eq, Show, G.Generic)

2526

2627switch :: Outcome -> Outcome

2728switch Win = Lose

@@ -56,32 +57,41 @@ die :: Matrix Double () SS

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

5758

5859-- Sprinkler

60+data G = Dry | Wet

61+ deriving (Bounded, Enum, Eq, Show, G.Generic)

5962

60−rain :: Matrix Double () Bool

63+data S = Off | On

64+ deriving (Bounded, Enum, Eq, Show, G.Generic)

65+

66+data R = No | Yes

67+ deriving (Bounded, Enum, Eq, Show, G.Generic)

68+

69+rain :: Matrix Double () R

6170rain = col [0.8, 0.2]

6271

63−sprinkler :: Matrix Double Bool Bool

72+sprinkler :: Matrix Double R S

6473sprinkler = fromLists [[0.6, 0.99], [0.4, 0.01]]

6574

66−grass :: Matrix Double (Bool, Bool) Bool

75+grass :: Matrix Double (S, R) G

6776grass = fromLists [[1, 0.2, 0.1, 0.01], [0, 0.8, 0.9, 0.99]]

6877

69−state :: Matrix Double () (Bool, (Bool, Bool))

70−state = khatri grass identity . khatri sprinkler identity . rain

78+tag f = khatri f identity

79+

80+state g s r = tag g `comp` tag s `comp` r

7181

72−grass_wet :: Matrix Double (Bool, (Bool, Bool)) One

82+grass_wet :: Matrix Double (G, (S, R)) One

7383grass_wet = row [0,1] . kp1

7484

75−rainning :: Matrix Double (Bool, (Bool, Bool)) One

85+rainning :: Matrix Double (G, (S, R)) One

7686rainning = row [0,1] . kp2 . kp2

7787

7888-- Alcuin Puzzle

7989

8090data Being = Farmer | Fox | Goose | Beans

81− deriving (Bounded, Enum, Eq, Show, Generic)

91+ deriving (Bounded, Enum, Eq, Show, G.Generic)

8292

8393data Bank = LeftB | RightB

84− deriving (Bounded, Enum, Eq, Show, Generic)

94+ deriving (Bounded, Enum, Eq, Show, G.Generic)

8595

8696eats :: Being -> Being -> Bool

8797eats Fox Goose = True

@@ -152,8 +162,8 @@ exec = do

152162 putStrLn "\n Checking that the last result is indeed a distribution: "

153163 prettyPrint (bang . sumSSM . khatri die die)

154164 putStrLn "\n Probability of grass being wet:"

155− prettyPrint (grass_wet . state)

165+ prettyPrint (grass_wet . state grass sprinkler rain)

156166 putStrLn "\n Probability of rain:"

157− prettyPrint (rainning . state)

167+ prettyPrint (rainning . state grass sprinkler rain)

158168 putStrLn "\n Is the arbitrary state a valid state? (Alcuin Puzzle)"

159169 print (inv bankStateR)

app/Spreadsheets.hs+3−14

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

1−{-# LANGUAGE DataKinds #-}

2−{-# LANGUAGE GADTs #-}

3−{-# LANGUAGE FlexibleContexts #-}

41{-# LANGUAGE DeriveGeneric #-}

63module Spreadsheets

@@ -42,17 +39,9 @@ xls w m t = junc (split w m) (split zeros r)

4239 where

4340 rExam = m `comp` tr w

4441 rTest = tr t

45− rFinal = rTest `maxPP` rExam

42+ rFinal = rTest `maxPW` rExam

4643 r = (rExam `comp` tr exam) + (rTest `comp` tr test) + (rFinal `comp` tr final)

4744

4845-- | Overloaded, point-wise 'max' function

49−maxPP_ :: Ord e => I.Matrix e a b -> I.Matrix e a b -> I.Matrix e a b

50−maxPP_ I.Empty I.Empty = I.Empty

51−maxPP_ (I.One a) (I.One b) = I.One (a `max` b)

52−maxPP_ (I.Junc a b) (I.Junc c d) = I.Junc (maxPP_ a c) (maxPP_ b d)

53−maxPP_ (I.Split a b) (I.Split c d) = I.Split (maxPP_ a c) (maxPP_ b d)

54−maxPP_ x@(I.Split _ _) y@(I.Junc _ _) = maxPP_ x (I.abideJS y)

55−maxPP_ x@(I.Junc _ _) y@(I.Split _ _) = maxPP_ (I.abideJS x) y

56−

57−maxPP :: Ord e => Matrix e a b -> Matrix e a b -> Matrix e a b

58−maxPP (M a) (M b) = M (maxPP_ a b)

46+maxPW :: Ord e => Matrix e a b -> Matrix e a b -> Matrix e a b

47+maxPW = zipWithM max

laop-0.1.0.0-docs.tar.gzdeleted

Binary file not shown.

src/LAoP/Matrix/Internal.hs+17−20

@@ -92,6 +92,9 @@ module LAoP.Matrix.Internal

9292 abideJS,

9393 abideSJ,

9494

95+ -- ** Zip matrices

96+ zipWithM,

97+

9598 -- * Biproduct approach

9699 -- ** Split

97100 (===),

@@ -244,26 +247,11 @@ instance Eq e => Eq (Matrix e cols rows) where

244247

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

246249

247− Empty + Empty = Empty

248− (One a) + (One b) = One (a + b)

249− (Junc a b) + (Junc c d) = Junc (a + c) (b + d)

250− (Split a b) + (Split c d) = Split (a + c) (b + d)

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

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

253−

254− Empty - Empty = Empty

255− (One a) - (One b) = One (a - b)

256− (Junc a b) - (Junc c d) = Junc (a - c) (b - d)

257− (Split a b) - (Split c d) = Split (a - c) (b - d)

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

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

260−

261− Empty * Empty = Empty

262− (One a) * (One b) = One (a * b)

263− (Junc a b) * (Junc c d) = Junc (a * c) (b * d)

264− (Split a b) * (Split c d) = Split (a * c) (b * d)

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

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

250+ a + b = zipWithM (+) a b

251+

252+ a - b = zipWithM (-) a b

253+

254+ a * b = zipWithM (*) a b

267255

268256 abs Empty = Empty

269257 abs (One a) = One (abs a)

@@ -827,6 +815,15 @@ pretty m = concat

827815prettyPrint :: (CountableDimensions cols rows, Show e) => Matrix e cols rows -> IO ()

828816prettyPrint = putStrLn . pretty

829817

818+-- | Zip two matrices with a given binary function

819+zipWithM :: (e -> f -> g) -> Matrix e cols rows -> Matrix f cols rows -> Matrix g cols rows

820+zipWithM f Empty Empty = Empty

821+zipWithM f (One a) (One b) = One (f a b)

822+zipWithM f (Junc a b) (Junc c d) = Junc (zipWithM f a c) (zipWithM f b d)

823+zipWithM f (Split a b) (Split c d) = Split (zipWithM f a c) (zipWithM f b d)

824+zipWithM f x@(Split _ _) y@(Junc _ _) = zipWithM f x (abideJS y)

825+zipWithM f x@(Junc _ _) y@(Split _ _) = zipWithM f (abideJS x) y

826+

830827-- Relational operators functions

831828

832829type Boolean = Natural 0 1

src/LAoP/Matrix/Nat.hs+7

@@ -108,6 +108,9 @@ module LAoP.Matrix.Nat

108108 abideJS,

109109 abideSJ,

110110

111+ -- ** Zip Matrices

112+ zipWithM,

113+

111114 -- * Biproduct approach

112115 -- ** Split

113116 (===),

@@ -473,3 +476,7 @@ pretty (M m) = I.pretty m

473476

474477prettyPrint :: (CountableDimensionsN cols rows, Show e) => Matrix e cols rows -> IO ()

475478prettyPrint (M m) = I.prettyPrint m

479+

480+-- | Zip two matrices with a given binary function

481+zipWithM :: (e -> f -> g) -> Matrix e cols rows -> Matrix f cols rows -> Matrix g cols rows

482+zipWithM f (M a) (M b) = M (I.zipWithM f a b)

src/LAoP/Matrix/Type.hs+7

@@ -125,6 +125,9 @@ module LAoP.Matrix.Type

125125 abideJS,

126126 abideSJ,

127127

128+ -- ** Zip Matrices

129+ zipWithM,

130+

128131 -- * Biproduct approach

129132 -- ** Split

130133 (===),

@@ -661,3 +664,7 @@ pretty (M m) = I.pretty m

661664-- | Matrix pretty printer

662665prettyPrint :: (CountableDimensionsN cols rows, Show e) => Matrix e cols rows -> IO ()

663666prettyPrint (M m) = I.prettyPrint m

667+

668+-- | Zip two matrices with a given binary function

669+zipWithM :: (e -> f -> g) -> Matrix e a b -> Matrix f a b -> Matrix g a b

670+zipWithM f (M a) (M b) = M (I.zipWithM f a b)