# Subsumption in partially ordered sets

Graham Klyne gk at ninebynine.org
Mon Nov 17 10:10:30 EST 2003

```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 ]
]
]]

```