Make morphisms polymophic

int-posets.cabal

@@ -24,7 +24,7 @@ Library
   Exposed-Modules:      Data.Poset,
                         Data.Poset.Graph,
                         Data.Poset.Morphism,
-                        Data.Semilattice
+                        Data.Poset.Semilattice
 
   GHC-Options:          -Wall
 

src/Data/Poset.hs

@@ -14,40 +14,40 @@ import Data.Maybe (listToMaybe)
 -- |   antisymmetric: if α ρ β and β ρ α ⇒ α = β ;
 -- |   transitive: if α ρ β and β ρ γ ⇒ α ρ γ .
 --
-type Relation = Int → Int → Bool
+type Relation α = α → α → Bool
 
-data Poset = Poset [Int] Relation
+data Poset α = Poset [α] (Relation α)
 
 -- | Build poset from a list of pairs connected by a binary relation
 --
-fromPairs ∷ [Int] → [(Int,Int)] → Poset
+fromPairs ∷ Eq α ⇒ [α] → [(α,α)] → Poset α
 fromPairs es rs = Poset es $ \a b → (a,b) `elem` rs
 
 -- | fromPairs with satisfying reflexivity and transitivity
 --
-fromPairsE ∷ [Int] → [(Int,Int)] → Poset
+fromPairsE ∷ Eq α ⇒ [α] → [(α,α)] → Poset α
 fromPairsE es rs = Poset es $ \a b → (a,b) `elem` expandedRelations
   where expandedRelations = nub [ (a,b) | a ← es, b ← connectWith g a ]
         g = graph rs
 
 -- | Get poset elements
 --
-elements ∷ Poset → [Int]
+elements ∷ Eq α ⇒ Poset α → [α]
 elements (Poset es _) = es
 
 -- | Get poset relation
 --
-relation ∷ Poset → Relation
+relation ∷ Eq α ⇒ Poset α → Relation α
 relation (Poset _ ρ) = ρ
 
 -- | Check Poset reflexivity
 --
-isReflexive ∷ Poset → Bool
+isReflexive ∷ Eq α ⇒ Poset α → Bool
 isReflexive (Poset es ρ) = and [ a `ρ` a  | a ← es ]
 
 -- | Check Poset antisymmetry
 --
