{-# LANGUAGE MultiParamTypeClasses #-}

{-| Module  : FiniteCategories
Description : The category of finite sets of elements you can order (it is optimized with the Data.Set type).
Copyright   : Guillaume Sabbagh 2021
License     : GPL-3
Maintainer  : guillaumesabbagh@protonmail.com
Stability   : experimental
Portability : portable

Same as `FinOrdSet` but using Data.Set as objects, it is more optimized but needs its elements to be ordered.
-}

module Set.FinOrdSet
(
    -- * The morphism of the category : `FinOrdMap`

    FinOrdMap(..),
    -- * The category itself : `FinOrdSet`

    FinOrdSet(..),
    powerFinOrdSet
)
where
    import  qualified   Data.Map                        as Map  (Map, (!), fromList, keys)
    import  qualified   Data.Set                        as Set  (Set, fromList, toList, powerSet, null, size, findMin)
    import              Data.List                               (intercalate, nub)
    import              FiniteCategory.FiniteCategory           (FiniteCategory(..), GeneratedFiniteCategory(..), Morphism(..), bruteForceDecompose)
    import              Control.Monad                           (filterM)
    import              Utils.CartesianProduct                  ((|^|))
    import              IO.PrettyPrint
    
    
    -- | `FinOrdMap` is the morphism of the `FinOrdSet` category.

    --

    -- It is represented by a `Data.Map`. The domain is the list of /keys/.

    -- We need to store the codomain of the map in order to differentiate different maps which would be the same if we couldn't compare codomains.

    -- For example, @f : {1,2,3} -> {1,2,3}@ and @g : {1,2,3} -> {1,2,3,4}@ would have the same `Data.Map` but are different.

    data FinOrdMap a = FinOrdMap {forall a. FinOrdMap a -> Set a
codomain :: Set.Set a, forall a. FinOrdMap a -> Map a a
function :: Map.Map a a} deriving (FinOrdMap a -> FinOrdMap a -> Bool
(FinOrdMap a -> FinOrdMap a -> Bool)
-> (FinOrdMap a -> FinOrdMap a -> Bool) -> Eq (FinOrdMap a)
forall a. Eq a => FinOrdMap a -> FinOrdMap a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FinOrdMap a -> FinOrdMap a -> Bool
$c/= :: forall a. Eq a => FinOrdMap a -> FinOrdMap a -> Bool
== :: FinOrdMap a -> FinOrdMap a -> Bool
$c== :: forall a. Eq a => FinOrdMap a -> FinOrdMap a -> Bool
Eq, Int -> FinOrdMap a -> ShowS
[FinOrdMap a] -> ShowS
FinOrdMap a -> String
(Int -> FinOrdMap a -> ShowS)
-> (FinOrdMap a -> String)
-> ([FinOrdMap a] -> ShowS)
-> Show (FinOrdMap a)
forall a. Show a => Int -> FinOrdMap a -> ShowS
forall a. Show a => [FinOrdMap a] -> ShowS
forall a. Show a => FinOrdMap a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FinOrdMap a] -> ShowS
$cshowList :: forall a. Show a => [FinOrdMap a] -> ShowS
show :: FinOrdMap a -> String
$cshow :: forall a. Show a => FinOrdMap a -> String
showsPrec :: Int -> FinOrdMap a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> FinOrdMap a -> ShowS
Show)
    
    instance (Ord a) => Morphism (FinOrdMap a) (Set.Set a) where
        @ :: FinOrdMap a -> FinOrdMap a -> FinOrdMap a
(@) FinOrdMap a
g FinOrdMap a
f = FinOrdMap :: forall a. Set a -> Map a a -> FinOrdMap a
FinOrdMap {codomain :: Set a
codomain=FinOrdMap a -> Set a
forall a. FinOrdMap a -> Set a
codomain FinOrdMap a
g, function :: Map a a
function=[(a, a)] -> Map a a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList[(a
k,(FinOrdMap a -> Map a a
forall a. FinOrdMap a -> Map a a
function FinOrdMap a
g)Map a a -> a -> a
forall k a. Ord k => Map k a -> k -> a
Map.!((FinOrdMap a -> Map a a
forall a. FinOrdMap a -> Map a a
function FinOrdMap a
f) Map a a -> a -> a
forall k a. Ord k => Map k a -> k -> a
Map.! a
k))| a
k <- Map a a -> [a]
forall k a. Map k a -> [k]
Map.keys (FinOrdMap a -> Map a a
forall a. FinOrdMap a -> Map a a
function FinOrdMap a
f)]}
        source :: FinOrdMap a -> Set a
