4ec595b · laop · git.iko.soy

git.iko.soy/laop

on master help sign in

Merge pull request #15 from bolt12/redundant

4ec595bArmando Santos6 years ago

src/LAoP/Matrix/Internal.hs+34−87

compare with master

unifiedsplit

@@ -243,7 +243,7 @@ type Trivial a = FromNat (Count a) ~ a

243-- class.

244instance (Num e) => Category (Matrix e) where

245 type Object (Matrix e) a = (FL a a, Countable a)

246− id = iden

246+ id = iden

247 (.) = comp

248

249instance NFData e => NFData (Matrix e cols rows) where

@@ -259,7 +259,6 @@ instance Eq e => Eq (Matrix e cols rows) where

259 x@(Join _ _) == y@(Fork _ _) = abideJF x == y

260

261instance Num e => Num (Matrix e cols rows) where

262−

263 a + b = zipWithM (+) a b

262 a + b = zipWithM (+) a b

264

263

265 a - b = zipWithM (-) a b

264 a - b = zipWithM (-) a b

@@ -326,7 +325,8 @@ instance (FromLists cols ()) => FromLists (Either () cols) () where

326 fromLists [h : t] = Join (One h) (fromLists [t])

325 fromLists [h : t] = Join (One h) (fromLists [t])

327 fromLists _ = error "Wrong dimensions"

326 fromLists _ = error "Wrong dimensions"

328

327

328+instance {-# OVERLAPPABLE #-}

329−instance {-# OVERLAPPABLE #-} (FromLists a (), FromLists b (), Countable a) => FromLists (Either a b) () where

329+ (FromLists a (), FromLists b (), Countable a) => FromLists (Either a b) () where

330 fromLists [l] =

331 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))

332 in Join (fromLists [take rowsA l]) (fromLists [drop rowsA l])

@@ -336,13 +336,15 @@ instance (FromLists () rows) => FromLists () (Either () rows) where

336 fromLists ([h] : t) = Fork (One h) (fromLists t)

337 fromLists _ = error "Wrong dimensions"

338

339+instance {-# OVERLAPPABLE #-}

339−instance {-# OVERLAPPABLE #-} (FromLists () a, FromLists () b, Countable a) => FromLists () (Either a b) where

340+ (FromLists () a, FromLists () b, Countable a) => FromLists () (Either a b) where

340 fromLists l@([_] : _) =

341 fromLists l@([_] : _) =

341 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))

342 let rowsA = fromInteger (natVal (Proxy :: Proxy (Count a)))

342 in Fork (fromLists (take rowsA l)) (fromLists (drop rowsA l))

343 in Fork (fromLists (take rowsA l)) (fromLists (drop rowsA l))

343 fromLists _ = error "Wrong dimensions"

344 fromLists _ = error "Wrong dimensions"

344

345

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

346 fromLists l@(h : t) =

348 fromLists l@(h : t) =

347 let lh = length h

349 let lh = length h

348 rowsC = fromInteger (natVal (Proxy :: Proxy (Count c)))

350 rowsC = fromInteger (natVal (Proxy :: Proxy (Count c)))

@@ -369,16 +371,15 @@ matrixBuilder' f =

369matrixBuilder ::

371matrixBuilder ::

370 forall e a b.

372 forall e a b.

371 ( FLN a b,

373 ( FLN a b,

372− CountableN b,

373 Enum a,

374 Enum a,

374 Enum b,

375 Enum b,

375 Bounded a,

376 Bounded a,

376 Bounded b,

377 Bounded b,

377 Eq a,

378 Eq a,

378− CountableDimsN a b

379+ Countable b

379 ) => ((a, b) -> e) -> Matrix e (Normalize a) (Normalize b)

380 ) => ((a, b) -> e) -> Matrix e (Normalize a) (Normalize b)

380matrixBuilder f =

381matrixBuilder f =

381− let r = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))

382+ let r = fromInteger $ natVal (Proxy :: Proxy (Count b))

382 positions = [(a, b) | a <- [minBound .. maxBound], b <- [minBound .. maxBound]]

383 positions = [(a, b) | a <- [minBound .. maxBound], b <- [minBound .. maxBound]]

383 in fromLists . map (map f) . transpose . buildList r $ positions

384 in fromLists . map (map f) . transpose . buildList r $ positions

384 where

385 where

@@ -434,24 +435,7 @@ fromF ::

434 ) =>

435 ) =>

435 (a -> b) ->

436 (a -> b) ->

436 Matrix e (Normalize a) (Normalize b)

437 Matrix e (Normalize a) (Normalize b)

437−fromF f =

438+fromF = fromF'

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

455

439

456-- Conversion

