7220N/A{- |

7220N/AModule : $Header$

7220N/ADescription : injective maps

7220N/ACopyright : (c) Uni Bremen 2006

7220N/ALicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt

7220N/A

7220N/AMaintainer : Christian.Maeder@dfki.de

7220N/AStability : provisional

7220N/APortability : portable

7220N/A

7220N/AInjective maps

7220N/A-}

7220N/A

7220N/Amodule Common.InjMap

7220N/A ( InjMap

7220N/A , unsafeConstructInjMap

7220N/A , getAToB

7220N/A , getBToA

7220N/A , empty

7220N/A , member

7220N/A , insert

7220N/A , delete

7220N/A , deleteA

7220N/A , deleteB

7220N/A , lookupWithA

7220N/A , lookupWithB

7220N/A , updateBWithA

7220N/A , updateAWithB

7220N/A ) where

7220N/A

7220N/Aimport qualified Data.Map as Map

7220N/A

7220N/A-- | the data type of injective maps

7220N/Adata InjMap a b = InjMap

7220N/A { getAToB :: Map.Map a b -- ^ the actual injective map

7220N/A , getBToA :: Map.Map b a -- ^ the inverse map

7220N/A } deriving (Show, Eq, Ord)

7220N/A

7220N/A-- | for serialization only

7220N/AunsafeConstructInjMap :: Map.Map a b -> Map.Map b a -> InjMap a b

7220N/AunsafeConstructInjMap = InjMap

7220N/A

7220N/A-- * the visible interface

7220N/A

7220N/A-- | get an empty injective map

7220N/Aempty :: InjMap a b

7220N/Aempty = InjMap Map.empty Map.empty

7220N/A

7220N/A{- | insert a pair into the given injective map. An existing key and the

7220N/Acorresponding content will be overridden. -}

7220N/Ainsert :: (Ord a, Ord b) => a -> b -> InjMap a b -> InjMap a b

7220N/Ainsert a b i = let InjMap m n = delete a b i in

7220N/A InjMap (Map.insert a b m) (Map.insert b a n)

7220N/A

7220N/A{- | delete the pair with the given key in the injective

7220N/Amap. Possibly two pairs may be deleted if the pair is not a member. -}

7220N/Adelete :: (Ord a, Ord b) => a -> b -> InjMap a b -> InjMap a b

7220N/Adelete a b (InjMap m n) =

InjMap (Map.delete (Map.findWithDefault a b n) $ Map.delete a m)

(Map.delete (Map.findWithDefault b a m) $ Map.delete b n)

-- | delete domain entry

deleteA :: (Ord a, Ord b) => a -> InjMap a b -> InjMap a b

deleteA a i@(InjMap m n) = case Map.lookup a m of

Just b -> case Map.lookup b n of

Just e -> if e == a then InjMap (Map.delete a m) $ Map.delete b n

else error "InjMap.deleteA1"

Nothing -> error "InjMap.deleteA2"

Nothing -> i

-- | delete codomain entry

deleteB :: (Ord a, Ord b) => b -> InjMap a b -> InjMap a b

deleteB b = transpose . deleteA b . transpose

-- | check membership of an injective pair

member :: (Ord a, Ord b) => a -> b -> InjMap a b -> Bool

member a b (InjMap m n) = case (Map.lookup a m, Map.lookup b n) of

(Just x, Just y) | x == b && y == a -> True

_ -> False

-- | transpose to avoid duplicate code

transpose :: InjMap a b -> InjMap b a

transpose (InjMap m n) = InjMap n m

-- | look up the content at domain

lookupWithA :: (Ord a, Ord b) => a -> InjMap a b -> Maybe b

lookupWithA a (InjMap m n) = case Map.lookup a m of

Just b -> case Map.lookup b n of

Just e -> if e == a then Just b

else error "InjMap.lookupWith1"

Nothing -> error "InjMap.lookupWith2"

Nothing -> Nothing

-- the errors indicate that the injectivity is destroyed

-- | look up the content at codomain

lookupWithB :: (Ord a, Ord b) => b -> InjMap a b -> Maybe a

lookupWithB y = lookupWithA y . transpose

-- | update codomain at domain value that must be defined

updateBWithA:: (Ord a, Ord b) => a -> b -> InjMap a b -> InjMap a b

updateBWithA a b m = case lookupWithA a m of

Nothing -> error "InjMap.updateBWithA"

_ -> insert a b m

-- | update domain at codomain value that must be defined

updateAWithB :: (Ord a, Ord b) => b -> a -> InjMap a b -> InjMap a b

updateAWithB b newA = transpose . updateBWithA b newA . transpose