git.iko.soy/laop
on master help sign in
Fixed Eq instance
commit2a059df11212b8a39e7c2d17b0f09afc8075be05 authorArmando Santos <armandoifsantos@gmail.com> dateSun 29 Dec 2019, 20:52 (7 years ago) parent03e9139
2 files changed+44−33
compare with master
unifiedsplit
app/Main.hs+30−22 src/Matrix/Type.hs+14−11
app/Main.hs+30−22
@@ -11,6 +11,7 @@ import Dist
1111import GHC.TypeLits
1212import Data.Coerce
1313import System.CPUTime
14+import System.Random
1415
1516-- Monty Hall Problem
1617data Outcome = Win | Lose
@@ -29,7 +30,7 @@ secondChoice = fromF switch
2930-- Dice sum
3031
3132sumSS :: Natural 6 -> Natural 6 -> Natural 12
32−sumSS = coerceNat (+)
33+sumSS = coerceNat (+)
3334
3435mulSS :: Natural 6 -> Natural 6 -> Natural 36
3536mulSS = coerceNat (*)
@@ -58,29 +59,36 @@ grass_wet = row [0,1] `comp` kp1 @Double @2 @4
5859
5960rainning = row [0,1] `comp` kp2 @Double @2 @2 `comp` kp2 @Double @2 @4
6061
61−-- Random Matrix multiplication
62+-- Random Matrix
6263
63−-- a :: Matrix Double 1000 1000
64−-- a = identity
64+randomRow :: IO [Double]
65+randomRow = mapM (const (randomRIO (0, 1000))) [0..2399]
6566
66−-- b :: Matrix Double 1000 1000
67−-- b = identity
67+randomList :: IO [[Double]]
68+randomList = mapM (const randomRow) [0..2399]
69+
70+randomMatrix :: IO (Matrix Double 2400 2400)
71+randomMatrix = fromLists <$> randomList
6872
6973main :: IO ()
7074main = do
71− putStrLn "Monty Hall Problem solution:"
72− prettyPrint (p1 @Double @1 `comp` secondChoice `comp` firstChoice)
73− putStrLn "\n Sum of dices probability:"
74− prettyPrint (sumSSM `comp` khatri die die)
75− putStrLn "\n Checking that the last result is indeed a distribution: "
76− prettyPrint (bang `comp` sumSSM `comp` khatri die die)
77− putStrLn "\n Probability of grass being wet:"
78− prettyPrint (grass_wet `comp` state)
79− putStrLn "\n Probability of rain:"
80− prettyPrint (rainning `comp` state)
81−
82− -- start <- getCPUTime
83− -- let !r = a `comp` b
84− -- end <- getCPUTime
85− -- print (end - start)
86−
75+ -- putStrLn "Monty Hall Problem solution:"
76+ -- prettyPrint (p1 @Double @1 `comp` secondChoice `comp` firstChoice)
77+ -- putStrLn "\n Sum of dices probability:"
78+ -- prettyPrint (sumSSM `comp` khatri die die)
79+ -- putStrLn "\n Checking that the last result is indeed a distribution: "
80+ -- prettyPrint (bang `comp` sumSSM `comp` khatri die die)
81+ -- putStrLn "\n Probability of grass being wet:"
82+ -- prettyPrint (grass_wet `comp` state)
83+ -- putStrLn "\n Probability of rain:"
84+ -- prettyPrint (rainning `comp` state)
85+
86+ -- Random Matrix multiplication
87+ !a <- randomMatrix
88+ !b <- randomMatrix
89+ !start <- getCPUTime
90+ let !r = b `comp` a
91+ !end <- getCPUTime
92+ print "Time in milisseconds:"
93+ print (fromInteger (end - start) / 1000000000)
94+ print (r == a)
src/Matrix/Type.hs+14−11
@@ -137,7 +137,6 @@ import Data.List
137137import Data.Proxy
138138import Data.Void
139139import GHC.TypeLits
140−import Data.Type.Bool
141140import Data.Type.Equality
142141import GHC.Generics
143142
@@ -168,13 +167,15 @@ type family Count (d :: Type) where
168167 Count d = Count (Rep d R)
169168
170169-- | Type family that computes of a given type dimension from a given natural
170+-- Thanks to Li-Yao Xia this type family is super fast.
171171type family FromNat (n :: Nat) where
172172 FromNat 0 = Void
173173 FromNat 1 = ()
174− FromNat n = If (Mod n 2 == 0)
175− (Either (FromNat (Div n 2)) (FromNat (Div n 2)))
176− (Either () (FromNat (n - 1)))
177− -- Either () (FromNat (n - 1))
174+ FromNat n = FromNat' (Mod n 2 == 0) (FromNat (Div n 2))
175+
176+type family FromNat' (b :: Bool) (m :: Type) :: Type where
177+ FromNat' 'True m = Either m m
178+ FromNat' 'False m = Either () (Either m m)
178179
179180-- | Type family that normalizes the representation of a given data
180181-- structure
@@ -182,10 +183,12 @@ type family Normalize (d :: Type) where
182183 Normalize d = FromNat (Count d)
183184
184185instance Eq e => Eq (Matrix e cols rows) where
185− Empty == Empty = True
186− (One a) == (One b) = a == b
187− (Junc a b) == (Junc c d) = a == c && b == d
188− (Split a b) == (Split c d) = a == c && b == d
186+ Empty == Empty = True
187+ (One a) == (One b) = a == b
188+ (Junc a b) == (Junc c d) = a == c && b == d
189+ (Split a b) == (Split c d) = a == c && b == d
190+ x@(Split a b) == y@(Junc c d) = x == abideJS y
191+ x@(Junc a b) == y@(Split c d) = abideJS x == y
189192
190193instance Num e => Num (Matrix e cols rows) where
191194
@@ -268,7 +271,7 @@ instance {-# OVERLAPPING #-} FromLists e () () where
268271 fromLists [[e]] = One e
269272 fromLists _ = error "Wrong dimensions"
270273
271−instance (FromLists e cols ()) => FromLists e (Either () cols) () where
274+instance {-# OVERLAPPING #-} (FromLists e cols ()) => FromLists e (Either () cols) () where
272275 fromLists [h : t] = Junc (One h) (fromLists [t])
273276 fromLists _ = error "Wrong dimensions"
274277
@@ -278,7 +281,7 @@ instance {-# OVERLAPPABLE #-} (FromLists e a (), FromLists e b (), KnownNat (Cou
278281 in Junc (fromLists [take rowsA l]) (fromLists [drop rowsA l])
279282 fromLists _ = error "Wrong dimensions"
280283
281−instance (FromLists e () rows) => FromLists e () (Either () rows) where
284+instance {-# OVERLAPPING #-} (FromLists e () rows) => FromLists e () (Either () rows) where
282285 fromLists ([h] : t) = Split (One h) (fromLists t)
283286 fromLists _ = error "Wrong dimensions"
284287