885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose{- |

885386b7e3f1c3e74b354576b98a092b0835d64eSumit BoseModule : $Header$

885386b7e3f1c3e74b354576b98a092b0835d64eSumit BoseDescription : Handling of tree-like partial ordering relations

885386b7e3f1c3e74b354576b98a092b0835d64eSumit BoseCopyright : (c) Ewaryst Schulz, DFKI Bremen 2010

885386b7e3f1c3e74b354576b98a092b0835d64eSumit BoseLicense : GPLv2 or higher, see LICENSE.txt

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit BoseMaintainer : ewaryst.schulz@dfki.de

885386b7e3f1c3e74b354576b98a092b0835d64eSumit BoseStability : experimental

885386b7e3f1c3e74b354576b98a092b0835d64eSumit BosePortability : portable

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit BoseThis module defines a basic datatype for tree-like partial orderings such as

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Boseencountered, e.g., in the set lattice.

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose -}

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bosemodule CSL.TreePO

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose{- ( Incomparable (..)

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose , SetOrdering (..)

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose , SetOrInterval (..)

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose , swapCompare

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose , swapCmp

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose , combineCmp

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose ) -}

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose where

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Boseimport qualified Data.Set as Set

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose-- ----------------------------------------------------------------------

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose-- * Datatypes for comparison

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose-- ----------------------------------------------------------------------

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bosedata Incomparable = Disjoint | Overlap deriving (Eq, Show)

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bosedata SetOrdering = Comparable Ordering | Incomparable Incomparable deriving Eq

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Boseinstance Show SetOrdering where

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose show (Comparable LT) = "<"

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose show (Comparable GT) = ">"

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose show (Comparable EQ) = "="

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose show (Incomparable x) = show x

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose{- | We represent Intervals with opened or closed end points over a linearly

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose ordered type 'a' as closed intervals over the type '(a, InfDev)', for

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose infinitesimal deviation.

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose - '(x, EpsLeft)' means an epsilon to the left of x

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose - '(x, Zero)' means x

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose - '(x, EpsRight)' means an epsilon to the right of x

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose We have EpsLeft < Zero < EpsRight and the ordering of 'a' lifts to the

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose lexicographical ordering of '(a, InfDev)' which captures well our intended

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose meaning.

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose We inject the type 'a' into the type '(a, InfDev)'

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose by mapping 'x' to '(x, Zero)'.

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose The mapping of intrvals is as follows:

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose A left opened interval starting at x becomes a left closed interval starting

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose at '(x, EpsRight)'.

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose We have:

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose 'forall y > x. (y, _) > (x, EpsRight)', hence in particular

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose '(y, Zero) > (x, EpsRight)'

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose but also

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose '(x, Zero) < (x, EpsRight)'

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose Analogously we represent a right opened one ending at y as a closed one

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose ending at '(x, EpsLeft)'.

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose-}

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bosedata InfDev = EpsLeft | Zero | EpsRight deriving (Eq, Show)

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Boseinstance Ord InfDev where

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose compare x y

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose | x == y = EQ

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose | otherwise =

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose case (x, y) of

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose (EpsLeft, _) -> LT

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose (EpsRight, _) -> GT

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose _ -> swapCompare $ compare y x

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bosenewtype CIType a = CIType (a, InfDev) deriving (Eq, Show)

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose-- | This type with the given ordering is to represent opened/closed intervals

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose-- over 'a' as closed intervals over '(a, InfDev)'

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Boseinstance Ord a => Ord (CIType a) where

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose compare (CIType (x, a)) (CIType (y, b)) =

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose case compare x y of

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose EQ -> compare a b

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose res -> res

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose-- | A finite set or an interval. True = closed, False = opened interval border.

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bosedata SetOrInterval a = Set (Set.Set a)

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose | IntVal (a, Bool) (a, Bool)

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose deriving (Eq, Ord, Show)

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose-- | A closed interval

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bosedata ClosedInterval a = ClosedInterval a a deriving (Eq, Ord, Show)

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose-- | Infinite integers = integers augmented by -Infty and +Infty

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bosedata InfInt = PosInf | NegInf | FinInt Integer deriving (Show, Eq)

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Boseinstance Ord InfInt where

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose compare x y

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose | x == y = EQ

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose | otherwise =

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose case (x, y) of

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose (NegInf, _) -> LT

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose (PosInf, _) -> GT

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose (FinInt a, FinInt b) -> compare a b

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose _ -> swapCompare $ compare y x

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Boseclass Continuous a

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Boseclass Discrete a where

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose nextA :: a -> a

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose prevA :: a -> a

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose intsizeA :: a -> a -> Maybe Integer

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Boseinstance Discrete InfInt where

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose nextA (FinInt a) = FinInt $ a+1

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose nextA x = x

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose prevA (FinInt a) = FinInt $ a-1

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose prevA x = x

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose intsizeA (FinInt a) (FinInt b) = Just $ (1+) $ abs $ b-a

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose intsizeA _ _ = Nothing

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose-- ----------------------------------------------------------------------

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose-- * Comparison facility for sets

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose-- ----------------------------------------------------------------------

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose-- | Compares closed intervals [l1, r1] and [l2, r2]. Assumes

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose-- | non-singular intervals, i.e., l1 < r1 and l2 < r2.

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose-- | Works only for linearly ordered types.

