on master help sign in
Updated 'FromNat' type family and 'FromList' Matrix instances to more efficient ones
commit03e91390fdd57d0190d2d6001ef90ab0f38dffaf authorArmando Santos <armandoifsantos@gmail.com> dateSun 29 Dec 2019, 18:30 (7 years ago) parentc0b17cc
2 files changed+41−28
app/Main.hs+19−19 src/Matrix/Type.hs+22−9
app/Main.hs+19−19
@@ -60,27 +60,27 @@ rainning = row [0,1] `comp` kp2 @Double @2 @2 `comp` kp2 @Double @2 @4
6060
6161-- Random Matrix multiplication
6262
63−a :: Matrix Double 1000 1000
64−a = identity
63+-- a :: Matrix Double 1000 1000
64+-- a = identity
6565
66−b :: Matrix Double 1000 1000
67−b = identity
66+-- b :: Matrix Double 1000 1000
67+-- b = identity
6868
6969main :: IO ()
7070main = 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)
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)
8686
src/Matrix/Type.hs+22−9
@@ -137,6 +137,8 @@ import Data.List
137137import Data.Proxy
138138import Data.Void
139139import GHC.TypeLits
140+import Data.Type.Bool
141+import Data.Type.Equality
140142import GHC.Generics
141143
142144-- | LAoP (Linear Algebra of Programming) Inductive Matrix definition.
@@ -169,7 +171,10 @@ type family Count (d :: Type) where
169171type family FromNat (n :: Nat) where
170172 FromNat 0 = Void
171173 FromNat 1 = ()
172− FromNat n = Either () (FromNat (n - 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))
173178
174179-- | Type family that normalizes the representation of a given data
175180-- structure
@@ -255,33 +260,41 @@ class FromLists e cols rows where
255260 -- error if the dimensions do not match.
256261 fromLists :: [[e]] -> Matrix e cols rows
257262
258−-- | Void base case
259263instance FromLists e Void Void where
260264 fromLists [] = Empty
261265 fromLists _ = error "Wrong dimensions"
262266
263−-- | Unit base case
264267instance {-# OVERLAPPING #-} FromLists e () () where
265268 fromLists [[e]] = One e
266269 fromLists _ = error "Wrong dimensions"
267270
268−-- | Row vector matrix definition
269271instance (FromLists e cols ()) => FromLists e (Either () cols) () where
270272 fromLists [h : t] = Junc (One h) (fromLists [t])
271273 fromLists _ = error "Wrong dimensions"
272274
273−-- | Column vector matrix definition
275+instance {-# OVERLAPPABLE #-} (FromLists e a (), FromLists e b (), KnownNat (Count a)) => FromLists e (Either a b) () where
276+ fromLists [l] =
277+ let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
278+ in Junc (fromLists [take rowsA l]) (fromLists [drop rowsA l])
279+ fromLists _ = error "Wrong dimensions"
280+
274281instance (FromLists e () rows) => FromLists e () (Either () rows) where
275282 fromLists ([h] : t) = Split (One h) (fromLists t)
276283 fromLists _ = error "Wrong dimensions"
277284
278−-- | Arbitrary matrix definition
279−instance {-# OVERLAPPABLE #-} (FromLists e cols c, FromLists e cols d) => FromLists e cols (Either c d) where
280− fromLists (h : t) =
285+instance {-# OVERLAPPABLE #-} (FromLists e () a, FromLists e () b, KnownNat (Count a)) => FromLists e () (Either a b) where
286+ fromLists l@([h] : t) =
287+ let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
288+ in Split (fromLists (take rowsA l)) (fromLists (drop rowsA l))
289+ fromLists _ = error "Wrong dimensions"
290+
291+instance {-# OVERLAPPABLE #-} (FromLists e (Either a b) c, FromLists e (Either a b) d, KnownNat (Count c)) => FromLists e (Either a b) (Either c d) where
292+ fromLists l@(h : t) =
281293 let lh = length h
294+ rowsC = fromInteger (natVal (Proxy :: Proxy (Count c)))
282295 condition = all (== lh) (map length t)
283296 in if lh > 0 && condition
284− then Split (fromLists [h]) (fromLists t)
297+ then Split (fromLists (take rowsC l)) (fromLists (drop rowsC l))
285298 else error "Not all rows have the same length"
286299
287300-- | Matrix builder function. Constructs a matrix provided with