source = [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList([a] -> Set a) -> (FinOrdMap a -> [a]) -> FinOrdMap a -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Map a a -> [a]
forall k a. Map k a -> [k]
Map.keys)(Map a a -> [a]) -> (FinOrdMap a -> Map a a) -> FinOrdMap a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FinOrdMap a -> Map a a
forall a. FinOrdMap a -> Map a a
function
        target :: FinOrdMap a -> Set a
target = FinOrdMap a -> Set a
forall a. FinOrdMap a -> Set a
codomain        
    
    instance (PrettyPrintable a, Ord a) => PrettyPrintable (FinOrdMap a) where
        pprint :: FinOrdMap a -> String
pprint FinOrdMap a
f = Set a -> String
forall a. PrettyPrintable a => a -> String
pprint (FinOrdMap a -> Set a
forall m o. Morphism m o => m -> o
source FinOrdMap a
f) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" -> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Set a -> String
forall a. PrettyPrintable a => a -> String
pprint (FinOrdMap a -> Set a
forall m o. Morphism m o => m -> o
target FinOrdMap a
f) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Map a a -> String
forall a. PrettyPrintable a => a -> String
pprint (FinOrdMap a -> Map a a
forall a. FinOrdMap a -> Map a a
function FinOrdMap a
f)
    
    -- | `FinOrdSet` stores the sets which constitutes its objects.

    data (FinOrdSet a) = FinOrdSet {forall a. FinOrdSet a -> [Set a]
sets :: [Set.Set a]} deriving (Int -> FinOrdSet a -> ShowS
[FinOrdSet a] -> ShowS
FinOrdSet a -> String
(Int -> FinOrdSet a -> ShowS)
-> (FinOrdSet a -> String)
-> ([FinOrdSet a] -> ShowS)
-> Show (FinOrdSet a)
forall a. Show a => Int -> FinOrdSet a -> ShowS
forall a. Show a => [FinOrdSet a] -> ShowS
forall a. Show a => FinOrdSet a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FinOrdSet a] -> ShowS
$cshowList :: forall a. Show a => [FinOrdSet a] -> ShowS
show :: FinOrdSet a -> String
$cshow :: forall a. Show a => FinOrdSet a -> String
showsPrec :: Int -> FinOrdSet a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> FinOrdSet a -> ShowS
Show)
    
    instance (Ord a) => FiniteCategory (FinOrdSet a) (FinOrdMap a) (Set.Set a) where
        ob :: FinOrdSet a -> [Set a]
ob = [Set a] -> [Set a]
forall a. Eq a => [a] -> [a]
nub([Set a] -> [Set a])
-> (FinOrdSet a -> [Set a]) -> FinOrdSet a -> [Set a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FinOrdSet a -> [Set a]
forall a. FinOrdSet a -> [Set a]
sets
        identity :: Morphism (FinOrdMap a) (Set a) =>
FinOrdSet a -> Set a -> FinOrdMap a
identity FinOrdSet a
c Set a
s 
            | Set a -> [Set a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Set a
s (FinOrdSet a -> [Set a]
forall c m o. FiniteCategory c m o => c -> [o]
ob FinOrdSet a
c) = FinOrdMap :: forall a. Set a -> Map a a -> FinOrdMap a
FinOrdMap {codomain :: Set a
codomain=Set a
s, function :: Map a a
function=[(a, a)] -> Map a a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(a
o,a
o)| a
o <- (Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
s)]}
            | Bool
otherwise = String -> FinOrdMap a
forall a. HasCallStack => String -> a
error(String
"Trying to get identity of an object not in the Set category.")
        ar :: Morphism (FinOrdMap a) (Set a) =>
FinOrdSet a -> Set a -> Set a -> [FinOrdMap a]
ar FinOrdSet a
c Set a
s Set a
t 
            | Set a -> Bool
forall a. Set a -> Bool
Set.null Set a
s = [FinOrdMap :: forall a. Set a -> Map a a -> FinOrdMap a
FinOrdMap {codomain :: Set a
codomain=Set a
t, function :: Map a a
function=[(a, a)] -> Map a a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList []}]
            | Set a -> Bool
forall a. Set a -> Bool
Set.null Set a
t = []
            | Bool
otherwise = (\[(a, a)]
x -> FinOrdMap :: forall a. Set a -> Map a a -> FinOrdMap a
FinOrdMap {codomain :: Set a
codomain=Set a
t, function :: Map a a
function=[(a, a)] -> Map a a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(a, a)]
x}) ([(a, a)] -> FinOrdMap a) -> [[(a, a)]] -> [FinOrdMap a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
domain [a]
i | [a]
i <- [[a]]
images] where
                domain :: [a]