-isAntisymmetric ∷ Poset → Bool
+isAntisymmetric ∷ Eq α ⇒ Poset α → Bool
 isAntisymmetric (Poset es ρ) = and
   [ a == b | a ← es, b ← es
   , a `ρ` b
@@ -56,7 +56,7 @@ isAntisymmetric (Poset es ρ) = and
 
 -- | Check Poset transitivity
 --
-isTransitive ∷ Poset → Bool
+isTransitive ∷ Eq α ⇒ Poset α → Bool
 isTransitive (Poset es ρ) = and
   [ a `ρ` c | a ← es, b ← es, c ← es
   , a `ρ` b
@@ -65,29 +65,29 @@ isTransitive (Poset es ρ) = and
 
 -- | Check poset correctness
 --
-isValid ∷ Poset → Bool
+isValid ∷ Eq α ⇒ Poset α → Bool
 isValid p = isReflexive p && isAntisymmetric p && isTransitive p
 
 -- | Find LowerCone of Poset element
 --  LowerCone is a set of elements connected with element by Binary Relation ρ
 --
-lowerCone ∷ Poset → Int → [Int]
+lowerCone ∷ Eq α ⇒ Poset α → α → [α]
 lowerCone (Poset es ρ) a = [ b | b ← es, b `ρ` a ]
 
 -- | infimums of Poset is an intersection of lowerCones of all elements
 --
-infimums ∷ Poset → [Int]
+infimums ∷ Eq α ⇒ Poset α → [α]
 infimums p@(Poset es _) = foldl1 intersect $ map (lowerCone p) es
 
 -- | infimum is an infimums with `Maybe' handle
 --
-infimum ∷ Poset → Maybe Int
+infimum ∷ Eq α ⇒ Poset α → Maybe α
 infimum = listToMaybe . infimums
 
 -- | Find infinum of 2 elements of Poset
 --
-infimums' ∷ Poset → Int → Int → [Int]
+infimums' ∷ Eq α ⇒ Poset α → α → α → [α]
 infimums' p = intersect `on` lowerCone p
 
-infimum' ∷ Poset → Int → Int → Maybe Int
+infimum' ∷ Eq α ⇒ Poset α → α → α → Maybe α
 infimum' p a b = listToMaybe $ infimums' p a b

src/Data/Poset/Morphism.hs

@@ -1,69 +1,47 @@
 {-# LANGUAGE UnicodeSyntax #-}
 module Data.Poset.Morphism where
 
-import Control.Monad (replicateM)
 import Data.Poset
 import Prelude hiding ((>>))
 
-import qualified Data.IntMap as IM
-
 -- | Morph states for «morphism»
 -- Morph is a map from Poset to Poset
 --
-type Morph = IM.IntMap Int
-
--- | Build Morph from list
---
-fromList ∷ [(Int,Int)] → Morph
-fromList = IM.fromList
-
--- | Build Morph from permutation
---
-fromPerm ∷ [Int] → Morph
-fromPerm = fromList . zip [1..]
+data Morph α = Morph [(α,α)]
 
--- | Show Morph as a list
---
-toList ∷ Morph → [(Int,Int)]
-toList = IM.toList
-
--- | Show Morph as a permutation
---
-toPerm ∷ Morph → [Int]
-toPerm = map snd . toList
 
 -- | Apply Morph to Poset element
 --
 infixr 7 >>
 
-(>>) ∷ Morph → Int → Int
-m >> a = m IM.! a
+(>>) ∷ Eq α ⇒ Morph α → α → α
+(Morph m) >> a = head $ map snd $ filter ((== a) . fst) m
 
 -- | Check for isotone property
 -- a ρ b ⇒ Morph(a) ρ Morph(b)
 --
-isotone ∷ Poset → Morph → Bool
+isotone ∷ Eq α ⇒ Poset α → Morph α → Bool
 isotone (Poset es ρ) m = and
   [ (m >> a) `ρ` (m >> b) | a ← es, b ← es, a `ρ` b ]
 
 -- | Check for reducibility
 -- Morph(a) ρ a
 --
-reducible ∷ Poset → Morph → Bool
+reducible ∷ Eq α ⇒ Poset α → Morph α → Bool
 reducible (Poset es ρ) m = and
   [ (m >> a) `ρ` a | a ← es ]
 
 -- | Check for idempotency
 -- Morph ∘ Morph ≡ Morph
 --
-idempotent ∷ Poset → Morph → Bool
+idempotent ∷ Eq α ⇒ Poset α → Morph α → Bool
 idempotent (Poset es _) m = and
   [ (m >> m >> a) == (m >> a) | a ← es ]
 
 -- | Check for fixity
 -- b ≡ Morph(b) AND a ρ b ⇒ a ≡ Morph(a)
 --
-fixed ∷ Poset → Morph → Bool
+fixed ∷ Eq α ⇒ Poset α → Morph α → Bool
 fixed (Poset es ρ) m = and
   [ a == (m >> a) | b ← es, b == (m >> b), a ← es, a `ρ` b ]
 
@@ -73,15 +51,10 @@ fixed (Poset es ρ) m = and
 -- - idempotency;
 -- - fixity;
 --
-nice ∷ Poset → Morph → Bool
+nice ∷ Eq α ⇒ Poset α → Morph α → Bool
 nice p m = and
   [ isotone p m
   , reducible p m
   , idempotent p m
   , fixed p m
   ]
-
--- | Generate all possible Morphs over n-size set
---
-generate ∷ Int → [Morph]
-generate n = map fromPerm $ replicateM n [1..n]

src/Data/Semilattice.hs → src/Data/Poset/Semilattice.hs

@@ -1,12 +1,12 @@
 {-# LANGUAGE UnicodeSyntax #-}
-module Data.Semilattice where
+module Data.Poset.Semilattice where
 
 import Data.Maybe (isJust)
 
 import Data.Poset
 
 -- | Semilattice is a Poset if infimum for every two elements exists
 --
-isSemilattice ∷ Poset → Bool
+isSemilattice ∷ Eq α ⇒ Poset α → Bool
 isSemilattice p@(Poset es _) = and
   [ isJust $ infimum' p a b | a ← es, b ← es ]