@@ -176,7 +176,6 @@ import Data.Kind
176import Data.List
176import Data.List
177import Data.Maybe
177import Data.Maybe
178import Data.Proxy
178import Data.Proxy
180import Data.Void
179import Data.Void
181import GHC.TypeLits
180import GHC.TypeLits
182import Data.Type.Equality
181import Data.Type.Equality
@@ -243,7 +242,7 @@ type Trivial a = FromNat (Count a) ~ a
244instance (Num e) => Category (Matrix e) where
243instance (Num e) => Category (Matrix e) where
245 type Object (Matrix e) a = (FL a a, Countable a)
244 type Object (Matrix e) a = (FL a a, Countable a)
246− id = iden
245+ id = iden
247 (.) = comp
246 (.) = comp
249instance NFData e => NFData (Matrix e cols rows) where
248instance NFData e => NFData (Matrix e cols rows) where
@@ -259,6 +258,7 @@ instance Eq e => Eq (Matrix e cols rows) where
259 x@(Join _ _) == y@(Fork _ _) = abideJF x == y
258 x@(Join _ _) == y@(Fork _ _) = abideJF x == y
261instance Num e => Num (Matrix e cols rows) where
260instance Num e => Num (Matrix e cols rows) where
262 a + b = zipWithM (+) a b
262 a + b = zipWithM (+) a b
264 a - b = zipWithM (-) a b
264 a - b = zipWithM (-) a b
@@ -317,34 +317,31 @@ class FromLists cols rows where
317 -- error if the dimensions do not match.
317 -- error if the dimensions do not match.
318 fromLists :: [[e]] -> Matrix e cols rows
318 fromLists :: [[e]] -> Matrix e cols rows
320−instance FromLists () () where
320+instance {-# OVERLAPPING #-} FromLists () () where
321 fromLists [[e]] = One e
321 fromLists [[e]] = One e
322 fromLists _ = error "Wrong dimensions"
322 fromLists _ = error "Wrong dimensions"
324−instance (FromLists cols ()) => FromLists (Either () cols) () where
324+instance {-# OVERLAPPING #-} (FromLists cols ()) => FromLists (Either () cols) () where
325 fromLists [h : t] = Join (One h) (fromLists [t])
325 fromLists [h : t] = Join (One h) (fromLists [t])
326 fromLists _ = error "Wrong dimensions"
326 fromLists _ = error "Wrong dimensions"
328−instance {-# OVERLAPPABLE #-}
329− (FromLists a (), FromLists b (), Countable a) => FromLists (Either a b) () where
328+instance {-# OVERLAPPABLE #-} (FromLists a (), FromLists b (), Countable a) => FromLists (Either a b) () where
330 fromLists [l] =
329 fromLists [l] =
331 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
330 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
332 in Join (fromLists [take rowsA l]) (fromLists [drop rowsA l])
331 in Join (fromLists [take rowsA l]) (fromLists [drop rowsA l])
333 fromLists _ = error "Wrong dimensions"
332 fromLists _ = error "Wrong dimensions"
335−instance (FromLists () rows) => FromLists () (Either () rows) where
334+instance {-# OVERLAPPING #-} (FromLists () rows) => FromLists () (Either () rows) where
336 fromLists ([h] : t) = Fork (One h) (fromLists t)
335 fromLists ([h] : t) = Fork (One h) (fromLists t)
337 fromLists _ = error "Wrong dimensions"
336 fromLists _ = error "Wrong dimensions"
339−instance {-# OVERLAPPABLE #-}
340− (FromLists () a, FromLists () b, Countable a) => FromLists () (Either a b) where
338+instance {-# OVERLAPPABLE #-} (FromLists () a, FromLists () b, Countable a) => FromLists () (Either a b) where
341 fromLists l@([_] : _) =
339 fromLists l@([_] : _) =
342 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
340 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
343 in Fork (fromLists (take rowsA l)) (fromLists (drop rowsA l))
341 in Fork (fromLists (take rowsA l)) (fromLists (drop rowsA l))
344 fromLists _ = error "Wrong dimensions"
342 fromLists _ = error "Wrong dimensions"
346−instance (FromLists (Either a b) c, FromLists (Either a b) d, Countable c)
344+instance {-# OVERLAPPABLE #-} (FromLists (Either a b) c, FromLists (Either a b) d, Countable c) => FromLists (Either a b) (Either c d) where
347− => FromLists (Either a b) (Either c d) where
348 fromLists l@(h : t) =
345 fromLists l@(h : t) =
349 let lh = length h
346 let lh = length h
350 rowsC = fromInteger (natVal (Proxy :: Proxy (Count c)))
347 rowsC = fromInteger (natVal (Proxy :: Proxy (Count c)))
@@ -371,15 +368,16 @@ matrixBuilder' f =
371matrixBuilder ::
368matrixBuilder ::
372 forall e a b.
369 forall e a b.
373 ( FLN a b,
370 ( FLN a b,
376 Bounded a,
374 Bounded a,
377 Bounded b,
375 Bounded b,
379− Countable b
377+ CountableDimsN a b
380 ) => ((a, b) -> e) -> Matrix e (Normalize a) (Normalize b)
378 ) => ((a, b) -> e) -> Matrix e (Normalize a) (Normalize b)
381matrixBuilder f =
379matrixBuilder f =
382− let r = fromInteger $ natVal (Proxy :: Proxy (Count b))
380+ let r = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
383 positions = [(a, b) | a <- [minBound .. maxBound], b <- [minBound .. maxBound]]
381 positions = [(a, b) | a <- [minBound .. maxBound], b <- [minBound .. maxBound]]
384 in fromLists . map (map f) . transpose . buildList r $ positions
382 in fromLists . map (map f) . transpose . buildList r $ positions
@@ -435,7 +433,24 @@ fromF ::
436 (a -> b) ->
434 (a -> b) ->
437 Matrix e (Normalize a) (Normalize b)
435 Matrix e (Normalize a) (Normalize b)
438−fromF = fromF'
436+fromF f =
437+ let minA = minBound @a
441+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))
442+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
443+ elementsA = take ccols [minA .. maxA]
444+ elementsB = take rrows [minB .. maxB]
445+ combinations = (,) <$> elementsA <*> elementsB
446+ combAp = map snd . sort . map (\(a, b) -> if f a == b
447+ then ((fromEnum a, fromEnum b), 1)
448+ else ((fromEnum a, fromEnum b), 0)) $ combinations
449+ mList = buildList combAp rrows
450+ in tr $ fromLists mList
453+ buildList l r = take r l : buildList (drop r l) r
440-- Conversion
455-- Conversion
@@ -931,7 +946,24 @@ fromFRel' ::
932 (a -> b) ->
947 (a -> b) ->
933 Relation cols rows
948 Relation cols rows
934−fromFRel' = fromF'
949+fromFRel' f =
950+ let minA = minBound @a
954+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count cols))
955+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count rows))
956+ elementsA = take ccols [minA .. maxA]
957+ elementsB = take rrows [minB .. maxB]
958+ combinations = (,) <$> elementsA <*> elementsB
959+ combAp = map snd . sort . map (\(a, b) -> if f a == b
960+ then ((fromEnum a, fromEnum b), nat 1)
961+ else ((fromEnum a, fromEnum b), nat 0)) $ combinations
962+ mList = buildList combAp rrows
963+ in tr $ fromLists mList
966+ buildList l r = take r l : buildList (drop r l) r
936-- | Lifts functions to relations with dimensions matching @a@ and @b@
968-- | Lifts functions to relations with dimensions matching @a@ and @b@
937-- cardinality's.
969-- cardinality's.
@@ -939,11 +971,28 @@ fromFRel ::
939 forall a b.
971 forall a b.
940 ( Liftable Boolean a b,
972 ( Liftable Boolean a b,
941 CountableDimsN a b,
973 CountableDimsN a b,
942− FLN b a
974+ FL (Normalize b) (Normalize a)
944 (a -> b) ->
976 (a -> b) ->
945 Relation (Normalize a) (Normalize b)
977 Relation (Normalize a) (Normalize b)
946−fromFRel = fromFRel'
978+fromFRel f =
979+ let minA = minBound @a
983+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))
984+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
985+ elementsA = take ccols [minA .. maxA]
986+ elementsB = take rrows [minB .. maxB]
987+ combinations = (,) <$> elementsA <*> elementsB
988+ combAp = map snd . sort . map (\(a, b) -> if f a == b
989+ then ((fromEnum a, fromEnum b), nat 1)
990+ else ((fromEnum a, fromEnum b), nat 0)) $ combinations
991+ mList = buildList combAp rrows
992+ in tr $ fromLists mList
995+ buildList l r = take r l : buildList (drop r l) r
948-- | Lifts a relation function to a Boolean Matrix
997-- | Lifts a relation function to a Boolean Matrix
@@ -953,7 +1002,7 @@ toRel ::
956− CountableDims a b,
1005+ CountableDimsN a b,
959 => (a -> b -> Bool) -> Relation (Normalize a) (Normalize b)
1008 => (a -> b -> Bool) -> Relation (Normalize a) (Normalize b)
@@ -962,8 +1011,8 @@ toRel f =
962 maxA = maxBound @a
1011 maxA = maxBound @a
963 minB = minBound @b
1012 minB = minBound @b
964 maxB = maxBound @b
1013 maxB = maxBound @b
965− ccols = fromInteger $ natVal (Proxy :: Proxy (Count a))
1014+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))
966− rrows = fromInteger $ natVal (Proxy :: Proxy (Count b))
1015+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
967 elementsA = take ccols [minA .. maxA]
1016 elementsA = take ccols [minA .. maxA]
968 elementsB = take rrows [minB .. maxB]
1017 elementsB = take rrows [minB .. maxB]
969 combinations = (,) <$> elementsA <*> elementsB
1018 combinations = (,) <$> elementsA <*> elementsB