domain = Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
s
                codomain :: [a]
codomain = Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
t
                images :: [[a]]
images = ([a]
codomain [a] -> Int -> [[a]]
forall {a}. [a] -> Int -> [[a]]
|^| ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
domain))
                
    instance (Ord a) => GeneratedFiniteCategory (FinOrdSet a) (FinOrdMap a) (Set.Set a) where
        genAr :: Morphism (FinOrdMap a) (Set a) =>
FinOrdSet a -> Set a -> Set a -> [FinOrdMap a]
genAr FinOrdSet a
c Set a
s Set a
t
            | Set a -> Bool
forall a. Set a -> Bool
Set.null Set a
s = [FinOrdMap :: forall a. Set a -> Map a a -> FinOrdMap a
FinOrdMap {codomain :: Set a
codomain=Set a
t, function :: Map a a
function= [(a, a)] -> Map a a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList []}]
            | Set a -> Bool
forall a. Set a -> Bool
Set.null Set a
t = []
            | Set a -> Int
forall a. Set a -> Int
Set.size Set a
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = [FinOrdMap :: forall a. Set a -> Map a a -> FinOrdMap a
FinOrdMap {codomain :: Set a
codomain=Set a
t, function :: Map a a
function=Map a a
injectiv}] 
            | Set a -> Int
forall a. Set a -> Int
Set.size Set a
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = [FinOrdMap :: forall a. Set a -> Map a a -> FinOrdMap a
FinOrdMap {codomain :: Set a
codomain=Set a
t, function :: Map a a
function=Map a a
surjectiv}]
            | Set a
s Set a -> Set a -> Bool
forall a. Eq a => a -> a -> Bool
== Set a
t = [FinOrdMap a] -> [FinOrdMap a]
forall a. Eq a => [a] -> [a]
nub ([FinOrdMap a] -> [FinOrdMap a]) -> [FinOrdMap a] -> [FinOrdMap a]
forall a b. (a -> b) -> a -> b
$ (\Map a a
m -> FinOrdMap :: forall a. Set a -> Map a a -> FinOrdMap a
FinOrdMap {codomain :: Set a
codomain=Set a
t, function :: Map a a
function=Map a a
m}) (Map a a -> FinOrdMap a) -> [Map a a] -> [FinOrdMap a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Map a a
transpose,Map a a
rotate,Map a a
project]           
            | Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Set a
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Set a
t = [FinOrdMap :: forall a. Set a -> Map a a -> FinOrdMap a
FinOrdMap {codomain :: Set a
codomain=Set a
t, function :: Map a a
function=Map a a
injectiv}] 
            | Bool
otherwise = [FinOrdMap :: forall a. Set a -> Map a a -> FinOrdMap a
FinOrdMap {codomain :: Set a
codomain=Set a
t, function :: Map a a
function=Map a a
surjectiv}]  
            where
            domain :: [a]
domain = Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
s
            codomain :: [a]
codomain = Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
t
            transpose :: Map a a
