{- |
Module      :  ./Common/Partial.hs
Description :  support for partial orders
Copyright   :  (c) Keith Wansbrough 200 and Uni Bremen 2005
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  Christian.Maeder@dfki.de
Stability   :  provisional
Portability :  portable

Support for partial orders

-}

module Common.Partial where

-- | the partial order relation type
type POrder a = a -> a -> Maybe Ordering

-- Ord a implies a total order
totalOrder :: Ord a => POrder a
totalOrder :: POrder a
totalOrder x :: a
x = Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just (Ordering -> Maybe Ordering)
-> (a -> Ordering) -> a -> Maybe Ordering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x

-- | split a list of elements into equivalence classes
equivBy :: POrder a -> [a] -> [[a]]
equivBy :: POrder a -> [a] -> [[a]]
equivBy order :: POrder a
order = [[a]] -> [a] -> [[a]]
equiv0 [] where
  equiv0 :: [[a]] -> [a] -> [[a]]
equiv0 = ([[a]] -> a -> [[a]]) -> [[a]] -> [a] -> [[a]]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [[a]] -> a -> [[a]]
add
  add :: [[a]] -> a -> [[a]]
add cs :: [[a]]
cs x :: a
x = case [[a]]
cs of
    [] -> [[a
x]]
    [] : _ -> [Char] -> [[a]]
forall a. HasCallStack => [Char] -> a
error "Partial.equivBy"
    c :: [a]
c@(y :: a
y : _) : r :: [[a]]
r -> case POrder a
order a
x a
y of
      Just EQ -> (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
c) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
r
      _ -> [a]
c [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]] -> a -> [[a]]
add [[a]]
r a
x

-- | split a set into the minimal elements and the remaining elements
minimalBy :: POrder a -> [a] -> ([a], [a])
minimalBy :: POrder a -> [a] -> ([a], [a])
minimalBy order :: POrder a
order es :: [a]
es = [a] -> [a] -> [a] -> ([a], [a])
go [a]
es [] [] where
  go :: [a] -> [a] -> [a] -> ([a], [a])
go l :: [a]
l ms :: [a]
ms rs :: [a]
rs = case [a]
l of
    [] -> ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
ms, [a] -> [a]
forall a. [a] -> [a]
reverse [a]
rs)
    x :: a
x : xs :: [a]
xs ->
      if (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\ e :: a
e -> POrder a
order a
x a
e Maybe Ordering -> Maybe Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just Ordering
GT) [a]
es
      then [a] -> [a] -> [a] -> ([a], [a])
go [a]
xs [a]
ms (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
rs)
      else [a] -> [a] -> [a] -> ([a], [a])
go [a]
xs (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ms) [a]
rs


-- | split a set into ranks of elements, minimal first
rankBy :: POrder a -> [a] -> [[a]]
rankBy :: POrder a -> [a] -> [[a]]
rankBy order :: POrder a
order l :: [a]
l = case [a]
l of
    [] -> []
    _ -> let (xs :: [a]
xs, ys :: [a]
ys) = POrder a -> [a] -> ([a], [a])
forall a. POrder a -> [a] -> ([a], [a])
minimalBy POrder a
order [a]
l in
      [a]
xs [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: POrder a -> [a] -> [[a]]
forall a. POrder a -> [a] -> [[a]]
rankBy POrder a
order [a]
ys

-- | A partial-ordering class.
class Partial a where
  pCmp :: POrder a
  pCmp a :: a
a b :: a
b | a
a a -> a -> Bool
forall a. Partial a => a -> a -> Bool
<=? a
b = Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just (Ordering -> Maybe Ordering) -> Ordering -> Maybe Ordering
forall a b. (a -> b) -> a -> b
$ if a
b a -> a -> Bool
forall a. Partial a => a -> a -> Bool
<=? a
a then Ordering
EQ else Ordering
LT
           | a
b a -> a -> Bool
forall a. Partial a => a -> a -> Bool
<=? a
a = Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just Ordering
GT
           | Bool
otherwise = Maybe Ordering
forall a. Maybe a
Nothing
  (<=?) :: a -> a -> Bool
  a :: a
a <=? b :: a
b = case POrder a
forall a. Partial a => POrder a
pCmp a
a a
b of
    Just o :: Ordering
o -> Ordering
o Ordering -> Ordering -> Bool
forall a. Ord a => a -> a -> Bool
<= Ordering
EQ
    _ -> Bool
False

equiv :: Partial a => [a] -> [[a]]
equiv :: [a] -> [[a]]
equiv = POrder a -> [a] -> [[a]]
forall a. POrder a -> [a] -> [[a]]
equivBy POrder a
forall a. Partial a => POrder a
pCmp

minimal :: Partial a => [a] -> ([a], [a])
minimal :: [a] -> ([a], [a])
minimal = POrder a -> [a] -> ([a], [a])
forall a. POrder a -> [a] -> ([a], [a])
minimalBy POrder a
forall a. Partial a => POrder a
pCmp

rank :: Partial a => [a] -> [[a]]
rank :: [a] -> [[a]]
rank = POrder a -> [a] -> [[a]]
forall a. POrder a -> [a] -> [[a]]
rankBy POrder a
forall a. Partial a => POrder a
pCmp

{- undecidable
instance Ord a => Partial a where
  pCmp = totalOrder
-}