[[
I've taken the suggestions made by Tom and Robert and combined them into a new module with some supporting functions and test cases. A copy is attached, in case it's of use to anyone.
]]
I've tightened the maxima function code in response to a comment from Tom, and added some more partial-ordering comparison primitives. Updated code is attached:
-- $Id: PartOrderedCollection.hs,v 1.4 2003/11/20 18:35:59 graham Exp $
(I just had a session trying to use the sourceforge CVS, but I can't find out how to get my combination of WinCVS and SSH tunnelling working.)
#g
------------ Graham Klyne For email: http://www.ninebynine.org/#Contact
-------------------------------------------------------------------------------- -- $Id: PartOrderedCollection.hs,v 1.4 2003/11/20 18:35:59 graham Exp $ -- -- Copyright (c) 2003, G. KLYNE. All rights reserved. -- See end of this file for licence information. -------------------------------------------------------------------------------- -- | -- Module : PartOrderedCollection -- Copyright : (c) 2003, Graham Klyne -- License : GPL V2 -- -- Maintainer : Graham Klyne -- Stability : provisional -- Portability : H98 -- -- This module provides methods to support operations on partially ordered -- collections. The partial ordering relationship is represented by -- Maybe Ordering. -- -- Thanks to members of the haskell-cafe mailing list: -- Robert <[EMAIL PROTECTED]> -- Tom Pledger <[EMAIL PROTECTED]> -- who suggested key ideas on which some of the code in this module is based. -- --------------------------------------------------------------------------------
module PartOrderedCollection ( PartCompare , minima, maxima , partCompareEq, partCompareOrd, partComparePair , partCompareListPartOrd, partCompareListOrd , partCompareMaybe, partCompareListMaybe , partCompareListSubset ) where import Maybe ( Maybe(..) ) ------------------------------------------------------------ -- Type of partial compare function ------------------------------------------------------------ type PartCompare a = a -> a -> Maybe Ordering ------------------------------------------------------------ -- Functions for minima and maxima of a part-ordered list ------------------------------------------------------------ -- |This function finds the maxima in a list of partially -- ordered values, preserving the sequence of retained -- values from the supplied list. -- -- It returns all those values in the supplied list -- for which there is no larger element in the list. -- maxima :: PartCompare a -> [a] -> [a] maxima cmp as = foldl add [] as where add [] e = [e] add ms@(m:mr) e = case cmp m e of Nothing -> m:(add mr e) Just GT -> ms Just EQ -> ms Just LT -> add mr e -- |This function finds the minima in a list of partially -- ordered values, preserving the sequence of retained -- values from the supplied list. -- -- It returns all those values in the supplied list -- for which there is no smaller element in the list. -- minima :: PartCompare a -> [a] -> [a] minima cmp = maxima (flip cmp) ------------------------------------------------------------ -- Partial ordering comparison functions ------------------------------------------------------------ -- |Partial ordering for Eq values partCompareEq :: (Eq a) => a -> a -> Maybe Ordering partCompareEq a1 a2 = if a1 == a2 then Just EQ else Nothing -- |Partial ordering for Ord values partCompareOrd :: (Ord a) => a -> a -> Maybe Ordering partCompareOrd a1 a2 = Just $ compare a1 a2 -- |Part-ordering comparison on pairs of values, -- where each has a part-ordering relationship partComparePair :: (a->a->Maybe Ordering) -> (b->b->Maybe Ordering) -> (a,b) -> (a,b) -> Maybe Ordering partComparePair cmpa cmpb (a1,b1) (a2,b2) = case (cmpa a1 a2,cmpb b1 b2) of (_,Nothing) -> Nothing (jc1,Just EQ) -> jc1 (Nothing,_) -> Nothing (Just EQ,jc2) -> jc2 (Just c1,Just c2) -> if c1 == c2 then Just c1 else Nothing -- |Part-ordering comparison on lists of partially ordered values, where: -- -- as==bs if members of as are all equal to corresponding members of bs -- as<=bs if members of as are all less than or equal to corresponding -- members of bs -- as>=bs if members of as are all greater than or equal to corresponding -- members of bs -- otherwise as and bs are unrelated -- partCompareListPartOrd :: PartCompare a -> [a] -> [a] -> Maybe Ordering partCompareListPartOrd cmp as bs = pcomp as bs EQ where pcomp [] [] ordp = Just ordp pcomp (a:as) (b:bs) ordp = case cmp a b of Just rel -> pcomp1 as bs rel ordp otherwise -> Nothing pcomp1 as bs ordn EQ = pcomp as bs ordn pcomp1 as bs EQ ordp = pcomp as bs ordp pcomp1 as bs ordn ordp = if ordn == ordp then pcomp as bs ordp else Nothing -- |Part-ordering comparison on lists of Ord values, where: -- -- as==bs if members of as are all equal to corresponding members of bs -- as<=bs if members of as are all less than or equal to corresponding -- members of bs -- as>=bs if members of as are all greater than or equal to corresponding -- members of bs -- otherwise as and bs are unrelated -- partCompareListOrd :: (Ord a) => [a] -> [a] -> Maybe Ordering partCompareListOrd = partCompareListPartOrd (Just `c2` compare) where c2 = (.) . (.) -- |Part-ordering comparison for Maybe values. partCompareMaybe :: (Eq a) => Maybe a -> Maybe a -> Maybe Ordering partCompareMaybe Nothing Nothing = Just EQ partCompareMaybe (Just _) Nothing = Just GT partCompareMaybe Nothing (Just _) = Just LT partCompareMaybe (Just a) (Just b) = if a == b then Just EQ else Nothing -- |Part-ordering comparison on lists of Maybe values. partCompareListMaybe :: (Eq a) => [Maybe a] -> [Maybe a] -> Maybe Ordering partCompareListMaybe = partCompareListPartOrd partCompareMaybe -- |Part-ordering comparison on lists based on subset relationship partCompareListSubset :: (Eq a) => [a] -> [a] -> Maybe Ordering partCompareListSubset a b | aeqvb = Just EQ | asubb = Just LT | bsuba = Just GT | otherwise = Nothing where asubb = a `subset` b bsuba = b `subset` a aeqvb = asubb && bsuba a `subset` b = and [ ma `elem` b | ma <- a ] ------------------------------------------------------------ -- Test cases ------------------------------------------------------------ {- notTrueFalse = Nothing :: Maybe Bool -- partCompareListOrd test01 = partCompareListOrd [1,2,3] [1,2,3] == Just EQ test02 = partCompareListOrd [1,2,3] [2,3,4] == Just LT test03 = partCompareListOrd [1,2,4] [1,2,3] == Just GT test04 = partCompareListOrd [1,2,3] [2,1,3] == Nothing -- partCompareMaybe test11 = partCompareMaybe (Just True) (Just True) == Just EQ test12 = partCompareMaybe (Just True) (Just False) == Nothing test13 = partCompareMaybe notTrueFalse (Just False) == Just LT test14 = partCompareMaybe (Just True) notTrueFalse == Just GT test15 = partCompareMaybe notTrueFalse notTrueFalse == Just EQ -- partCompareListMaybe test21 = partCompareListMaybe [Just True,Just False] [Just True,Just False] == Just EQ test22 = partCompareListMaybe [Just True,Just False] [Just True,Just True] == Nothing test23 = partCompareListMaybe [Just False,Just True] [Just False,Just True] == Just EQ test24 = partCompareListMaybe [Nothing, Just True] [Just False,Just True] == Just LT test25 = partCompareListMaybe [Just False,Just True] [Just False,Nothing] == Just GT test26 = partCompareListMaybe [Nothing, Just True] [Just False,Nothing] == Nothing test27 = partCompareListMaybe [Nothing,Just True] [Nothing,Nothing] == Just GT test28 = partCompareListMaybe [notTrueFalse,notTrueFalse] [notTrueFalse,notTrueFalse] == Just EQ -- minima, maxima test31a = maxima partCompareListMaybe ds1a == ds1b test31b = minima partCompareListMaybe ds1a == ds1c ds1a = [ [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'] ] ds1c = [ [Nothing ,Nothing ,Nothing ] ] test32a = maxima partCompareListMaybe ds2a == ds2b test32b = minima partCompareListMaybe ds2a == ds2c ds2a = [ [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'] ] ds2b = [ [Just 'a',Just 'b',Nothing ] , [Just 'a',Nothing ,Just 'c'] , [Nothing ,Just 'b',Just 'c'] ] ds2c = [ [Just 'a',Nothing ,Nothing ] , [Nothing ,Just 'b',Nothing ] , [Nothing ,Nothing ,Just 'c'] ] test33a = maxima partCompareListMaybe ds3a == ds3b test33b = minima partCompareListMaybe ds3a == ds3c ds3a = [ [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"] ] 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"] ] ds3c = [ [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"] ] test34a = maxima partCompareListMaybe ds4a == ds4b test34b = minima partCompareListMaybe ds4a == ds4c ds4a = [ [Just 1, Just 1 ] , [Just 2, Nothing] , [Nothing,Just 3 ] , [Nothing,Nothing] ] ds4b = [ [Just 1, Just 1 ] , [Just 2, Nothing] , [Nothing,Just 3 ] ] ds4c = [ [Nothing,Nothing] ] -- Check handling of equal values test35a = maxima partCompareListMaybe ds5a == ds5b test35b = minima partCompareListMaybe ds5a == ds5c ds5a = [ [Just 1, Just 1 ] , [Just 2, Nothing] , [Nothing,Just 3 ] , [Nothing,Nothing] , [Just 1, Just 1 ] , [Just 2, Nothing] , [Nothing,Just 3 ] , [Nothing,Nothing] ] ds5b = [ [Just 1, Just 1 ] , [Just 2, Nothing] , [Nothing,Just 3 ] ] ds5c = [ [Nothing,Nothing] ] -- test case 32 with different ordering of values test36a = maxima partCompareListMaybe ds6a == ds6b test36b = minima partCompareListMaybe ds6a == ds6c ds6a = [ [Just 'a',Just 'b',Nothing ] , [Nothing ,Nothing ,Just 'c'] , [Nothing ,Just 'b',Nothing ] , [Nothing ,Just 'b',Just 'c'] , [Just 'a',Nothing ,Nothing ] , [Just 'a',Nothing ,Just 'c'] ] ds6b = [ [Just 'a',Just 'b',Nothing ] , [Nothing ,Just 'b',Just 'c'] , [Just 'a',Nothing ,Just 'c'] ] ds6c = [ [Nothing ,Nothing ,Just 'c'] , [Nothing ,Just 'b',Nothing ] , [Just 'a',Nothing ,Nothing ] ] test = and [ test01, test02, test03, test04 , test11, test12, test13, test14, test15 , test21, test22, test23, test24, test25, test26, test27, test28 , test31a, test31b, test32a, test32b, test33a, test33b , test34a, test34b, test35a, test35b, test36a, test36b ] -} -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, G. KLYNE. All rights reserved. -- -- This file is part of Swish. -- -- Swish is free software; you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation; either version 2 of the License, or -- (at your option) any later version. -- -- Swish is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with Swish; if not, write to: -- The Free Software Foundation, Inc., -- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -- -------------------------------------------------------------------------------- -- $Source: /file/cvsdev/HaskellRDF/PartOrderedCollection.hs,v $ -- $Author: graham $ -- $Revision: 1.4 $ -- $Log: PartOrderedCollection.hs,v $ -- Revision 1.4 2003/11/20 18:35:59 graham -- Compacted maxima code by use of foldl -- (per further suggestion by Tom Pledger). -- -- Revision 1.3 2003/11/20 17:58:09 graham -- Class-constraint backward chaining: all test cases passed. -- -- Revision 1.2 2003/11/19 22:13:03 graham -- Some backward chaining tests passed -- -- Revision 1.1 2003/11/19 15:21:26 graham -- Add PartOrderedCollection module --
_______________________________________________ Haskell-Cafe mailing list [EMAIL PROTECTED] http://www.haskell.org/mailman/listinfo/haskell-cafe