885386b7e3f1c3e74b354576b98a092b0835d64eSumit BosecmpClosedInts :: Ord a => ClosedInterval a -- ^ [l1, r1]

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose -> ClosedInterval a -- ^ [l2, r2]

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose -> SetOrdering

885386b7e3f1c3e74b354576b98a092b0835d64eSumit BosecmpClosedInts (ClosedInterval l1 r1) (ClosedInterval l2 r2)

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose | l1 == l2 && r1 == r2 = Comparable EQ

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose | l1 <= l2 && r1 >= r2 = Comparable GT

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose | l1 >= l2 && r1 <= r2 = Comparable LT

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose | r1 < l2 || r2 < l1 = Incomparable Disjoint

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose | otherwise = Incomparable Overlap

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose-- ----------------------------------------------------------------------

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose-- ** Comparison for discrete types

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose-- ----------------------------------------------------------------------

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose-- | Membership in 'SetOrInterval'

885386b7e3f1c3e74b354576b98a092b0835d64eSumit BosemembSoID :: (Discrete a, Ord a) => a -> SetOrInterval a -> Bool

885386b7e3f1c3e74b354576b98a092b0835d64eSumit BosemembSoID x (Set s) = Set.member x s

885386b7e3f1c3e74b354576b98a092b0835d64eSumit BosemembSoID x i = let ClosedInterval a b = setToClosedIntD i in x >= a && x <= b

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose-- | Checks if the set is empty.

885386b7e3f1c3e74b354576b98a092b0835d64eSumit BosenullSoID :: (Discrete a, Ord a) => SetOrInterval a -> Bool

885386b7e3f1c3e74b354576b98a092b0835d64eSumit BosenullSoID (Set s) = Set.null s

885386b7e3f1c3e74b354576b98a092b0835d64eSumit BosenullSoID i = let ClosedInterval a b = setToClosedIntD i in a > b

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose-- | If the set is singular, i.e., consists only from one point, then we

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose-- return this point. Reports error on empty SoI's.

885386b7e3f1c3e74b354576b98a092b0835d64eSumit BosetoSingularD :: (Discrete a, Ord a) => SetOrInterval a -> Maybe a

