diff --git a/Data/Bimap.hs b/Data/Bimap.hs --- a/Data/Bimap.hs +++ b/Data/Bimap.hs @@ -54,6 +54,8 @@ -- * Conversion\/traversal fromList, fromAList, + fromAscPairList, + fromAscPairListUnchecked, toList, toAscList, toAscListR, @@ -282,6 +284,46 @@ toList :: Bimap a b -> [(a, b)] toList = toAscList +{-| /O(n)/. Build a bimap from a list of pairs, where both the @fst@ +and @snd@ halves of the list are in strictly ascending order. + +This precondition is checked; an invalid list will cause an error. + +/Version: 0.2.3/-} +fromAscPairList :: (Ord a, Ord b) + => [(a, b)] -> Bimap a b +fromAscPairList xs + | isBiAscending xs = fromAscPairListUnchecked xs + | otherwise = error + "Data.Bimap.fromAscPairList: list not correctly ascending" + +isBiAscending :: (Ord a, Ord b) + => [(a, b)] -> Bool +isBiAscending = allAdjacent bothLess + where + -- True if the binary relation f is true for all adjacent pairs + -- in the input list + allAdjacent :: (c -> c -> Bool) -> [c] -> Bool + allAdjacent f xs = all (uncurry f) $ zip xs (tail xs) + -- True if both components of the first pair are strictly less + -- than their counterparts in the second pair + bothLess (x1, y1) (x2, y2) = (x1 < x2) && (y1 < y2) + +{-| /O(n)/. Build a bimap from a list of pairs, where both the @fst@ +and @snd@ halves of the list are in strictly ascending order. + +This precondition is /not/ checked; an invalid list will produce a +malformed bimap. + +/Version: 0.2.3/-} +fromAscPairListUnchecked :: (Ord a, Ord b) + => [(a, b)] -> Bimap a b +fromAscPairListUnchecked xs = MkBimap + (M.fromAscList xs) + (M.fromAscList $ map swap xs) + where + swap (x, y) = (y, x) + {-| /O(n)/. Convert to a list of associated pairs, with the left-hand values in ascending order. @@ -340,7 +382,8 @@ {-| /O(n*log n)/. Test if the internal bimap structure is valid. This should be true -for any bimap created using the public interface. +for any bimap created using the public interface, unless +'fromAscPairListUnchecked' has been used inappropriately. /Version: 0.2/-} valid :: (Ord a, Ord b) => Bimap a b -> Bool diff --git a/HISTORY b/HISTORY --- a/HISTORY +++ b/HISTORY @@ -1,3 +1,9 @@ +Version 0.2.3 (1 Jul 2008) + + * added fromAscPairList and fromAscPairListUnchecked + (thanks to Janis Voigtländer) + * more tests for min/max functions (thanks to Jochem Berndsen) + Version 0.2.2 (18 Jun 2008) * added min/max functions (thanks to Jochem Berndsen) diff --git a/Test/Tests.hs b/Test/Tests.hs --- a/Test/Tests.hs +++ b/Test/Tests.hs @@ -1,7 +1,9 @@ module Test.Tests where +import Data.List (sort) import Prelude hiding (null, lookup) import Test.QuickCheck +import Test.QuickCheck.Batch import Data.Bimap @@ -43,6 +45,27 @@ where _ = xs :: [(Int, Integer)] +-- a monotone bimap can be reconstituted via fromAscPairList +prop_fromAscPairList_reconstitute xs = and + [ (not . isBottom) bi' + , valid bi' + , (bi == bi') + ] + where + xs' = zip (sort $ map fst xs) (sort $ map snd xs) + bi :: Bimap Int Integer + bi = fromList xs' + bi' = fromAscPairList . toAscList $ bi + +-- fromAscPairList will never produce an invalid bimap +prop_fromAscPairList_check xs = or + [ isBottom bi + , valid bi + ] + where + bi :: Bimap Int Integer + bi = fromAscPairList xs + -- if a pair is a member of the bimap, then both elements are present -- and associated with each other prop_pairMember bi k v = @@ -149,37 +172,43 @@ swap (x, y) = (y, x) +-- deleteFindMin and deleteMin agree prop_deleteMin_is_delete bi = not (null bi) ==> - snd (deleteFindMin bi) `equals` deleteMin bi + snd (deleteFindMin bi) == deleteMin bi where _ = bi :: Bimap Int Integer - x `equals` y = toList x == toList y +-- deleteFindMin and findMin agree prop_deleteMin_is_find bi = not (null bi) ==> fst (deleteFindMin bi) == findMin bi where _ = bi :: Bimap Int Integer +-- elements removed by deleteFindMin are no longer in the bimap prop_deleteMin_deletes bi = not (null bi) ==> fst (deleteFindMin bi) `pairNotMember` snd (deleteFindMin bi) where _ = bi :: Bimap Int Integer +-- findMin finds a member of the map prop_findMin_member bi = not (null bi) ==> findMin bi `pairMember` bi where _ = bi :: Bimap Int Integer - + +-- the minimum of a singleton bimap is its contents prop_singleton_is_findMin x y = findMin bi == (x, y) where bi :: Bimap Int Integer bi = singleton x y +-- deleting the minimum of a singleton leaves it empty prop_singleton_deleteMin_empty x y = null (deleteMin bi) where bi :: Bimap Int Integer bi = singleton x y +-- the minimum of a bimap is <= all other elements prop_findMin_is_minimal bi = all (\ (a, _) -> a >= x) lst where lst = toList bi @@ -222,13 +251,10 @@ _ = bi :: Bimap Int Integer y = fst . findMinR $ bi - - prop_deleteMax_is_delete bi = not (null bi) ==> - snd (deleteFindMax bi) `equals` deleteMax bi + snd (deleteFindMax bi) == deleteMax bi where _ = bi :: Bimap Int Integer - x `equals` y = toList x == toList y prop_deleteMax_is_find bi = not (null bi) ==> fst (deleteFindMax bi) == findMax bi @@ -296,4 +322,44 @@ lst = toList bi _ = bi :: Bimap Int Integer y = fst . findMaxR $ bi + +prop_deleteMin_is_valid bi = not (null bi) ==> + valid (deleteMin bi) + where + _ = bi :: Bimap Int Integer + +prop_deleteFindMin_is_valid bi = not (null bi) ==> + valid (snd $ deleteFindMin bi) + where + _ = bi :: Bimap Int Integer + +prop_deleteMinR_is_valid bi = not (null bi) ==> + valid (deleteMinR bi) + where + _ = bi :: Bimap Int Integer + +prop_deleteFindMinR_is_valid bi = not (null bi) ==> + valid (snd $ deleteFindMinR bi) + where + _ = bi :: Bimap Int Integer + +prop_deleteMax_is_valid bi = not (null bi) ==> + valid (deleteMax bi) + where + _ = bi :: Bimap Int Integer + +prop_deleteFindMax_is_valid bi = not (null bi) ==> + valid (snd $ deleteFindMax bi) + where + _ = bi :: Bimap Int Integer + +prop_deleteMaxR_is_valid bi = not (null bi) ==> + valid (deleteMaxR bi) + where + _ = bi :: Bimap Int Integer + +prop_deleteFindMaxR_is_valid bi = not (null bi) ==> + valid (snd $ deleteFindMaxR bi) + where + _ = bi :: Bimap Int Integer diff --git a/bimap.cabal b/bimap.cabal --- a/bimap.cabal +++ b/bimap.cabal @@ -1,6 +1,6 @@ cabal-version: >= 1.2.3.0 name: bimap -version: 0.2.2 +version: 0.2.3 synopsis: Bidirectional mapping between two key types description: A data structure representing a bidirectional mapping between two @@ -10,7 +10,7 @@ license: BSD3 license-file: LICENSE copyright: Stuart Cook and contributors 2008 -author: Stuart Cook +author: Stuart Cook and contributors 2008 maintainer: scook0@gmail.com homepage: http://code.haskell.org/bimap -- This build-type is a lie, but we're only using hooks to specify