@@ -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,
@@ -243,7 +241,7 @@ type Trivial a = FromNat (Count a) ~ a
243241-- class.
244242instance (Num e) => Category (Matrix e) where
245243 type Object (Matrix e) a = (FL a a, Countable a)
246− id = iden
244+ id = iden
247245 (.) = comp
248246
249247instance NFData e => NFData (Matrix e cols rows) where
@@ -259,6 +257,7 @@ instance Eq e => Eq (Matrix e cols rows) where
259257 x@(Join _ _) == y@(Fork _ _) = abideJF x == y
260258
261259instance Num e => Num (Matrix e cols rows) where
260+
262261 a + b = zipWithM (+) a b
263262
264263 a - b = zipWithM (-) a b
@@ -325,8 +324,7 @@ instance (FromLists cols ()) => FromLists (Either () cols) () where
325324 fromLists [h : t] = Join (One h) (fromLists [t])
326325 fromLists _ = error "Wrong dimensions"
327326
328−instance {-# OVERLAPPABLE #-}
329− (FromLists a (), FromLists b (), Countable a) => FromLists (Either a b) () where
327+instance {-# OVERLAPPABLE #-} (FromLists a (), FromLists b (), Countable a) => FromLists (Either a b) () where
330328 fromLists [l] =
331329 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
332330 in Join (fromLists [take rowsA l]) (fromLists [drop rowsA l])
@@ -336,15 +334,13 @@ instance (FromLists () rows) => FromLists () (Either () rows) where
336334 fromLists ([h] : t) = Fork (One h) (fromLists t)
337335 fromLists _ = error "Wrong dimensions"
338336
339−instance {-# OVERLAPPABLE #-}
340− (FromLists () a, FromLists () b, Countable a) => FromLists () (Either a b) where
341− fromLists l@([_] : _) =
337+instance {-# OVERLAPPABLE #-} (FromLists () a, FromLists () b, Countable a) => FromLists () (Either a b) where
338+ fromLists l@([_] : _) =
342339 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
343340 in Fork (fromLists (take rowsA l)) (fromLists (drop rowsA l))
344341 fromLists _ = error "Wrong dimensions"
345342
346−instance (FromLists (Either a b) c, FromLists (Either a b) d, Countable c)
347− => FromLists (Either a b) (Either c d) where
343+instance (FromLists (Either a b) c, FromLists (Either a b) d, Countable c) => FromLists (Either a b) (Either c d) where
348344 fromLists l@(h : t) =
349345 let lh = length h
350346 rowsC = fromInteger (natVal (Proxy :: Proxy (Count c)))
@@ -371,15 +367,16 @@ matrixBuilder' f =
371367matrixBuilder ::
372368 forall e a b.
373369 ( FLN a b,
370+ CountableN b,
374371 Enum a,
375372 Enum b,
376373 Bounded a,
377374 Bounded b,
378375 Eq a,
379− Countable b
376+ CountableDimsN a b
380377 ) => ((a, b) -> e) -> Matrix e (Normalize a) (Normalize b)
381378matrixBuilder f =
382− let r = fromInteger $ natVal (Proxy :: Proxy (Count b))
379+ let r = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
383380 positions = [(a, b) | a <- [minBound .. maxBound], b <- [minBound .. maxBound]]
384381 in fromLists . map (map f) . transpose . buildList r $ positions
385382 where
@@ -435,7 +432,24 @@ fromF ::
435432 ) =>
436433 (a -> b) ->
437434 Matrix e (Normalize a) (Normalize b)
438−fromF = fromF'
435+fromF f =
436+ let minA = minBound @a
437+ maxA = maxBound @a
438+ minB = minBound @b
439+ maxB = maxBound @b
440+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))
441+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
442+ elementsA = take ccols [minA .. maxA]
443+ elementsB = take rrows [minB .. maxB]
444+ combinations = (,) <$> elementsA <*> elementsB
445+ combAp = map snd . sort . map (\(a, b) -> if f a == b
446+ then ((fromEnum a, fromEnum b), 1)
447+ else ((fromEnum a, fromEnum b), 0)) $ combinations
448+ mList = buildList combAp rrows
449+ in tr $ fromLists mList
450+ where
451+ buildList [] _ = []
452+ buildList l r = take r l : buildList (drop r l) r
439453
440454-- Conversion
441455
@@ -497,7 +511,7 @@ comp (Join a b) (Fork c d) = comp a c + comp b d -- Divide-and-conquer l
497511comp (Fork a b) c = Fork (comp a c) (comp b c) -- Fork fusion law
498512comp c (Join a b) = Join (comp c a) (comp c b) -- Join fusion law
499513{-# NOINLINE comp #-}
500−{-# RULES
514+{-# RULES
501515 "comp/iden1" forall m. comp m iden = m ;
502516 "comp/iden2" forall m. comp iden m = m
503517#-}
@@ -544,38 +558,24 @@ i2 = tr p2
544558
545559-- | Obtain the number of rows.
546560--
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''.
561+-- NOTE: The 'KnownNat' constaint is needed in order to obtain the
562+-- dimensions in constant time.
563+--
564+-- TODO: A 'rows' function that does not need the 'KnownNat' constraint in
565+-- exchange for performance.
550566rows :: forall e cols rows. (Countable rows) => Matrix e cols rows -> Int
551567rows _ = fromInteger $ natVal (Proxy :: Proxy (Count rows))
552568
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−
562569-- | Obtain the number of columns.
570+--
571+-- NOTE: The 'KnownNat' constaint is needed in order to obtain the
572+-- dimensions in constant time.
563573--
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''.
574+-- TODO: A 'columns' function that does not need the 'KnownNat' constraint in
575+-- exchange for performance.
567576columns :: forall e cols rows. (Countable cols) => Matrix e cols rows -> Int
568577columns _ = fromInteger $ natVal (Proxy :: Proxy (Count cols))
569578
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−
579579-- Coproduct Bifunctor
580580
581581infixl 5 -|-
@@ -630,7 +630,7 @@ sndM = matrixBuilder' f
630630-- | Khatri Rao Matrix product also known as matrix pairing.
631631--
632632-- NOTE: That this is not a true categorical product, see for instance:
633−--
633+--
634634-- @
635635-- | fstM . kr a b == a
636636-- kr a b ==> |
@@ -666,7 +666,7 @@ infixl 4 ><
666666 FL (Normalize (m, n)) n,
667667 FL (Normalize (p, q)) p,
668668 FL (Normalize (p, q)) q
669− )
669+ )
670670 => Matrix e m p -> Matrix e n q -> Matrix e (Normalize (m, n)) (Normalize (p, q))
671671(><) a b =
672672 let fstM' = fstM @e @m @n
@@ -931,7 +931,24 @@ fromFRel' ::
931931 ) =>
932932 (a -> b) ->
933933 Relation cols rows
934−fromFRel' = fromF'
934+fromFRel' f =
935+ let minA = minBound @a
936+ maxA = maxBound @a
937+ minB = minBound @b
938+ maxB = maxBound @b
939+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count cols))
940+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count rows))
941+ elementsA = take ccols [minA .. maxA]
942+ elementsB = take rrows [minB .. maxB]
943+ combinations = (,) <$> elementsA <*> elementsB
944+ combAp = map snd . sort . map (\(a, b) -> if f a == b
945+ then ((fromEnum a, fromEnum b), nat 1)
946+ else ((fromEnum a, fromEnum b), nat 0)) $ combinations
947+ mList = buildList combAp rrows
948+ in tr $ fromLists mList
949+ where
950+ buildList [] _ = []
951+ buildList l r = take r l : buildList (drop r l) r
935952
936953-- | Lifts functions to relations with dimensions matching @a@ and @b@
937954-- cardinality's.
@@ -939,11 +956,28 @@ fromFRel ::
939956 forall a b.
940957 ( Liftable Boolean a b,
941958 CountableDimsN a b,
942− FLN b a
959+ FL (Normalize b) (Normalize a)
943960 ) =>
944961 (a -> b) ->
945962 Relation (Normalize a) (Normalize b)
946−fromFRel = fromFRel'
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 (Normalize a)))
969+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
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
947981
948982-- | Lifts a relation function to a Boolean Matrix
949983toRel ::
@@ -953,17 +987,17 @@ toRel ::
953987 Enum a,
954988 Enum b,
955989 Eq b,
956− CountableDims a b,
990+ CountableDimsN a b,
957991 FLN b a
958− )
992+ )
959993 => (a -> b -> Bool) -> Relation (Normalize a) (Normalize b)
960994toRel f =
961995 let minA = minBound @a
962996 maxA = maxBound @a
963997 minB = minBound @b
964998 maxB = maxBound @b
965− ccols = fromInteger $ natVal (Proxy :: Proxy (Count a))
966− rrows = fromInteger $ natVal (Proxy :: Proxy (Count b))
999+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))
1000+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
9671001 elementsA = take ccols [minA .. maxA]
9681002 elementsB = take rrows [minB .. maxB]
9691003 combinations = (,) <$> elementsA <*> elementsB