885386b7e3f1c3e74b354576b98a092b0835d64eSumit BosetoSingularD d

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose | nullSoID d = error "toSingularD: empty set"

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose | otherwise =

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose case d of

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose Set s

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose | Set.size s == 1 -> Just $ Set.findMin s

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose | otherwise -> Nothing

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose _ -> let ClosedInterval a b = setToClosedIntD d

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose in if a == b then Just a else Nothing

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose-- | Transforms a 'SetOrInterval' to a closed representation

885386b7e3f1c3e74b354576b98a092b0835d64eSumit BosesetToClosedIntD :: (Discrete a, Ord a) => SetOrInterval a -> ClosedInterval a

885386b7e3f1c3e74b354576b98a092b0835d64eSumit BosesetToClosedIntD (Set s) = ClosedInterval (Set.findMin s) $ Set.findMax s

885386b7e3f1c3e74b354576b98a092b0835d64eSumit BosesetToClosedIntD (IntVal (l, bL) (r, bR)) =

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose ClosedInterval (if bL then l else nextA l) $ if bR then r else prevA r

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose

885386b7e3f1c3e74b354576b98a092b0835d64eSumit Bose-- | Compare sets over discrete types

cmpSoIsD :: (Discrete a, Ord a) =>

SetOrInterval a -> SetOrInterval a -> SetOrdering

cmpSoIsD d1 d2 =

case (toSingularD d1, toSingularD d2) of

(Just x1, Just x2)

| x1 == x2 -> Comparable EQ

| otherwise -> Incomparable Disjoint

(Just x, _)

| membSoID x d2 -> Comparable LT

| otherwise -> Incomparable Disjoint

(_, Just x)

| membSoID x d1 -> Comparable GT

| otherwise -> Incomparable Disjoint

_ -> cmpSoIsExD d1 d2 -- singular cases are dispelled here

-- | Compare sets helper function which only works on regular (non-singular)

-- sets

cmpSoIsExD :: (Discrete a, Ord a) =>

SetOrInterval a -> SetOrInterval a -> SetOrdering

cmpSoIsExD i1@(IntVal _ _) i2@(IntVal _ _) =

cmpClosedInts (setToClosedIntD i1) $ setToClosedIntD i2

cmpSoIsExD s1@(Set _) s2@(Set _) = cmpSoIsEx s1 s2

cmpSoIsExD i1@(IntVal _ _) s2@(Set s) =

let ci2@(ClosedInterval a2 b2) = setToClosedIntD s2

in case cmpClosedInts (setToClosedIntD i1) ci2 of

Comparable EQ -> case intsizeA a2 b2 of

Just dst

| fromIntegral (Set.size s) == dst ->

Comparable EQ

| otherwise -> Comparable GT

-- Nothing means infinite. This is a misuse!

_ -> error "cmpSoIsExD: unbounded finite set!"

Comparable LT -> if any (flip membSoID i1) $ Set.toList s

then Incomparable Overlap

else Incomparable Disjoint

so -> so

cmpSoIsExD s1 i2 = swapCmp $ cmpSoIsExD i2 s1

-- ----------------------------------------------------------------------

-- ** Comparison for continuous types

-- ----------------------------------------------------------------------

-- | Membership in 'SetOrInterval'

membSoI :: Ord a => a -> SetOrInterval a -> Bool

membSoI x (Set s) = Set.member x s

membSoI x i = let ClosedInterval a b = setToClosedInt i

x' = CIType (x, Zero) in x' >= a && x' <= b

-- | Checks if the set is empty.

-- Only for continuous types.

nullSoI :: (Continuous a, Ord a) => SetOrInterval a -> Bool

nullSoI (Set s) = Set.null s

nullSoI (IntVal (a, bA) (b, bB)) = a == b && not (bA && bB)

-- | If the set is singular, i.e., consists only from one point, then we

-- return this point. Reports error on empty SoI's.

-- Only for continuous types.

toSingular :: (Continuous a, Ord a) => SetOrInterval a -> Maybe a

toSingular d

| nullSoI d = error "toSingular: empty set"

| otherwise =

case d of

Set s

| Set.size s == 1 -> Just $ Set.findMin s

| otherwise -> Nothing

