Data/Poset/Internal.hs

   1 {-
   2  - Copyright (C) 2009-2010 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 infixl 4 <,<=,>=,>,<==>,</=>
  79
  80 -- | Class for partially ordered data types where sorting makes sense.
  81 -- This includes all totally ordered sets and floating point types.  Instances
  82 -- should satisfy the following laws:
  83 --
  84 -- * The set of elements for which 'isOrdered' returns true is totally ordered.
  85 --
  86 -- * The max (or min) of an insignificant element and a significant element
  87 -- is the significant one.
  88 --
  89 -- * The result of sorting a list should contain only significant elements.
  90 --
  91 -- * @max a b@ = @max b a@
  92 --
  93 -- * @min a b@ = @min b a@
  94 --
  95 -- The idea comes from floating point types, where non-comparable elements
  96 -- (NaNs) are the exception rather than the rule.  For these types, we can
  97 -- define 'max', 'min' and 'sortBy' to ignore insignificant elements.  Thus, a
  98 -- sort of floating point values will discard all NaNs and order the remaining
  99 -- elements.
 100 --
 101 -- Minimal complete definition: 'isOrdered'
 102 class Poset a => Sortable a where
 103     sortBy :: (a -> a -> Ordering) -> [a] -> [a]
 104     isOrdered :: a -> Bool
 105     max :: a -> a -> a
 106     min :: a -> a -> a
 107
 108     sortBy f = List.sortBy ((totalOrder .) . f) . filter isOrdered
 109     max a b = case a `compare` b of
 110         LT -> b
 111         EQ -> a
 112         GT -> a
 113         NC -> if isOrdered a then a else if isOrdered b then b else a
 114     min a b = case a `compare` b of
 115         LT -> a
 116         EQ -> b
 117         GT -> b
 118         NC -> if isOrdered a then a else if isOrdered b then b else a
 119
 120 -- | Class for totally ordered data types.  Instances should satisfy
 121 -- @isOrdered a = True@ for all @a@.
 122 class Sortable a => Ord a
 123
 124 -- This hack allows us to leverage existing data structures defined in terms
 125 -- of 'Prelude.Ord'.
 126 instance Data.Poset.Internal.Ord a => Prelude.Ord a where
 127     compare = (totalOrder .) . compare
 128     (<)     = (<)
 129     (<=)    = (<=)
 130     (>=)    = (>=)
 131     (>)     = (>)
 132     min     = min
 133     max     = max