@@ -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 (..),
@@ -86,9 +86,7 @@ module LAoP.Matrix.Internal
8686 -- * Misc
8787 -- ** Get dimensions
8888 columns,
89− columns',
9089 rows,
91− rows',
9290
9391 -- ** Matrix Transposition
9492 tr,
@@ -176,7 +174,6 @@ import Data.Kind
176174import Data.List
177175import Data.Maybe
178176import Data.Proxy
179−import Data.Typeable
180177import Data.Void
181178import GHC.TypeLits
182179import Data.Type.Equality
@@ -243,7 +240,7 @@ type Trivial a = FromNat (Count a) ~ a
243240-- class.
244241instance (Num e) => Category (Matrix e) where
245242 type Object (Matrix e) a = (FL a a, Countable a)
246− id = iden
243+ id = iden
247244 (.) = comp
248245
249246instance NFData e => NFData (Matrix e cols rows) where
@@ -259,6 +256,7 @@ instance Eq e => Eq (Matrix e cols rows) where
259256 x@(Join _ _) == y@(Fork _ _) = abideJF x == y
260257
261258instance Num e => Num (Matrix e cols rows) where
259+
262260 a + b = zipWithM (+) a b
263261
264262 a - b = zipWithM (-) a b
@@ -317,34 +315,31 @@ class FromLists cols rows where
317315 -- error if the dimensions do not match.
318316 fromLists :: [[e]] -> Matrix e cols rows
319317
320−instance FromLists () () where
318+instance {-# OVERLAPPING #-} FromLists () () where
321319 fromLists [[e]] = One e
322320 fromLists _ = error "Wrong dimensions"
323321
324−instance (FromLists cols ()) => FromLists (Either () cols) () where
322+instance {-# OVERLAPPING #-} (FromLists cols ()) => FromLists (Either () cols) () where
325323 fromLists [h : t] = Join (One h) (fromLists [t])
326324 fromLists _ = error "Wrong dimensions"
327325
328−instance {-# OVERLAPPABLE #-}
329− (FromLists a (), FromLists b (), Countable a) => FromLists (Either a b) () where
326+instance {-# OVERLAPPABLE #-} (FromLists a (), FromLists b (), Countable a) => FromLists (Either a b) () where
330327 fromLists [l] =
331328 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
332329 in Join (fromLists [take rowsA l]) (fromLists [drop rowsA l])
333330 fromLists _ = error "Wrong dimensions"
334331
335−instance (FromLists () rows) => FromLists () (Either () rows) where
332+instance {-# OVERLAPPING #-} (FromLists () rows) => FromLists () (Either () rows) where
336333 fromLists ([h] : t) = Fork (One h) (fromLists t)
337334 fromLists _ = error "Wrong dimensions"
338335
339−instance {-# OVERLAPPABLE #-}
340− (FromLists () a, FromLists () b, Countable a) => FromLists () (Either a b) where
341− fromLists l@([_] : _) =
336+instance {-# OVERLAPPABLE #-} (FromLists () a, FromLists () b, Countable a) => FromLists () (Either a b) where
337+ fromLists l@([_] : _) =
342338 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
343339 in Fork (fromLists (take rowsA l)) (fromLists (drop rowsA l))
344340 fromLists _ = error "Wrong dimensions"
345341
346−instance (FromLists (Either a b) c, FromLists (Either a b) d, Countable c)
347− => FromLists (Either a b) (Either c d) where
342+instance {-# OVERLAPPABLE #-} (FromLists (Either a b) c, FromLists (Either a b) d, Countable c) => FromLists (Either a b) (Either c d) where
348343 fromLists l@(h : t) =
349344 let lh = length h
350345 rowsC = fromInteger (natVal (Proxy :: Proxy (Count c)))
@@ -371,15 +366,16 @@ matrixBuilder' f =
371366matrixBuilder ::
372367 forall e a b.
373368 ( FLN a b,
369+ CountableN b,
374370 Enum a,
375371 Enum b,
376372 Bounded a,
377373 Bounded b,
378374 Eq a,
379− Countable b
375+ CountableDimsN a b
380376 ) => ((a, b) -> e) -> Matrix e (Normalize a) (Normalize b)
381377matrixBuilder f =
382− let r = fromInteger $ natVal (Proxy :: Proxy (Count b))
378+ let r = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
383379 positions = [(a, b) | a <- [minBound .. maxBound], b <- [minBound .. maxBound]]
384380 in fromLists . map (map f) . transpose . buildList r $ positions
385381 where
@@ -435,7 +431,24 @@ fromF ::
435431 ) =>
436432 (a -> b) ->
437433 Matrix e (Normalize a) (Normalize b)
438−fromF = fromF'
434+fromF f =
435+ let minA = minBound @a
436+ maxA = maxBound @a
437+ minB = minBound @b
438+ maxB = maxBound @b
439+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))
440+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
441+ elementsA = take ccols [minA .. maxA]
442+ elementsB = take rrows [minB .. maxB]
443+ combinations = (,) <$> elementsA <*> elementsB
444+ combAp = map snd . sort . map (\(a, b) -> if f a == b
445+ then ((fromEnum a, fromEnum b), 1)
446+ else ((fromEnum a, fromEnum b), 0)) $ combinations
447+ mList = buildList combAp rrows
448+ in tr $ fromLists mList
449+ where
450+ buildList [] _ = []
451+ buildList l r = take r l : buildList (drop r l) r
439452
440453-- Conversion
441454
@@ -497,7 +510,7 @@ comp (Join a b) (Fork c d) = comp a c + comp b d -- Divide-and-conquer l
497510comp (Fork a b) c = Fork (comp a c) (comp b c) -- Fork fusion law
498511comp c (Join a b) = Join (comp c a) (comp c b) -- Join fusion law
499512{-# NOINLINE comp #-}
500−{-# RULES
513+{-# RULES
501514 "comp/iden1" forall m. comp m iden = m ;
502515 "comp/iden2" forall m. comp iden m = m
503516#-}
@@ -544,38 +557,24 @@ i2 = tr p2
544557
545558-- | Obtain the number of rows.
546559--
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''.
560+-- NOTE: The 'KnownNat' constaint is needed in order to obtain the
561+-- dimensions in constant time.
562+--
563+-- TODO: A 'rows' function that does not need the 'KnownNat' constraint in
564+-- exchange for performance.
550565rows :: forall e cols rows. (Countable rows) => Matrix e cols rows -> Int
551566rows _ = fromInteger $ natVal (Proxy :: Proxy (Count rows))
552567
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−
562568-- | Obtain the number of columns.
569+--
570+-- NOTE: The 'KnownNat' constaint is needed in order to obtain the
571+-- dimensions in constant time.
563572--
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''.
573+-- TODO: A 'columns' function that does not need the 'KnownNat' constraint in
574+-- exchange for performance.
567575columns :: forall e cols rows. (Countable cols) => Matrix e cols rows -> Int
568576columns _ = fromInteger $ natVal (Proxy :: Proxy (Count cols))
569577
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−
579578-- Coproduct Bifunctor
580579
581580infixl 5 -|-
@@ -630,7 +629,7 @@ sndM = matrixBuilder' f
630629-- | Khatri Rao Matrix product also known as matrix pairing.
631630--
632631-- NOTE: That this is not a true categorical product, see for instance:
633−--
632+--
634633-- @
635634-- | fstM . kr a b == a
636635-- kr a b ==> |
@@ -666,7 +665,7 @@ infixl 4 ><
666665 FL (Normalize (m, n)) n,
667666 FL (Normalize (p, q)) p,
668667 FL (Normalize (p, q)) q
669− )
668+ )
670669 => Matrix e m p -> Matrix e n q -> Matrix e (Normalize (m, n)) (Normalize (p, q))
671670(><) a b =
672671 let fstM' = fstM @e @m @n
@@ -931,7 +930,24 @@ fromFRel' ::
931930 ) =>
932931 (a -> b) ->
933932 Relation cols rows
934−fromFRel' = fromF'
933+fromFRel' f =
934+ let minA = minBound @a
935+ maxA = maxBound @a
936+ minB = minBound @b
937+ maxB = maxBound @b
938+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count cols))
939+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count rows))
940+ elementsA = take ccols [minA .. maxA]
941+ elementsB = take rrows [minB .. maxB]
942+ combinations = (,) <$> elementsA <*> elementsB
943+ combAp = map snd . sort . map (\(a, b) -> if f a == b
944+ then ((fromEnum a, fromEnum b), nat 1)
945+ else ((fromEnum a, fromEnum b), nat 0)) $ combinations
946+ mList = buildList combAp rrows
947+ in tr $ fromLists mList
948+ where
949+ buildList [] _ = []
950+ buildList l r = take r l : buildList (drop r l) r
935951
936952-- | Lifts functions to relations with dimensions matching @a@ and @b@
937953-- cardinality's.
@@ -939,11 +955,28 @@ fromFRel ::
939955 forall a b.
940956 ( Liftable Boolean a b,
941957 CountableDimsN a b,
942− FLN b a
958+ FL (Normalize b) (Normalize a)
943959 ) =>
944960 (a -> b) ->
945961 Relation (Normalize a) (Normalize b)
946−fromFRel = fromFRel'
962+fromFRel f =
963+ let minA = minBound @a
964+ maxA = maxBound @a
965+ minB = minBound @b
966+ maxB = maxBound @b
967+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))
968+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
969+ elementsA = take ccols [minA .. maxA]
970+ elementsB = take rrows [minB .. maxB]
971+ combinations = (,) <$> elementsA <*> elementsB
972+ combAp = map snd . sort . map (\(a, b) -> if f a == b
973+ then ((fromEnum a, fromEnum b), nat 1)
974+ else ((fromEnum a, fromEnum b), nat 0)) $ combinations
975+ mList = buildList combAp rrows
976+ in tr $ fromLists mList
977+ where
978+ buildList [] _ = []
979+ buildList l r = take r l : buildList (drop r l) r
947980
948981-- | Lifts a relation function to a Boolean Matrix
949982toRel ::
@@ -953,17 +986,17 @@ toRel ::
953986 Enum a,
954987 Enum b,
955988 Eq b,
956− CountableDims a b,
989+ CountableDimsN a b,
957990 FLN b a
958− )
991+ )
959992 => (a -> b -> Bool) -> Relation (Normalize a) (Normalize b)
960993toRel f =
961994 let minA = minBound @a
962995 maxA = maxBound @a
963996 minB = minBound @b
964997 maxB = maxBound @b
965− ccols = fromInteger $ natVal (Proxy :: Proxy (Count a))
966− rrows = fromInteger $ natVal (Proxy :: Proxy (Count b))
998+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))
999+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
9671000 elementsA = take ccols [minA .. maxA]
9681001 elementsB = take rrows [minB .. maxB]
9691002 combinations = (,) <$> elementsA <*> elementsB