transpose = [(a, a)] -> Map a a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([([a]
domain [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
0, [a]
domain [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
1),([a]
domain [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
1, [a]
domain [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
0)][(a, a)] -> [(a, a)] -> [(a, a)]
forall a. [a] -> [a] -> [a]
++[(a
o,a
o) | a
o <- Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
2 [a]
domain])
            rotatedDomain :: [a]
rotatedDomain = ([a] -> [a]
forall a. [a] -> [a]
tail [a]
domain) [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [([a] -> a
forall a. [a] -> a
head [a]
domain)]
            rotate :: Map a a
rotate = [(a, a)] -> Map a a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
domain [a]
rotatedDomain)                
            project :: Map a a
project = [(a, a)] -> Map a a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (([a]
domain [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
0, [a]
domain [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
1)(a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
:[(a
o,a
o) | a
o <- [a] -> [a]
forall a. [a] -> [a]
tail [a]
domain])
            injectiv :: Map a a
injectiv = [(a, a)] -> Map a a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
domain [a]
codomain)
            surjectiv :: Map a a
surjectiv = [(a, a)] -> Map a a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
domain ((Int -> a -> [a]
forall a. Int -> a -> [a]
replicate ((Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Set a
s)Int -> Int -> Int
forall a. Num a => a -> a -> a
-(Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Set a
t)Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) ([a] -> a
forall a. [a] -> a
head [a]
codomain))[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
codomain))
        
        decompose :: Morphism (FinOrdMap a) (Set a) =>
FinOrdSet a -> FinOrdMap a -> [FinOrdMap a]
decompose = FinOrdSet a -> FinOrdMap a -> [FinOrdMap a]
forall c m o.
(GeneratedFiniteCategory c m o, Morphism m o, Eq m) =>
c -> m -> [m]
bruteForceDecompose

    instance (Ord a) => Eq (FinOrdSet a) where
        FinOrdSet {sets :: forall a. FinOrdSet a -> [Set a]
sets=[Set a]
ss1} == :: FinOrdSet a -> FinOrdSet a -> Bool
== FinOrdSet {sets :: forall a. FinOrdSet a -> [Set a]
sets=[Set a]
ss2} = if [Set a]
ss1 [Set a] -> [Set a] -> Bool
forall a. Eq a => a -> a -> Bool
== [] then [Set a]
ss2 [Set a] -> [Set a] -> Bool
forall a. Eq a => a -> a -> Bool
== [] else ([Set a] -> [Set a] -> Bool
forall {t :: * -> *} {a}. (Foldable t, Eq a) => [a] -> t a -> Bool
isIncluded [Set a]
ss1 [Set a]
ss2) Bool -> Bool -> Bool
&& ([Set a] -> [Set a] -> Bool
forall {t :: * -> *} {a}. (Foldable t, Eq a) => [a] -> t a -> Bool
isIncluded [Set a]
ss2 [Set a]
ss1)
            where
                isIncluded :: [a] -> t a -> Bool
isIncluded [] t a
ss2 = Bool
True
                isIncluded (a
s:[a]
ss1) t a
ss2 = (a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
s t a
ss2) Bool -> Bool -> Bool
&& ([a] -> t a -> Bool
isIncluded [a]
ss1 t a
ss2)
                
    instance (PrettyPrintable a) =>  PrettyPrintable (FinOrdSet a) where
        pprint :: FinOrdSet a -> String
pprint FinOrdSet {sets :: forall a. FinOrdSet a -> [Set a]
sets=[Set a]
ss} = String
"FinOrdSet of "String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Set a] -> String
forall a. PrettyPrintable a => a -> String
pprint [Set a]
ss

    -- | Returns the `FinOrdSet` category such that every subset of the set given is an object of the category.

    powerFinOrdSet :: (Ord a) => Set.Set a -> FinOrdSet a
    powerFinOrdSet :: forall a. Ord a => Set a -> FinOrdSet a
powerFinOrdSet Set a
x = FinOrdSet :: forall a. [Set a] -> FinOrdSet a
FinOrdSet {sets :: [Set a]
sets = (Set (Set a) -> [Set a]
forall a. Set a -> [a]
Set.toList)(Set (Set a) -> [Set a])
-> (Set a -> Set (Set a)) -> Set a -> [Set a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Set a -> Set (Set a)
forall a. Set a -> Set (Set a)
Set.powerSet) (Set a -> [Set a]) -> Set a -> [Set a]
forall a b. (a -> b) -> a -> b
$ Set a
x}