440-- Conversion

457

441

@@ -805,38 +789,35 @@ corr p = let f = fromF' p :: Matrix e q ()

805

789

806-- Pretty print

790-- Pretty print

807

791

808−prettyAux :: Show e => [[e]] -> [[e]] -> String

792+fill :: Show e => [[e]] -> String -> 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

793+fill m str = replicate (widest - length str - 2) ' ' ++ str

815−prettyAux [h] m = "│ " ++ fill (unwords $ map show h) ++ " │\n"

816 where

794 where

817− v = fmap show m

795+ v = fmap show m

818− widest = maximum $ fmap length v

796+ widest = maximum $ fmap length v

797+

798+fill2 :: Show e => Matrix e cols rows -> String -> String

819− fill str = replicate (widest - length str - 2) ' ' ++ str

799+fill2 m str = replicate (widest - length str - 2) ' ' ++ str

820−prettyAux (h : t) l = "│ " ++ fill (unwords $ map show h) ++ " │\n" ++

821− prettyAux t l

822 where

800 where

823− v = fmap show l

801+ v = map show (toList m)

824− widest = maximum $ fmap length v

802+ widest = maximum $ map length v

825− fill str = replicate (widest - length str - 2) ' ' ++ str

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

826

810

827-- | Matrix pretty printer

811-- | Matrix pretty printer

828pretty :: (CountableDims cols rows, Show e) => Matrix e cols rows -> String

812pretty :: (CountableDims cols rows, Show e) => Matrix e cols rows -> String

829pretty m = concat

813pretty m = concat

830 [ "┌ ", unwords (replicate (columns m) blank), " ┐\n"

814 [ "┌ ", unwords (replicate (columns m) blank), " ┐\n"

831 , unlines

815 , 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] ]

833 , "└ ", unwords (replicate (columns m) blank), " ┘"

817 , "└ ", unwords (replicate (columns m) blank), " ┘"

834 ]

818 ]

835 where

819 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 ""

840 safeGet i j m

821 safeGet i j m

841 | i > rows m || j > columns m || i < 1 || j < 1 = Nothing

822 | i > rows m || j > columns m || i < 1 || j < 1 = Nothing

842 | otherwise = Just $ unsafeGet i j m (toList m)

823 | otherwise = Just $ unsafeGet i j m (toList m)

@@ -947,24 +928,7 @@ fromFRel' ::

947 ) =>

928 ) =>

948 (a -> b) ->

929 (a -> b) ->

949 Relation cols rows

930 Relation cols rows

950−fromFRel' f =

931+fromFRel' = fromF'

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

968

932

969-- | Lifts functions to relations with dimensions matching @a@ and @b@

933-- | Lifts functions to relations with dimensions matching @a@ and @b@

970-- cardinality's.

934-- cardinality's.

@@ -972,28 +936,11 @@ fromFRel ::

972 forall a b.

936 forall a b.

973 ( Liftable Boolean a b,

937 ( Liftable Boolean a b,

974 CountableDimsN a b,

938 CountableDimsN a b,

975− FL (Normalize b) (Normalize a)

939+ FLN b a

976 ) =>

940 ) =>

977 (a -> b) ->

941 (a -> b) ->

978 Relation (Normalize a) (Normalize b)

942 Relation (Normalize a) (Normalize b)

979−fromFRel f =

943+fromFRel = fromFRel'

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

997

944

998-- | Lifts a relation function to a Boolean Matrix

945-- | Lifts a relation function to a Boolean Matrix

999toRel ::

946toRel ::

@@ -1003,7 +950,7 @@ toRel ::

1003 Enum a,

950 Enum a,

1004 Enum b,

951 Enum b,

1005 Eq b,

952 Eq b,

1006− CountableDimsN a b,

953+ CountableDims a b,

1007 FLN b a

954 FLN b a

1008 )

955 )

1009 => (a -> b -> Bool) -> Relation (Normalize a) (Normalize b)

956 => (a -> b -> Bool) -> Relation (Normalize a) (Normalize b)

@@ -1012,8 +959,8 @@ toRel f =

1012 maxA = maxBound @a

959 maxA = maxBound @a

1013 minB = minBound @b

960 minB = minBound @b

1014 maxB = maxBound @b

961 maxB = maxBound @b

1015− ccols = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize a)))

962+ ccols = fromInteger $ natVal (Proxy :: Proxy (Count a))

1016− rrows = fromInteger $ natVal (Proxy :: Proxy (Count (Normalize b)))

963+ rrows = fromInteger $ natVal (Proxy :: Proxy (Count b))

1017 elementsA = take ccols [minA .. maxA]

964 elementsA = take ccols [minA .. maxA]

