@@ -30,7 +30,7 @@
30-- motivation behind the library, the underlying theory, and implementation details.
30-- motivation behind the library, the underlying theory, and implementation details.
32-- This module offers many of the combinators mentioned in the work of
32-- This module offers many of the combinators mentioned in the work of
33−-- Macedo (2012) and Oliveira (2012).
33+-- Macedo (2012) and Oliveira (2012).
35-- This is an Internal module and it is no supposed to be imported.
35-- This is an Internal module and it is no supposed to be imported.
@@ -43,23 +43,14 @@ module LAoP.Matrix.Internal
44 -- There exists two type families that make it easier to write
44 -- There exists two type families that make it easier to write
45 -- matrix dimensions: 'FromNat' and 'Count'. This approach
45 -- matrix dimensions: 'FromNat' and 'Count'. This approach
46− -- leads to a very straightforward implementation
46+ -- leads to a very straightforward implementation
47− -- of LAoP combinators.
47+ -- of LAoP combinators.
49 -- * Type safe matrix representation
49 -- * Type safe matrix representation
50 Matrix (..),
50 Matrix (..),
52− -- * Constraint type aliases
62 -- * Primitives
52 -- * Primitives
@@ -75,7 +66,6 @@ module LAoP.Matrix.Internal
77 matrixBuilder,
68 matrixBuilder,
@@ -86,9 +76,7 @@ module LAoP.Matrix.Internal
87 -- ** Get dimensions
77 -- ** Get dimensions
93 -- ** Matrix Transposition
81 -- ** Matrix Transposition
@@ -130,7 +118,6 @@ module LAoP.Matrix.Internal
131 -- | Note that given the restrictions imposed it is not possible to
119 -- | Note that given the restrictions imposed it is not possible to
132 -- implement the standard type classes present in standard Haskell.
120 -- implement the standard type classes present in standard Haskell.
134 -- *** Matrix pairing projections
121 -- *** Matrix pairing projections
@@ -176,17 +163,17 @@ import Data.Kind
176import Data.List
163import Data.List
177import Data.Maybe
164import Data.Maybe
178import Data.Proxy
165import Data.Proxy
180import Data.Void
166import Data.Void
181import GHC.TypeLits
167import GHC.TypeLits
182import Data.Type.Equality
168import Data.Type.Equality
183import GHC.Generics
169import GHC.Generics
184import Control.DeepSeq
170import Control.DeepSeq
171+import Control.Category
185−import Prelude hiding (id, (.))
172+import Prelude hiding ((.))
186−import qualified Prelude (id, (.))
188-- | LAoP (Linear Algebra of Programming) Inductive Matrix definition.
174-- | LAoP (Linear Algebra of Programming) Inductive Matrix definition.
189data Matrix e cols rows where
175data Matrix e cols rows where
176+ Empty :: Matrix e Void Void
190 One :: e -> Matrix e () ()
177 One :: e -> Matrix e () ()
191 Join :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows
178 Join :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows
192 Fork :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)
179 Fork :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)
@@ -216,6 +203,7 @@ type family Count (d :: Type) :: Nat where
217-- Thanks to Li-Yao Xia this type family is super fast.
204-- Thanks to Li-Yao Xia this type family is super fast.
218type family FromNat (n :: Nat) :: Type where
205type family FromNat (n :: Nat) :: Type where
219 FromNat 1 = ()
207 FromNat 1 = ()
220 FromNat n = FromNat' (Mod n 2 == 0) (FromNat (Div n 2))
208 FromNat n = FromNat' (Mod n 2 == 0) (FromNat (Div n 2))
@@ -232,26 +220,29 @@ type family Normalize (d :: Type) :: Type where
232-- | Constraint type synonyms to keep the type signatures less convoluted
220-- | Constraint type synonyms to keep the type signatures less convoluted
233type Countable a = KnownNat (Count a)
221type Countable a = KnownNat (Count a)
234type CountableN a = KnownNat (Count (Normalize a))
222type CountableN a = KnownNat (Count (Normalize a))
235−type CountableDims a b = (Countable a, Countable b)
223+type CountableDimensions a b = (Countable a, Countable b)
236−type CountableDimsN a b = (CountableN a, CountableN b)
224+type CountableDimensionsN a b = (CountableN a, CountableN b)
237−type FL a b = FromLists a b
238−type FLN a b = FromLists (Normalize a) (Normalize b)
225+type FromListsN e a b = FromLists e (Normalize a) (Normalize b)
239type Liftable e a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num e, Ord e)
226type Liftable e a b = (Bounded a, Bounded b, Enum a, Enum b, Eq b, Num e, Ord e)
240type Trivial a = FromNat (Count a) ~ a
227type Trivial a = FromNat (Count a) ~ a
242−-- | It is possible to implement a constrained version of the category type
229+-- | It isn't possible to implement the 'id' function so it's
243−-- class.
230+-- implementation is 'undefined'. However 'comp' can be and this partial
231+-- class implementation exists just to make the code more readable.
233+-- Please use 'iden' instead.
244instance (Num e) => Category (Matrix e) where
234instance (Num e) => Category (Matrix e) where
245− type Object (Matrix e) a = (FL a a, Countable a)
235+ id = undefined
247− (.) = comp
236+ (.) = comp
249instance NFData e => NFData (Matrix e cols rows) where
238instance NFData e => NFData (Matrix e cols rows) where
250 rnf (One e) = rnf e
240 rnf (One e) = rnf e
251 rnf (Join a b) = rnf a `seq` rnf b
241 rnf (Join a b) = rnf a `seq` rnf b
252 rnf (Fork a b) = rnf a `seq` rnf b
242 rnf (Fork a b) = rnf a `seq` rnf b
254instance Eq e => Eq (Matrix e cols rows) where
244instance Eq e => Eq (Matrix e cols rows) where
245+ Empty == Empty = True
255 (One a) == (One b) = a == b
246 (One a) == (One b) = a == b
256 (Join a b) == (Join c d) = a == c && b == d
247 (Join a b) == (Join c d) = a == c && b == d
257 (Fork a b) == (Fork c d) = a == c && b == d
248 (Fork a b) == (Fork c d) = a == c && b == d
@@ -259,21 +250,25 @@ instance Eq e => Eq (Matrix e cols rows) where
259 x@(Join _ _) == y@(Fork _ _) = abideJF x == y
250 x@(Join _ _) == y@(Fork _ _) = abideJF x == y
261instance Num e => Num (Matrix e cols rows) where
252instance Num e => Num (Matrix e cols rows) where
262 a + b = zipWithM (+) a b
254 a + b = zipWithM (+) a b
264 a - b = zipWithM (-) a b
256 a - b = zipWithM (-) a b
266 a * b = zipWithM (*) a b
258 a * b = zipWithM (*) a b
268 abs (One a) = One (abs a)
261 abs (One a) = One (abs a)
269 abs (Join a b) = Join (abs a) (abs b)
262 abs (Join a b) = Join (abs a) (abs b)
270 abs (Fork a b) = Fork (abs a) (abs b)
263 abs (Fork a b) = Fork (abs a) (abs b)
265+ signum Empty = Empty
272 signum (One a) = One (signum a)
266 signum (One a) = One (signum a)
273 signum (Join a b) = Join (signum a) (signum b)
267 signum (Join a b) = Join (signum a) (signum b)
274 signum (Fork a b) = Fork (signum a) (signum b)
268 signum (Fork a b) = Fork (signum a) (signum b)
276instance Ord e => Ord (Matrix e cols rows) where
270instance Ord e => Ord (Matrix e cols rows) where
271+ Empty <= Empty = True
277 (One a) <= (One b) = a <= b
272 (One a) <= (One b) = a <= b
278 (Join a b) <= (Join c d) = (a <= c) && (b <= d)
273 (Join a b) <= (Join c d) = (a <= c) && (b <= d)
279 (Fork a b) <= (Fork c d) = (a <= c) && (b <= d)
274 (Fork a b) <= (Fork c d) = (a <= c) && (b <= d)
@@ -282,6 +277,10 @@ instance Ord e => Ord (Matrix e cols rows) where
283-- Primitives
278-- Primitives
280+-- | Empty matrix constructor
281+empty :: Matrix e Void Void
285-- | Unit matrix constructor
284-- | Unit matrix constructor
286one :: e -> Matrix e () ()
285one :: e -> Matrix e () ()
@@ -312,39 +311,40 @@ infixl 2 ===
313-- Given that it is not possible to branch on types at the term level type
312-- Given that it is not possible to branch on types at the term level type
314-- classes are needed very much like an inductive definition but on types.
313-- classes are needed very much like an inductive definition but on types.
315−class FromLists cols rows where
314+class FromLists e cols rows where
316 -- | Build a matrix out of a list of list of elements. Throws a runtime
315 -- | Build a matrix out of a list of list of elements. Throws a runtime
317 -- error if the dimensions do not match.
316 -- error if the dimensions do not match.
318 fromLists :: [[e]] -> Matrix e cols rows
317 fromLists :: [[e]] -> Matrix e cols rows
320−instance FromLists () () where
319+instance FromLists e Void Void where
320+ fromLists [] = Empty
321+ fromLists _ = error "Wrong dimensions"
323+instance {-# OVERLAPPING #-} FromLists e () () where
321 fromLists [[e]] = One e
324 fromLists [[e]] = One e
322 fromLists _ = error "Wrong dimensions"
325 fromLists _ = error "Wrong dimensions"
324−instance (FromLists cols ()) => FromLists (Either () cols) () where
327+instance {-# OVERLAPPING #-} (FromLists e cols ()) => FromLists e (Either () cols) () where
325 fromLists [h : t] = Join (One h) (fromLists [t])
328 fromLists [h : t] = Join (One h) (fromLists [t])
326 fromLists _ = error "Wrong dimensions"
329 fromLists _ = error "Wrong dimensions"
328−instance {-# OVERLAPPABLE #-}
329− (FromLists a (), FromLists b (), Countable a) => FromLists (Either a b) () where
331+instance {-# OVERLAPPABLE #-} (FromLists e a (), FromLists e b (), Countable a) => FromLists e (Either a b) () where
330 fromLists [l] =
332 fromLists [l] =
331 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
333 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
332 in Join (fromLists [take rowsA l]) (fromLists [drop rowsA l])
334 in Join (fromLists [take rowsA l]) (fromLists [drop rowsA l])
333 fromLists _ = error "Wrong dimensions"
335 fromLists _ = error "Wrong dimensions"
335−instance (FromLists () rows) => FromLists () (Either () rows) where
337+instance {-# OVERLAPPING #-} (FromLists e () rows) => FromLists e () (Either () rows) where
336 fromLists ([h] : t) = Fork (One h) (fromLists t)
338 fromLists ([h] : t) = Fork (One h) (fromLists t)
337 fromLists _ = error "Wrong dimensions"
339 fromLists _ = error "Wrong dimensions"
339−instance {-# OVERLAPPABLE #-}
340− (FromLists () a, FromLists () b, Countable a) => FromLists () (Either a b) where
341+instance {-# OVERLAPPABLE #-} (FromLists e () a, FromLists e () b, Countable a) => FromLists e () (Either a b) where
341− fromLists l@([_] : _) =
342+ fromLists l@([_] : _) =
342 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
343 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
343 in Fork (fromLists (take rowsA l)) (fromLists (drop rowsA l))
344 in Fork (fromLists (take rowsA l)) (fromLists (drop rowsA l))
344 fromLists _ = error "Wrong dimensions"
345 fromLists _ = error "Wrong dimensions"
346−instance (FromLists (Either a b) c, FromLists (Either a b) d, Countable c)
347+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
347− => FromLists (Either a b) (Either c d) where
348 fromLists l@(h : t) =
348 fromLists l@(h : t) =
349 let lh = length h
349 let lh = length h
350 rowsC = fromInteger (natVal (Proxy :: Proxy (Count c)))
350 rowsC = fromInteger (natVal (Proxy :: Proxy (Count c)))
@@ -354,44 +354,24 @@ instance (FromLists (Either a b) c, FromLists (Either a b) d, Countable c)
354 else error "Not all rows have the same length"
354 else error "Not all rows have the same length"
356-- | Matrix builder function. Constructs a matrix provided with
356-- | Matrix builder function. Constructs a matrix provided with
357−-- a construction function that operates with indices.
357+-- a construction function.
358−matrixBuilder' ::
358+matrixBuilder ::
359 forall e cols rows.
359 forall e cols rows.
360− ( FL cols rows,
360+ ( FromLists e cols rows,
361− CountableDims cols rows
361+ CountableDimensions cols rows
362 ) => ((Int, Int) -> e) -> Matrix e cols rows
362 ) => ((Int, Int) -> e) -> Matrix e cols rows
363−matrixBuilder' f =
363+matrixBuilder f =
364 let c = fromInteger $ natVal (Proxy :: Proxy (Count cols))
364 let c = fromInteger $ natVal (Proxy :: Proxy (Count cols))
365 r = fromInteger $ natVal (Proxy :: Proxy (Count rows))
365 r = fromInteger $ natVal (Proxy :: Proxy (Count rows))
366 positions = [(a, b) | a <- [0 .. (r - 1)], b <- [0 .. (c - 1)]]
366 positions = [(a, b) | a <- [0 .. (r - 1)], b <- [0 .. (c - 1)]]
367 in fromLists . map (map f) . groupBy (\(x, _) (w, _) -> x == w) $ positions
367 in fromLists . map (map f) . groupBy (\(x, _) (w, _) -> x == w) $ positions
369−-- | Matrix builder function. Constructs a matrix provided with
370−-- a construction function that operates with arbitrary types.
380− ) => ((a, b) -> e) -> Matrix e (Normalize a) (Normalize b)
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
387− buildList r l = take r l : buildList r (drop r l)
389-- | Constructs a column vector matrix
369-- | Constructs a column vector matrix
390−col :: (FL () rows) => [e] -> Matrix e () rows
370+col :: (FromLists e () rows) => [e] -> Matrix e () rows
391col = fromLists . map (: [])
371col = fromLists . map (: [])
393-- | Constructs a row vector matrix
373-- | Constructs a row vector matrix
394−row :: (FL cols ()) => [e] -> Matrix e cols ()
374+row :: (FromLists e cols ()) => [e] -> Matrix e cols ()
395row = fromLists . (: [])
375row = fromLists . (: [])
397-- | Lifts functions to matrices with arbitrary dimensions.
377-- | Lifts functions to matrices with arbitrary dimensions.
@@ -401,8 +381,8 @@ row = fromLists . (: [])
402 forall a b cols rows e.
382 forall a b cols rows e.
403 ( Liftable e a b,
383 ( Liftable e a b,
404− CountableDims cols rows,
384+ CountableDimensions cols rows,
405− FL rows cols
385+ FromLists e rows cols
407 (a -> b) ->
387 (a -> b) ->
408 Matrix e cols rows
388 Matrix e cols rows
@@ -430,17 +410,35 @@ fromF' f =
431 forall a b e.
411 forall a b e.
432 ( Liftable e a b,
412 ( Liftable e a b,
433− CountableDimsN a b,
413+ CountableDimensionsN a b,
434− FLN b a
414+ FromListsN e b a
436 (a -> b) ->
416 (a -> b) ->
437 Matrix e (Normalize a) (Normalize b)
417 Matrix e (Normalize a) (Normalize b)
438−fromF = fromF'
418+fromF f =
419+ let minA = minBound @a
423+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))
424+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
425+ elementsA = take ccols [minA .. maxA]
426+ elementsB = take rrows [minB .. maxB]
427+ combinations = (,) <$> elementsA <*> elementsB
428+ combAp = map snd . sort . map (\(a, b) -> if f a == b
429+ then ((fromEnum a, fromEnum b), 1)
430+ else ((fromEnum a, fromEnum b), 0)) $ combinations
431+ mList = buildList combAp rrows
432+ in tr $ fromLists mList
435+ buildList l r = take r l : buildList (drop r l) r
440-- Conversion
437-- Conversion
442-- | Converts a matrix to a list of lists of elements.
439-- | Converts a matrix to a list of lists of elements.
443toLists :: Matrix e cols rows -> [[e]]
440toLists :: Matrix e cols rows -> [[e]]
444toLists (One e) = [[e]]
442toLists (One e) = [[e]]
445toLists (Fork l r) = toLists l ++ toLists r
443toLists (Fork l r) = toLists l ++ toLists r
446toLists (Join l r) = zipWith (++) (toLists l) (toLists r)
444toLists (Join l r) = zipWith (++) (toLists l) (toLists r)
@@ -452,28 +450,28 @@ toList = concat . toLists
452-- Zeros Matrix
450-- Zeros Matrix
454-- | The zero matrix. A matrix wholly filled with zeros.
452-- | The zero matrix. A matrix wholly filled with zeros.
455−zeros :: (Num e, FL cols rows, CountableDims cols rows) => Matrix e cols rows
453+zeros :: (Num e, FromLists e cols rows, CountableDimensions cols rows) => Matrix e cols rows
456−zeros = matrixBuilder' (const 0)
454+zeros = matrixBuilder (const 0)
458-- Ones Matrix
456-- Ones Matrix
460-- | The ones matrix. A matrix wholly filled with ones.
458-- | The ones matrix. A matrix wholly filled with ones.
462-- Also known as T (Top) matrix.
460-- Also known as T (Top) matrix.
463−ones :: (Num e, FL cols rows, CountableDims cols rows) => Matrix e cols rows
461+ones :: (Num e, FromLists e cols rows, CountableDimensions cols rows) => Matrix e cols rows
464−ones = matrixBuilder' (const 1)
462+ones = matrixBuilder (const 1)
466-- Const Matrix
464-- Const Matrix
468-- | The constant matrix constructor. A matrix wholly filled with a given
466-- | The constant matrix constructor. A matrix wholly filled with a given
470−constant :: (Num e, FL cols rows, CountableDims cols rows) => e -> Matrix e cols rows
468+constant :: (Num e, FromLists e cols rows, CountableDimensions cols rows) => e -> Matrix e cols rows
471−constant e = matrixBuilder' (const e)
469+constant e = matrixBuilder (const e)
473-- Bang Matrix
471-- Bang Matrix
475-- | The T (Top) row vector matrix.
473-- | The T (Top) row vector matrix.
476−bang :: forall e cols. (Num e, Enum e, FL cols (), Countable cols) => Matrix e cols ()
474+bang :: forall e cols. (Num e, Enum e, FromLists e cols (), Countable cols) => Matrix e cols ()
478 let c = fromInteger $ natVal (Proxy :: Proxy (Count cols))
476 let c = fromInteger $ natVal (Proxy :: Proxy (Count cols))
479 in fromLists [take c [1, 1 ..]]
477 in fromLists [take c [1, 1 ..]]
@@ -481,8 +479,8 @@ bang =
481-- iden Matrix
479-- iden Matrix
483-- | iden matrix.
481-- | iden matrix.
484−iden :: forall e cols . (Num e, FL cols cols, Countable cols) => Matrix e cols cols
482+iden :: (Num e, FromLists e cols cols, Countable cols) => Matrix e cols cols
485−iden = matrixBuilder' (bool 0 1 . uncurry (==))
483+iden = matrixBuilder (bool 0 1 . uncurry (==))
486{-# NOINLINE iden #-}
484{-# NOINLINE iden #-}
488-- Matrix composition (MMM)
486-- Matrix composition (MMM)
@@ -492,12 +490,13 @@ iden = matrixBuilder' (bool 0 1 . uncurry (==))
492-- This definition takes advantage of divide-and-conquer and fusion laws
490-- This definition takes advantage of divide-and-conquer and fusion laws
493-- from LAoP.
491-- from LAoP.
494comp :: (Num e) => Matrix e cr rows -> Matrix e cols cr -> Matrix e cols rows
492comp :: (Num e) => Matrix e cr rows -> Matrix e cols cr -> Matrix e cols rows
493+comp Empty Empty = Empty
495comp (One a) (One b) = One (a * b)
494comp (One a) (One b) = One (a * b)
496comp (Join a b) (Fork c d) = comp a c + comp b d -- Divide-and-conquer law
495comp (Join a b) (Fork c d) = comp a c + comp b d -- Divide-and-conquer law
497comp (Fork a b) c = Fork (comp a c) (comp b c) -- Fork fusion law
496comp (Fork a b) c = Fork (comp a c) (comp b c) -- Fork fusion law
498comp c (Join a b) = Join (comp c a) (comp c b) -- Join fusion law
497comp c (Join a b) = Join (comp c a) (comp c b) -- Join fusion law
499{-# NOINLINE comp #-}
498{-# NOINLINE comp #-}
500−{-# RULES
499+{-# RULES
501 "comp/iden1" forall m. comp m iden = m ;
500 "comp/iden1" forall m. comp m iden = m ;
502 "comp/iden2" forall m. comp iden m = m
501 "comp/iden2" forall m. comp iden m = m
@@ -507,6 +506,7 @@ comp c (Join a b) = Join (comp c a) (comp c b) -- Join fusion law
507infixl 7 .|
506infixl 7 .|
508-- | Scalar multiplication of matrices.
507-- | Scalar multiplication of matrices.
509(.|) :: Num e => e -> Matrix e cols rows -> Matrix e cols rows
508(.|) :: Num e => e -> Matrix e cols rows -> Matrix e cols rows
510(.|) e (One a) = One (e * a)
510(.|) e (One a) = One (e * a)
511(.|) e (Join a b) = Join (e .| a) (e .| b)
511(.|) e (Join a b) = Join (e .| a) (e .| b)
512(.|) e (Fork a b) = Fork (e .| a) (e .| b)
512(.|) e (Fork a b) = Fork (e .| a) (e .| b)
@@ -516,6 +516,7 @@ infixl 7 .|
516infixl 7 ./
516infixl 7 ./
517-- | Scalar multiplication of matrices.
517-- | Scalar multiplication of matrices.
518(./) :: Fractional e => Matrix e cols rows -> e -> Matrix e cols rows
518(./) :: Fractional e => Matrix e cols rows -> e -> Matrix e cols rows
519(./) (One a) e = One (a / e)
520(./) (One a) e = One (a / e)
520(./) (Join a b) e = Join (a ./ e) (b ./ e)
521(./) (Join a b) e = Join (a ./ e) (b ./ e)
521(./) (Fork a b) e = Fork (a ./ e) (b ./ e)
522(./) (Fork a b) e = Fork (a ./ e) (b ./ e)
@@ -523,59 +524,45 @@ infixl 7 ./
523-- Projections
524-- Projections
525-- | Biproduct first component projection
526-- | Biproduct first component projection
526−p1 :: (Num e, CountableDims n m, FL n m, FL m m) => Matrix e (Either m n) m
527+p1 :: (Num e, CountableDimensions n m, FromLists e n m, FromLists e m m) => Matrix e (Either m n) m
527−p1 = join id zeros
528+p1 = join iden zeros
529-- | Biproduct second component projection
530-- | Biproduct second component projection
530−p2 :: (Num e, CountableDims n m, FL m n, FL n n) => Matrix e (Either m n) n
531+p2 :: (Num e, CountableDimensions n m, FromLists e m n, FromLists e n n) => Matrix e (Either m n) n
531−p2 = join zeros id
532+p2 = join zeros iden
533-- Injections
534-- Injections
535-- | Biproduct first component injection
536-- | Biproduct first component injection
536−i1 :: (Num e, CountableDims n m, FL n m, FL m m) => Matrix e m (Either m n)
537+i1 :: (Num e, CountableDimensions n m, FromLists e n m, FromLists e m m) => Matrix e m (Either m n)
537i1 = tr p1
538i1 = tr p1
539-- | Biproduct second component injection
540-- | Biproduct second component injection
540−i2 :: (Num e, CountableDims n m, FL m n, FL n n) => Matrix e n (Either m n)
541+i2 :: (Num e, CountableDimensions n m, FromLists e m n, FromLists e n n) => Matrix e n (Either m n)
541i2 = tr p2
542i2 = tr p2
543-- Dimensions
544-- Dimensions
545-- | Obtain the number of rows.
546-- | Obtain the number of rows.
547−-- NOTE: The 'KnownNat' constraint is needed in order to obtain the
548+-- NOTE: The 'KnownNat' constaint is needed in order to obtain the
548−-- dimensions in constant time. For a version that doesn't require the
549+-- dimensions in constant time.
549−-- constraint see 'rows''.
550+--
551+-- TODO: A 'rows' function that does not need the 'KnownNat' constraint in
552+-- exchange for performance.
550rows :: forall e cols rows. (Countable rows) => Matrix e cols rows -> Int
553rows :: forall e cols rows. (Countable rows) => Matrix e cols rows -> Int
551rows _ = fromInteger $ natVal (Proxy :: Proxy (Count rows))
554rows _ = fromInteger $ natVal (Proxy :: Proxy (Count rows))
553−-- | Obtain the number of rows in an inefficient manner, but without any
556−-- For a more efficient version see 'rows'.
557−rows' :: Matrix e cols rows -> Int
559−rows' (Join lhs _) = rows' lhs
560−rows' (Fork top bottom) = rows' top + rows' bottom
562-- | Obtain the number of columns.
556-- | Obtain the number of columns.
558+-- NOTE: The 'KnownNat' constaint is needed in order to obtain the
559+-- dimensions in constant time.
564−-- NOTE: The 'KnownNat' constraint is needed in order to obtain the
561+-- TODO: A 'columns' function that does not need the 'KnownNat' constraint in
565−-- dimensions in constant time. For a version that doesn't require the
562+-- exchange for performance.
566−-- constraint see 'columns''.
567columns :: forall e cols rows. (Countable cols) => Matrix e cols rows -> Int
563columns :: forall e cols rows. (Countable cols) => Matrix e cols rows -> Int
568columns _ = fromInteger $ natVal (Proxy :: Proxy (Count cols))
564columns _ = fromInteger $ natVal (Proxy :: Proxy (Count cols))
570−-- | Obtain the number of columns in an inefficient manner, but without any
573−-- For a more efficient version see 'columns'.
574−columns' :: Matrix e cols rows -> Int
576−columns' (Join lhs rhs) = columns' lhs + columns' rhs
577−columns' (Fork top _) = columns' top
579-- Coproduct Bifunctor
566-- Coproduct Bifunctor
581infixl 5 -|-
568infixl 5 -|-
@@ -584,11 +571,11 @@ infixl 5 -|-
585 forall e n k m j.
572 forall e n k m j.
587− CountableDims j k,
574+ CountableDimensions j k,
588− FL k k,
575+ FromLists e k k,
589− FL j k,
576+ FromLists e j k,
590− FL k j,
577+ FromLists e k j,
591− FL j j
578+ FromLists e j j
593 Matrix e n k ->
580 Matrix e n k ->
594 Matrix e m j ->
581 Matrix e m j ->
@@ -601,11 +588,11 @@ infixl 5 -|-
602 forall e m k .
589 forall e m k .
604− CountableDims k m,
591+ CountableDimensions k m,
605− FL (Normalize (m, k)) m,
592+ FromLists e (Normalize (m, k)) m,
606 CountableN (m, k)
593 CountableN (m, k)
607 ) => Matrix e (Normalize (m, k)) m
594 ) => Matrix e (Normalize (m, k)) m
608−fstM = matrixBuilder' f
595+fstM = matrixBuilder f
610 offset = fromInteger (natVal (Proxy :: Proxy (Count k)))
597 offset = fromInteger (natVal (Proxy :: Proxy (Count k)))
@@ -616,11 +603,11 @@ fstM = matrixBuilder' f
617 forall e m k .
604 forall e m k .
619− CountableDims k m,
606+ CountableDimensions k m,
620− FL (Normalize (m, k)) k,
607+ FromLists e (Normalize (m, k)) k,
621 CountableN (m, k)
608 CountableN (m, k)
622 ) => Matrix e (Normalize (m, k)) k
609 ) => Matrix e (Normalize (m, k)) k
623−sndM = matrixBuilder' f
610+sndM = matrixBuilder f
625 offset = fromInteger (natVal (Proxy :: Proxy (Count k)))
612 offset = fromInteger (natVal (Proxy :: Proxy (Count k)))
@@ -630,7 +617,7 @@ sndM = matrixBuilder' f
630-- | Khatri Rao Matrix product also known as matrix pairing.
617-- | Khatri Rao Matrix product also known as matrix pairing.
632-- NOTE: That this is not a true categorical product, see for instance:
619-- NOTE: That this is not a true categorical product, see for instance:
635-- | fstM . kr a b == a
622-- | fstM . kr a b == a
636-- kr a b ==> |
623-- kr a b ==> |
@@ -641,10 +628,10 @@ sndM = matrixBuilder' f
642 forall e cols a b.
629 forall e cols a b.
644− CountableDims a b,
631+ CountableDimensions a b,
645 CountableN (a, b),
632 CountableN (a, b),
646− FL (Normalize (a, b)) a,
633+ FromLists e (Normalize (a, b)) a,
647− FL (Normalize (a, b)) b
634+ FromLists e (Normalize (a, b)) b
648 ) => Matrix e cols a -> Matrix e cols b -> Matrix e cols (Normalize (a, b))
635 ) => Matrix e cols a -> Matrix e cols b -> Matrix e cols (Normalize (a, b))
650 let fstM' = fstM @e @a @b
637 let fstM' = fstM @e @a @b
@@ -659,14 +646,14 @@ infixl 4 ><
660 forall e m p n q.
647 forall e m p n q.
662− CountableDims m n,
649+ CountableDimensions m n,
663− CountableDims p q,
650+ CountableDimensions p q,
664− CountableDimsN (m, n) (p, q),
651+ CountableDimensionsN (m, n) (p, q),
665− FL (Normalize (m, n)) m,
652+ FromLists e (Normalize (m, n)) m,
666− FL (Normalize (m, n)) n,
653+ FromLists e (Normalize (m, n)) n,
667− FL (Normalize (p, q)) p,
654+ FromLists e (Normalize (p, q)) p,
668− FL (Normalize (p, q)) q
655+ FromLists e (Normalize (p, q)) q
670 => Matrix e m p -> Matrix e n q -> Matrix e (Normalize (m, n)) (Normalize (p, q))
657 => Matrix e m p -> Matrix e n q -> Matrix e (Normalize (m, n)) (Normalize (p, q))
671(><) a b =
658(><) a b =
672 let fstM' = fstM @e @m @n
659 let fstM' = fstM @e @m @n
@@ -684,6 +671,7 @@ infixl 4 ><
685abideJF :: Matrix e cols rows -> Matrix e cols rows
672abideJF :: Matrix e cols rows -> Matrix e cols rows
686abideJF (Join (Fork a c) (Fork b d)) = Fork (Join (abideJF a) (abideJF b)) (Join (abideJF c) (abideJF d)) -- Join-Fork abide law
673abideJF (Join (Fork a c) (Fork b d)) = Fork (Join (abideJF a) (abideJF b)) (Join (abideJF c) (abideJF d)) -- Join-Fork abide law
674+abideJF Empty = Empty
687abideJF (One e) = One e
675abideJF (One e) = One e
688abideJF (Join a b) = Join (abideJF a) (abideJF b)
676abideJF (Join a b) = Join (abideJF a) (abideJF b)
689abideJF (Fork a b) = Fork (abideJF a) (abideJF b)
677abideJF (Fork a b) = Fork (abideJF a) (abideJF b)
@@ -697,6 +685,7 @@ abideJF (Fork a b) = Fork (abideJF a) (abideJF b)
698abideFJ :: Matrix e cols rows -> Matrix e cols rows
686abideFJ :: Matrix e cols rows -> Matrix e cols rows
699abideFJ (Fork (Join a b) (Join c d)) = Join (Fork (abideFJ a) (abideFJ c)) (Fork (abideFJ b) (abideFJ d)) -- Fork-Join abide law
687abideFJ (Fork (Join a b) (Join c d)) = Join (Fork (abideFJ a) (abideFJ c)) (Fork (abideFJ b) (abideFJ d)) -- Fork-Join abide law
688+abideFJ Empty = Empty
700abideFJ (One e) = One e
689abideFJ (One e) = One e
701abideFJ (Join a b) = Join (abideFJ a) (abideFJ b)
690abideFJ (Join a b) = Join (abideFJ a) (abideFJ b)
702abideFJ (Fork a b) = Fork (abideFJ a) (abideFJ b)
691abideFJ (Fork a b) = Fork (abideFJ a) (abideFJ b)
@@ -705,6 +694,7 @@ abideFJ (Fork a b) = Fork (abideFJ a) (abideFJ b)
706-- | Matrix transposition.
695-- | Matrix transposition.
707tr :: Matrix e cols rows -> Matrix e rows cols
696tr :: Matrix e cols rows -> Matrix e rows cols
708tr (One e) = One e
698tr (One e) = One e
709tr (Join a b) = Fork (tr a) (tr b)
699tr (Join a b) = Fork (tr a) (tr b)
710tr (Fork a b) = Join (tr a) (tr b)
700tr (Fork a b) = Join (tr a) (tr b)
@@ -713,32 +703,32 @@ tr (Fork a b) = Join (tr a) (tr b)
714-- | Selective functors 'select' operator equivalent inspired by the
704-- | Selective functors 'select' operator equivalent inspired by the
715-- ArrowMonad solution presented in the paper.
705-- ArrowMonad solution presented in the paper.
716−select :: (Num e, FL b b, Countable b) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b
706+select :: (Num e, FromLists e b b, Countable b) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b
717select (Fork a b) y = y . a + b -- Divide-and-conquer law
707select (Fork a b) y = y . a + b -- Divide-and-conquer law
718select (Join (Fork a c) (Fork b d)) y = join (y . a + c) (y . b + d) -- Pattern matching + DnC law
708select (Join (Fork a c) (Fork b d)) y = join (y . a + c) (y . b + d) -- Pattern matching + DnC law
719−select m y = join y id . m
709+select m y = join y iden . m
723− CountableDims a b,
713+ CountableDimensions a b,
724− CountableDims c (Either b c),
714+ CountableDimensions c (Either b c),
725− FL c b,
715+ FromLists e c b,
726− FL a b,
716+ FromLists e a b,
727− FL a a,
717+ FromLists e a a,
728− FL b b,
718+ FromLists e b b,
729− FL c c,
719+ FromLists e c c,
730− FL b a,
720+ FromLists e b a,
731− FL b c,
721+ FromLists e b c,
732− FL (Either b c) b,
722+ FromLists e (Either b c) b,
733− FL (Either b c) c
723+ FromLists e (Either b c) c
735 => Matrix e cols (Either a b) -> Matrix e a c -> Matrix e b c -> Matrix e cols c
725 => Matrix e cols (Either a b) -> Matrix e a c -> Matrix e b c -> Matrix e cols c
736branch x l r = f x `select` g l `select` r
726branch x l r = f x `select` g l `select` r
738− f :: (Num e, Countable a, CountableDims b c, FL a b, FL c b, FL b b, FL b a, FL a a)
728+ 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)
739 => Matrix e cols (Either a b) -> Matrix e cols (Either a (Either b c))
729 => Matrix e cols (Either a b) -> Matrix e cols (Either a (Either b c))
740 f m = fork (tr i1) (i1 . tr i2) . m
730 f m = fork (tr i1) (i1 . tr i2) . m
741− g :: (Num e, CountableDims b c, FL b c, FL c c) => Matrix e a c -> Matrix e a (Either b c)
731+ g :: (Num e, CountableDimensions b c, FromLists e b c, FromLists e c c) => Matrix e a c -> Matrix e a (Either b c)
742 g m = i2 . m
732 g m = i2 . m
744-- McCarthy's Conditional
734-- McCarthy's Conditional
@@ -747,9 +737,9 @@ branch x l r = f x `select` g l `select` r
748 ( Trivial cols,
738 ( Trivial cols,
749 Countable cols,
739 Countable cols,
750− FL () cols,
740+ FromLists e () cols,
751− FL cols (),
741+ FromLists e cols (),
752− FL cols cols,
742+ FromLists e cols cols,
753 Bounded a,
743 Bounded a,
@@ -762,9 +752,9 @@ cond p f g = join f g . grd p
763 ( Trivial q,
753 ( Trivial q,
764 Countable q,
754 Countable q,
765− FL () q,
755+ FromLists e () q,
766− FL q (),
756+ FromLists e q (),
767− FL q q,
757+ FromLists e q q,
768 Bounded a,
758 Bounded a,
@@ -778,14 +768,14 @@ corr ::
778 forall e a q .
768 forall e a q .
779 ( Trivial q,
769 ( Trivial q,
780 Countable q,
770 Countable q,
781− FL () q,
771+ FromLists e () q,
782− FL q (),
772+ FromLists e q (),
783− FL q q,
773+ FromLists e q q,
784 Liftable e a Bool
774 Liftable e a Bool
786 => (a -> Bool) -> Matrix e q q
776 => (a -> Bool) -> Matrix e q q
787corr p = let f = fromF' p :: Matrix e q ()
777corr p = let f = fromF' p :: Matrix e q ()
788− in kr f (id :: Matrix e q q)
778+ in kr f (iden :: Matrix e q q)
790-- Pretty print
780-- Pretty print
@@ -809,7 +799,7 @@ prettyAux (h : t) l = "│ " ++ fill (unwords $ map show h) ++ " │\n" ++
809 fill str = replicate (widest - length str - 2) ' ' ++ str
799 fill str = replicate (widest - length str - 2) ' ' ++ str
811-- | Matrix pretty printer
801-- | Matrix pretty printer
812−pretty :: (CountableDims cols rows, Show e) => Matrix e cols rows -> String
802+pretty :: (CountableDimensions cols rows, Show e) => Matrix e cols rows -> String
813pretty m = concat
803pretty m = concat
814 [ "┌ ", unwords (replicate (columns m) blank), " ┐\n"
804 [ "┌ ", unwords (replicate (columns m) blank), " ┐\n"
815 , unlines
805 , unlines
@@ -838,11 +828,12 @@ pretty m = concat
838 (safeGet i j m)
828 (safeGet i j m)
840-- | Matrix pretty printer
830-- | Matrix pretty printer
841−prettyPrint :: (CountableDims cols rows, Show e) => Matrix e cols rows -> IO ()
831+prettyPrint :: (CountableDimensions cols rows, Show e) => Matrix e cols rows -> IO ()
842prettyPrint = putStrLn . pretty
832prettyPrint = putStrLn . pretty
844-- | Zip two matrices with a given binary function
834-- | Zip two matrices with a given binary function
845zipWithM :: (e -> f -> g) -> Matrix e cols rows -> Matrix f cols rows -> Matrix g cols rows
835zipWithM :: (e -> f -> g) -> Matrix e cols rows -> Matrix f cols rows -> Matrix g cols rows
836+zipWithM _ Empty Empty = Empty
846zipWithM f (One a) (One b) = One (f a b)
837zipWithM f (One a) (One b) = One (f a b)
847zipWithM f (Join a b) (Join c d) = Join (zipWithM f a c) (zipWithM f b d)
838zipWithM f (Join a b) (Join c d) = Join (zipWithM f a c) (zipWithM f b d)
848zipWithM f (Fork a b) (Fork c d) = Fork (zipWithM f a c) (zipWithM f b d)
839zipWithM f (Fork a b) (Fork c d) = Fork (zipWithM f a c) (zipWithM f b d)
@@ -867,12 +858,14 @@ fromBool False = nat 0
868-- | Relational negation
859-- | Relational negation
869negateM :: Relation cols rows -> Relation cols rows
860negateM :: Relation cols rows -> Relation cols rows
861+negateM Empty = Empty
870negateM (One (Nat p)) = One (Nat (negate p))
862negateM (One (Nat p)) = One (Nat (negate p))
871negateM (Join a b) = Join (negateM a) (negateM b)
863negateM (Join a b) = Join (negateM a) (negateM b)
872negateM (Fork a b) = Fork (negateM a) (negateM b)
864negateM (Fork a b) = Fork (negateM a) (negateM b)
874-- | Relational addition
866-- | Relational addition
875orM :: Relation cols rows -> Relation cols rows -> Relation cols rows
867orM :: Relation cols rows -> Relation cols rows -> Relation cols rows
868+orM Empty Empty = Empty
876orM (One a) (One b) = One (fromBool (toBool a || toBool b))
869orM (One a) (One b) = One (fromBool (toBool a || toBool b))
877orM (Join a b) (Join c d) = Join (orM a c) (orM b d)
870orM (Join a b) (Join c d) = Join (orM a c) (orM b d)
878orM (Fork a b) (Fork c d) = Fork (orM a c) (orM b d)
871orM (Fork a b) (Fork c d) = Fork (orM a c) (orM b d)
@@ -881,6 +874,7 @@ orM x@(Join _ _) y@(Fork _ _) = orM (abideJF x) y
882-- | Relational multiplication
875-- | Relational multiplication
883andM :: Relation cols rows -> Relation cols rows -> Relation cols rows
876andM :: Relation cols rows -> Relation cols rows -> Relation cols rows
877+andM Empty Empty = Empty
884andM (One a) (One b) = One (fromBool (toBool a && toBool b))
878andM (One a) (One b) = One (fromBool (toBool a && toBool b))
885andM (Join a b) (Join c d) = Join (andM a c) (andM b d)
879andM (Join a b) (Join c d) = Join (andM a c) (andM b d)
886andM (Fork a b) (Fork c d) = Fork (andM a c) (andM b d)
880andM (Fork a b) (Fork c d) = Fork (andM a c) (andM b d)
@@ -889,6 +883,7 @@ andM x@(Join _ _) y@(Fork _ _) = andM (abideJF x) y
890-- | Relational subtraction
884-- | Relational subtraction
891subM :: Relation cols rows -> Relation cols rows -> Relation cols rows
885subM :: Relation cols rows -> Relation cols rows -> Relation cols rows
886+subM Empty Empty = Empty
892subM (One a) (One b) = if a - b < nat 0 then One (nat 0) else One (a - b)
887subM (One a) (One b) = if a - b < nat 0 then One (nat 0) else One (a - b)
893subM (Join a b) (Join c d) = Join (subM a c) (subM b d)
888subM (Join a b) (Join c d) = Join (subM a c) (subM b d)
894subM (Fork a b) (Fork c d) = Fork (subM a c) (subM b d)
889subM (Fork a b) (Fork c d) = Fork (subM a c) (subM b d)
@@ -897,6 +892,7 @@ subM x@(Join _ _) y@(Fork _ _) = subM (abideJF x) y
898-- | Matrix relational composition.
893-- | Matrix relational composition.
899compRel :: Relation cr rows -> Relation cols cr -> Relation cols rows
894compRel :: Relation cr rows -> Relation cols cr -> Relation cols rows
895+compRel Empty Empty = Empty
900compRel (One a) (One b) = One (fromBool (toBool a && toBool b))
896compRel (One a) (One b) = One (fromBool (toBool a && toBool b))
901compRel (Join a b) (Fork c d) = orM (compRel a c) (compRel b d) -- Divide-and-conquer law
897compRel (Join a b) (Fork c d) = orM (compRel a c) (compRel b d) -- Divide-and-conquer law
902compRel (Fork a b) c = Fork (compRel a c) (compRel b c) -- Fork fusion law
898compRel (Fork a b) c = Fork (compRel a c) (compRel b c) -- Fork fusion law
@@ -904,6 +900,7 @@ compRel c (Join a b) = Join (compRel c a) (compRel c b) -- Join fusion
905-- | Matrix relational right division
901-- | Matrix relational right division
906divR :: Relation b c -> Relation b a -> Relation a c
902divR :: Relation b c -> Relation b a -> Relation a c
903+divR Empty Empty = Empty
907divR (One a) (One b) = One (fromBool (not (toBool b) || toBool a)) -- b implies a
904divR (One a) (One b) = One (fromBool (not (toBool b) || toBool a)) -- b implies a
908divR (Join a b) (Join c d) = andM (divR a c) (divR b d)
905divR (Join a b) (Join c d) = andM (divR a c) (divR b d)
909divR (Fork a b) c = Fork (divR a c) (divR b c)
906divR (Fork a b) c = Fork (divR a c) (divR b c)
@@ -926,24 +923,58 @@ divS s r = divL r s `intersection` divR (tr r) (tr s)
926fromFRel' ::
923fromFRel' ::
927 forall a b cols rows.
924 forall a b cols rows.
928 ( Liftable Boolean a b,
925 ( Liftable Boolean a b,
929− CountableDims cols rows,
926+ CountableDimensions cols rows,
930− FL rows cols
927+ FromLists Boolean rows cols
932 (a -> b) ->
929 (a -> b) ->
933 Relation cols rows
930 Relation cols rows
934−fromFRel' = fromF'
931+fromFRel' f =
932+ let minA = minBound @a
936+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count cols))
937+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count rows))
938+ elementsA = take ccols [minA .. maxA]
939+ elementsB = take rrows [minB .. maxB]
940+ combinations = (,) <$> elementsA <*> elementsB
941+ combAp = map snd . sort . map (\(a, b) -> if f a == b
942+ then ((fromEnum a, fromEnum b), nat 1)
943+ else ((fromEnum a, fromEnum b), nat 0)) $ combinations
944+ mList = buildList combAp rrows
945+ in tr $ fromLists mList
948+ buildList l r = take r l : buildList (drop r l) r
936-- | Lifts functions to relations with dimensions matching @a@ and @b@
950-- | Lifts functions to relations with dimensions matching @a@ and @b@
937-- cardinality's.
951-- cardinality's.
938fromFRel ::
952fromFRel ::
939 forall a b.
953 forall a b.
940 ( Liftable Boolean a b,
954 ( Liftable Boolean a b,
941− CountableDimsN a b,
955+ CountableDimensionsN a b,
942− FLN b a
956+ FromLists Boolean (Normalize b) (Normalize a)
944 (a -> b) ->
958 (a -> b) ->
945 Relation (Normalize a) (Normalize b)
959 Relation (Normalize a) (Normalize b)
946−fromFRel = fromFRel'
960+fromFRel f =
961+ let minA = minBound @a
965+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))
966+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
967+ elementsA = take ccols [minA .. maxA]
968+ elementsB = take rrows [minB .. maxB]
969+ combinations = (,) <$> elementsA <*> elementsB
970+ combAp = map snd . sort . map (\(a, b) -> if f a == b
971+ then ((fromEnum a, fromEnum b), nat 1)
972+ else ((fromEnum a, fromEnum b), nat 0)) $ combinations
973+ mList = buildList combAp rrows
974+ in tr $ fromLists mList
977+ buildList l r = take r l : buildList (drop r l) r
948-- | Lifts a relation function to a Boolean Matrix
979-- | Lifts a relation function to a Boolean Matrix
@@ -953,17 +984,17 @@ toRel ::
956− CountableDims a b,
987+ CountableDimensionsN a b,
957− FLN b a
988+ FromListsN Boolean b a
959 => (a -> b -> Bool) -> Relation (Normalize a) (Normalize b)
990 => (a -> b -> Bool) -> Relation (Normalize a) (Normalize b)
961 let minA = minBound @a
992 let minA = minBound @a
962 maxA = maxBound @a
993 maxA = maxBound @a
963 minB = minBound @b
994 minB = minBound @b
964 maxB = maxBound @b
995 maxB = maxBound @b
965− ccols = fromInteger $ natVal (Proxy :: Proxy (Count a))
996+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))
966− rrows = fromInteger $ natVal (Proxy :: Proxy (Count b))
997+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
967 elementsA = take ccols [minA .. maxA]
998 elementsA = take ccols [minA .. maxA]
968 elementsB = take rrows [minB .. maxB]
999 elementsB = take rrows [minB .. maxB]
969 combinations = (,) <$> elementsA <*> elementsB
1000 combinations = (,) <$> elementsA <*> elementsB