Subsumption in partially ordered sets

[Graham Klyne]

I have a need for an algorithm to perform "subsumption" on partially 
ordered sets of values.  That is, given a selection of values from a 
partially ordered set, remove all values from the collection that are less 
than some other member of the collection.

Below is some code I have written, which works, but I'm not sure that it's 
especially efficient or elegant.  Are there any published Haskell libraries 
that contain something like this?

#g
--

(The implementation here is based on values of type (Eq a) => [Maybe a], 
where the partial ordering is defined by function 'pcompare'.  Function 
dropSubsumed (and helpers) is the subsumption calculation.  testds1, 
testds2, testds3, testds4, testds5 are test cases, and all should be True.)

[[
-- Type for result of partial order comparison (PNR is no-relationship)
data PartOrdering = PLT | PEQ | PGT | PNR deriving (Eq, Show)

--  Drop tuples from the supplied list that are subsumed by
--  more specific ones.
--
dropSubsumed :: (Eq a) => [[Maybe a]] -> [[Maybe a]]
dropSubsumed []      = []
dropSubsumed [a]     = [a]
dropSubsumed (a1:as) = dropSubsumed1 a1 as

dropSubsumed1 a1 []       = [a1]
dropSubsumed1 a1 (a2:a2s) = case pcompare a1 a2 of
     PEQ -> dropSubsumed1 a1 a2s
     PGT -> dropSubsumed1 a1 a2s
     PLT -> dropSubsumed1 a2 a2s
     PNR -> dropSubsumed2 [] a1 $ dropSubsumed1 a2 a2s

--  Merge new head element into list from which subsumed elements
--  have already been removed.  The extra (first) parameter is used
--  to construct a result in which the order of remaining elements
--  is preserved with respect to the original list.
dropSubsumed2 a1s a []          = a : revConcat a1s []
dropSubsumed2 a1s a ar@(a2:a2s) = case pcompare a a2 of
     PEQ -> a : revConcat a1s a2s
     PGT -> a : revConcat a1s a2s
     PLT -> revConcat a1s ar
     PNR -> dropSubsumed2 (a2:a1s) a a2s

revConcat :: [a] -> [a] -> [a]
revConcat [] a2s = a2s
revConcat (a1:a1s) a2s = revConcat a1s (a1:a2s)

--  Perform subsumption calculation between a pair of tuples
--  A tuple with more information subsumes a one with less but
--  consistent information.
--
pcompare :: (Eq a) => [Maybe a] -> [Maybe a] -> PartOrdering
pcompare a1s a2s = pcompare1 a1s a2s PEQ
pcompare1 []            []            po = po
pcompare1 (Just _:a1s)  (Nothing:a2s) po =
     if (po == PEQ) || (po==PGT) then pcompare1 a1s a2s PGT else PNR
pcompare1 (Nothing:a1s) (Just _:a2s)  po =
     if (po == PEQ) || (po==PLT) then pcompare1 a1s a2s PLT else PNR
pcompare1 (a1:a1s)     (a2:a2s)       po =
     if a1 == a2 then pcompare1 a1s a2s po else PNR
pcompare1 _            _              _  = PNR

testds1 = ds1a == ds1b
ds1a = dropSubsumed
     [ [Just 'a',Just 'b',Just 'c']
     , [Just 'a',Just 'b',Nothing ]
     , [Just 'a',Nothing ,Just 'c']
     , [Just 'a',Nothing ,Nothing ]
     , [Nothing ,Just 'b',Just 'c']
     , [Nothing ,Just 'b',Nothing ]
     , [Nothing ,Nothing ,Just 'c']
     , [Nothing ,Nothing ,Nothing ]
     ]
ds1b =
     [ [Just 'a',Just 'b',Just 'c']
     ]

testds2 = ds2a == ds2b
ds2a = dropSubsumed
     [ [Just 'a',Just 'b',Nothing ]
     , [Just 'a',Nothing ,Just 'c']
     , [Just 'a',Nothing ,Nothing ]
     , [Nothing ,Just 'b',Just 'c']
     , [Nothing ,Just 'b',Nothing ]
     , [Nothing ,Nothing ,Just 'c']
     , [Nothing ,Nothing ,Nothing ]
     ]
ds2b =
     [ [Just 'a',Just 'b',Nothing ]
     , [Just 'a',Nothing ,Just 'c']
     , [Nothing ,Just 'b',Just 'c']
     ]

testds3 = ds3a == ds3b
ds3a = dropSubsumed
     [ [Just "a1",Just "b1",Just "c1"]
     , [Just "a2",Just "b2",Nothing  ]
     , [Just "a3",Nothing  ,Just "c3"]
     , [Just "a4",Nothing  ,Nothing  ]
     , [Nothing  ,Just "b5",Just "c5"]
     , [Nothing  ,Just "b6",Nothing  ]
     , [Nothing  ,Nothing  ,Just "c7"]
     , [Nothing  ,Nothing  ,Nothing  ]
     ]
ds3b =
     [ [Just "a1",Just "b1",Just "c1"]
     , [Just "a2",Just "b2",Nothing  ]
     , [Just "a3",Nothing  ,Just "c3"]
     , [Just "a4",Nothing  ,Nothing  ]
     , [Nothing  ,Just "b5",Just "c5"]
     , [Nothing  ,Just "b6",Nothing  ]
     , [Nothing  ,Nothing  ,Just "c7"]
     ]

testds4 = ds4a == ds4b
ds4a = dropSubsumed
     [ [Just 1, Just 1 ]
     , [Just 2, Nothing]
     , [Nothing,Just 3 ]
     , [Nothing,Nothing]
     ]
ds4b =
     [ [Just 1, Just 1 ]
     , [Just 2, Nothing]
     , [Nothing,Just 3 ]
     ]

-- Check handling of equal values
testds5 = ds5a == ds5b
ds5a = dropSubsumed
     [ [Just 1, Just 1 ]
     , [Just 2, Nothing]
     , [Nothing,Just 3 ]
     , [Nothing,Nothing]
     , [Just 1, Just 1 ]
     , [Just 2, Nothing]
     , [Nothing,Just 3 ]
     ]
ds5b =
     [ [Just 1, Just 1 ]
     , [Just 2, Nothing]
     , [Nothing,Just 3 ]
     ]
]]