@@ -30,7 +30,7 @@
3030-- motivation behind the library, the underlying theory, and implementation details.
3131--
3232-- This module offers many of the combinators mentioned in the work of
33−-- Macedo (2012) and Oliveira (2012).
33+-- Macedo (2012) and Oliveira (2012).
3434--
3535-- This is an Internal module and it is no supposed to be imported.
3636--
@@ -43,8 +43,8 @@ module LAoP.Matrix.Internal
4343 --
4444 -- There exists two type families that make it easier to write
4545 -- matrix dimensions: 'FromNat' and 'Count'. This approach
46− -- leads to a very straightforward implementation
47− -- of LAoP combinators.
46+ -- leads to a very straightforward implementation
47+ -- of LAoP combinators.
4848
4949 -- * Type safe matrix representation
5050 Matrix (..),
@@ -60,7 +60,6 @@ module LAoP.Matrix.Internal
6060 Trivial,
6161
6262 -- * Primitives
63− empty,
6463 one,
6564 join,
6665 fork,
@@ -87,7 +86,9 @@ module LAoP.Matrix.Internal
8786 -- * Misc
8887 -- ** Get dimensions
8988 columns,
89+ columns',
9090 rows,
91+ rows',
9192
9293 -- ** Matrix Transposition
9394 tr,
@@ -175,6 +176,7 @@ import Data.Kind
175176import Data.List
176177import Data.Maybe
177178import Data.Proxy
179+import Data.Typeable
178180import Data.Void
179181import GHC.TypeLits
180182import Data.Type.Equality
@@ -185,7 +187,6 @@ import qualified Prelude (id, (.))
185187
186188-- | LAoP (Linear Algebra of Programming) Inductive Matrix definition.
187189data Matrix e cols rows where
188− Empty :: Matrix e Void Void
189190 One :: e -> Matrix e () ()
190191 Join :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows
191192 Fork :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)
@@ -215,7 +216,6 @@ type family Count (d :: Type) :: Nat where
215216--
216217-- Thanks to Li-Yao Xia this type family is super fast.
217218type family FromNat (n :: Nat) :: Type where
218− FromNat 0 = Void
219219 FromNat 1 = ()
220220 FromNat n = FromNat' (Mod n 2 == 0) (FromNat (Div n 2))
221221
@@ -243,17 +243,15 @@ type Trivial a = FromNat (Count a) ~ a
243243-- class.
244244instance (Num e) => Category (Matrix e) where
245245 type Object (Matrix e) a = (FL a a, Countable a)
246− id = iden
246+ id = iden
247247 (.) = comp
248248
249249instance NFData e => NFData (Matrix e cols rows) where
250− rnf Empty = ()
251250 rnf (One e) = rnf e
252251 rnf (Join a b) = rnf a `seq` rnf b
253252 rnf (Fork a b) = rnf a `seq` rnf b
254253
255254instance Eq e => Eq (Matrix e cols rows) where
256− Empty == Empty = True
257255 (One a) == (One b) = a == b
258256 (Join a b) == (Join c d) = a == c && b == d
259257 (Fork a b) == (Fork c d) = a == c && b == d
@@ -261,25 +259,21 @@ instance Eq e => Eq (Matrix e cols rows) where
261259 x@(Join _ _) == y@(Fork _ _) = abideJF x == y
262260
263261instance Num e => Num (Matrix e cols rows) where
264−
265262 a + b = zipWithM (+) a b
266263
267264 a - b = zipWithM (-) a b
268265
269266 a * b = zipWithM (*) a b
270267
271− abs Empty = Empty
272268 abs (One a) = One (abs a)
273269 abs (Join a b) = Join (abs a) (abs b)
274270 abs (Fork a b) = Fork (abs a) (abs b)
275271
276− signum Empty = Empty
277272 signum (One a) = One (signum a)
278273 signum (Join a b) = Join (signum a) (signum b)
279274 signum (Fork a b) = Fork (signum a) (signum b)
280275
281276instance Ord e => Ord (Matrix e cols rows) where
282− Empty <= Empty = True
283277 (One a) <= (One b) = a <= b
284278 (Join a b) <= (Join c d) = (a <= c) && (b <= d)
285279 (Fork a b) <= (Fork c d) = (a <= c) && (b <= d)
@@ -288,10 +282,6 @@ instance Ord e => Ord (Matrix e cols rows) where
288282
289283-- Primitives
290284
291−-- | Empty matrix constructor
292−empty :: Matrix e Void Void
293−empty = Empty
294−
295285-- | Unit matrix constructor
296286one :: e -> Matrix e () ()
297287one = One
@@ -327,35 +317,34 @@ class FromLists cols rows where
327317 -- error if the dimensions do not match.
328318 fromLists :: [[e]] -> Matrix e cols rows
329319
330−instance FromLists Void Void where
331− fromLists [] = Empty
332− fromLists _ = error "Wrong dimensions"
333−
334−instance {-# OVERLAPPING #-} FromLists () () where
320+instance FromLists () () where
335321 fromLists [[e]] = One e
336322 fromLists _ = error "Wrong dimensions"
337323
338−instance {-# OVERLAPPING #-} (FromLists cols ()) => FromLists (Either () cols) () where
324+instance (FromLists cols ()) => FromLists (Either () cols) () where
339325 fromLists [h : t] = Join (One h) (fromLists [t])
340326 fromLists _ = error "Wrong dimensions"
341327
342−instance {-# OVERLAPPABLE #-} (FromLists a (), FromLists b (), Countable a) => FromLists (Either a b) () where
328+instance {-# OVERLAPPABLE #-}
329+ (FromLists a (), FromLists b (), Countable a) => FromLists (Either a b) () where
343330 fromLists [l] =
344331 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
345332 in Join (fromLists [take rowsA l]) (fromLists [drop rowsA l])
346333 fromLists _ = error "Wrong dimensions"
347334
348−instance {-# OVERLAPPING #-} (FromLists () rows) => FromLists () (Either () rows) where
335+instance (FromLists () rows) => FromLists () (Either () rows) where
349336 fromLists ([h] : t) = Fork (One h) (fromLists t)
350337 fromLists _ = error "Wrong dimensions"
351338
352−instance {-# OVERLAPPABLE #-} (FromLists () a, FromLists () b, Countable a) => FromLists () (Either a b) where
353− fromLists l@([_] : _) =
339+instance {-# OVERLAPPABLE #-}
340+ (FromLists () a, FromLists () b, Countable a) => FromLists () (Either a b) where
341+ fromLists l@([_] : _) =
354342 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
355343 in Fork (fromLists (take rowsA l)) (fromLists (drop rowsA l))
356344 fromLists _ = error "Wrong dimensions"
357345
358−instance {-# OVERLAPPABLE #-} (FromLists (Either a b) c, FromLists (Either a b) d, Countable c) => FromLists (Either a b) (Either c d) where
346+instance (FromLists (Either a b) c, FromLists (Either a b) d, Countable c)
347+ => FromLists (Either a b) (Either c d) where
359348 fromLists l@(h : t) =
360349 let lh = length h
361350 rowsC = fromInteger (natVal (Proxy :: Proxy (Count c)))
@@ -382,16 +371,15 @@ matrixBuilder' f =
382371matrixBuilder ::
383372 forall e a b.
384373 ( FLN a b,
385− CountableN b,
386374 Enum a,
387375 Enum b,
388376 Bounded a,
389377 Bounded b,
390378 Eq a,
391− CountableDimsN a b
379+ Countable b
392380 ) => ((a, b) -> e) -> Matrix e (Normalize a) (Normalize b)
393381matrixBuilder f =
394− let r = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
382+ let r = fromInteger $ natVal (Proxy :: Proxy (Count b))
395383 positions = [(a, b) | a <- [minBound .. maxBound], b <- [minBound .. maxBound]]
396384 in fromLists . map (map f) . transpose . buildList r $ positions
397385 where
@@ -447,30 +435,12 @@ fromF ::
447435 ) =>
448436 (a -> b) ->
449437 Matrix e (Normalize a) (Normalize b)
450−fromF f =
451− let minA = minBound @a
452− maxA = maxBound @a
453− minB = minBound @b
454− maxB = maxBound @b
455− ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))
456− rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
457− elementsA = take ccols [minA .. maxA]
458− elementsB = take rrows [minB .. maxB]
459− combinations = (,) <$> elementsA <*> elementsB
460− combAp = map snd . sort . map (\(a, b) -> if f a == b
461− then ((fromEnum a, fromEnum b), 1)
462− else ((fromEnum a, fromEnum b), 0)) $ combinations
463− mList = buildList combAp rrows
464− in tr $ fromLists mList
465− where
466− buildList [] _ = []
467− buildList l r = take r l : buildList (drop r l) r
438+fromF = fromF'
468439
469440-- Conversion
470441
471442-- | Converts a matrix to a list of lists of elements.
472443toLists :: Matrix e cols rows -> [[e]]
473−toLists Empty = []
474444toLists (One e) = [[e]]
475445toLists (Fork l r) = toLists l ++ toLists r
476446toLists (Join l r) = zipWith (++) (toLists l) (toLists r)
@@ -522,13 +492,12 @@ iden = matrixBuilder' (bool 0 1 . uncurry (==))
522492-- This definition takes advantage of divide-and-conquer and fusion laws
523493-- from LAoP.
524494comp :: (Num e) => Matrix e cr rows -> Matrix e cols cr -> Matrix e cols rows
525−comp Empty Empty = Empty
526495comp (One a) (One b) = One (a * b)
527496comp (Join a b) (Fork c d) = comp a c + comp b d -- Divide-and-conquer law
528497comp (Fork a b) c = Fork (comp a c) (comp b c) -- Fork fusion law
529498comp c (Join a b) = Join (comp c a) (comp c b) -- Join fusion law
530499{-# NOINLINE comp #-}
531−{-# RULES
500+{-# RULES
532501 "comp/iden1" forall m. comp m iden = m ;
533502 "comp/iden2" forall m. comp iden m = m
534503#-}
@@ -538,7 +507,6 @@ comp c (Join a b) = Join (comp c a) (comp c b) -- Join fusion law
538507infixl 7 .|
539508-- | Scalar multiplication of matrices.
540509(.|) :: Num e => e -> Matrix e cols rows -> Matrix e cols rows
541−(.|) _ Empty = Empty
542510(.|) e (One a) = One (e * a)
543511(.|) e (Join a b) = Join (e .| a) (e .| b)
544512(.|) e (Fork a b) = Fork (e .| a) (e .| b)
@@ -548,7 +516,6 @@ infixl 7 .|
548516infixl 7 ./
549517-- | Scalar multiplication of matrices.
550518(./) :: Fractional e => Matrix e cols rows -> e -> Matrix e cols rows
551−(./) Empty _ = Empty
552519(./) (One a) e = One (a / e)
553520(./) (Join a b) e = Join (a ./ e) (b ./ e)
554521(./) (Fork a b) e = Fork (a ./ e) (b ./ e)
@@ -577,24 +544,38 @@ i2 = tr p2
577544
578545-- | Obtain the number of rows.
579546--
580−-- NOTE: The 'KnownNat' constaint is needed in order to obtain the
581−-- dimensions in constant time.
582−--
583−-- TODO: A 'rows' function that does not need the 'KnownNat' constraint in
584−-- exchange for performance.
547+-- NOTE: The 'KnownNat' constraint is needed in order to obtain the
548+-- dimensions in constant time. For a version that doesn't require the
549+-- constraint see 'rows''.
585550rows :: forall e cols rows. (Countable rows) => Matrix e cols rows -> Int
586551rows _ = fromInteger $ natVal (Proxy :: Proxy (Count rows))
587552
553+-- | Obtain the number of rows in an inefficient manner, but without any
554+-- constraints.
555+--
556+-- For a more efficient version see 'rows'.
557+rows' :: Matrix e cols rows -> Int
558+rows' (One _) = 1
559+rows' (Join lhs _) = rows' lhs
560+rows' (Fork top bottom) = rows' top + rows' bottom
561+
588562-- | Obtain the number of columns.
589−--
590−-- NOTE: The 'KnownNat' constaint is needed in order to obtain the
591−-- dimensions in constant time.
592563--
593−-- TODO: A 'columns' function that does not need the 'KnownNat' constraint in
594−-- exchange for performance.
564+-- NOTE: The 'KnownNat' constraint is needed in order to obtain the
565+-- dimensions in constant time. For a version that doesn't require the
566+-- constraint see 'columns''.
595567columns :: forall e cols rows. (Countable cols) => Matrix e cols rows -> Int
596568columns _ = fromInteger $ natVal (Proxy :: Proxy (Count cols))
597569
570+-- | Obtain the number of columns in an inefficient manner, but without any
571+-- constraints.
572+--
573+-- For a more efficient version see 'columns'.
574+columns' :: Matrix e cols rows -> Int
575+columns' (One _) = 1
576+columns' (Join lhs rhs) = columns' lhs + columns' rhs
577+columns' (Fork top _) = columns' top
578+
598579-- Coproduct Bifunctor
599580
600581infixl 5 -|-
@@ -649,7 +630,7 @@ sndM = matrixBuilder' f
649630-- | Khatri Rao Matrix product also known as matrix pairing.
650631--
651632-- NOTE: That this is not a true categorical product, see for instance:
652−--
633+--
653634-- @
654635-- | fstM . kr a b == a
655636-- kr a b ==> |
@@ -685,7 +666,7 @@ infixl 4 ><
685666 FL (Normalize (m, n)) n,
686667 FL (Normalize (p, q)) p,
687668 FL (Normalize (p, q)) q
688− )
669+ )
689670 => Matrix e m p -> Matrix e n q -> Matrix e (Normalize (m, n)) (Normalize (p, q))
690671(><) a b =
691672 let fstM' = fstM @e @m @n
@@ -703,7 +684,6 @@ infixl 4 ><
703684-- @
704685abideJF :: Matrix e cols rows -> Matrix e cols rows
705686abideJF (Join (Fork a c) (Fork b d)) = Fork (Join (abideJF a) (abideJF b)) (Join (abideJF c) (abideJF d)) -- Join-Fork abide law
706−abideJF Empty = Empty
707687abideJF (One e) = One e
708688abideJF (Join a b) = Join (abideJF a) (abideJF b)
709689abideJF (Fork a b) = Fork (abideJF a) (abideJF b)
@@ -717,7 +697,6 @@ abideJF (Fork a b) = Fork (abideJF a) (abideJF b)
717697-- @
718698abideFJ :: Matrix e cols rows -> Matrix e cols rows
719699abideFJ (Fork (Join a b) (Join c d)) = Join (Fork (abideFJ a) (abideFJ c)) (Fork (abideFJ b) (abideFJ d)) -- Fork-Join abide law
720−abideFJ Empty = Empty
721700abideFJ (One e) = One e
722701abideFJ (Join a b) = Join (abideFJ a) (abideFJ b)
723702abideFJ (Fork a b) = Fork (abideFJ a) (abideFJ b)
@@ -726,7 +705,6 @@ abideFJ (Fork a b) = Fork (abideFJ a) (abideFJ b)
726705
727706-- | Matrix transposition.
728707tr :: Matrix e cols rows -> Matrix e rows cols
729−tr Empty = Empty
730708tr (One e) = One e
731709tr (Join a b) = Fork (tr a) (tr b)
732710tr (Fork a b) = Join (tr a) (tr b)
@@ -865,7 +843,6 @@ prettyPrint = putStrLn . pretty
865843
866844-- | Zip two matrices with a given binary function
867845zipWithM :: (e -> f -> g) -> Matrix e cols rows -> Matrix f cols rows -> Matrix g cols rows
868−zipWithM _ Empty Empty = Empty
869846zipWithM f (One a) (One b) = One (f a b)
870847zipWithM f (Join a b) (Join c d) = Join (zipWithM f a c) (zipWithM f b d)
871848zipWithM f (Fork a b) (Fork c d) = Fork (zipWithM f a c) (zipWithM f b d)
@@ -890,14 +867,12 @@ fromBool False = nat 0
890867
891868-- | Relational negation
892869negateM :: Relation cols rows -> Relation cols rows
893−negateM Empty = Empty
894870negateM (One (Nat p)) = One (Nat (negate p))
895871negateM (Join a b) = Join (negateM a) (negateM b)
896872negateM (Fork a b) = Fork (negateM a) (negateM b)
897873
898874-- | Relational addition
899875orM :: Relation cols rows -> Relation cols rows -> Relation cols rows
900−orM Empty Empty = Empty
901876orM (One a) (One b) = One (fromBool (toBool a || toBool b))
902877orM (Join a b) (Join c d) = Join (orM a c) (orM b d)
903878orM (Fork a b) (Fork c d) = Fork (orM a c) (orM b d)
@@ -906,7 +881,6 @@ orM x@(Join _ _) y@(Fork _ _) = orM (abideJF x) y
906881
907882-- | Relational multiplication
908883andM :: Relation cols rows -> Relation cols rows -> Relation cols rows
909−andM Empty Empty = Empty
910884andM (One a) (One b) = One (fromBool (toBool a && toBool b))
911885andM (Join a b) (Join c d) = Join (andM a c) (andM b d)
912886andM (Fork a b) (Fork c d) = Fork (andM a c) (andM b d)
@@ -915,7 +889,6 @@ andM x@(Join _ _) y@(Fork _ _) = andM (abideJF x) y
915889
916890-- | Relational subtraction
917891subM :: Relation cols rows -> Relation cols rows -> Relation cols rows
918−subM Empty Empty = Empty
919892subM (One a) (One b) = if a - b < nat 0 then One (nat 0) else One (a - b)
920893subM (Join a b) (Join c d) = Join (subM a c) (subM b d)
921894subM (Fork a b) (Fork c d) = Fork (subM a c) (subM b d)
@@ -924,7 +897,6 @@ subM x@(Join _ _) y@(Fork _ _) = subM (abideJF x) y
924897
925898-- | Matrix relational composition.
926899compRel :: Relation cr rows -> Relation cols cr -> Relation cols rows
927−compRel Empty Empty = Empty
928900compRel (One a) (One b) = One (fromBool (toBool a && toBool b))
929901compRel (Join a b) (Fork c d) = orM (compRel a c) (compRel b d) -- Divide-and-conquer law
930902compRel (Fork a b) c = Fork (compRel a c) (compRel b c) -- Fork fusion law
@@ -932,7 +904,6 @@ compRel c (Join a b) = Join (compRel c a) (compRel c b) -- Join fusion
932904
933905-- | Matrix relational right division
934906divR :: Relation b c -> Relation b a -> Relation a c
935−divR Empty Empty = Empty
936907divR (One a) (One b) = One (fromBool (not (toBool b) || toBool a)) -- b implies a
937908divR (Join a b) (Join c d) = andM (divR a c) (divR b d)
938909divR (Fork a b) c = Fork (divR a c) (divR b c)
@@ -960,24 +931,7 @@ fromFRel' ::
960931 ) =>
961932 (a -> b) ->
962933 Relation cols rows
963−fromFRel' f =
964− let minA = minBound @a
965− maxA = maxBound @a
966− minB = minBound @b
967− maxB = maxBound @b
968− ccols = fromInteger $ natVal (Proxy :: Proxy (Count cols))
969− rrows = fromInteger $ natVal (Proxy :: Proxy (Count rows))
970− elementsA = take ccols [minA .. maxA]
971− elementsB = take rrows [minB .. maxB]
972− combinations = (,) <$> elementsA <*> elementsB
973− combAp = map snd . sort . map (\(a, b) -> if f a == b
974− then ((fromEnum a, fromEnum b), nat 1)
975− else ((fromEnum a, fromEnum b), nat 0)) $ combinations
976− mList = buildList combAp rrows
977− in tr $ fromLists mList
978− where
979− buildList [] _ = []
980− buildList l r = take r l : buildList (drop r l) r
934+fromFRel' = fromF'
981935
982936-- | Lifts functions to relations with dimensions matching @a@ and @b@
983937-- cardinality's.
@@ -985,28 +939,11 @@ fromFRel ::
985939 forall a b.
986940 ( Liftable Boolean a b,
987941 CountableDimsN a b,
988− FL (Normalize b) (Normalize a)
942+ FLN b a
989943 ) =>
990944 (a -> b) ->
991945 Relation (Normalize a) (Normalize b)
992−fromFRel f =
993− let minA = minBound @a
994− maxA = maxBound @a
995− minB = minBound @b
996− maxB = maxBound @b
997− ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))
998− rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
999− elementsA = take ccols [minA .. maxA]
1000− elementsB = take rrows [minB .. maxB]
1001− combinations = (,) <$> elementsA <*> elementsB
1002− combAp = map snd . sort . map (\(a, b) -> if f a == b
1003− then ((fromEnum a, fromEnum b), nat 1)
1004− else ((fromEnum a, fromEnum b), nat 0)) $ combinations
1005− mList = buildList combAp rrows
1006− in tr $ fromLists mList
1007− where
1008− buildList [] _ = []
1009− buildList l r = take r l : buildList (drop r l) r
946+fromFRel = fromFRel'
1010947
1011948-- | Lifts a relation function to a Boolean Matrix
1012949toRel ::
@@ -1016,17 +953,17 @@ toRel ::
1016953 Enum a,
1017954 Enum b,
1018955 Eq b,
1019− CountableDimsN a b,
956+ CountableDims a b,
1020957 FLN b a
1021− )
958+ )
1022959 => (a -> b -> Bool) -> Relation (Normalize a) (Normalize b)
1023960toRel f =
1024961 let minA = minBound @a
1025962 maxA = maxBound @a
1026963 minB = minBound @b
1027964 maxB = maxBound @b
1028− ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))
1029− rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
965+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count a))
966+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count b))
1030967 elementsA = take ccols [minA .. maxA]
1031968 elementsB = take rrows [minB .. maxB]
1032969 combinations = (,) <$> elementsA <*> elementsB