git.iko.soy/laop
on master help sign in
Organized app folder.
d4b69a9Armando Santos
app/Benchmarks.hsnew file+102
compare with master
unifiedsplit
@@ -0,0 +1,102 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE BangPatterns #-}
3+{-# LANGUAGE TypeApplications #-}
4+{-# LANGUAGE FlexibleContexts #-}
5+{-# LANGUAGE AllowAmbiguousTypes #-}
6+{-# LANGUAGE ScopedTypeVariables #-}
7+
8+module Benchmarks
9+ ( benchmark
10+ )
11+ where
12+
13+import LAoP.Dist.Internal
14+import LAoP.Utils
15+import LAoP.Matrix.Type hiding (CountableN, Countable, FromListsN)
16+import qualified LAoP.Matrix.Type as T (FromListsN)
17+import Criterion.Main
18+import Control.DeepSeq
19+import Test.QuickCheck
20+import GHC.TypeLits
21+import Data.Proxy
22+import Data.Time.Clock.POSIX (getPOSIXTime)
23+
24+selectM2 ::
25+ ( Num e,
26+ T.FromListsN e b b,
27+ CountableN b
28+ ) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b
29+selectM2 m y = junc y identity `comp` m
30+
31+selectD2 ::
32+ ( FromListsN b b,
33+ CountableN b
34+ ) => Dist (Either a b) -> Matrix Prob a b -> Dist b
35+selectD2 (D d) m = D (junc m identity `comp` d)
36+
37+randomDist :: forall a . (Countable a, FromListsN () a) => Gen (Dist a)
38+randomDist = do
39+ let size = fromInteger (natVal (Proxy :: Proxy (Count a)))
40+ l <- vectorOf size (arbitrary :: Gen Prob)
41+ let ln = normalize l
42+ lr = map (:[]) ln
43+ m = fromLists lr
44+ return (D m)
45+
46+randomMatrix :: forall a b . (CountableDimensions a b, FromListsN a b) => Gen (Matrix Prob a b)
47+randomMatrix = do
48+ let cols = fromInteger (natVal (Proxy :: Proxy (Count a)))
49+ rows = fromInteger (natVal (Proxy :: Proxy (Count b)))
50+ l <- vectorOf (cols * rows) (arbitrary :: Gen Float)
51+ let lr = buildList l cols
52+ m = fromLists lr
53+ return m
54+
55+buildList [] _ = []
56+buildList l r = take r l : buildList (drop r l) r
57+
58+normalize :: [Prob] -> [Prob]
59+normalize l = let l' = map abs l
60+ s = sum l'
61+ in map (/ s) l'
62+
63+setupEnv = do
64+ m11 <- generate (resize 1 (randomMatrix @(Natural 0 10) @(Natural 0 10) ))
65+ m12 <- generate (resize 1 (randomMatrix @(Natural 0 10) @(Natural 0 10) ))
66+ m21 <- generate (resize 1 (randomMatrix @(Natural 0 100) @(Natural 0 100) ))
67+ m22 <- generate (resize 1 (randomMatrix @(Natural 0 100) @(Natural 0 100) ))
68+ m31 <- generate (resize 1 (randomMatrix @(Natural 0 300) @(Natural 0 300) ))
69+ m32 <- generate (resize 1 (randomMatrix @(Natural 0 300) @(Natural 0 300) ))
70+ m40 <- generate (resize 1 (randomMatrix @(Natural 0 100) @(Either (Natural 0 100) (Natural 0 100) )))
71+ dist <- generate (resize 1 (randomDist @(Either (Natural 0 1000) (Natural 0 1000)) ))
72+ dist2 <- generate (resize 1 (randomMatrix @(Natural 0 1000) @(Natural 0 1000) ))
73+ return (m11, m12, m21, m22, m31, m32, m40, dist, dist2)
74+
75+benchmark :: IO ()
76+benchmark = defaultMain [
77+ env setupEnv $ \ ~(m11, m12, m21, m22, m31, m32, m40, dist, dist2) -> bgroup "main" [
78+ bgroup "Matrix composition" [
79+ bench "WHNF - 10x10" $ whnf (comp m11) m12
80+ , bench "NF - 10x10" $ nf (comp m11) m12
81+ , bench "WHNF - 100x100" $ whnf (comp m21) m22
82+ , bench "NF - 100x100" $ nf (comp m21) m22
83+ , bench "WHNF - 300x300" $ whnf (comp m31) m32
84+ , bench "NF - 300x300" $ nf (comp m31) m32
85+ ],
86+ bgroup "Dist - Applicative `select`" [
87+ bench "WHNF" $ whnf (selectD2 dist) dist2
88+ , bench "NF" $ nf (selectD2 dist) dist2
89+ ],
90+ bgroup "Dist - Selective `select`" [
91+ bench "WHNF" $ whnf (selectD dist) dist2
92+ , bench "NF" $ nf (selectD dist) dist2
93+ ],
94+ bgroup "Matrix - Applicative `select`" [
95+ bench "WHNF" $ whnf (selectM2 m40) m21
96+ , bench "NF" $ nf (selectM2 m40) m21
97+ ],
98+ bgroup "Matrix - Selective `select`" [
99+ bench "WHNF" $ whnf (selectM m40) m21
100+ , bench "NF" $ nf (selectM m40) m21
101+ ]
102+ ] ]
app/Examples.hsnew file+159
@@ -0,0 +1,159 @@
1+{-# LANGUAGE DeriveGeneric #-}
2+{-# LANGUAGE FlexibleContexts #-}
3+{-# LANGUAGE TypeOperators #-}
4+{-# LANGUAGE TypeApplications #-}
5+{-# LANGUAGE DataKinds #-}
6+
7+module Examples
8+ ( exec
9+ )
10+ where
11+
12+import LAoP.Matrix.Type
13+import qualified LAoP.Relation as R
14+import LAoP.Utils
15+import LAoP.Dist
16+import GHC.TypeLits
17+import Data.Coerce
18+import GHC.Generics
19+import Control.Category hiding (id)
20+import Prelude hiding ((.))
21+
22+-- Monty Hall Problem
23+data Outcome = Win | Lose
24+ deriving (Bounded, Enum, Eq, Show, Generic)
25+
26+switch :: Outcome -> Outcome
27+switch Win = Lose
28+switch Lose = Win
29+
30+firstChoice :: Matrix Double () Outcome
31+firstChoice = col [1/3, 2/3]
32+
33+secondChoice :: Matrix Double Outcome Outcome
34+secondChoice = fromF' switch
35+
36+-- Dice sum
37+
38+type SS = Natural 1 6 -- Sample Space
39+
40+sumSS :: SS -> SS -> Natural 2 12
41+sumSS = coerceNat (+)
42+
43+sumSSM = fromF' (uncurry sumSS)
44+
45+condition :: (Int, Int) -> Int -> Int
46+condition (fst, snd) thrd = if fst == snd
47+ then fst * 3
48+ else fst + snd + thrd
49+
50+conditionSS :: (SS, SS) -> SS -> Natural 3 18
51+conditionSS = coerceNat2 condition
52+
53+conditionalThrows = fromF' (uncurry conditionSS) . khatri (khatri die die) die
54+
55+die :: Matrix Double () SS
56+die = col $ map (const (1/6)) [nat @1 @6 1 .. nat 6]
57+
58+-- Sprinkler
59+
60+rain :: Matrix Double () Bool
61+rain = col [0.8, 0.2]
62+
63+sprinkler :: Matrix Double Bool Bool
64+sprinkler = fromLists [[0.6, 0.99], [0.4, 0.01]]
65+
66+grass :: Matrix Double (Bool, Bool) Bool
67+grass = fromLists [[1, 0.2, 0.1, 0.01], [0, 0.8, 0.9, 0.99]]
68+
69+state :: Matrix Double () (Bool, (Bool, Bool))
70+state = khatri grass identity . khatri sprinkler identity . rain
71+
72+grass_wet :: Matrix Double (Bool, (Bool, Bool)) One
73+grass_wet = row [0,1] . kp1
74+
75+rainning :: Matrix Double (Bool, (Bool, Bool)) One
76+rainning = row [0,1] . kp2 . kp2
77+
78+-- Alcuin Puzzle
79+
80+data Being = Farmer | Fox | Goose | Beans
81+ deriving (Bounded, Enum, Eq, Show, Generic)
82+
83+data Bank = LeftB | RightB
84+ deriving (Bounded, Enum, Eq, Show, Generic)
85+
86+eats :: Being -> Being -> Bool
87+eats Fox Goose = True
88+eats Goose Beans = True
89+eats _ _ = False
90+
91+eatsR :: R.Relation Being Being
92+eatsR = R.toRel eats
93+
94+cross :: Bank -> Bank
95+cross LeftB = RightB
96+cross RightB = LeftB
97+
98+crossR :: R.Relation Bank Bank
99+crossR = R.fromF' cross
100+
101+-- | Initial state, everyone in the left bank
102+locationLeft :: Being -> Bank
103+locationLeft _ = LeftB
104+
105+locationLeftR :: R.Relation Being Bank
106+locationLeftR = R.fromF' locationLeft
107+
108+-- | Initial state, everyone in the right bank
109+locationRight :: Being -> Bank
110+locationRight _ = RightB
111+
112+locationRightR :: R.Relation Being Bank
113+locationRightR = R.fromF' locationRight
114+
115+-- Properties
116+
117+-- Being at the same bank
118+sameBank :: R.Relation Being Bank -> R.Relation Being Being
119+sameBank = R.ker
120+
121+-- Risk of somebody eating somebody else
122+canEat :: R.Relation Being Bank -> R.Relation Being Being
123+canEat w = sameBank w `R.intersection` eatsR
124+
125+-- "Starvation" property.
126+inv :: R.Relation Being Bank -> Bool
127+inv w = (w `R.comp` canEat w) `R.sse` (w `R.comp` farmer)
128+ where
129+ farmer :: R.Relation Being Being
130+ farmer = R.fromF' (const Farmer)
131+
132+-- Arbitrary state
133+bankState :: Being -> Bank -> Bool
134+bankState Farmer LeftB = True
135+bankState Fox LeftB = True
136+bankState Goose RightB = True
137+bankState Beans RightB = True
138+bankState _ _ = False
139+
140+bankStateR :: R.Relation Being Bank
141+bankStateR = R.toRel bankState
142+
143+-- Main
144+exec :: IO ()
145+exec = do
146+ putStrLn "Monty Hall Problem solution:"
147+ prettyPrint (secondChoice . firstChoice)
148+ putStrLn "\n Sum of dices probability:"
149+ prettyPrint (sumSSM `comp` khatri die die)
150+ putStrLn "\n Conditional dice throw:"
151+ prettyPrint conditionalThrows
152+ putStrLn "\n Checking that the last result is indeed a distribution: "
153+ prettyPrint (bang . sumSSM . khatri die die)
154+ putStrLn "\n Probability of grass being wet:"
155+ prettyPrint (grass_wet . state)
156+ putStrLn "\n Probability of rain:"
157+ prettyPrint (rainning . state)
158+ putStrLn "\n Is the arbitrary state a valid state? (Alcuin Puzzle)"
159+ print (inv bankStateR)
app/Main.hs+3−152
@@ -1,156 +1,7 @@
1−{-# LANGUAGE DeriveGeneric #-}
2−{-# LANGUAGE FlexibleContexts #-}
3−{-# LANGUAGE TypeOperators #-}
4−{-# LANGUAGE TypeApplications #-}
5−{-# LANGUAGE DataKinds #-}
6−
7module Main where
1module Main where
8
2
9−import LAoP.Matrix.Type
3+import Examples
10−import qualified LAoP.Relation as R
4+import Benchmarks
11−import LAoP.Utils
12−import LAoP.Dist
13−import GHC.TypeLits
14−import Data.Coerce
15−import GHC.Generics
16−import Control.Category hiding (id)
17−import Prelude hiding ((.))
18−
19−-- Monty Hall Problem
20−data Outcome = Win | Lose
21− deriving (Bounded, Enum, Eq, Show, Generic)
22−
23−switch :: Outcome -> Outcome
24−switch Win = Lose
25−switch Lose = Win
26−
27−firstChoice :: Matrix Double () Outcome
28−firstChoice = col [1/3, 2/3]
29−
30−secondChoice :: Matrix Double Outcome Outcome
31−secondChoice = fromF' switch
32−
33−-- Dice sum
34−
35−type SS = Natural 1 6 -- Sample Space
36−
37−sumSS :: SS -> SS -> Natural 2 12
38−sumSS = coerceNat (+)
39−
40−sumSSM = fromF' (uncurry sumSS)
41−
42−condition :: (Int, Int) -> Int -> Int
43−condition (fst, snd) thrd = if fst == snd
44− then fst * 3
45− else fst + snd + thrd
46−
47−conditionSS :: (SS, SS) -> SS -> Natural 3 18
48−conditionSS = coerceNat2 condition
49−
50−conditionalThrows = fromF' (uncurry conditionSS) . khatri (khatri die die) die
51−
52−die :: Matrix Double () SS
53−die = col $ map (const (1/6)) [nat @1 @6 1 .. nat 6]
54−
55−-- Sprinkler
56−
57−rain :: Matrix Double () Bool
58−rain = col [0.8, 0.2]
59−
60−sprinkler :: Matrix Double Bool Bool
61−sprinkler = fromLists [[0.6, 0.99], [0.4, 0.01]]
62−
63−grass :: Matrix Double (Bool, Bool) Bool
64−grass = fromLists [[1, 0.2, 0.1, 0.01], [0, 0.8, 0.9, 0.99]]
65−
66−state :: Matrix Double () (Bool, (Bool, Bool))
67−state = khatri grass identity . khatri sprinkler identity . rain
68−
69−grass_wet :: Matrix Double (Bool, (Bool, Bool)) One
70−grass_wet = row [0,1] . kp1
71−
72−rainning :: Matrix Double (Bool, (Bool, Bool)) One
73−rainning = row [0,1] . kp2 . kp2
74−
75−-- Alcuin Puzzle
76−
77−data Being = Farmer | Fox | Goose | Beans
78− deriving (Bounded, Enum, Eq, Show, Generic)
79−
80−data Bank = LeftB | RightB
81− deriving (Bounded, Enum, Eq, Show, Generic)
82−
83−eats :: Being -> Being -> Bool
84−eats Fox Goose = True
85−eats Goose Beans = True
86−eats _ _ = False
87−
88−eatsR :: R.Relation Being Being
89−eatsR = R.toRel eats
90−
91−cross :: Bank -> Bank
92−cross LeftB = RightB
93−cross RightB = LeftB
94−
95−crossR :: R.Relation Bank Bank
96−crossR = R.fromF' cross
97−
98−-- | Initial state, everyone in the left bank
99−locationLeft :: Being -> Bank
100−locationLeft _ = LeftB
101−
102−locationLeftR :: R.Relation Being Bank
103−locationLeftR = R.fromF' locationLeft
104−
105−-- | Initial state, everyone in the right bank
106−locationRight :: Being -> Bank
107−locationRight _ = RightB
108−
109−locationRightR :: R.Relation Being Bank
110−locationRightR = R.fromF' locationRight
111−
112−-- Properties
113−
114−-- Being at the same bank
115−sameBank :: R.Relation Being Bank -> R.Relation Being Being
116−sameBank = R.ker
117−
118−-- Risk of somebody eating somebody else
119−canEat :: R.Relation Being Bank -> R.Relation Being Being
120−canEat w = sameBank w `R.intersection` eatsR
121−
122−-- "Starvation" property.
123−inv :: R.Relation Being Bank -> Bool
124−inv w = (w `R.comp` canEat w) `R.sse` (w `R.comp` farmer)
125− where
126− farmer :: R.Relation Being Being
127− farmer = R.fromF' (const Farmer)
128−
129−-- Arbitrary state
130−bankState :: Being -> Bank -> Bool
131−bankState Farmer LeftB = True
132−bankState Fox LeftB = True
133−bankState Goose RightB = True
134−bankState Beans RightB = True
135−bankState _ _ = False
136−
137−bankStateR :: R.Relation Being Bank
138−bankStateR = R.toRel bankState
139
5
140−-- Main
141main :: IO ()
6main :: IO ()
142−main = do
7+main = benchmark
143− putStrLn "Monty Hall Problem solution:"
144− prettyPrint (secondChoice . firstChoice)
145− putStrLn "\n Sum of dices probability:"
146− prettyPrint (sumSSM `comp` khatri die die)
147− putStrLn "\n Conditional dice throw:"
148− prettyPrint conditionalThrows
149− putStrLn "\n Checking that the last result is indeed a distribution: "
150− prettyPrint (bang . sumSSM . khatri die die)
151− putStrLn "\n Probability of grass being wet:"
152− prettyPrint (grass_wet . state)
153− putStrLn "\n Probability of rain:"
154− prettyPrint (rainning . state)
155− putStrLn "\n Is the arbitrary state a valid state? (Alcuin Puzzle)"
156− print (inv bankStateR)
app/Spreadsheets.hsnew file+48
@@ -0,0 +1,48 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE GADTs #-}
3+{-# LANGUAGE FlexibleContexts #-}
4+{-# LANGUAGE DeriveGeneric #-}
5+module Spreadsheets
6+ (
7+ )
8+ where
9+
10+import LAoP.Matrix.Type
11+import GHC.Generics
12+
13+data Student = Student1 | Student2 | Student3 | Student4
14+ deriving (Eq, Show, Enum, Bounded, Generic)
15+
16+data Question = Question1 | Question2 | Question3 | Question4
17+ deriving (Eq, Show, Enum, Bounded, Generic)
18+
19+data Results = Test | Exam | Final
20+ deriving (Eq, Show, Enum, Bounded, Generic)
21+
22+test :: Matrix Float One Results
23+test = point Test
24+
25+exam :: Matrix Float One Results
26+exam = point Exam
27+
28+final :: Matrix Float One Results
29+final = point Final
30+
31+m :: Matrix Float Question Student
32+m = fromLists [[95, 90, 100, 40], [20, 90, 90, 0], [30, 20, 95, 0], [50, 80, 100, 30]]
33+
34+w :: Matrix Float Question One
35+w = fromLists [[0.2, 0.3, 0.2, 0.3]]
36+
37+xls :: Matrix Float Question One
38+ -> Matrix Float Question Student
39+ -> Matrix Float Student One
40+ -> Matrix Float (Either Question Results) (Either One Student)
41+xls w m t = junc (split w m) (split zeros r)
42+ where
43+ rExam = m `comp` tr w
44+ rTest = tr t
45+ rFinal = rTest `max` rExam
46+ rAux = junc rTest (junc rExam rFinal)
47+ r = tr (converter `comp` tr rAux)
48+ converter = junc test (junc exam final)
src/LAoP/Dist.hs−2
@@ -43,7 +43,6 @@ module LAoP.Dist
43 FromListsN,
43 FromListsN,
44 Liftable,
44 Liftable,
45 TrivialP,
45 TrivialP,
46− TrivialE,
47
46
48 -- * Functor instance equivalent functions
47 -- * Functor instance equivalent functions
49 fmapD,
48 fmapD,
@@ -54,7 +53,6 @@ module LAoP.Dist
54
53
55 -- * Selective equivalent functions
54 -- * Selective equivalent functions
56 selectD,
55 selectD,
57− selectD2,
58
56
59 -- * Monad equivalent functions
57 -- * Monad equivalent functions
60 returnD,
58 returnD,
src/LAoP/Dist/Internal.hs+5−13
@@ -1,3 +1,4 @@
1+{-# LANGUAGE DerivingVia #-}
1{-# LANGUAGE ConstraintKinds #-}
2{-# LANGUAGE ConstraintKinds #-}
2{-# LANGUAGE GADTs #-}
3{-# LANGUAGE GADTs #-}
3{-# LANGUAGE AllowAmbiguousTypes #-}
4{-# LANGUAGE AllowAmbiguousTypes #-}
@@ -19,13 +20,11 @@ module LAoP.Dist.Internal
19 FromListsN,
20 FromListsN,
20 Liftable,
21 Liftable,
21 TrivialP,
22 TrivialP,
22− TrivialE,
23
23
24 fmapD,
24 fmapD,
25 unitD,
25 unitD,
26 multD,
26 multD,
27 selectD,
27 selectD,
28− selectD2,
29 returnD,
28 returnD,
30 bindD,
29 bindD,
31 (??),
30 (??),
@@ -42,12 +41,13 @@ module LAoP.Dist.Internal
42 )
41 )
43 where
42 where
44
43
45−import LAoP.Matrix.Type hiding (TrivialP, TrivialE, Countable, CountableDimensions, CountableN, CountableDimensionsN, Liftable, FromListsN)
44+import LAoP.Matrix.Type hiding (TrivialP, Countable, CountableDimensions, CountableN, CountableDimensionsN, Liftable, FromListsN)
46import qualified LAoP.Matrix.Internal as I
45import qualified LAoP.Matrix.Internal as I
47import LAoP.Utils
46import LAoP.Utils
48import GHC.TypeLits
47import GHC.TypeLits
49import Data.Proxy
48import Data.Proxy
50import Data.List (sortBy)
49import Data.List (sortBy)
50+import Control.DeepSeq
51
51
52-- | Type synonym for probability value
52-- | Type synonym for probability value
53type Prob = Float
53type Prob = Float
@@ -55,6 +55,7 @@ type Prob = Float
55-- | Type synonym for column vector matrices. This represents a probability
55-- | Type synonym for column vector matrices. This represents a probability
56-- distribution.
56-- distribution.
57newtype Dist a = D (Matrix Prob () a)
57newtype Dist a = D (Matrix Prob () a)
58+ deriving (Show, Num, Eq, Ord, NFData) via (Matrix Prob () a)
58
59
59-- | Constraint type synonyms to keep the type signatures less convoluted
60-- | Constraint type synonyms to keep the type signatures less convoluted
60type Countable a = KnownNat (I.Count a)
61type Countable a = KnownNat (I.Count a)
@@ -63,7 +64,6 @@ type CountableDimensionsN a b = (CountableN a, CountableN b)
63type FromListsN a b = I.FromLists Prob (I.Normalize a) (I.Normalize b)
64type FromListsN a b = I.FromLists Prob (I.Normalize a) (I.Normalize b)
64type Liftable a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num Prob, Ord Prob)
65type Liftable a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num Prob, Ord Prob)
65type TrivialP a b = Normalize (a, b) ~ Normalize (Normalize a, Normalize b)
66type TrivialP a b = Normalize (a, b) ~ Normalize (Normalize a, Normalize b)
66−type TrivialE a b = Normalize (Either a b) ~ Either (Normalize a) (Normalize b)
67
67
68-- | Functor instance
68-- | Functor instance
69fmapD ::
69fmapD ::
@@ -91,19 +91,11 @@ multD (D a) (D b) = D (khatri a b)
91
91
92-- | Selective instance function
92-- | Selective instance function
93selectD ::
93selectD ::
94− ( TrivialE a b,
95− FromListsN b b,
94+ ( FromListsN b b,
96 CountableN b
95 CountableN b
97 ) => Dist (Either a b) -> Matrix Prob a b -> Dist b
96 ) => Dist (Either a b) -> Matrix Prob a b -> Dist b
98selectD (D d) m = D (selectM d m)
97selectD (D d) m = D (selectM d m)
99
98
100−selectD2 ::
101− ( TrivialE a b,
102− FromListsN b b,
103− CountableN b
104− ) => Dist (Either a b) -> Matrix Prob a b -> Dist b
105−selectD2 (D d) m = D (junc m identity `comp` d)
106−
107-- | Monad instance 'return' function
99-- | Monad instance 'return' function
108returnD :: forall a . (Enum a, FromListsN () a, Countable a) => a -> Dist a
100returnD :: forall a . (Enum a, FromListsN () a, Countable a) => a -> Dist a
109returnD a = D (col l)
101returnD a = D (col l)
src/LAoP/Matrix/Internal.hs+5−3
@@ -205,6 +205,7 @@ type family FromNat' (b :: Bool) (m :: Type) :: Type where
205-- | Type family that normalizes the representation of a given data
205-- | Type family that normalizes the representation of a given data
206-- structure
206-- structure
207type family Normalize (d :: Type) :: Type where
207type family Normalize (d :: Type) :: Type where
208+ Normalize (Either a b) = Either (Normalize a) (Normalize b)
208 Normalize d = FromNat (Count d)
209 Normalize d = FromNat (Count d)
209
210
210-- | Constraint type synonyms to keep the type signatures less convoluted
211-- | Constraint type synonyms to keep the type signatures less convoluted
@@ -214,6 +215,7 @@ type CountableDimensions a b = (Countable a, Countable b)
214type CountableDimensionsN a b = (CountableN a, CountableN b)
215type CountableDimensionsN a b = (CountableN a, CountableN b)
215type FromListsN e a b = FromLists e (Normalize a) (Normalize b)
216type FromListsN e a b = FromLists e (Normalize a) (Normalize b)
216type Liftable e a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num e, Ord e)
217type Liftable e a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num e, Ord e)
218+type Trivial a = FromNat (Count a) ~ a
217
219
218-- | It isn't possible to implement the 'id' function so it's
220-- | It isn't possible to implement the 'id' function so it's
219-- implementation is 'undefined'. However 'comp' can be and this partial
221-- implementation is 'undefined'. However 'comp' can be and this partial
@@ -721,7 +723,7 @@ branch x l r = f x `select` g l `select` r
721
723
722-- | McCarthy's Conditional expresses probabilistic choice.
724-- | McCarthy's Conditional expresses probabilistic choice.
723cond ::
725cond ::
724− ( cols ~ Normalize cols,
726+ ( Trivial cols,
725 Countable cols,
727 Countable cols,
726 FromLists e () cols,
728 FromLists e () cols,
727 FromLists e cols (),
729 FromLists e cols (),
@@ -736,7 +738,7 @@ cond ::
736cond p f g = junc f g . grd p
738cond p f g = junc f g . grd p
737
739
738grd ::
740grd ::
739− ( q ~ Normalize q,
741+ ( Trivial q,
740 Countable q,
742 Countable q,
741 FromLists e () q,
743 FromLists e () q,
742 FromLists e q (),
744 FromLists e q (),
@@ -752,7 +754,7 @@ grd f = split (corr f) (corr (not . f))
752
754
753corr ::
755corr ::
754 forall e a q .
756 forall e a q .
755− ( q ~ Normalize q,
757+ ( Trivial q,
756 Countable q,
758 Countable q,
757 FromLists e () q,
759 FromLists e () q,
758 FromLists e q (),
760 FromLists e q (),
src/LAoP/Matrix/Nat.hs+1−1
@@ -253,7 +253,7 @@ fromF' ::
253 ) =>
253 ) =>
254 (a -> b) ->
254 (a -> b) ->
255 Matrix e (I.Count a) (I.Count b)
255 Matrix e (I.Count a) (I.Count b)
256−fromF' = M . I.fromF'
256+fromF' = undefined -- M . I.fromF'
257
257
258-- Conversion
258-- Conversion
259
259
src/LAoP/Matrix/Type.hs+24−20
@@ -64,7 +64,6 @@ module LAoP.Matrix.Type
64 FromListsN,
64 FromListsN,
65 Liftable,
65 Liftable,
66 Trivial,
66 Trivial,
67− TrivialE,
68 TrivialP,
67 TrivialP,
69
68
70 -- * Type aliases
69 -- * Type aliases
@@ -93,6 +92,7 @@ module LAoP.Matrix.Type
93 zeros,
92 zeros,
94 ones,
93 ones,
95 bang,
94 bang,
95+ point,
96 constant,
96 constant,
97
97
98 -- * Functor instance equivalent function
98 -- * Functor instance equivalent function
@@ -189,8 +189,9 @@ type CountableN a = KnownNat (I.Count (I.Normalize a))
189type CountableDimensionsN a b = (CountableN a, CountableN b)
189type CountableDimensionsN a b = (CountableN a, CountableN b)
190type FromListsN e a b = I.FromLists e (I.Normalize a) (I.Normalize b)
190type FromListsN e a b = I.FromLists e (I.Normalize a) (I.Normalize b)
191type Liftable e a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num e, Ord e)
191type Liftable e a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num e, Ord e)
192−type Trivial a = I.Normalize a ~ I.Normalize (I.Normalize a)
192+type Trivial a = I.Normalize (I.Normalize a) ~ I.Normalize (I.Normalize (I.Normalize a))
193−type TrivialE a b = I.Normalize (Either a b) ~ Either (I.Normalize a) (I.Normalize b)
193+type Trivial2 a = I.Normalize a ~ I.Normalize (I.Normalize a)
194+type Trivial3 a = I.FromNat (I.Count (I.Normalize (I.Normalize a))) ~ I.Normalize (I.Normalize a)
194type TrivialP a b = I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)
195type TrivialP a b = I.Normalize (a, b) ~ I.Normalize (I.Normalize a, I.Normalize b)
195
196
196-- | It isn't possible to implement the 'id' function so it's
197-- | It isn't possible to implement the 'id' function so it's
@@ -220,7 +221,6 @@ one = M . I.One
220
221
221-- | Matrix 'Junc' constructor
222-- | Matrix 'Junc' constructor
222junc ::
223junc ::
223− (TrivialE a b) =>
224 Matrix e a rows ->
224 Matrix e a rows ->
225 Matrix e b rows ->
225 Matrix e b rows ->
226 Matrix e (Either a b) rows
226 Matrix e (Either a b) rows
@@ -229,7 +229,6 @@ junc (M a) (M b) = M (I.Junc a b)
229infixl 3 |||
229infixl 3 |||
230-- | Matrix 'Junc' constructor
230-- | Matrix 'Junc' constructor
231(|||) ::
231(|||) ::
232− (TrivialE a b) =>
233 Matrix e a rows ->
232 Matrix e a rows ->
234 Matrix e b rows ->
233 Matrix e b rows ->
235 Matrix e (Either a b) rows
234 Matrix e (Either a b) rows
@@ -237,7 +236,6 @@ infixl 3 |||
237
236
238-- | Matrix 'Split' constructor
237-- | Matrix 'Split' constructor
239split ::
238split ::
240− (TrivialE a b) =>
241 Matrix e cols a ->
239 Matrix e cols a ->
242 Matrix e cols b ->
240 Matrix e cols b ->
243 Matrix e cols (Either a b)
241 Matrix e cols (Either a b)
@@ -246,7 +244,6 @@ split (M a) (M b) = M (I.Split a b)
246infixl 2 ===
244infixl 2 ===
247-- | Matrix 'Split' constructor
245-- | Matrix 'Split' constructor
248(===) ::
246(===) ::
249− (TrivialE a b) =>
250 Matrix e cols a ->
247 Matrix e cols a ->
251 Matrix e cols b ->
248 Matrix e cols b ->
252 Matrix e cols (Either a b)
249 Matrix e cols (Either a b)
@@ -396,6 +393,18 @@ bang ::
396 Matrix e cols One
393 Matrix e cols One
397bang = M I.bang
394bang = M I.bang
398
395
396+-- | Point constant relation
397+point ::
398+ ( Bounded a,
399+ Enum a,
400+ Eq a,
401+ Num e,
402+ Ord e,
403+ CountableN a,
404+ FromListsN e a One
405+ ) => a -> Matrix e One a
406+point = fromF' . const
407+
399-- Identity Matrix
408-- Identity Matrix
400
409
401-- | Identity matrix
410-- | Identity matrix
@@ -418,8 +427,7 @@ p1 ::
418 ( Num e,
427 ( Num e,
419 CountableDimensionsN n m,
428 CountableDimensionsN n m,
420 FromListsN e n m,
429 FromListsN e n m,
421− FromListsN e m m,
430+ FromListsN e m m
422− TrivialE m n
423 ) =>
431 ) =>
424 Matrix e (Either m n) m
432 Matrix e (Either m n) m
425p1 = M I.p1
433p1 = M I.p1
@@ -429,8 +437,7 @@ p2 ::
429 ( Num e,
437 ( Num e,
430 CountableDimensionsN n m,
438 CountableDimensionsN n m,
431 FromListsN e m n,
439 FromListsN e m n,
432− FromListsN e n n,
440+ FromListsN e n n
433− TrivialE m n
434 ) =>
441 ) =>
435 Matrix e (Either m n) n
442 Matrix e (Either m n) n
436p2 = M I.p2
443p2 = M I.p2
@@ -442,8 +449,7 @@ i1 ::
442 ( Num e,
449 ( Num e,
443 CountableDimensionsN n m,
450 CountableDimensionsN n m,
444 FromListsN e n m,
451 FromListsN e n m,
445− FromListsN e m m,
452+ FromListsN e m m
446− TrivialE m n
447 ) =>
453 ) =>
448 Matrix e m (Either m n)
454 Matrix e m (Either m n)
449i1 = tr p1
455i1 = tr p1
@@ -453,8 +459,7 @@ i2 ::
453 ( Num e,
459 ( Num e,
454 CountableDimensionsN n m,
460 CountableDimensionsN n m,
455 FromListsN e m n,
461 FromListsN e m n,
456− FromListsN e n n,
462+ FromListsN e n n
457− TrivialE m n
458 ) =>
463 ) =>
459 Matrix e n (Either m n)
464 Matrix e n (Either m n)
460i2 = tr p2
465i2 = tr p2
@@ -492,9 +497,7 @@ infixl 5 -|-
492 FromListsN e k k,
497 FromListsN e k k,
493 FromListsN e j k,
498 FromListsN e j k,
494 FromListsN e k j,
499 FromListsN e k j,
495− FromListsN e j j,
500+ FromListsN e j j
496− TrivialE n m,
497− TrivialE k j
498 ) =>
501 ) =>
499 Matrix e n k ->
502 Matrix e n k ->
500 Matrix e m j ->
503 Matrix e m j ->
@@ -610,8 +613,7 @@ tr (M m) = M (I.tr m)
610selectM ::
613selectM ::
611 ( Num e,
614 ( Num e,
612 FromListsN e b b,
615 FromListsN e b b,
613− CountableN b,
616+ CountableN b
614− TrivialE a b
615 ) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b
617 ) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b
616selectM (M m) (M y) = M (I.select m y)
618selectM (M m) (M y) = M (I.select m y)
617
619
@@ -620,6 +622,8 @@ selectM (M m) (M y) = M (I.select m y)
620-- | McCarthy's Conditional expresses probabilistic choice.
622-- | McCarthy's Conditional expresses probabilistic choice.
621cond ::
623cond ::
622 ( Trivial a,
624 ( Trivial a,
625+ Trivial2 a,
626+ Trivial3 a,
623 CountableN a,
627 CountableN a,
624 FromListsN e () a,
628 FromListsN e () a,
625 FromListsN e a (),
629 FromListsN e a (),