1018 elementsB = take rrows [minB .. maxB]

965 elementsB = take rrows [minB .. maxB]

1019 combinations = (,) <$> elementsA <*> elementsB

966 combinations = (,) <$> elementsA <*> elementsB

src/LAoP/Matrix/Type.hs+2−2

@@ -333,7 +333,7 @@ matrixBuilder ::

333 Bounded a,

334 Bounded b,

335 Eq a,

336− CountableDimsN a b

336+ Countable b

337 ) => ((a, b) -> e) -> Matrix e a b

338matrixBuilder f = M (I.matrixBuilder f)

339

@@ -370,7 +370,7 @@ fromF = M . I.fromF

370-- | Lifts relation functions to Boolean Matrix

371toRel ::

372 ( Liftable (Natural 0 1) a b,

373− CountableDimsN a b,

373+ CountableDims a b,

374 FLN b a

375 ) => (a -> b -> Bool) -> Matrix (Natural 0 1) a b

376toRel = M . I.toRel

src/LAoP/Relation/Internal.hs+12−9

@@ -283,7 +283,7 @@ relationBuilder ::

283 Bounded a,

284 Bounded b,

285 Eq a,

286− CountableDimsN a b

286+ CountableDims a b

287 ) => ((a, b) -> Boolean) -> Relation a b

288relationBuilder = R . I.matrixBuilder

289

@@ -301,7 +301,7 @@ fromF' f = R (I.fromFRel' f)

301

302-- | Lifts functions to matrices with dimensions matching @a@ and @b@

303-- cardinality's.

304−fromF ::

304+fromF ::

305 ( Liftable a b,

306 CountableDimsN a b,

307 FLN b a

@@ -312,7 +312,7 @@ fromF f = R (I.fromFRel f)

312-- | Lifts relation functions to 'Relation'

313toRel ::

314 ( Liftable a b,

315− CountableDimsN a b,

315+ CountableDims a b,

316 FLN b a

317 )

318 => (a -> b -> Bool) -> Relation a b

@@ -348,7 +348,7 @@ toBool r = case toList r of

348-- | Power transpose.

349--

350-- Maps a relation to a set valued function.

351−pt ::

351+pt ::

352 ( Liftable a b,

353 Eq a,

354 CountableDimsN a b,

@@ -365,7 +365,7 @@ belongs ::

365 ( Bounded a,

366 Enum a,

367 Eq a,

368− CountableDimsN (List a) a,

368+ CountableDims (List a) a,

369 FLN a (List a)

370 )

371 => Relation (List a) a

@@ -413,7 +413,7 @@ bang ::

413bang = ones

414

415-- | Point constant relation

416−point ::

416+point ::

417 ( Bounded a,

418 Enum a,

419 Eq a,

@@ -927,6 +927,7 @@ untrans s = fstR . conv (splitR (conv s) sndR)

927predR ::

928 ( Bounded a,

929 Enum a,

930+ Countable a,

930 CountableN a,

931 CountableN a,

931 FLN a a,

932 FLN a a,

932 FLN Bool a

933 FLN Bool a

@@ -954,23 +955,25 @@ equalizer f g = id `intersection` divisionF f g

954-- @

955-- @

955-- 'guard' p = 'i2' ``overriddenBy`` 'i1' `.` 'predR' p

956-- 'guard' p = 'i2' ``overriddenBy`` 'i1' `.` 'predR' p

956-- @

957-- @

957−guard ::

958+guard ::

958 ( Bounded b,

959 ( Bounded b,

959 Enum b,

960 Enum b,

960 CountableN b,

961 CountableN b,

962+ Countable b,

961 FLN b b,

963 FLN b b,

962 FLN Bool b

964 FLN Bool b

963 ) => Relation b Bool -> Relation b (Either b b)

965 ) => Relation b Bool -> Relation b (Either b b)

964guard p = conv (eitherR (predR p) (predR (negate p)))

966guard p = conv (eitherR (predR p) (predR (negate p)))

965

967

966-- | Relational McCarthy's conditional.

968-- | Relational McCarthy's conditional.

967−cond ::

969+cond ::

968 ( Bounded b,

970 ( Bounded b,

969 Enum b,

971 Enum b,

972+ Countable b,

970 CountableN b,

973 CountableN b,

971 FLN b b,

974 FLN b b,

972 FLN Bool b

975 FLN Bool b

973− )

976+ )

974 => Relation b Bool -> Relation b c -> Relation b c -> Relation b c

977 => Relation b Bool -> Relation b c -> Relation b c -> Relation b c

975cond p r s = eitherR r s . guard p

978cond p r s = eitherR r s . guard p

976

979