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 a2srevConcat :: [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 _ _ _ = PNRtestds1 = 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 ]
]
]]_______________________________________________ Haskell-Cafe mailing list [EMAIL PROTECTED] http://www.haskell.org/mailman/listinfo/haskell-cafe
