@@ -52,8 +52,8 @@ module LAoP.Matrix.Internal
5252 -- * Primitives
5353 empty,
5454 one,
55− junc,
56− split,
55+ join,
56+ fork,
5757
5858 -- * Auxiliary type families
5959 FromNat,
@@ -81,6 +81,10 @@ module LAoP.Matrix.Internal
8181 -- ** Matrix Transposition
8282 tr,
8383
84+ -- ** Scalar multiplication/division of matrices
85+ (.|),
86+ (./),
87+
8488 -- ** Selective operator
8589 select,
8690 branch,
@@ -89,19 +93,19 @@ module LAoP.Matrix.Internal
8993 cond,
9094
9195 -- ** Matrix "abiding"
92− abideJS,
93− abideSJ,
96+ abideJF,
97+ abideFJ,
9498
9599 -- ** Zip matrices
96100 zipWithM,
97101
98102 -- * Biproduct approach
99− -- ** Split
103+ -- ** Fork
100104 (===),
101105 -- *** Projections
102106 p1,
103107 p2,
104− -- ** Junc
108+ -- ** Join
105109 (|||),
106110 -- *** Injections
107111 i1,
@@ -115,11 +119,11 @@ module LAoP.Matrix.Internal
115119 -- | Note that given the restrictions imposed it is not possible to
116120 -- implement the standard type classes present in standard Haskell.
117121 -- *** Matrix pairing projections
118− kp1,
119− kp2,
122+ fstM,
123+ sndM,
120124
121125 -- *** Matrix pairing
122− khatri,
126+ kr,
123127
124128 -- * Matrix composition and lifting
125129
@@ -127,10 +131,10 @@ module LAoP.Matrix.Internal
127131
128132 -- | Note that given the restrictions imposed it is not possible to
129133 -- implement the standard type classes present in standard Haskell.
130− identity,
134+ iden,
131135 comp,
132− fromF,
133136 fromF',
137+ fromF,
134138
135139 -- * Matrix printing
136140 pretty,
@@ -171,8 +175,8 @@ import Prelude hiding ((.))
171175data Matrix e cols rows where
172176 Empty :: Matrix e Void Void
173177 One :: e -> Matrix e () ()
174− Junc :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows
175− Split :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)
178+ Join :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows
179+ Fork :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)
176180
177181deriving instance (Show e) => Show (Matrix e cols rows)
178182
@@ -226,24 +230,24 @@ type Trivial a = FromNat (Count a) ~ a
226230-- implementation is 'undefined'. However 'comp' can be and this partial
227231-- class implementation exists just to make the code more readable.
228232--
229−-- Please use 'identity' instead.
233+-- Please use 'iden' instead.
230234instance (Num e) => Category (Matrix e) where
231− id = undefined
235+ id = undefined
232236 (.) = comp
233237
234238instance NFData e => NFData (Matrix e cols rows) where
235− rnf Empty = ()
236− rnf (One e) = rnf e
237− rnf (Junc a b) = rnf a `seq` rnf b
238− rnf (Split a b) = rnf a `seq` rnf b
239+ rnf Empty = ()
240+ rnf (One e) = rnf e
241+ rnf (Join a b) = rnf a `seq` rnf b
242+ rnf (Fork a b) = rnf a `seq` rnf b
239243
240244instance Eq e => Eq (Matrix e cols rows) where
241− Empty == Empty = True
242− (One a) == (One b) = a == b
243− (Junc a b) == (Junc c d) = a == c && b == d
244− (Split a b) == (Split c d) = a == c && b == d
245− x@(Split _ _) == y@(Junc _ _) = x == abideJS y
246− x@(Junc _ _) == y@(Split _ _) = abideJS x == y
245+ Empty == Empty = True
246+ (One a) == (One b) = a == b
247+ (Join a b) == (Join c d) = a == c && b == d
248+ (Fork a b) == (Fork c d) = a == c && b == d
249+ x@(Fork _ _) == y@(Join _ _) = x == abideJF y
250+ x@(Join _ _) == y@(Fork _ _) = abideJF x == y
247251
248252instance Num e => Num (Matrix e cols rows) where
249253
@@ -253,23 +257,23 @@ instance Num e => Num (Matrix e cols rows) where
253257
254258 a * b = zipWithM (*) a b
255259
256− abs Empty = Empty
257− abs (One a) = One (abs a)
258− abs (Junc a b) = Junc (abs a) (abs b)
259− abs (Split a b) = Split (abs a) (abs b)
260+ abs Empty = Empty
261+ abs (One a) = One (abs a)
262+ abs (Join a b) = Join (abs a) (abs b)
263+ abs (Fork a b) = Fork (abs a) (abs b)
260264
261− signum Empty = Empty
262− signum (One a) = One (signum a)
263− signum (Junc a b) = Junc (signum a) (signum b)
264− signum (Split a b) = Split (signum a) (signum b)
265+ signum Empty = Empty
266+ signum (One a) = One (signum a)
267+ signum (Join a b) = Join (signum a) (signum b)
268+ signum (Fork a b) = Fork (signum a) (signum b)
265269
266270instance Ord e => Ord (Matrix e cols rows) where
267− Empty <= Empty = True
268− (One a) <= (One b) = a <= b
269− (Junc a b) <= (Junc c d) = (a <= c) && (b <= d)
270− (Split a b) <= (Split c d) = (a <= c) && (b <= d)
271− x@(Split _ _) <= y@(Junc _ _) = x <= abideJS y
272− x@(Junc _ _) <= y@(Split _ _) = abideJS x <= y
271+ Empty <= Empty = True
272+ (One a) <= (One b) = a <= b
273+ (Join a b) <= (Join c d) = (a <= c) && (b <= d)
274+ (Fork a b) <= (Fork c d) = (a <= c) && (b <= d)
275+ x@(Fork _ _) <= y@(Join _ _) = x <= abideJF y
276+ x@(Join _ _) <= y@(Fork _ _) = abideJF x <= y
273277
274278-- Primitives
275279
@@ -281,25 +285,25 @@ empty = Empty
281285one :: e -> Matrix e () ()
282286one = One
283287
284−-- | Matrix 'Junc' constructor
285−junc :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows
286−junc = Junc
288+-- | Matrix 'Join' constructor
289+join :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows
290+join = Join
287291
288292infixl 3 |||
289293
290−-- | Matrix 'Junc' constructor
294+-- | Matrix 'Join' constructor
291295(|||) :: Matrix e a rows -> Matrix e b rows -> Matrix e (Either a b) rows
292−(|||) = Junc
296+(|||) = Join
293297
294−-- | Matrix 'Split' constructor
295−split :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)
296−split = Split
298+-- | Matrix 'Fork' constructor
299+fork :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)
300+fork = Fork
297301
298302infixl 2 ===
299303
300−-- | Matrix 'Split' constructor
304+-- | Matrix 'Fork' constructor
301305(===) :: Matrix e cols a -> Matrix e cols b -> Matrix e cols (Either a b)
302−(===) = Split
306+(===) = Fork
303307
304308-- Construction
305309
@@ -321,32 +325,32 @@ instance {-# OVERLAPPING #-} FromLists e () () where
321325 fromLists _ = error "Wrong dimensions"
322326
323327instance {-# OVERLAPPING #-} (FromLists e cols ()) => FromLists e (Either () cols) () where
324− fromLists [h : t] = Junc (One h) (fromLists [t])
328+ fromLists [h : t] = Join (One h) (fromLists [t])
325329 fromLists _ = error "Wrong dimensions"
326330
327331instance {-# OVERLAPPABLE #-} (FromLists e a (), FromLists e b (), Countable a) => FromLists e (Either a b) () where
328− fromLists [l] =
332+ fromLists [l] =
329333 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
330− in Junc (fromLists [take rowsA l]) (fromLists [drop rowsA l])
334+ in Join (fromLists [take rowsA l]) (fromLists [drop rowsA l])
331335 fromLists _ = error "Wrong dimensions"
332336
333337instance {-# OVERLAPPING #-} (FromLists e () rows) => FromLists e () (Either () rows) where
334− fromLists ([h] : t) = Split (One h) (fromLists t)
338+ fromLists ([h] : t) = Fork (One h) (fromLists t)
335339 fromLists _ = error "Wrong dimensions"
336340
337341instance {-# OVERLAPPABLE #-} (FromLists e () a, FromLists e () b, Countable a) => FromLists e () (Either a b) where
338342 fromLists l@([_] : _) =
339343 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
340− in Split (fromLists (take rowsA l)) (fromLists (drop rowsA l))
344+ in Fork (fromLists (take rowsA l)) (fromLists (drop rowsA l))
341345 fromLists _ = error "Wrong dimensions"
342346
343347instance {-# OVERLAPPABLE #-} (FromLists e (Either a b) c, FromLists e (Either a b) d, Countable c) => FromLists e (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
349− then Split (fromLists (take rowsC l)) (fromLists (drop rowsC l))
353+ 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
@@ -355,9 +359,7 @@ matrixBuilder ::
355359 forall e cols rows.
356360 ( FromLists e cols rows,
357361 CountableDimensions cols rows
358− ) =>
359− ((Int, Int) -> e) ->
360− Matrix e cols rows
362+ ) => ((Int, Int) -> e) -> Matrix e cols rows
361363matrixBuilder f =
362364 let c = fromInteger $ natVal (Proxy :: Proxy (Count cols))
363365 r = fromInteger $ natVal (Proxy :: Proxy (Count rows))
@@ -376,7 +378,7 @@ row = fromLists . (: [])
376378--
377379-- NOTE: Be careful to not ask for a matrix bigger than the cardinality of
378380-- types @a@ or @b@ allows.
379−fromF ::
381+fromF' ::
380382 forall a b cols rows e.
381383 ( Liftable e a b,
382384 CountableDimensions cols rows,
@@ -384,7 +386,7 @@ fromF ::
384386 ) =>
385387 (a -> b) ->
386388 Matrix e cols rows
387−fromF f =
389+fromF' f =
388390 let minA = minBound @a
389391 maxA = maxBound @a
390392 minB = minBound @b
@@ -394,8 +396,8 @@ fromF f =
394396 elementsA = take ccols [minA .. maxA]
395397 elementsB = take rrows [minB .. maxB]
396398 combinations = (,) <$> elementsA <*> elementsB
397− combAp = map snd . sort . map (\(a, b) -> if f a == b
398− then ((fromEnum a, fromEnum b), 1)
399+ combAp = map snd . sort . map (\(a, b) -> if f a == b
400+ then ((fromEnum a, fromEnum b), 1)
399401 else ((fromEnum a, fromEnum b), 0)) $ combinations
400402 mList = buildList combAp rrows
401403 in tr $ fromLists mList
@@ -405,7 +407,7 @@ fromF f =
405407
406408-- | Lifts functions to matrices with dimensions matching @a@ and @b@
407409-- cardinality's.
408−fromF' ::
410+fromF ::
409411 forall a b e.
410412 ( Liftable e a b,
411413 CountableDimensionsN a b,
@@ -413,7 +415,7 @@ fromF' ::
413415 ) =>
414416 (a -> b) ->
415417 Matrix e (Normalize a) (Normalize b)
416−fromF' f =
418+fromF f =
417419 let minA = minBound @a
418420 maxA = maxBound @a
419421 minB = minBound @b
@@ -423,8 +425,8 @@ fromF' f =
423425 elementsA = take ccols [minA .. maxA]
424426 elementsB = take rrows [minB .. maxB]
425427 combinations = (,) <$> elementsA <*> elementsB
426− combAp = map snd . sort . map (\(a, b) -> if f a == b
427− then ((fromEnum a, fromEnum b), 1)
428+ combAp = map snd . sort . map (\(a, b) -> if f a == b
429+ then ((fromEnum a, fromEnum b), 1)
428430 else ((fromEnum a, fromEnum b), 0)) $ combinations
429431 mList = buildList combAp rrows
430432 in tr $ fromLists mList
@@ -438,8 +440,8 @@ fromF' f =
438440toLists :: Matrix e cols rows -> [[e]]
439441toLists Empty = []
440442toLists (One e) = [[e]]
441−toLists (Split l r) = toLists l ++ toLists r
442−toLists (Junc l r) = zipWith (++) (toLists l) (toLists r)
443+toLists (Fork l r) = toLists l ++ toLists r
444+toLists (Join l r) = zipWith (++) (toLists l) (toLists r)
443445
444446-- | Converts a matrix to a list of elements.
445447toList :: Matrix e cols rows -> [e]
@@ -474,12 +476,12 @@ bang =
474476 let c = fromInteger $ natVal (Proxy :: Proxy (Count cols))
475477 in fromLists [take c [1, 1 ..]]
476478
477−-- Identity Matrix
479+-- iden Matrix
478480
479−-- | Identity matrix.
480−identity :: (Num e, FromLists e cols cols, Countable cols) => Matrix e cols cols
481−identity = matrixBuilder (bool 0 1 . uncurry (==))
482−{-# NOINLINE identity #-}
481+-- | iden matrix.
482+iden :: (Num e, FromLists e cols cols, Countable cols) => Matrix e cols cols
483+iden = matrixBuilder (bool 0 1 . uncurry (==))
484+{-# NOINLINE iden #-}
483485
484486-- Matrix composition (MMM)
485487
@@ -488,32 +490,52 @@ identity = matrixBuilder (bool 0 1 . uncurry (==))
488490-- This definition takes advantage of divide-and-conquer and fusion laws
489491-- from LAoP.
490492comp :: (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)
493−comp (Junc a b) (Split c d) = comp a c + comp b d -- Divide-and-conquer law
494−comp (Split a b) c = Split (comp a c) (comp b c) -- Split fusion law
495−comp c (Junc a b) = Junc (comp c a) (comp c b) -- Junc fusion law
493+comp Empty Empty = Empty
494+comp (One a) (One b) = One (a * b)
495+comp (Join a b) (Fork c d) = comp a c + comp b d -- Divide-and-conquer law
496+comp (Fork a b) c = Fork (comp a c) (comp b c) -- Fork fusion law
497+comp c (Join a b) = Join (comp c a) (comp c b) -- Join fusion law
496498{-# NOINLINE comp #-}
497499{-# RULES
498− "comp/identity1" forall m. comp m identity = m ;
499− "comp/identity2" forall m. comp identity m = m
500+ "comp/iden1" forall m. comp m iden = m ;
501+ "comp/iden2" forall m. comp iden m = m
500502#-}
501503
504+-- Scalar multiplication of matrices
505+
506+infixl 7 .|
507+-- | Scalar multiplication of matrices.
508+(.|) :: Num e => e -> Matrix e cols rows -> Matrix e cols rows
509+(.|) _ Empty = Empty
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+(./) Empty _ = Empty
520+(./) (One a) e = One (a / e)
521+(./) (Join a b) e = Join (a ./ e) (b ./ e)
522+(./) (Fork a b) e = Fork (a ./ e) (b ./ e)
523+
502524-- Projections
503525
504526-- | Biproduct first component projection
505527p1 :: forall e m n. (Num e, CountableDimensions n m, FromLists e n m, FromLists e m m) => Matrix e (Either m n) m
506528p1 =
507− let iden = identity :: Matrix e m m
529+ let iden = iden :: Matrix e m m
508530 zero = zeros :: Matrix e n m
509− in junc iden zero
531+ in join iden zero
510532
511533-- | Biproduct second component projection
512534p2 :: forall e m n. (Num e, CountableDimensions n m, FromLists e m n, FromLists e n n) => Matrix e (Either m n) n
513535p2 =
514− let iden = identity :: Matrix e n n
536+ let iden = iden :: Matrix e n n
515537 zero = zeros :: Matrix e m n
516− in junc zero iden
538+ in join zero iden
517539
518540-- Injections
519541
@@ -564,71 +586,71 @@ infixl 5 -|-
564586 Matrix e n k ->
565587 Matrix e m j ->
566588 Matrix e (Either n m) (Either k j)
567−(-|-) a b = Junc (i1 . a) (i2 . b)
589+(-|-) a b = Join (i1 . a) (i2 . b)
568590
569591-- Khatri Rao Product and projections
570592
571593-- | Khatri Rao product first component projection matrix.
572−kp1 ::
594+fstM ::
573595 forall e m k .
574596 ( Num e,
575597 CountableDimensions k m,
576598 FromLists e (Normalize (m, k)) m,
577599 CountableN (m, k)
578600 ) => Matrix e (Normalize (m, k)) m
579−kp1 = matrixBuilder f
601+fstM = matrixBuilder f
580602 where
581603 offset = fromInteger (natVal (Proxy :: Proxy (Count k)))
582604 f (x, y)
583605 | y >= (x * offset) && y <= (x * offset + offset - 1) = 1
584− | otherwise = 0
606+ | otherwise = 0
585607
586608-- | Khatri Rao product second component projection matrix.
587−kp2 ::
609+sndM ::
588610 forall e m k .
589611 ( Num e,
590612 CountableDimensions k m,
591613 FromLists e (Normalize (m, k)) k,
592614 CountableN (m, k)
593615 ) => Matrix e (Normalize (m, k)) k
594−kp2 = matrixBuilder f
616+sndM = matrixBuilder f
595617 where
596618 offset = fromInteger (natVal (Proxy :: Proxy (Count k)))
597619 f (x, y)
598620 | x == y || mod (y - x) offset == 0 = 1
599− | otherwise = 0
621+ | otherwise = 0
600622
601623-- | Khatri Rao Matrix product also known as matrix pairing.
602624--
603625-- NOTE: That this is not a true categorical product, see for instance:
604626--
605627-- @
606−-- | kp1 . khatri a b == a
607−-- khatri a b ==> |
608−-- | kp2 . khatri a b == b
628+-- | fstM . kr a b == a
629+-- kr a b ==> |
630+-- | sndM . kr a b == b
609631-- @
610632--
611633-- __Emphasis__ on the implication symbol.
612−khatri ::
613− forall e cols a b.
634+kr ::
635+ forall e cols a b.
614636 ( Num e,
615637 CountableDimensions a b,
616638 CountableN (a, b),
617639 FromLists e (Normalize (a, b)) a,
618640 FromLists e (Normalize (a, b)) b
619641 ) => Matrix e cols a -> Matrix e cols b -> Matrix e cols (Normalize (a, b))
620−khatri a b =
621− let kp1' = kp1 @e @a @b
622− kp2' = kp2 @e @a @b
623− in (tr kp1') . a * (tr kp2') . b
642+kr a b =
643+ let fstM' = fstM @e @a @b
644+ sndM' = sndM @e @a @b
645+ in tr fstM' . a * tr sndM' . b
624646
625647-- Product Bifunctor (Kronecker)
626648
627649infixl 4 ><
628650
629651-- | Matrix product functor also known as kronecker product
630−(><) ::
631− forall e m p n q.
652+(><) ::
653+ forall e m p n q.
632654 ( Num e,
633655 CountableDimensions m n,
634656 CountableDimensions p q,
@@ -640,57 +662,57 @@ infixl 4 ><
640662 )
641663 => Matrix e m p -> Matrix e n q -> Matrix e (Normalize (m, n)) (Normalize (p, q))
642664(><) a b =
643− let kp1' = kp1 @e @m @n
644− kp2' = kp2 @e @m @n
645− in khatri (a . kp1') (b . kp2')
665+ let fstM' = fstM @e @m @n
666+ sndM' = sndM @e @m @n
667+ in kr (a . fstM') (b . sndM')
646668
647−-- Matrix abide Junc Split
669+-- Matrix abide Join Fork
648670
649−-- | Matrix "abiding" followin the 'Junc'-'Split' abide law.
650−--
671+-- | Matrix "abiding" following the 'Join'-'Fork' exchange law.
672+--
651673-- Law:
652674--
653675-- @
654−-- 'Junc' ('Split' a c) ('Split' b d) == 'Split' ('Junc' a b) ('Junc' c d)
676+-- 'Join' ('Fork' a c) ('Fork' b d) == 'Fork' ('Join' a b) ('Join' c d)
655677-- @
656−abideJS :: Matrix e cols rows -> Matrix e cols rows
657−abideJS (Junc (Split a c) (Split b d)) = Split (Junc (abideJS a) (abideJS b)) (Junc (abideJS c) (abideJS d)) -- Junc-Split abide law
658−abideJS Empty = Empty
659−abideJS (One e) = One e
660−abideJS (Junc a b) = Junc (abideJS a) (abideJS b)
661−abideJS (Split a b) = Split (abideJS a) (abideJS b)
678+abideJF :: Matrix e cols rows -> Matrix e cols rows
679+abideJF (Join (Fork a c) (Fork b d)) = Fork (Join (abideJF a) (abideJF b)) (Join (abideJF c) (abideJF d)) -- Join-Fork abide law
680+abideJF Empty = Empty
681+abideJF (One e) = One e
682+abideJF (Join a b) = Join (abideJF a) (abideJF b)
683+abideJF (Fork a b) = Fork (abideJF a) (abideJF b)
662684
663−-- Matrix abide Split Junc
685+-- Matrix abide Fork Join
664686
665−-- | Matrix "abiding" followin the 'Split'-'Junc' abide law.
666−--
687+-- | Matrix "abiding" followin the 'Fork'-'Join' abide law.
688+--
667689-- @
668−-- 'Split' ('Junc' a b) ('Junc' c d) == 'Junc' ('Split' a c) ('Split' b d)
690+-- 'Fork' ('Join' a b) ('Join' c d) == 'Join' ('Fork' a c) ('Fork' b d)
669691-- @
670−abideSJ :: Matrix e cols rows -> Matrix e cols rows
671−abideSJ (Split (Junc a b) (Junc c d)) = Junc (Split (abideSJ a) (abideSJ c)) (Split (abideSJ b) (abideSJ d)) -- Split-Junc abide law
672−abideSJ Empty = Empty
673−abideSJ (One e) = One e
674−abideSJ (Junc a b) = Junc (abideSJ a) (abideSJ b)
675−abideSJ (Split a b) = Split (abideSJ a) (abideSJ b)
692+abideFJ :: Matrix e cols rows -> Matrix e cols rows
693+abideFJ (Fork (Join a b) (Join c d)) = Join (Fork (abideFJ a) (abideFJ c)) (Fork (abideFJ b) (abideFJ d)) -- Fork-Join abide law
694+abideFJ Empty = Empty
695+abideFJ (One e) = One e
696+abideFJ (Join a b) = Join (abideFJ a) (abideFJ b)
697+abideFJ (Fork a b) = Fork (abideFJ a) (abideFJ b)
676698
677699-- Matrix transposition
678700
679701-- | Matrix transposition.
680702tr :: Matrix e cols rows -> Matrix e rows cols
681−tr Empty = Empty
682−tr (One e) = One e
683−tr (Junc a b) = Split (tr a) (tr b)
684−tr (Split a b) = Junc (tr a) (tr b)
703+tr Empty = Empty
704+tr (One e) = One e
705+tr (Join a b) = Fork (tr a) (tr b)
706+tr (Fork a b) = Join (tr a) (tr b)
685707
686708-- Selective 'select' operator
687709
688710-- | Selective functors 'select' operator equivalent inspired by the
689711-- ArrowMonad solution presented in the paper.
690712select :: (Num e, FromLists e b b, Countable b) => Matrix e cols (Either a b) -> Matrix e a b -> Matrix e cols b
691−select (Split a b) y = y . a + b -- Divide-and-conquer law
692−select (Junc (Split a c) (Split b d)) y = junc (y . a + c) (y . b + d) -- Pattern matching + DnC law
693−select m y = junc y identity . m
713+select (Fork a b) y = y . a + b -- Divide-and-conquer law
714+select (Join (Fork a c) (Fork b d)) y = join (y . a + c) (y . b + d) -- Pattern matching + DnC law
715+select m y = join y iden . m
694716
695717branch ::
696718 ( Num e,
@@ -711,7 +733,7 @@ branch x l r = f x `select` g l `select` r
711733 where
712734 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)
713735 => Matrix e cols (Either a b) -> Matrix e cols (Either a (Either b c))
714− f m = split (tr i1) (i1 . tr i2) . m
736+ f m = fork (tr i1) (i1 . tr i2) . m
715737 g :: (Num e, CountableDimensions b c, FromLists e b c, FromLists e c c) => Matrix e a c -> Matrix e a (Either b c)
716738 g m = i2 . m
717739
@@ -731,9 +753,9 @@ cond ::
731753 )
732754 =>
733755 (a -> Bool) -> Matrix e cols rows -> Matrix e cols rows -> Matrix e cols rows
734−cond p f g = junc f g . grd p
756+cond p f g = join f g . grd p
735757
736−grd ::
758+grd ::
737759 ( Trivial q,
738760 Countable q,
739761 FromLists e () q,
@@ -746,40 +768,40 @@ grd ::
746768 )
747769 =>
748770 (a -> Bool) -> Matrix e q (Either q q)
749−grd f = split (corr f) (corr (not . f))
771+grd f = fork (corr f) (corr (not . f))
750772
751−corr ::
752− forall e a q .
773+corr ::
774+ forall e a q .
753775 ( Trivial q,
754776 Countable q,
755777 FromLists e () q,
756778 FromLists e q (),
757779 FromLists e q q,
758780 Liftable e a Bool
759− )
781+ )
760782 => (a -> Bool) -> Matrix e q q
761−corr p = let f = fromF p :: Matrix e q ()
762− in khatri f (identity :: Matrix e q q)
783+corr p = let f = fromF' p :: Matrix e q ()
784+ in kr f (iden :: Matrix e q q)
763785
764786-- Pretty print
765787
766788prettyAux :: Show e => [[e]] -> [[e]] -> String
767789prettyAux [] _ = ""
768−prettyAux [[e]] m = "│ " ++ fill (show e) ++ " │\n"
790+prettyAux [[e]] m = "│ " ++ fill (show e) ++ " │\n"
769791 where
770792 v = fmap show m
771793 widest = maximum $ fmap length v
772794 fill str = replicate (widest - length str - 2) ' ' ++ str
773−prettyAux [h] m = "│ " ++ fill (unwords $ map show h) ++ " │\n"
795+prettyAux [h] m = "│ " ++ fill (unwords $ map show h) ++ " │\n"
774796 where
775− v = fmap show m
776− widest = maximum $ fmap length v
797+ v = fmap show m
798+ widest = maximum $ fmap length v
777799 fill str = replicate (widest - length str - 2) ' ' ++ str
778−prettyAux (h : t) l = "│ " ++ fill (unwords $ map show h) ++ " │\n" ++
800+prettyAux (h : t) l = "│ " ++ fill (unwords $ map show h) ++ " │\n" ++
779801 prettyAux t l
780802 where
781− v = fmap show l
782− widest = maximum $ fmap length v
803+ v = fmap show l
804+ widest = maximum $ fmap length v
783805 fill str = replicate (widest - length str - 2) ' ' ++ str
784806
785807-- | Matrix pretty printer
@@ -791,16 +813,16 @@ pretty m = concat
791813 , "└ ", unwords (replicate (columns m) blank), " ┘"
792814 ]
793815 where
794− strings = map show (toList m)
795− widest = maximum $ map length strings
816+ strings = map show (toList m)
817+ widest = maximum $ map length strings
796818 fill str = replicate (widest - length str) ' ' ++ str
797− blank = fill ""
819+ blank = fill ""
798820 safeGet i j m
799821 | i > rows m || j > columns m || i < 1 || j < 1 = Nothing
800822 | otherwise = Just $ unsafeGet i j m (toList m)
801823 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 =
824+ encode m (i,j) = (i-1)*m + j - 1
825+ getElem i j m =
804826 fromMaybe
805827 (error $
806828 "getElem: Trying to get the "
@@ -817,16 +839,16 @@ prettyPrint = putStrLn . pretty
817839
818840-- | Zip two matrices with a given binary function
819841zipWithM :: (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 (Junc a b) (Junc c d) = Junc (zipWithM f a c) (zipWithM f b d)
823−zipWithM f (Split a b) (Split c d) = Split (zipWithM f a c) (zipWithM f b d)
824−zipWithM f x@(Split _ _) y@(Junc _ _) = zipWithM f x (abideJS y)
825−zipWithM f x@(Junc _ _) y@(Split _ _) = zipWithM f (abideJS x) y
842+zipWithM _ Empty Empty = Empty
843+zipWithM f (One a) (One b) = One (f a b)
844+zipWithM f (Join a b) (Join c d) = Join (zipWithM f a c) (zipWithM f b d)
845+zipWithM f (Fork a b) (Fork c d) = Fork (zipWithM f a c) (zipWithM f b d)
846+zipWithM f x@(Fork _ _) y@(Join _ _) = zipWithM f x (abideJF y)
847+zipWithM f x@(Join _ _) y@(Fork _ _) = zipWithM f (abideJF x) y
826848
827849-- Relational operators functions
828850
829−type Boolean = Natural 0 1
851+type Boolean = Natural 0 1
830852type Relation a b = Matrix Boolean a b
831853
832854-- | Helper conversion function
@@ -843,53 +865,52 @@ fromBool False = nat 0
843865-- | Relational negation
844866negateM :: Relation cols rows -> Relation cols rows
845867negateM Empty = Empty
846−negateM (One (Nat 0)) = One (Nat 1)
847−negateM (One (Nat 1)) = One (Nat 0)
848−negateM (Junc a b) = Junc (negateM a) (negateM b)
849−negateM (Split a b) = Split (negateM a) (negateM b)
868+negateM (One (Nat p)) = One (Nat (negate p))
869+negateM (Join a b) = Join (negateM a) (negateM b)
870+negateM (Fork a b) = Fork (negateM a) (negateM b)
850871
851872-- | Relational addition
852873orM :: 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 (Junc a b) (Junc c d) = Junc (orM a c) (orM b d)
856−orM (Split a b) (Split c d) = Split (orM a c) (orM b d)
857−orM x@(Split _ _) y@(Junc _ _) = orM x (abideJS y)
858−orM x@(Junc _ _) y@(Split _ _) = orM (abideJS x) y
874+orM Empty Empty = Empty
875+orM (One a) (One b) = One (fromBool (toBool a || toBool b))
876+orM (Join a b) (Join c d) = Join (orM a c) (orM b d)
877+orM (Fork a b) (Fork c d) = Fork (orM a c) (orM b d)
878+orM x@(Fork _ _) y@(Join _ _) = orM x (abideJF y)
879+orM x@(Join _ _) y@(Fork _ _) = orM (abideJF x) y
859880
860881-- | Relational multiplication
861882andM :: 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 (Junc a b) (Junc c d) = Junc (andM a c) (andM b d)
865−andM (Split a b) (Split c d) = Split (andM a c) (andM b d)
866−andM x@(Split _ _) y@(Junc _ _) = andM x (abideJS y)
867−andM x@(Junc _ _) y@(Split _ _) = andM (abideJS x) y
883+andM Empty Empty = Empty
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 (Junc a b) (Junc c d) = Junc (subM a c) (subM b d)
874−subM (Split a b) (Split c d) = Split (subM a c) (subM b d)
875−subM x@(Split _ _) y@(Junc _ _) = subM x (abideJS y)
876−subM x@(Junc _ _) y@(Split _ _) = subM (abideJS x) y
892+subM Empty Empty = Empty
893+subM (One a) (One b) = if a - b < nat 0 then One (nat 0) else One (a - b)
894+subM (Join a b) (Join c d) = Join (subM a c) (subM b d)
895+subM (Fork a b) (Fork c d) = Fork (subM a c) (subM b d)
896+subM x@(Fork _ _) y@(Join _ _) = subM x (abideJF y)
897+subM x@(Join _ _) y@(Fork _ _) = subM (abideJF x) y
877898
878899-- | Matrix relational composition.
879900compRel :: 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))
882−compRel (Junc a b) (Split c d) = orM (compRel a c) (compRel b d) -- Divide-and-conquer law
883−compRel (Split a b) c = Split (compRel a c) (compRel b c) -- Split fusion law
884−compRel c (Junc a b) = Junc (compRel c a) (compRel c b) -- Junc fusion law
901+compRel Empty Empty = Empty
902+compRel (One a) (One b) = One (fromBool (toBool a && toBool b))
903+compRel (Join a b) (Fork c d) = orM (compRel a c) (compRel b d) -- Divide-and-conquer law
904+compRel (Fork a b) c = Fork (compRel a c) (compRel b c) -- Fork fusion law
905+compRel c (Join a b) = Join (compRel c a) (compRel c b) -- Join fusion law
885906
886907-- | Matrix relational right division
887908divR :: Relation b c -> Relation b a -> Relation a c
888909divR Empty Empty = Empty
889910divR (One a) (One b) = One (fromBool (not (toBool b) || toBool a)) -- b implies a
890−divR (Junc a b) (Junc c d) = andM (divR a c) (divR b d)
891−divR (Split a b) c = Split (divR a c) (divR b c)
892−divR c (Split a b) = Junc (divR c a) (divR c b)
911+divR (Join a b) (Join c d) = andM (divR a c) (divR b d)
912+divR (Fork a b) c = Fork (divR a c) (divR b c)
913+divR c (Fork a b) = Join (divR c a) (divR c b)
893914
894915-- | Matrix relational left division
895916divL :: Relation c b -> Relation a b -> Relation a c
@@ -905,7 +926,7 @@ divS s r = divL r s `intersection` divR (tr r) (tr s)
905926--
906927-- NOTE: Be careful to not ask for a relation bigger than the cardinality of
907928-- types @a@ or @b@ allows.
908−fromFRel ::
929+fromFRel' ::
909930 forall a b cols rows.
910931 ( Liftable Boolean a b,
911932 CountableDimensions cols rows,
@@ -913,7 +934,7 @@ fromFRel ::
913934 ) =>
914935 (a -> b) ->
915936 Relation cols rows
916−fromFRel f =
937+fromFRel' f =
917938 let minA = minBound @a
918939 maxA = maxBound @a
919940 minB = minBound @b
@@ -923,8 +944,8 @@ fromFRel f =
923944 elementsA = take ccols [minA .. maxA]
924945 elementsB = take rrows [minB .. maxB]
925946 combinations = (,) <$> elementsA <*> elementsB
926− combAp = map snd . sort . map (\(a, b) -> if f a == b
927− then ((fromEnum a, fromEnum b), nat 1)
947+ combAp = map snd . sort . map (\(a, b) -> if f a == b
948+ then ((fromEnum a, fromEnum b), nat 1)
928949 else ((fromEnum a, fromEnum b), nat 0)) $ combinations
929950 mList = buildList combAp rrows
930951 in tr $ fromLists mList
@@ -934,7 +955,7 @@ fromFRel f =
934955
935956-- | Lifts functions to relations with dimensions matching @a@ and @b@
936957-- cardinality's.
937−fromFRel' ::
958+fromFRel ::
938959 forall a b.
939960 ( Liftable Boolean a b,
940961 CountableDimensionsN a b,
@@ -942,7 +963,7 @@ fromFRel' ::
942963 ) =>
943964 (a -> b) ->
944965 Relation (Normalize a) (Normalize b)
945−fromFRel' f =
966+fromFRel f =
946967 let minA = minBound @a
947968 maxA = maxBound @a
948969 minB = minBound @b
@@ -952,8 +973,8 @@ fromFRel' f =
952973 elementsA = take ccols [minA .. maxA]
953974 elementsB = take rrows [minB .. maxB]
954975 combinations = (,) <$> elementsA <*> elementsB
955− combAp = map snd . sort . map (\(a, b) -> if f a == b
956− then ((fromEnum a, fromEnum b), nat 1)
976+ combAp = map snd . sort . map (\(a, b) -> if f a == b
977+ then ((fromEnum a, fromEnum b), nat 1)
957978 else ((fromEnum a, fromEnum b), nat 0)) $ combinations
958979 mList = buildList combAp rrows
959980 in tr $ fromLists mList
@@ -962,7 +983,7 @@ fromFRel' f =
962983 buildList l r = take r l : buildList (drop r l) r
963984
964985-- | Lifts a relation function to a Boolean Matrix
965−toRel ::
986+toRel ::
966987 forall a b.
967988 ( Bounded a,
968989 Bounded b,
@@ -983,8 +1004,8 @@ toRel f =
9831004 elementsA = take ccols [minA .. maxA]
9841005 elementsB = take rrows [minB .. maxB]
9851006 combinations = (,) <$> elementsA <*> elementsB
986− combAp = map snd . sort . map (\(a, b) -> if uncurry f (a, b)
987− then ((fromEnum a, fromEnum b), nat 1)
1007+ combAp = map snd . sort . map (\(a, b) -> if uncurry f (a, b)
1008+ then ((fromEnum a, fromEnum b), nat 1)
9881009 else ((fromEnum a, fromEnum b), nat 0)) $ combinations
9891010 mList = buildList combAp rrows
9901011 in tr $ fromLists mList