IntVal (a, _) (b, _)

| a == b -> Just a

| otherwise -> Nothing

-- | Transforms a 'SetOrInterval' to a closed representation

-- Only for continuous types.

setToClosedInt :: Ord a =>

SetOrInterval a -> ClosedInterval (CIType a)

setToClosedInt (Set s) = ClosedInterval (CIType (Set.findMin s, Zero))

$ CIType (Set.findMax s, Zero)

setToClosedInt (IntVal (l, bL) (r, bR)) =

ClosedInterval (CIType (l, if bL then Zero else EpsRight))

$ CIType (r, if bR then Zero else EpsLeft)

-- | Compare sets over continuous types

cmpSoIs :: (Continuous a, Ord a) =>

SetOrInterval a -> SetOrInterval a -> SetOrdering

cmpSoIs d1 d2 =

case (toSingular d1, toSingular d2) of

(Just x1, Just x2)

| x1 == x2 -> Comparable EQ

| otherwise -> Incomparable Disjoint

(Just x, _)

| membSoI x d2 -> Comparable LT

| otherwise -> Incomparable Disjoint

(_, Just x)

| membSoI x d1 -> Comparable GT

| otherwise -> Incomparable Disjoint

_ -> cmpSoIsEx d1 d2 -- singular cases are dispelled here

-- | Compare sets helper function which only works on regular (non-singular)

-- sets

cmpSoIsEx :: (Ord a) => SetOrInterval a -> SetOrInterval a -> SetOrdering

cmpSoIsEx (Set s1) (Set s2)

| s1 == s2 = Comparable EQ

| s1 `Set.isSubsetOf` s2 = Comparable LT

| s2 `Set.isSubsetOf` s1 = Comparable GT

| Set.null $ Set.intersection s1 s2 = Incomparable Disjoint

| otherwise = Incomparable Overlap

cmpSoIsEx i1@(IntVal _ _) i2@(IntVal _ _) =

cmpClosedInts (setToClosedInt i1) $ setToClosedInt i2

cmpSoIsEx i1@(IntVal _ _) s2@(Set s) =

case cmpClosedInts (setToClosedInt i1) $ setToClosedInt s2 of

Comparable EQ -> Comparable GT

Comparable LT -> if any (flip membSoI i1) $ Set.toList s

then Incomparable Overlap

else Incomparable Disjoint

so -> so

cmpSoIsEx s1 i2 = swapCmp $ cmpSoIsEx i2 s1

-- ----------------------------------------------------------------------

-- * Combining comparison results

-- ----------------------------------------------------------------------

swapCompare :: Ordering -> Ordering

swapCompare GT = LT

swapCompare LT = GT

swapCompare x = x

swapCmp :: SetOrdering -> SetOrdering

swapCmp (Comparable x) = Comparable $ swapCompare x

swapCmp x = x

{- | We combine the comparison outcome of the individual parameters with

the following (symmetrical => commutative) table:

> \ | > < = O D

> -------------

> > | > O > O D

> < | < < O D

> = | = O D

> O | O D

> D | D

>

> , where

>

> > | < | = | O | D

> ---------------------------------------------

> RightOf | LeftOf | Equal | Overlap | Disjoint

The purpose of this table is to use it for cartesian products as follows

Let

A', A'' \subset A

B', B'' \subset B

In order to get the comparison result for A' x B' and A'' x B'' we compare

A' and A'' as well as B' and B'' and combine the results with the above table.

Note that for empty sets the comparable results <,>,= are preferred over the

disjoint result.

-}

combineCmp :: SetOrdering -> SetOrdering -> SetOrdering

combineCmp x y

| x == y = x -- idempotence

| otherwise =

case (x, y) of

(_, Incomparable Disjoint) -> Incomparable Disjoint

(Incomparable Overlap, _) -> Incomparable Overlap

(Comparable EQ, _) -> y -- neutral element

(Comparable GT, Comparable LT) -> Incomparable Overlap

_ -> combineCmp y x -- commutative (should capture all cases)