on master help sign in
Merge pull request #15 from bolt12/redundant

Removed redundant type families

commit4ec595b5fbb297727124fcefb87527b3b3286c21 authorArmando Santos <armandoifsantos@gmail.com> dateSat 6 Jun 2020, 00:02 (6 years ago) parentc3f6ef8cf35b19
3 files changed+48−98
src/LAoP/Matrix/Internal.hs+34−87 src/LAoP/Matrix/Type.hs+2−2 src/LAoP/Relation/Internal.hs+12−9
src/LAoP/Matrix/Internal.hs+34−87
@@ -243,7 +243,7 @@ type Trivial a = FromNat (Count a) ~ a
243243-- class.
244244instance (Num e) => Category (Matrix e) where
245245 type Object (Matrix e) a = (FL a a, Countable a)
246− id = iden
246+ id = iden
247247 (.) = comp
248248
249249instance NFData e => NFData (Matrix e cols rows) where
@@ -259,7 +259,6 @@ instance Eq e => Eq (Matrix e cols rows) where
259259 x@(Join _ _) == y@(Fork _ _) = abideJF x == y
260260
261261instance Num e => Num (Matrix e cols rows) where
262−
263262 a + b = zipWithM (+) a b
264263
265264 a - b = zipWithM (-) a b
@@ -326,7 +325,8 @@ instance (FromLists cols ()) => FromLists (Either () cols) () where
326325 fromLists [h : t] = Join (One h) (fromLists [t])
327326 fromLists _ = error "Wrong dimensions"
328327
329−instance {-# OVERLAPPABLE #-} (FromLists a (), FromLists b (), Countable a) => FromLists (Either a b) () where
328+instance {-# OVERLAPPABLE #-}
329+ (FromLists a (), FromLists b (), Countable a) => FromLists (Either a b) () where
330330 fromLists [l] =
331331 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
332332 in Join (fromLists [take rowsA l]) (fromLists [drop rowsA l])
@@ -336,13 +336,15 @@ instance (FromLists () rows) => FromLists () (Either () rows) where
336336 fromLists ([h] : t) = Fork (One h) (fromLists t)
337337 fromLists _ = error "Wrong dimensions"
338338
339−instance {-# OVERLAPPABLE #-} (FromLists () a, FromLists () b, Countable a) => FromLists () (Either a b) where
339+instance {-# OVERLAPPABLE #-}
340+ (FromLists () a, FromLists () b, Countable a) => FromLists () (Either a b) where
340341 fromLists l@([_] : _) =
341342 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))
342343 in Fork (fromLists (take rowsA l)) (fromLists (drop rowsA l))
343344 fromLists _ = error "Wrong dimensions"
344345
345−instance (FromLists (Either a b) c, FromLists (Either a b) d, Countable c) => FromLists (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
346348 fromLists l@(h : t) =
347349 let lh = length h
348350 rowsC = fromInteger (natVal (Proxy :: Proxy (Count c)))
@@ -369,16 +371,15 @@ matrixBuilder' f =
369371matrixBuilder ::
370372 forall e a b.
371373 ( FLN a b,
372− CountableN b,
373374 Enum a,
374375 Enum b,
375376 Bounded a,
376377 Bounded b,
377378 Eq a,
378− CountableDimsN a b
379+ Countable b
379380 ) => ((a, b) -> e) -> Matrix e (Normalize a) (Normalize b)
380381matrixBuilder f =
381− let r = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
382+ let r = fromInteger $ natVal (Proxy :: Proxy (Count b))
382383 positions = [(a, b) | a <- [minBound .. maxBound], b <- [minBound .. maxBound]]
383384 in fromLists . map (map f) . transpose . buildList r $ positions
384385 where
@@ -434,24 +435,7 @@ fromF ::
434435 ) =>
435436 (a -> b) ->
436437 Matrix e (Normalize a) (Normalize b)
437−fromF f =
438− let minA = minBound @a
439− maxA = maxBound @a
440− minB = minBound @b
441− maxB = maxBound @b
442− ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))
443− rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
444− elementsA = take ccols [minA .. maxA]
445− elementsB = take rrows [minB .. maxB]
446− combinations = (,) <$> elementsA <*> elementsB
447− combAp = map snd . sort . map (\(a, b) -> if f a == b
448− then ((fromEnum a, fromEnum b), 1)
449− else ((fromEnum a, fromEnum b), 0)) $ combinations
450− mList = buildList combAp rrows
451− in tr $ fromLists mList
452− where
453− buildList [] _ = []
454− buildList l r = take r l : buildList (drop r l) r
438+fromF = fromF'
455439
456440-- Conversion
457441
@@ -805,38 +789,35 @@ corr p = let f = fromF' p :: Matrix e q ()
805789
806790-- Pretty print
807791
808−prettyAux :: Show e => [[e]] -> [[e]] -> String
809−prettyAux [] _ = ""
810−prettyAux [[e]] m = "│ " ++ fill (show e) ++ " │\n"
811− where
812− v = fmap show m
813− widest = maximum $ fmap length v
814− fill str = replicate (widest - length str - 2) ' ' ++ str
815−prettyAux [h] m = "│ " ++ fill (unwords $ map show h) ++ " │\n"
792+fill :: Show e => [[e]] -> String -> String
793+fill m str = replicate (widest - length str - 2) ' ' ++ str
816794 where
817− v = fmap show m
818− widest = maximum $ fmap length v
819− fill str = replicate (widest - length str - 2) ' ' ++ str
820−prettyAux (h : t) l = "│ " ++ fill (unwords $ map show h) ++ " │\n" ++
821− prettyAux t l
795+ v = fmap show m
796+ widest = maximum $ fmap length v
797+
798+fill2 :: Show e => Matrix e cols rows -> String -> String
799+fill2 m str = replicate (widest - length str - 2) ' ' ++ str
822800 where
823− v = fmap show l
824− widest = maximum $ fmap length v
825− fill str = replicate (widest - length str - 2) ' ' ++ str
801+ v = map show (toList m)
802+ widest = maximum $ map length v
803+
804+prettyAux :: Show e => [[e]] -> [[e]] -> String
805+prettyAux [] _ = ""
806+prettyAux [[e]] m = "│ " ++ fill m (show e) ++ " │\n"
807+prettyAux [h] m = "│ " ++ fill m (unwords $ map show h) ++ " │\n"
808+prettyAux (h : t) m = "│ " ++ fill m (unwords $ map show h) ++ " │\n" ++
809+ prettyAux t m
826810
827811-- | Matrix pretty printer
828812pretty :: (CountableDims cols rows, Show e) => Matrix e cols rows -> String
829813pretty m = concat
830814 [ "┌ ", unwords (replicate (columns m) blank), " ┐\n"
831815 , unlines
832− [ "│ " ++ unwords (fmap (\j -> fill $ show $ getElem i j m) [1..columns m]) ++ " │" | i <- [1..rows m] ]
816+ [ "│ " ++ unwords (fmap (\j -> fill2 m $ show $ getElem i j m) [1..columns m]) ++ " │" | i <- [1..rows m] ]
833817 , "└ ", unwords (replicate (columns m) blank), " ┘"
834818 ]
835819 where
836− strings = map show (toList m)
837− widest = maximum $ map length strings
838− fill str = replicate (widest - length str) ' ' ++ str
839− blank = fill ""
820+ blank = fill2 m ""
840821 safeGet i j m
841822 | i > rows m || j > columns m || i < 1 || j < 1 = Nothing
842823 | otherwise = Just $ unsafeGet i j m (toList m)
@@ -947,24 +928,7 @@ fromFRel' ::
947928 ) =>
948929 (a -> b) ->
949930 Relation cols rows
950−fromFRel' f =
951− let minA = minBound @a
952− maxA = maxBound @a
953− minB = minBound @b
954− maxB = maxBound @b
955− ccols = fromInteger $ natVal (Proxy :: Proxy (Count cols))
956− rrows = fromInteger $ natVal (Proxy :: Proxy (Count rows))
957− elementsA = take ccols [minA .. maxA]
958− elementsB = take rrows [minB .. maxB]
959− combinations = (,) <$> elementsA <*> elementsB
960− combAp = map snd . sort . map (\(a, b) -> if f a == b
961− then ((fromEnum a, fromEnum b), nat 1)
962− else ((fromEnum a, fromEnum b), nat 0)) $ combinations
963− mList = buildList combAp rrows
964− in tr $ fromLists mList
965− where
966− buildList [] _ = []
967− buildList l r = take r l : buildList (drop r l) r
931+fromFRel' = fromF'
968932
969933-- | Lifts functions to relations with dimensions matching @a@ and @b@
970934-- cardinality's.
@@ -972,28 +936,11 @@ fromFRel ::
972936 forall a b.
973937 ( Liftable Boolean a b,
974938 CountableDimsN a b,
975− FL (Normalize b) (Normalize a)
939+ FLN b a
976940 ) =>
977941 (a -> b) ->
978942 Relation (Normalize a) (Normalize b)
979−fromFRel f =
980− let minA = minBound @a
981− maxA = maxBound @a
982− minB = minBound @b
983− maxB = maxBound @b
984− ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))
985− rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
986− elementsA = take ccols [minA .. maxA]
987− elementsB = take rrows [minB .. maxB]
988− combinations = (,) <$> elementsA <*> elementsB
989− combAp = map snd . sort . map (\(a, b) -> if f a == b
990− then ((fromEnum a, fromEnum b), nat 1)
991− else ((fromEnum a, fromEnum b), nat 0)) $ combinations
992− mList = buildList combAp rrows
993− in tr $ fromLists mList
994− where
995− buildList [] _ = []
996− buildList l r = take r l : buildList (drop r l) r
943+fromFRel = fromFRel'
997944
998945-- | Lifts a relation function to a Boolean Matrix
999946toRel ::
@@ -1003,7 +950,7 @@ toRel ::
1003950 Enum a,
1004951 Enum b,
1005952 Eq b,
1006− CountableDimsN a b,
953+ CountableDims a b,
1007954 FLN b a
1008955 )
1009956 => (a -> b -> Bool) -> Relation (Normalize a) (Normalize b)
@@ -1012,8 +959,8 @@ toRel f =
1012959 maxA = maxBound @a
1013960 minB = minBound @b
1014961 maxB = maxBound @b
1015− ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))
1016− rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))
962+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count a))
963+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count b))
1017964 elementsA = take ccols [minA .. maxA]
1018965 elementsB = take rrows [minB .. maxB]
1019966 combinations = (,) <$> elementsA <*> elementsB
src/LAoP/Matrix/Type.hs+2−2
@@ -333,7 +333,7 @@ matrixBuilder ::
333333 Bounded a,
334334 Bounded b,
335335 Eq a,
336− CountableDimsN a b
336+ Countable b
337337 ) => ((a, b) -> e) -> Matrix e a b
338338matrixBuilder f = M (I.matrixBuilder f)
339339
@@ -370,7 +370,7 @@ fromF = M . I.fromF
370370-- | Lifts relation functions to Boolean Matrix
371371toRel ::
372372 ( Liftable (Natural 0 1) a b,
373− CountableDimsN a b,
373+ CountableDims a b,
374374 FLN b a
375375 ) => (a -> b -> Bool) -> Matrix (Natural 0 1) a b
376376toRel = M . I.toRel
src/LAoP/Relation/Internal.hs+12−9
@@ -283,7 +283,7 @@ relationBuilder ::
283283 Bounded a,
284284 Bounded b,
285285 Eq a,
286− CountableDimsN a b
286+ CountableDims a b
287287 ) => ((a, b) -> Boolean) -> Relation a b
288288relationBuilder = R . I.matrixBuilder
289289
@@ -301,7 +301,7 @@ fromF' f = R (I.fromFRel' f)
301301
302302-- | Lifts functions to matrices with dimensions matching @a@ and @b@
303303-- cardinality's.
304−fromF ::
304+fromF ::
305305 ( Liftable a b,
306306 CountableDimsN a b,
307307 FLN b a
@@ -312,7 +312,7 @@ fromF f = R (I.fromFRel f)
312312-- | Lifts relation functions to 'Relation'
313313toRel ::
314314 ( Liftable a b,
315− CountableDimsN a b,
315+ CountableDims a b,
316316 FLN b a
317317 )
318318 => (a -> b -> Bool) -> Relation a b
@@ -348,7 +348,7 @@ toBool r = case toList r of
348348-- | Power transpose.
349349--
350350-- Maps a relation to a set valued function.
351−pt ::
351+pt ::
352352 ( Liftable a b,
353353 Eq a,
354354 CountableDimsN a b,
@@ -365,7 +365,7 @@ belongs ::
365365 ( Bounded a,
366366 Enum a,
367367 Eq a,
368− CountableDimsN (List a) a,
368+ CountableDims (List a) a,
369369 FLN a (List a)
370370 )
371371 => Relation (List a) a
@@ -413,7 +413,7 @@ bang ::
413413bang = ones
414414
415415-- | Point constant relation
416−point ::
416+point ::
417417 ( Bounded a,
418418 Enum a,
419419 Eq a,
@@ -927,6 +927,7 @@ untrans s = fstR . conv (splitR (conv s) sndR)
927927predR ::
928928 ( Bounded a,
929929 Enum a,
930+ Countable a,
930931 CountableN a,
931932 FLN a a,
932933 FLN Bool a
@@ -954,23 +955,25 @@ equalizer f g = id `intersection` divisionF f g
954955-- @
955956-- 'guard' p = 'i2' ``overriddenBy`` 'i1' `.` 'predR' p
956957-- @
957−guard ::
958+guard ::
958959 ( Bounded b,
959960 Enum b,
960961 CountableN b,
962+ Countable b,
961963 FLN b b,
962964 FLN Bool b
963965 ) => Relation b Bool -> Relation b (Either b b)
964966guard p = conv (eitherR (predR p) (predR (negate p)))
965967
966968-- | Relational McCarthy's conditional.
967−cond ::
969+cond ::
968970 ( Bounded b,
969971 Enum b,
972+ Countable b,
970973 CountableN b,
971974 FLN b b,
972975 FLN Bool b
973− )
976+ )
974977 => Relation b Bool -> Relation b c -> Relation b c -> Relation b c
975978cond p r s = eitherR r s . guard p
976979