Partial.hs revision e6d40133bc9f858308654afb1262b8b483ec5922
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly{- |
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'ReillyModule : $Header$
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'ReillyDescription : support for partial orders
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'ReillyCopyright : (c) Keith Wansbrough 200 and Uni Bremen 2005
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'ReillyLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'ReillyMaintainer : maeder@tzi.de
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'ReillyStability : provisional
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'ReillyPortability : portable
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'ReillySupport for partial orders
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly-}
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reillymodule Common.Partial where
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly-- | the partial order relation type
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reillytype POrder a = a -> a -> Maybe Ordering
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly-- Ord a implies a total order
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'ReillytotalOrder :: Ord a => POrder a
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'ReillytotalOrder x y = Just (compare x y)
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly-- | split a list of elements into equivalence classes
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'ReillyequivBy :: POrder a -> [a] -> [[a]]
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'ReillyequivBy order l = equiv0 [] l
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly where equiv0 cs [] = cs
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly equiv0 cs (x:xs) = equiv0 (add x cs) xs
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly add x [] = [[x]]
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly add _ ([] : _) = error "Partial.equivBy"
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly add x (c@(y:_):cs) = case order x y of
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly Just EQ -> (x:c) : cs
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly _ -> c : add x cs
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly-- | split a set into the minimal elements and the remaining elements
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'ReillyminimalBy :: POrder a -> [a] -> ([a],[a])
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'ReillyminimalBy order es = go es [] []
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly where go (x:xs) ms rs = if any (\ e -> order x e == Just GT) es
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly then go xs ms (x:rs)
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly else go xs (x:ms) rs
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly go [] ms rs = (reverse ms, reverse rs)
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly-- | split a set into ranks of elements, minimal first
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'ReillyrankBy :: POrder a -> [a] -> [[a]]
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'ReillyrankBy order l = case l of
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly [] -> []
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly _ -> let (xs,ys) = minimalBy order l
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly in xs : rankBy order ys
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly-- | A partial-ordering class.
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reillyclass Partial a where
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly pCmp :: POrder a
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly pCmp a b = if a <=? b then
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly if b <=? a then Just EQ else Just LT
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly else if b <=? a then Just GT else Nothing
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly (<=?) :: a -> a -> Bool
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly a <=? b = case pCmp a b of
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly Just o -> o <= EQ
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly _ -> False
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reillyequiv :: Partial a => [a] -> [[a]]
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reillyequiv = equivBy pCmp
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reillyminimal :: Partial a => [a] -> ([a],[a])
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reillyminimal = minimalBy pCmp
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reillyrank :: Partial a => [a] -> [[a]]
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reillyrank = rankBy pCmp
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly{- undecidable
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reillyinstance Ord a => Partial a where
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly pCmp = totalOrder
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly-}
059e541d741fa3faa3a2e4cf81fc7627a87ce3b7Liam O'Reilly