{-# 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 {codomain :: Set.Set a, function :: Map.Map a a} deriving (Eq, Show)
instance (Ord a) => Morphism (FinOrdMap a) (Set.Set a) where
(@) g f = FinOrdMap {codomain=codomain g, function=Map.fromList[(k,(function g)Map.!((function f) Map.! k))| k <- Map.keys (function f)]}
source = Set.fromList.(Map.keys).function
target = codomain
instance (PrettyPrintable a, Ord a) => PrettyPrintable (FinOrdMap a) where
pprint f = pprint (source f) ++ " -> " ++ pprint (target f) ++ "\n" ++ pprint (function f)
-- | `FinOrdSet` stores the sets which constitutes its objects.
data (FinOrdSet a) = FinOrdSet {sets :: [Set.Set a]} deriving (Show)
instance (Ord a) => FiniteCategory (FinOrdSet a) (FinOrdMap a) (Set.Set a) where
ob = nub.sets
identity c s
| elem s (ob c) = FinOrdMap {codomain=s, function=Map.fromList [(o,o)| o <- (Set.toList s)]}
| otherwise = error("Trying to get identity of an object not in the Set category.")
ar c s t
| Set.null s = [FinOrdMap {codomain=t, function=Map.fromList []}]
| Set.null t = []
| otherwise = (\x -> FinOrdMap {codomain=t, function=Map.fromList x}) <$> [zip domain i | i <- images] where
domain = Set.toList s
codomain = Set.toList t
images = (codomain |^| (length domain))
instance (Ord a) => GeneratedFiniteCategory (FinOrdSet a) (FinOrdMap a) (Set.Set a) where
genAr c s t
| Set.null s = [FinOrdMap {codomain=t, function= Map.fromList []}]
| Set.null t = []
| Set.size s == 1 = [FinOrdMap {codomain=t, function=injectiv}]
| Set.size t == 1 = [FinOrdMap {codomain=t, function=surjectiv}]
| s == t = nub $ (\m -> FinOrdMap {codomain=t, function=m}) <$> [transpose,rotate,project]
| length s < length t = [FinOrdMap {codomain=t, function=injectiv}]
| otherwise = [FinOrdMap {codomain=t, function=surjectiv}]
where
domain = Set.toList s
codomain = Set.toList t
transpose = Map.fromList ([(domain !! 0, domain !! 1),(domain !! 1, domain !! 0)]++[(o,o) | o <- drop 2 domain])
rotatedDomain = (tail domain) ++ [(head domain)]
rotate = Map.fromList (zip domain rotatedDomain)
project = Map.fromList ((domain !! 0, domain !! 1):[(o,o) | o <- tail domain])
injectiv = Map.fromList (zip domain codomain)
surjectiv = Map.fromList (zip domain ((replicate ((length s)-(length t)+1) (head codomain))++codomain))
decompose = bruteForceDecompose
instance (Ord a) => Eq (FinOrdSet a) where
FinOrdSet {sets=ss1} == FinOrdSet {sets=ss2} = if ss1 == [] then ss2 == [] else (isIncluded ss1 ss2) && (isIncluded ss2 ss1)
where
isIncluded [] ss2 = True
isIncluded (s:ss1) ss2 = (elem s ss2) && (isIncluded ss1 ss2)
instance (PrettyPrintable a) => PrettyPrintable (FinOrdSet a) where
pprint FinOrdSet {sets=ss} = "FinOrdSet of "++ pprint 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 x = FinOrdSet {sets = (Set.toList).(Set.powerSet) $ x}