Data/Poset/Internal.hs

   1 {-
   2  - Copyright (C) 2009 Nick Bowler.
   3  -
   4  - License BSD2:  2-clause BSD license.  See LICENSE for full terms.
   5  - This is free software: you are free to change and redistribute it.
   6  - There is NO WARRANTY, to the extent permitted by law.
   7  -}
   8
   9 {-# LANGUAGE FlexibleInstances, OverlappingInstances, UndecidableInstances #-}
  10 module Data.Poset.Internal where
  11
  12 import qualified Data.List as List
  13 import qualified Prelude
  14 import Prelude hiding (Ordering(..), Ord(..))
  15
  16 import Data.Monoid
  17
  18 data Ordering = LT | EQ | GT | NC
  19     deriving (Eq, Show, Read, Bounded, Enum)
  20
  21 -- Lexicographic ordering.
  22 instance Monoid Ordering where
  23     mempty = EQ
  24     mappend EQ x = x
  25     mappend NC _ = NC
  26     mappend LT _ = LT
  27     mappend GT _ = GT
  28
  29 -- | Internal-use function to convert our Ordering to the ordinary one.
  30 totalOrder :: Ordering -> Prelude.Ordering
  31 totalOrder LT = Prelude.LT
  32 totalOrder EQ = Prelude.EQ
  33 totalOrder GT = Prelude.GT
  34 totalOrder NC = error "Uncomparable elements in total order."
  35
  36 -- | Internal-use function to convert the ordinary Ordering to ours.
  37 partialOrder :: Prelude.Ordering -> Ordering
  38 partialOrder Prelude.LT = LT
  39 partialOrder Prelude.EQ = EQ
  40 partialOrder Prelude.GT = GT
  41
  42 -- | Class for partially ordered data types.  Instances should satisfy the
  43 -- following laws for all values a, b and c:
  44 --
  45 -- * @a <= a@.
  46 --
  47 -- * @a <= b@ and @b <= a@ implies @a == b@.
  48 --
  49 -- * @a <= b@ and @b <= c@ implies @a <= c@.
  50 --
  51 -- But note that the floating point instances don't satisfy the first rule.
  52 --
  53 -- Minimal complete definition: 'compare' or '<='.
  54 class Eq a => Poset a where
  55     compare :: a -> a -> Ordering
  56     -- | Is comparable to.
  57     (<==>)  :: a -> a -> Bool
  58     -- | Is not comparable to.
  59     (</=>)  :: a -> a -> Bool
  60     (<)     :: a -> a -> Bool
  61     (<=)    :: a -> a -> Bool
  62     (>=)    :: a -> a -> Bool
  63     (>)     :: a -> a -> Bool
  64
  65     a `compare` b
  66         | a == b = EQ
  67         | a <= b = LT
  68         | b <= a = GT
  69         | otherwise = NC
  70
  71     a <    b = a `compare` b == LT
  72     a >    b = a `compare` b == GT
  73     a <==> b = a `compare` b /= NC
  74     a </=> b = a `compare` b == NC
  75     a <=   b = a < b || a `compare` b == EQ
  76     a >=   b = a > b || a `compare` b == EQ
  77
  78 -- | Class for partially ordered data types where sorting makes sense.
  79 -- This includes all totally ordered sets and floating point types.  Instances
  80 -- should satisfy the following laws:
  81 --
  82 -- * The set of elements for which 'isOrdered' returns true is totally ordered.
  83 --
  84 -- * The max (or min) of an insignificant element and a significant element
  85 -- is the significant one.
  86 --
  87 -- * The result of sorting a list should contain only significant elements.
  88 --
  89 -- * @max a b@ = @max b a@
  90 --
  91 -- * @min a b@ = @min b a@
  92 --
  93 -- The idea comes from floating point types, where non-comparable elements
  94 -- (NaNs) are the exception rather than the rule.  For these types, we can
  95 -- define 'max', 'min' and 'sortBy' to ignore insignificant elements.  Thus, a
  96 -- sort of floating point values will discard all NaNs and order the remaining
  97 -- elements.
  98 --
  99 -- Minimal complete definition: 'isOrdered'
 100 class Poset a => Sortable a where
 101     sortBy :: (a -> a -> Ordering) -> [a] -> [a]
 102     isOrdered :: a -> Bool
 103     max :: a -> a -> a
 104     min :: a -> a -> a
 105
 106     sortBy f = List.sortBy ((totalOrder .) . f) . filter isOrdered
 107     max a b = case a `compare` b of
 108         LT -> b
 109         EQ -> a
 110         GT -> a
 111         NC -> if isOrdered a then a else if isOrdered b then b else a
 112     min a b = case a `compare` b of
 113         LT -> a
 114         EQ -> b
 115         GT -> b
 116         NC -> if isOrdered a then a else if isOrdered b then b else a
 117
 118 -- | Class for totally ordered data types.  Instances should satisfy
 119 -- @isOrdered a = True@ for all @a@.
 120 class Sortable a => Ord a
 121
 122 -- This hack allows us to leverage existing data structures defined in terms
 123 -- of 'Prelude.Ord'.
 124 instance Data.Poset.Internal.Ord a => Prelude.Ord a where
 125     compare = (totalOrder .) . compare
 126     (<)     = (<)
 127     (<=)    = (<=)
 128     (>=)    = (>=)
 129     (>)     = (>)
 130     min     = min
 131     max     = max