{- | 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 -}