@@ -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,14 +43,23 @@ 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 (..),
5151
52+ -- * Constraint type aliases
53+ Countable,
54+ CountableDims,
55+ CountableN,
56+ CountableDimsN,
57+ FL,
58+ FLN,
59+ Liftable,
60+ Trivial,
61+
5262 -- * Primitives
53− empty,
5463 one,
5564 join,
5665 fork,
@@ -66,6 +75,7 @@ module LAoP.Matrix.Internal
6675 toLists,
6776 toList,
6877 matrixBuilder,
78+ matrixBuilder',
6979 row,
7080 col,
7181 zeros,
@@ -76,11 +86,17 @@ module LAoP.Matrix.Internal
7686 -- * Misc
7787 -- ** Get dimensions
7888 columns,
89+ columns',
7990 rows,
91+ rows',
8092
8193 -- ** Matrix Transposition
8294 tr,
8395
96+ -- ** Scalar multiplication/division of matrices
97+ (.|),
98+ (./),
99+
84100 -- ** Selective operator
85101 select,
86102 branch,
@@ -89,8 +105,8 @@ module LAoP.Matrix.Internal
89105 cond,
90106
91107 -- ** Matrix "abiding"
92− abideJS,
93− abideSJ,
108+ abideJF,
109+ abideFJ,
94110
95111 -- ** Zip matrices
96112 zipWithM,
@@ -114,12 +130,13 @@ module LAoP.Matrix.Internal
114130
115131 -- | Note that given the restrictions imposed it is not possible to
116132 -- implement the standard type classes present in standard Haskell.
133+
117134 -- *** Matrix pairing projections
118135 fstM,
119136 sndM,
120137
121138 -- *** Matrix pairing
122− khatri,
139+ kr,
123140
124141 -- * Matrix composition and lifting
125142
@@ -159,17 +176,17 @@ import Data.Kind
159176import Data.List
160177import Data.Maybe
161178import Data.Proxy
179+import Data.Typeable
162180import Data.Void
163181import GHC.TypeLits
164182import Data.Type.Equality
165183import GHC.Generics
166184import Control.DeepSeq
167−import Control.Category
168−import Prelude hiding ((.))
185+import Prelude hiding (id, (.))
186+import qualified Prelude (id, (.))
169187
170188-- | LAoP (Linear Algebra of Programming) Inductive Matrix definition.
171189data Matrix e cols rows where
172− Empty :: Matrix e Void Void
173190 One :: e -> Matrix e () ()
174191 Join :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows
175192 Fork :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)
@@ -199,7 +216,6 @@ type family Count (d :: Type) :: Nat where
199216--
200217-- Thanks to Li-Yao Xia this type family is super fast.
201218type family FromNat (n :: Nat) :: Type where
202− FromNat 0 = Void
203219 FromNat 1 = ()
204220 FromNat n = FromNat' (Mod n 2 == 0) (FromNat (Div n 2))
205221
@@ -216,67 +232,56 @@ type family Normalize (d :: Type) :: Type where
216232-- | Constraint type synonyms to keep the type signatures less convoluted
217233type Countable a = KnownNat (Count a)
218234type CountableN a = KnownNat (Count (Normalize a))
219−type CountableDimensions a b = (Countable a, Countable b)
220−type CountableDimensionsN a b = (CountableN a, CountableN b)
221−type FromListsN e a b = FromLists e (Normalize a) (Normalize b)
235+type CountableDims a b = (Countable a, Countable b)
236+type CountableDimsN a b = (CountableN a, CountableN b)
237+type FL a b = FromLists a b
238+type FLN a b = FromLists (Normalize a) (Normalize b)
222239type Liftable e a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num e, Ord e)
223240type Trivial a = FromNat (Count a) ~ a
224241
225−-- | It isn't possible to implement the 'id' function so it's
226−-- implementation is 'undefined'. However 'comp' can be and this partial
227−-- class implementation exists just to make the code more readable.
228−--
229−-- Please use 'iden' instead.
242+-- | It is possible to implement a constrained version of the category type
243+-- class.
230244instance (Num e) => Category (Matrix e) where
231− id = undefined
232− (.) = comp
245+ type Object (Matrix e) a = (FL a a, Countable a)
246+ id = iden
247+ (.) = comp
233248
234249instance NFData e => NFData (Matrix e cols rows) where
235− rnf Empty = ()
236− rnf (One e) = rnf e
250+ rnf (One e) = rnf e
237251 rnf (Join a b) = rnf a `seq` rnf b
238252 rnf (Fork a b) = rnf a `seq` rnf b
239253
240254instance Eq e => Eq (Matrix e cols rows) where
241− Empty == Empty = True
242− (One a) == (One b) = a == b
243− (Join a b) == (Join c d) = a == c && b == d
244− (Fork a b) == (Fork c d) = a == c && b == d
245− x@(Fork _ _) == y@(Join _ _) = x == abideJS y
246− x@(Join _ _) == y@(Fork _ _) = abideJS x == y
255+ (One a) == (One b) = a == b
256+ (Join a b) == (Join c d) = a == c && b == d
257+ (Fork a b) == (Fork c d) = a == c && b == d
258+ x@(Fork _ _) == y@(Join _ _) = x == abideJF y
259+ x@(Join _ _) == y@(Fork _ _) = abideJF x == y
247260
248261instance Num e => Num (Matrix e cols rows) where
249−
250262 a + b = zipWithM (+) a b
251263
252264 a - b = zipWithM (-) a b
253265
254266 a * b = zipWithM (*) a b
255267
256− abs Empty = Empty
257− abs (One a) = One (abs a)
258− abs (Join a b) = Join (abs a) (abs b)
268+ abs (One a) = One (abs a)
269+ abs (Join a b) = Join (abs a) (abs b)
259270 abs (Fork a b) = Fork (abs a) (abs b)
260271
261− signum Empty = Empty
262− signum (One a) = One (signum a)
263− signum (Join a b) = Join (signum a) (signum b)
272+ signum (One a) = One (signum a)
273+ signum (Join a b) = Join (signum a) (signum b)
264274 signum (Fork a b) = Fork (signum a) (signum b)
265275
266276instance Ord e => Ord (Matrix e cols rows) where
267− Empty <= Empty = True
268− (One a) <= (One b) = a <= b
269− (Join a b) <= (Join c d) = (a <= c) && (b <= d)
270− (Fork a b) <= (Fork c d) = (a <= c) && (b <= d)
271− x@(Fork _ _) <= y@(Join _ _) = x <= abideJS y
272− x@(Join _ _) <= y@(Fork _ _) = abideJS x <= y
277+ (One a) <= (One b) = a <= b
278+ (Join a b) <= (Join c d) = (a <= c) && (b <= d)
279+ (Fork a b) <= (Fork c d) = (a <= c) && (b <= d)
280+ x@(Fork _ _) <= y@(Join _ _) = x <= abideJF y
281+ x@(Join _ _) <= y@(Fork _ _) = abideJF x <= y
273282
274283-- Primitives
275284
276−-- | Empty matrix constructor
277−empty :: Matrix e Void Void
278−empty = Empty
279−
280285-- | Unit matrix constructor
281286one :: e -> Matrix e () ()
282287one = One
@@ -307,69 +312,86 @@ infixl 2 ===
307312--
308313-- Given that it is not possible to branch on types at the term level type
309314-- classes are needed very much like an inductive definition but on types.
310−class FromLists e cols rows where
315+class FromLists cols rows where
311316 -- | Build a matrix out of a list of list of elements. Throws a runtime
312317 -- error if the dimensions do not match.
313318 fromLists :: [[e]] -> Matrix e cols rows
314319
315−instance FromLists e Void Void where
316− fromLists [] = Empty
317− fromLists _ = error "Wrong dimensions"
318−
319−instance {-# OVERLAPPING #-} FromLists e () () where
320+instance FromLists () () where
320321 fromLists [[e]] = One e
321322 fromLists _ = error "Wrong dimensions"
322323
323−instance {-# OVERLAPPING #-} (FromLists e cols ()) => FromLists e (Either () cols) () where
324+instance (FromLists cols ()) => FromLists (Either () cols) () where
324325 fromLists [h : t] = Join (One h) (fromLists [t])
325326 fromLists _ = error "Wrong dimensions"
326327
327−instance {-# OVERLAPPABLE #-} (FromLists e a (), FromLists e b (), Countable a) => FromLists e (Either a b) () where
328− fromLists [l] =
328+instance {-# OVERLAPPABLE #-}
329+ (FromLists a (), FromLists b (), Countable a) => FromLists (Either a b) () where
330+ fromLists [l] =
329331 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
330332 in Join (fromLists [take rowsA l]) (fromLists [drop rowsA l])
331333 fromLists _ = error "Wrong dimensions"
332334
333−instance {-# OVERLAPPING #-} (FromLists e () rows) => FromLists e () (Either () rows) where
335+instance (FromLists () rows) => FromLists () (Either () rows) where
334336 fromLists ([h] : t) = Fork (One h) (fromLists t)
335337 fromLists _ = error "Wrong dimensions"
336338
337−instance {-# OVERLAPPABLE #-} (FromLists e () a, FromLists e () b, Countable a) => FromLists e () (Either a b) where
338− fromLists l@([_] : _) =
339+instance {-# OVERLAPPABLE #-}
340+ (FromLists () a, FromLists () b, Countable a) => FromLists () (Either a b) where
341+ fromLists l@([_] : _) =
339342 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
340343 in Fork (fromLists (take rowsA l)) (fromLists (drop rowsA l))
341344 fromLists _ = error "Wrong dimensions"
342345
343−instance {-# OVERLAPPABLE #-} (FromLists e (Either a b) c, FromLists e (Either a b) d, Countable c) => FromLists e (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
344348 fromLists l@(h : t) =
345349 let lh = length h
346350 rowsC = fromInteger (natVal (Proxy :: Proxy (Count c)))
347− condition = all (== lh) (map length t)
351+ condition = all ((== lh) . length) t
348352 in if lh > 0 && condition
349353 then Fork (fromLists (take rowsC l)) (fromLists (drop rowsC l))
350354 else error "Not all rows have the same length"
351355
352356-- | Matrix builder function. Constructs a matrix provided with
353−-- a construction function.
354−matrixBuilder ::
357+-- a construction function that operates with indices.
358+matrixBuilder' ::
355359 forall e cols rows.
356− ( FromLists e cols rows,
357− CountableDimensions cols rows
358− ) =>
359− ((Int, Int) -> e) ->
360− Matrix e cols rows
361−matrixBuilder f =
360+ ( FL cols rows,
361+ CountableDims cols rows
362+ ) => ((Int, Int) -> e) -> Matrix e cols rows
363+matrixBuilder' f =
362364 let c = fromInteger $ natVal (Proxy :: Proxy (Count cols))
363365 r = fromInteger $ natVal (Proxy :: Proxy (Count rows))
364366 positions = [(a, b) | a <- [0 .. (r - 1)], b <- [0 .. (c - 1)]]
365367 in fromLists . map (map f) . groupBy (\(x, _) (w, _) -> x == w) $ positions
366368
369+-- | Matrix builder function. Constructs a matrix provided with
370+-- a construction function that operates with arbitrary types.
371+matrixBuilder ::
372+ forall e a b.
373+ ( FLN a b,
374+ Enum a,
375+ Enum b,
376+ Bounded a,
377+ Bounded b,
378+ Eq a,
379+ Countable b
380+ ) => ((a, b) -> e) -> Matrix e (Normalize a) (Normalize b)
381+matrixBuilder f =
382+ let r = fromInteger $ natVal (Proxy :: Proxy (Count b))
383+ positions = [(a, b) | a <- [minBound .. maxBound], b <- [minBound .. maxBound]]
384+ in fromLists . map (map f) . transpose . buildList r $ positions
385+ where
386+ buildList _ [] = []
387+ buildList r l = take r l : buildList r (drop r l)
388+
367389-- | Constructs a column vector matrix
368−col :: (FromLists e () rows) => [e] -> Matrix e () rows
390+col :: (FL () rows) => [e] -> Matrix e () rows
369391col = fromLists . map (: [])
370392
371393-- | Constructs a row vector matrix
372−row :: (FromLists e cols ()) => [e] -> Matrix e cols ()
394+row :: (FL cols ()) => [e] -> Matrix e cols ()
373395row = fromLists . (: [])
374396
375397-- | Lifts functions to matrices with arbitrary dimensions.
@@ -379,8 +401,8 @@ row = fromLists . (: [])
379401fromF' ::
380402 forall a b cols rows e.
381403 ( Liftable e a b,
382− CountableDimensions cols rows,
383− FromLists e rows cols
404+ CountableDims cols rows,
405+ FL rows cols
384406 ) =>
385407 (a -> b) ->
386408 Matrix e cols rows
@@ -394,8 +416,8 @@ fromF' f =
394416 elementsA = take ccols [minA .. maxA]
395417 elementsB = take rrows [minB .. maxB]
396418 combinations = (,) <$> elementsA <*> elementsB
397− combAp = map snd . sort . map (\(a, b) -> if f a == b
398− then ((fromEnum a, fromEnum b), 1)
419+ combAp = map snd . sort . map (\(a, b) -> if f a == b
420+ then ((fromEnum a, fromEnum b), 1)
399421 else ((fromEnum a, fromEnum b), 0)) $ combinations
400422 mList = buildList combAp rrows
401423 in tr $ fromLists mList
@@ -408,35 +430,17 @@ fromF' f =
408430fromF ::
409431 forall a b e.
410432 ( Liftable e a b,
411− CountableDimensionsN a b,
412− FromListsN e b a
433+ CountableDimsN a b,
434+ FLN b a
413435 ) =>
414436 (a -> b) ->
415437 Matrix e (Normalize a) (Normalize b)
416−fromF f =
417− let minA = minBound @a
418− maxA = maxBound @a
419− minB = minBound @b
420− maxB = maxBound @b
421− ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))
422− rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
423− elementsA = take ccols [minA .. maxA]
424− elementsB = take rrows [minB .. maxB]
425− combinations = (,) <$> elementsA <*> elementsB
426− combAp = map snd . sort . map (\(a, b) -> if f a == b
427− then ((fromEnum a, fromEnum b), 1)
428− else ((fromEnum a, fromEnum b), 0)) $ combinations
429− mList = buildList combAp rrows
430− in tr $ fromLists mList
431− where
432− buildList [] _ = []
433− buildList l r = take r l : buildList (drop r l) r
438+fromF = fromF'
434439
435440-- Conversion
436441
437442-- | Converts a matrix to a list of lists of elements.
438443toLists :: Matrix e cols rows -> [[e]]
439−toLists Empty = []
440444toLists (One e) = [[e]]
441445toLists (Fork l r) = toLists l ++ toLists r
442446toLists (Join l r) = zipWith (++) (toLists l) (toLists r)
@@ -448,28 +452,28 @@ toList = concat . toLists
448452-- Zeros Matrix
449453
450454-- | The zero matrix. A matrix wholly filled with zeros.
451−zeros :: (Num e, FromLists e cols rows, CountableDimensions cols rows) => Matrix e cols rows
452−zeros = matrixBuilder (const 0)
455+zeros :: (Num e, FL cols rows, CountableDims cols rows) => Matrix e cols rows
456+zeros = matrixBuilder' (const 0)
453457
454458-- Ones Matrix
455459
456460-- | The ones matrix. A matrix wholly filled with ones.
457461--
458462-- Also known as T (Top) matrix.
459−ones :: (Num e, FromLists e cols rows, CountableDimensions cols rows) => Matrix e cols rows
460−ones = matrixBuilder (const 1)
463+ones :: (Num e, FL cols rows, CountableDims cols rows) => Matrix e cols rows
464+ones = matrixBuilder' (const 1)
461465
462466-- Const Matrix
463467
464468-- | The constant matrix constructor. A matrix wholly filled with a given
465469-- value.
466−constant :: (Num e, FromLists e cols rows, CountableDimensions cols rows) => e -> Matrix e cols rows
467−constant e = matrixBuilder (const e)
470+constant :: (Num e, FL cols rows, CountableDims cols rows) => e -> Matrix e cols rows
471+constant e = matrixBuilder' (const e)
468472
469473-- Bang Matrix
470474
471475-- | The T (Top) row vector matrix.
472−bang :: forall e cols. (Num e, Enum e, FromLists e cols (), Countable cols) => Matrix e cols ()
476+bang :: forall e cols. (Num e, Enum e, FL cols (), Countable cols) => Matrix e cols ()
473477bang =
474478 let c = fromInteger $ natVal (Proxy :: Proxy (Count cols))
475479 in fromLists [take c [1, 1 ..]]
@@ -477,8 +481,8 @@ bang =
477481-- iden Matrix
478482
479483-- | iden matrix.
480−iden :: (Num e, FromLists e cols cols, Countable cols) => Matrix e cols cols
481−iden = matrixBuilder (bool 0 1 . uncurry (==))
484+iden :: forall e cols . (Num e, FL cols cols, Countable cols) => Matrix e cols cols
485+iden = matrixBuilder' (bool 0 1 . uncurry (==))
482486{-# NOINLINE iden #-}
483487
484488-- Matrix composition (MMM)
@@ -488,65 +492,90 @@ iden = matrixBuilder (bool 0 1 . uncurry (==))
488492-- This definition takes advantage of divide-and-conquer and fusion laws
489493-- from LAoP.
490494comp :: (Num e) => Matrix e cr rows -> Matrix e cols cr -> Matrix e cols rows
491−comp Empty Empty = Empty
492−comp (One a) (One b) = One (a * b)
495+comp (One a) (One b) = One (a * b)
493496comp (Join a b) (Fork c d) = comp a c + comp b d -- Divide-and-conquer law
494497comp (Fork a b) c = Fork (comp a c) (comp b c) -- Fork fusion law
495−comp c (Join a b) = Join (comp c a) (comp c b) -- Join fusion law
498+comp c (Join a b) = Join (comp c a) (comp c b) -- Join fusion law
496499{-# NOINLINE comp #-}
497−{-# RULES
500+{-# RULES
498501 "comp/iden1" forall m. comp m iden = m ;
499502 "comp/iden2" forall m. comp iden m = m
500503#-}
501504
505+-- Scalar multiplication of matrices
506+
507+infixl 7 .|
508+-- | Scalar multiplication of matrices.
509+(.|) :: Num e => e -> Matrix e cols rows -> Matrix e cols rows
510+(.|) e (One a) = One (e * a)
511+(.|) e (Join a b) = Join (e .| a) (e .| b)
512+(.|) e (Fork a b) = Fork (e .| a) (e .| b)
513+
514+-- Scalar division of matrices
515+
516+infixl 7 ./
517+-- | Scalar multiplication of matrices.
518+(./) :: Fractional e => Matrix e cols rows -> e -> Matrix e cols rows
519+(./) (One a) e = One (a / e)
520+(./) (Join a b) e = Join (a ./ e) (b ./ e)
521+(./) (Fork a b) e = Fork (a ./ e) (b ./ e)
522+
502523-- Projections
503524
504525-- | Biproduct first component projection
505−p1 :: forall e m n. (Num e, CountableDimensions n m, FromLists e n m, FromLists e m m) => Matrix e (Either m n) m
506−p1 =
507− let iden = iden :: Matrix e m m
508− zero = zeros :: Matrix e n m
509− in join iden zero
526+p1 :: (Num e, CountableDims n m, FL n m, FL m m) => Matrix e (Either m n) m
527+p1 = join id zeros
510528
511529-- | Biproduct second component projection
512−p2 :: forall e m n. (Num e, CountableDimensions n m, FromLists e m n, FromLists e n n) => Matrix e (Either m n) n
513−p2 =
514− let iden = iden :: Matrix e n n
515− zero = zeros :: Matrix e m n
516− in join zero iden
530+p2 :: (Num e, CountableDims n m, FL m n, FL n n) => Matrix e (Either m n) n
531+p2 = join zeros id
517532
518533-- Injections
519534
520535-- | Biproduct first component injection
521−i1 :: (Num e, CountableDimensions n m, FromLists e n m, FromLists e m m) => Matrix e m (Either m n)
536+i1 :: (Num e, CountableDims n m, FL n m, FL m m) => Matrix e m (Either m n)
522537i1 = tr p1
523538
524539-- | Biproduct second component injection
525−i2 :: (Num e, CountableDimensions n m, FromLists e m n, FromLists e n n) => Matrix e n (Either m n)
540+i2 :: (Num e, CountableDims n m, FL m n, FL n n) => Matrix e n (Either m n)
526541i2 = tr p2
527542
528543-- Dimensions
529544
530545-- | Obtain the number of rows.
531546--
532−-- NOTE: The 'KnownNat' constaint is needed in order to obtain the
533−-- dimensions in constant time.
534−--
535−-- TODO: A 'rows' function that does not need the 'KnownNat' constraint in
536−-- 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''.
537550rows :: forall e cols rows. (Countable rows) => Matrix e cols rows -> Int
538551rows _ = fromInteger $ natVal (Proxy :: Proxy (Count rows))
539552
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+
540562-- | Obtain the number of columns.
541−--
542−-- NOTE: The 'KnownNat' constaint is needed in order to obtain the
543−-- dimensions in constant time.
544563--
545−-- TODO: A 'columns' function that does not need the 'KnownNat' constraint in
546−-- 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''.
547567columns :: forall e cols rows. (Countable cols) => Matrix e cols rows -> Int
548568columns _ = fromInteger $ natVal (Proxy :: Proxy (Count cols))
549569
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+
550579-- Coproduct Bifunctor
551580
552581infixl 5 -|-
@@ -555,11 +584,11 @@ infixl 5 -|-
555584(-|-) ::
556585 forall e n k m j.
557586 ( Num e,
558− CountableDimensions j k,
559− FromLists e k k,
560− FromLists e j k,
561− FromLists e k j,
562− FromLists e j j
587+ CountableDims j k,
588+ FL k k,
589+ FL j k,
590+ FL k j,
591+ FL j j
563592 ) =>
564593 Matrix e n k ->
565594 Matrix e m j ->
@@ -569,150 +598,147 @@ infixl 5 -|-
569598-- Khatri Rao Product and projections
570599
571600-- | Khatri Rao product first component projection matrix.
572−fstM ::
601+fstM ::
573602 forall e m k .
574603 ( Num e,
575− CountableDimensions k m,
576− FromLists e (Normalize (m, k)) m,
604+ CountableDims k m,
605+ FL (Normalize (m, k)) m,
577606 CountableN (m, k)
578607 ) => Matrix e (Normalize (m, k)) m
579−fstM = matrixBuilder f
608+fstM = matrixBuilder' f
580609 where
581610 offset = fromInteger (natVal (Proxy :: Proxy (Count k)))
582611 f (x, y)
583612 | y >= (x * offset) && y <= (x * offset + offset - 1) = 1
584− | otherwise = 0
613+ | otherwise = 0
585614
586615-- | Khatri Rao product second component projection matrix.
587−sndM ::
616+sndM ::
588617 forall e m k .
589618 ( Num e,
590− CountableDimensions k m,
591− FromLists e (Normalize (m, k)) k,
619+ CountableDims k m,
620+ FL (Normalize (m, k)) k,
592621 CountableN (m, k)
593622 ) => Matrix e (Normalize (m, k)) k
594−sndM = matrixBuilder f
623+sndM = matrixBuilder' f
595624 where
596625 offset = fromInteger (natVal (Proxy :: Proxy (Count k)))
597626 f (x, y)
598627 | x == y || mod (y - x) offset == 0 = 1
599− | otherwise = 0
628+ | otherwise = 0
600629
601630-- | Khatri Rao Matrix product also known as matrix pairing.
602631--
603632-- NOTE: That this is not a true categorical product, see for instance:
604−--
633+--
605634-- @
606−-- | fstM . khatri a b == a
607−-- khatri a b ==> |
608−-- | sndM . khatri a b == b
635+-- | fstM . kr a b == a
636+-- kr a b ==> |
637+-- | sndM . kr a b == b
609638-- @
610639--
611640-- __Emphasis__ on the implication symbol.
612−khatri ::
613− forall e cols a b.
641+kr ::
642+ forall e cols a b.
614643 ( Num e,
615− CountableDimensions a b,
644+ CountableDims a b,
616645 CountableN (a, b),
617− FromLists e (Normalize (a, b)) a,
618− FromLists e (Normalize (a, b)) b
646+ FL (Normalize (a, b)) a,
647+ FL (Normalize (a, b)) b
619648 ) => Matrix e cols a -> Matrix e cols b -> Matrix e cols (Normalize (a, b))
620−khatri a b =
649+kr a b =
621650 let fstM' = fstM @e @a @b
622651 sndM' = sndM @e @a @b
623− in (tr fstM') . a * (tr sndM') . b
652+ in (tr fstM' . a) * (tr sndM' . b)
624653
625654-- Product Bifunctor (Kronecker)
626655
627656infixl 4 ><
628657
629658-- | Matrix product functor also known as kronecker product
630−(><) ::
631− forall e m p n q.
659+(><) ::
660+ forall e m p n q.
632661 ( Num e,
633− CountableDimensions m n,
634− CountableDimensions p q,
635− CountableDimensionsN (m, n) (p, q),
636− FromLists e (Normalize (m, n)) m,
637− FromLists e (Normalize (m, n)) n,
638− FromLists e (Normalize (p, q)) p,
639− FromLists e (Normalize (p, q)) q
640− )
662+ CountableDims m n,
663+ CountableDims p q,
664+ CountableDimsN (m, n) (p, q),
665+ FL (Normalize (m, n)) m,
666+ FL (Normalize (m, n)) n,
667+ FL (Normalize (p, q)) p,
668+ FL (Normalize (p, q)) q
669+ )
641670 => Matrix e m p -> Matrix e n q -> Matrix e (Normalize (m, n)) (Normalize (p, q))
642671(><) a b =
643672 let fstM' = fstM @e @m @n
644673 sndM' = sndM @e @m @n
645− in khatri (a . fstM') (b . sndM')
674+ in kr (a . fstM') (b . sndM')
646675
647676-- Matrix abide Join Fork
648677
649−-- | Matrix "abiding" followin the 'Join'-'Fork' abide law.
650−--
678+-- | Matrix "abiding" following the 'Join'-'Fork' exchange law.
679+--
651680-- Law:
652681--
653682-- @
654683-- 'Join' ('Fork' a c) ('Fork' b d) == 'Fork' ('Join' a b) ('Join' c d)
655684-- @
656−abideJS :: Matrix e cols rows -> Matrix e cols rows
657−abideJS (Join (Fork a c) (Fork b d)) = Fork (Join (abideJS a) (abideJS b)) (Join (abideJS c) (abideJS d)) -- Join-Fork abide law
658−abideJS Empty = Empty
659−abideJS (One e) = One e
660−abideJS (Join a b) = Join (abideJS a) (abideJS b)
661−abideJS (Fork a b) = Fork (abideJS a) (abideJS b)
685+abideJF :: Matrix e cols rows -> Matrix e cols rows
686+abideJF (Join (Fork a c) (Fork b d)) = Fork (Join (abideJF a) (abideJF b)) (Join (abideJF c) (abideJF d)) -- Join-Fork abide law
687+abideJF (One e) = One e
688+abideJF (Join a b) = Join (abideJF a) (abideJF b)
689+abideJF (Fork a b) = Fork (abideJF a) (abideJF b)
662690
663691-- Matrix abide Fork Join
664692
665693-- | Matrix "abiding" followin the 'Fork'-'Join' abide law.
666−--
694+--
667695-- @
668696-- 'Fork' ('Join' a b) ('Join' c d) == 'Join' ('Fork' a c) ('Fork' b d)
669697-- @
670−abideSJ :: Matrix e cols rows -> Matrix e cols rows
671−abideSJ (Fork (Join a b) (Join c d)) = Join (Fork (abideSJ a) (abideSJ c)) (Fork (abideSJ b) (abideSJ d)) -- Fork-Join abide law
672−abideSJ Empty = Empty
673−abideSJ (One e) = One e
674−abideSJ (Join a b) = Join (abideSJ a) (abideSJ b)
675−abideSJ (Fork a b) = Fork (abideSJ a) (abideSJ b)
698+abideFJ :: Matrix e cols rows -> Matrix e cols rows
699+abideFJ (Fork (Join a b) (Join c d)) = Join (Fork (abideFJ a) (abideFJ c)) (Fork (abideFJ b) (abideFJ d)) -- Fork-Join abide law
700+abideFJ (One e) = One e
701+abideFJ (Join a b) = Join (abideFJ a) (abideFJ b)
702+abideFJ (Fork a b) = Fork (abideFJ a) (abideFJ b)
676703
677704-- Matrix transposition
678705
679706-- | Matrix transposition.
680707tr :: Matrix e cols rows -> Matrix e rows cols
681−tr Empty = Empty
682−tr (One e) = One e
683−tr (Join a b) = Fork (tr a) (tr b)
708+tr (One e) = One e
709+tr (Join a b) = Fork (tr a) (tr b)
684710tr (Fork a b) = Join (tr a) (tr b)
685711
686712-- Selective 'select' operator
687713
688714-- | Selective functors 'select' operator equivalent inspired by the
689715-- ArrowMonad solution presented in the paper.
690−select :: (Num e, FromLists e b b, Countable b) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b
691−select (Fork a b) y = y . a + b -- Divide-and-conquer law
716+select :: (Num e, FL b b, Countable b) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b
717+select (Fork a b) y = y . a + b -- Divide-and-conquer law
692718select (Join (Fork a c) (Fork b d)) y = join (y . a + c) (y . b + d) -- Pattern matching + DnC law
693−select m y = join y iden . m
719+select m y = join y id . m
694720
695721branch ::
696722 ( Num e,
697− CountableDimensions a b,
698− CountableDimensions c (Either b c),
699− FromLists e c b,
700− FromLists e a b,
701− FromLists e a a,
702− FromLists e b b,
703− FromLists e c c,
704− FromLists e b a,
705− FromLists e b c,
706− FromLists e (Either b c) b,
707− FromLists e (Either b c) c
723+ CountableDims a b,
724+ CountableDims c (Either b c),
725+ FL c b,
726+ FL a b,
727+ FL a a,
728+ FL b b,
729+ FL c c,
730+ FL b a,
731+ FL b c,
732+ FL (Either b c) b,
733+ FL (Either b c) c
708734 )
709735 => Matrix e cols (Either a b) -> Matrix e a c -> Matrix e b c -> Matrix e cols c
710736branch x l r = f x `select` g l `select` r
711737 where
712− f :: (Num e, Countable a, CountableDimensions b c, FromLists e a b, FromLists e c b, FromLists e b b, FromLists e b a, FromLists e a a)
738+ f :: (Num e, Countable a, CountableDims b c, FL a b, FL c b, FL b b, FL b a, FL a a)
713739 => Matrix e cols (Either a b) -> Matrix e cols (Either a (Either b c))
714740 f m = fork (tr i1) (i1 . tr i2) . m
715− g :: (Num e, CountableDimensions b c, FromLists e b c, FromLists e c c) => Matrix e a c -> Matrix e a (Either b c)
741+ g :: (Num e, CountableDims b c, FL b c, FL c c) => Matrix e a c -> Matrix e a (Either b c)
716742 g m = i2 . m
717743
718744-- McCarthy's Conditional
@@ -721,9 +747,9 @@ branch x l r = f x `select` g l `select` r
721747cond ::
722748 ( Trivial cols,
723749 Countable cols,
724− FromLists e () cols,
725− FromLists e cols (),
726− FromLists e cols cols,
750+ FL () cols,
751+ FL cols (),
752+ FL cols cols,
727753 Bounded a,
728754 Enum a,
729755 Num e,
@@ -733,12 +759,12 @@ cond ::
733759 (a -> Bool) -> Matrix e cols rows -> Matrix e cols rows -> Matrix e cols rows
734760cond p f g = join f g . grd p
735761
736−grd ::
762+grd ::
737763 ( Trivial q,
738764 Countable q,
739− FromLists e () q,
740− FromLists e q (),
741− FromLists e q q,
765+ FL () q,
766+ FL q (),
767+ FL q q,
742768 Bounded a,
743769 Enum a,
744770 Num e,
@@ -748,42 +774,42 @@ grd ::
748774 (a -> Bool) -> Matrix e q (Either q q)
749775grd f = fork (corr f) (corr (not . f))
750776
751−corr ::
752− forall e a q .
777+corr ::
778+ forall e a q .
753779 ( Trivial q,
754780 Countable q,
755− FromLists e () q,
756− FromLists e q (),
757− FromLists e q q,
781+ FL () q,
782+ FL q (),
783+ FL q q,
758784 Liftable e a Bool
759− )
785+ )
760786 => (a -> Bool) -> Matrix e q q
761787corr p = let f = fromF' p :: Matrix e q ()
762− in khatri f (iden :: Matrix e q q)
788+ in kr f (id :: Matrix e q q)
763789
764790-- Pretty print
765791
766792prettyAux :: Show e => [[e]] -> [[e]] -> String
767793prettyAux [] _ = ""
768−prettyAux [[e]] m = "│ " ++ fill (show e) ++ " │\n"
794+prettyAux [[e]] m = "│ " ++ fill (show e) ++ " │\n"
769795 where
770796 v = fmap show m
771797 widest = maximum $ fmap length v
772798 fill str = replicate (widest - length str - 2) ' ' ++ str
773−prettyAux [h] m = "│ " ++ fill (unwords $ map show h) ++ " │\n"
799+prettyAux [h] m = "│ " ++ fill (unwords $ map show h) ++ " │\n"
774800 where
775− v = fmap show m
776− widest = maximum $ fmap length v
801+ v = fmap show m
802+ widest = maximum $ fmap length v
777803 fill str = replicate (widest - length str - 2) ' ' ++ str
778−prettyAux (h : t) l = "│ " ++ fill (unwords $ map show h) ++ " │\n" ++
804+prettyAux (h : t) l = "│ " ++ fill (unwords $ map show h) ++ " │\n" ++
779805 prettyAux t l
780806 where
781− v = fmap show l
782− widest = maximum $ fmap length v
807+ v = fmap show l
808+ widest = maximum $ fmap length v
783809 fill str = replicate (widest - length str - 2) ' ' ++ str
784810
785811-- | Matrix pretty printer
786−pretty :: (CountableDimensions cols rows, Show e) => Matrix e cols rows -> String
812+pretty :: (CountableDims cols rows, Show e) => Matrix e cols rows -> String
787813pretty m = concat
788814 [ "┌ ", unwords (replicate (columns m) blank), " ┐\n"
789815 , unlines
@@ -791,16 +817,16 @@ pretty m = concat
791817 , "└ ", unwords (replicate (columns m) blank), " ┘"
792818 ]
793819 where
794− strings = map show (toList m)
795− widest = maximum $ map length strings
820+ strings = map show (toList m)
821+ widest = maximum $ map length strings
796822 fill str = replicate (widest - length str) ' ' ++ str
797− blank = fill ""
823+ blank = fill ""
798824 safeGet i j m
799825 | i > rows m || j > columns m || i < 1 || j < 1 = Nothing
800826 | otherwise = Just $ unsafeGet i j m (toList m)
801827 unsafeGet i j m l = l !! encode (columns m) (i,j)
802− encode m (i,j) = (i-1)*m + j - 1
803− getElem i j m =
828+ encode m (i,j) = (i-1)*m + j - 1
829+ getElem i j m =
804830 fromMaybe
805831 (error $
806832 "getElem: Trying to get the "
@@ -812,21 +838,20 @@ pretty m = concat
812838 (safeGet i j m)
813839
814840-- | Matrix pretty printer
815−prettyPrint :: (CountableDimensions cols rows, Show e) => Matrix e cols rows -> IO ()
841+prettyPrint :: (CountableDims cols rows, Show e) => Matrix e cols rows -> IO ()
816842prettyPrint = putStrLn . pretty
817843
818844-- | Zip two matrices with a given binary function
819845zipWithM :: (e -> f -> g) -> Matrix e cols rows -> Matrix f cols rows -> Matrix g cols rows
820−zipWithM f Empty Empty = Empty
821−zipWithM f (One a) (One b) = One (f a b)
822−zipWithM f (Join a b) (Join c d) = Join (zipWithM f a c) (zipWithM f b d)
823−zipWithM f (Fork a b) (Fork c d) = Fork (zipWithM f a c) (zipWithM f b d)
824−zipWithM f x@(Fork _ _) y@(Join _ _) = zipWithM f x (abideJS y)
825−zipWithM f x@(Join _ _) y@(Fork _ _) = zipWithM f (abideJS x) y
846+zipWithM f (One a) (One b) = One (f a b)
847+zipWithM f (Join a b) (Join c d) = Join (zipWithM f a c) (zipWithM f b d)
848+zipWithM f (Fork a b) (Fork c d) = Fork (zipWithM f a c) (zipWithM f b d)
849+zipWithM f x@(Fork _ _) y@(Join _ _) = zipWithM f x (abideJF y)
850+zipWithM f x@(Join _ _) y@(Fork _ _) = zipWithM f (abideJF x) y
826851
827852-- Relational operators functions
828853
829−type Boolean = Natural 0 1
854+type Boolean = Natural 0 1
830855type Relation a b = Matrix Boolean a b
831856
832857-- | Helper conversion function
@@ -842,54 +867,47 @@ fromBool False = nat 0
842867
843868-- | Relational negation
844869negateM :: Relation cols rows -> Relation cols rows
845−negateM Empty = Empty
846−negateM (One (Nat 0)) = One (Nat 1)
847−negateM (One (Nat 1)) = One (Nat 0)
870+negateM (One (Nat p)) = One (Nat (negate p))
848871negateM (Join a b) = Join (negateM a) (negateM b)
849−negateM (Fork a b) = Fork (negateM a) (negateM b)
872+negateM (Fork a b) = Fork (negateM a) (negateM b)
850873
851874-- | Relational addition
852875orM :: Relation cols rows -> Relation cols rows -> Relation cols rows
853−orM Empty Empty = Empty
854−orM (One a) (One b) = One (fromBool (toBool a || toBool b))
855−orM (Join a b) (Join c d) = Join (orM a c) (orM b d)
856−orM (Fork a b) (Fork c d) = Fork (orM a c) (orM b d)
857−orM x@(Fork _ _) y@(Join _ _) = orM x (abideJS y)
858−orM x@(Join _ _) y@(Fork _ _) = orM (abideJS x) y
876+orM (One a) (One b) = One (fromBool (toBool a || toBool b))
877+orM (Join a b) (Join c d) = Join (orM a c) (orM b d)
878+orM (Fork a b) (Fork c d) = Fork (orM a c) (orM b d)
879+orM x@(Fork _ _) y@(Join _ _) = orM x (abideJF y)
880+orM x@(Join _ _) y@(Fork _ _) = orM (abideJF x) y
859881
860882-- | Relational multiplication
861883andM :: Relation cols rows -> Relation cols rows -> Relation cols rows
862−andM Empty Empty = Empty
863−andM (One a) (One b) = One (fromBool (toBool a && toBool b))
864−andM (Join a b) (Join c d) = Join (andM a c) (andM b d)
865−andM (Fork a b) (Fork c d) = Fork (andM a c) (andM b d)
866−andM x@(Fork _ _) y@(Join _ _) = andM x (abideJS y)
867−andM x@(Join _ _) y@(Fork _ _) = andM (abideJS x) y
884+andM (One a) (One b) = One (fromBool (toBool a && toBool b))
885+andM (Join a b) (Join c d) = Join (andM a c) (andM b d)
886+andM (Fork a b) (Fork c d) = Fork (andM a c) (andM b d)
887+andM x@(Fork _ _) y@(Join _ _) = andM x (abideJF y)
888+andM x@(Join _ _) y@(Fork _ _) = andM (abideJF x) y
868889
869890-- | Relational subtraction
870891subM :: Relation cols rows -> Relation cols rows -> Relation cols rows
871−subM Empty Empty = Empty
872−subM (One a) (One b) = if a - b < nat 0 then One (nat 0) else One (a - b)
873−subM (Join a b) (Join c d) = Join (subM a c) (subM b d)
874−subM (Fork a b) (Fork c d) = Fork (subM a c) (subM b d)
875−subM x@(Fork _ _) y@(Join _ _) = subM x (abideJS y)
876−subM x@(Join _ _) y@(Fork _ _) = subM (abideJS x) y
892+subM (One a) (One b) = if a - b < nat 0 then One (nat 0) else One (a - b)
893+subM (Join a b) (Join c d) = Join (subM a c) (subM b d)
894+subM (Fork a b) (Fork c d) = Fork (subM a c) (subM b d)
895+subM x@(Fork _ _) y@(Join _ _) = subM x (abideJF y)
896+subM x@(Join _ _) y@(Fork _ _) = subM (abideJF x) y
877897
878898-- | Matrix relational composition.
879899compRel :: Relation cr rows -> Relation cols cr -> Relation cols rows
880−compRel Empty Empty = Empty
881−compRel (One a) (One b) = One (fromBool (toBool a && toBool b))
900+compRel (One a) (One b) = One (fromBool (toBool a && toBool b))
882901compRel (Join a b) (Fork c d) = orM (compRel a c) (compRel b d) -- Divide-and-conquer law
883902compRel (Fork a b) c = Fork (compRel a c) (compRel b c) -- Fork fusion law
884−compRel c (Join a b) = Join (compRel c a) (compRel c b) -- Join fusion law
903+compRel c (Join a b) = Join (compRel c a) (compRel c b) -- Join fusion law
885904
886905-- | Matrix relational right division
887906divR :: Relation b c -> Relation b a -> Relation a c
888−divR Empty Empty = Empty
889907divR (One a) (One b) = One (fromBool (not (toBool b) || toBool a)) -- b implies a
890908divR (Join a b) (Join c d) = andM (divR a c) (divR b d)
891−divR (Fork a b) c = Fork (divR a c) (divR b c)
892−divR c (Fork a b) = Join (divR c a) (divR c b)
909+divR (Fork a b) c = Fork (divR a c) (divR b c)
910+divR c (Fork a b) = Join (divR c a) (divR c b)
893911
894912-- | Matrix relational left division
895913divL :: Relation c b -> Relation a b -> Relation a c
@@ -908,83 +926,49 @@ divS s r = divL r s `intersection` divR (tr r) (tr s)
908926fromFRel' ::
909927 forall a b cols rows.
910928 ( Liftable Boolean a b,
911− CountableDimensions cols rows,
912− FromLists Boolean rows cols
929+ CountableDims cols rows,
930+ FL rows cols
913931 ) =>
914932 (a -> b) ->
915933 Relation cols rows
916−fromFRel' f =
917− let minA = minBound @a
918− maxA = maxBound @a
919− minB = minBound @b
920− maxB = maxBound @b
921− ccols = fromInteger $ natVal (Proxy :: Proxy (Count cols))
922− rrows = fromInteger $ natVal (Proxy :: Proxy (Count rows))
923− elementsA = take ccols [minA .. maxA]
924− elementsB = take rrows [minB .. maxB]
925− combinations = (,) <$> elementsA <*> elementsB
926− combAp = map snd . sort . map (\(a, b) -> if f a == b
927− then ((fromEnum a, fromEnum b), nat 1)
928− else ((fromEnum a, fromEnum b), nat 0)) $ combinations
929− mList = buildList combAp rrows
930− in tr $ fromLists mList
931− where
932− buildList [] _ = []
933− buildList l r = take r l : buildList (drop r l) r
934+fromFRel' = fromF'
934935
935936-- | Lifts functions to relations with dimensions matching @a@ and @b@
936937-- cardinality's.
937938fromFRel ::
938939 forall a b.
939940 ( Liftable Boolean a b,
940− CountableDimensionsN a b,
941− FromLists Boolean (Normalize b) (Normalize a)
941+ CountableDimsN a b,
942+ FLN b a
942943 ) =>
943944 (a -> b) ->
944945 Relation (Normalize a) (Normalize b)
945−fromFRel f =
946− let minA = minBound @a
947− maxA = maxBound @a
948− minB = minBound @b
949− maxB = maxBound @b
950− ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))
951− rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
952− elementsA = take ccols [minA .. maxA]
953− elementsB = take rrows [minB .. maxB]
954− combinations = (,) <$> elementsA <*> elementsB
955− combAp = map snd . sort . map (\(a, b) -> if f a == b
956− then ((fromEnum a, fromEnum b), nat 1)
957− else ((fromEnum a, fromEnum b), nat 0)) $ combinations
958− mList = buildList combAp rrows
959− in tr $ fromLists mList
960− where
961− buildList [] _ = []
962− buildList l r = take r l : buildList (drop r l) r
946+fromFRel = fromFRel'
963947
964948-- | Lifts a relation function to a Boolean Matrix
965−toRel ::
949+toRel ::
966950 forall a b.
967951 ( Bounded a,
968952 Bounded b,
969953 Enum a,
970954 Enum b,
971955 Eq b,
972− CountableDimensionsN a b,
973− FromListsN Boolean b a
974− )
956+ CountableDims a b,
957+ FLN b a
958+ )
975959 => (a -> b -> Bool) -> Relation (Normalize a) (Normalize b)
976960toRel f =
977961 let minA = minBound @a
978962 maxA = maxBound @a
979963 minB = minBound @b
980964 maxB = maxBound @b
981− ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))
982− rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
965+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count a))
966+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count b))
983967 elementsA = take ccols [minA .. maxA]
984968 elementsB = take rrows [minB .. maxB]
985969 combinations = (,) <$> elementsA <*> elementsB
986− combAp = map snd . sort . map (\(a, b) -> if uncurry f (a, b)
987− then ((fromEnum a, fromEnum b), nat 1)
970+ combAp = map snd . sort . map (\(a, b) -> if uncurry f (a, b)
971+ then ((fromEnum a, fromEnum b), nat 1)
988972 else ((fromEnum a, fromEnum b), nat 0)) $ combinations
989973 mList = buildList combAp rrows
990974 in tr $ fromLists mList