8733d12c944d57a250b466973f2271b491ba98f4cmaeder{-# LANGUAGE DeriveDataTypeable #-}
dee396d567b71629f09f7e0692396afff732e33bChristian Maeder{- |
e9458b1a7a19a63aa4c179f9ab20f4d50681c168Jens ElknerModule : ./Common/InjMap.hs
e6d40133bc9f858308654afb1262b8b483ec5922Till MossakowskiDescription : injective maps
dee396d567b71629f09f7e0692396afff732e33bChristian MaederCopyright : (c) Uni Bremen 2006
98890889ffb2e8f6f722b00e265a211f13b5a861Corneliu-Claudiu ProdescuLicense : GPLv2 or higher, see LICENSE.txt
dee396d567b71629f09f7e0692396afff732e33bChristian Maeder
3f69b6948966979163bdfe8331c38833d5d90ecdChristian MaederMaintainer : Christian.Maeder@dfki.de
dee396d567b71629f09f7e0692396afff732e33bChristian MaederStability : provisional
dee396d567b71629f09f7e0692396afff732e33bChristian MaederPortability : portable
dee396d567b71629f09f7e0692396afff732e33bChristian Maeder
e6d40133bc9f858308654afb1262b8b483ec5922Till MossakowskiInjective maps
dee396d567b71629f09f7e0692396afff732e33bChristian Maeder-}
0f54077ce2753086afc4025f6d282fd66a7a04adChristian Maeder
dee396d567b71629f09f7e0692396afff732e33bChristian Maedermodule Common.InjMap
0f54077ce2753086afc4025f6d282fd66a7a04adChristian Maeder ( InjMap
b91b82fd2625c349da6284f252cf4c50a6519650Christian Maeder , unsafeConstructInjMap
b91b82fd2625c349da6284f252cf4c50a6519650Christian Maeder , getAToB
b91b82fd2625c349da6284f252cf4c50a6519650Christian Maeder , getBToA
0f54077ce2753086afc4025f6d282fd66a7a04adChristian Maeder , empty
0f54077ce2753086afc4025f6d282fd66a7a04adChristian Maeder , member
0f54077ce2753086afc4025f6d282fd66a7a04adChristian Maeder , insert
0f54077ce2753086afc4025f6d282fd66a7a04adChristian Maeder , delete
b91b82fd2625c349da6284f252cf4c50a6519650Christian Maeder , deleteA
b91b82fd2625c349da6284f252cf4c50a6519650Christian Maeder , deleteB
0f54077ce2753086afc4025f6d282fd66a7a04adChristian Maeder , lookupWithA
0f54077ce2753086afc4025f6d282fd66a7a04adChristian Maeder , lookupWithB
6a9b85953df4e29a996536ffc7dbf7ef9dbc64c7Cui Jian , updateBWithA
6a9b85953df4e29a996536ffc7dbf7ef9dbc64c7Cui Jian , updateAWithB
0f54077ce2753086afc4025f6d282fd66a7a04adChristian Maeder ) where
dee396d567b71629f09f7e0692396afff732e33bChristian Maeder
8733d12c944d57a250b466973f2271b491ba98f4cmaederimport Data.Data
ad270004874ce1d0697fb30d7309f180553bb315Christian Maederimport qualified Data.Map as Map
dee396d567b71629f09f7e0692396afff732e33bChristian Maeder
0f54077ce2753086afc4025f6d282fd66a7a04adChristian Maeder-- | the data type of injective maps
0f54077ce2753086afc4025f6d282fd66a7a04adChristian Maederdata InjMap a b = InjMap
b91b82fd2625c349da6284f252cf4c50a6519650Christian Maeder { getAToB :: Map.Map a b -- ^ the actual injective map
b91b82fd2625c349da6284f252cf4c50a6519650Christian Maeder , getBToA :: Map.Map b a -- ^ the inverse map
8733d12c944d57a250b466973f2271b491ba98f4cmaeder } deriving (Show, Eq, Ord, Typeable, Data)
72ab63869f1e2ade586af4acb9218b46ab25ea9bCui Jian
b91b82fd2625c349da6284f252cf4c50a6519650Christian Maeder-- | for serialization only
74d9a385499bf903b24848dff450a153f525bda7Christian MaederunsafeConstructInjMap :: Map.Map a b -> Map.Map b a -> InjMap a b
b91b82fd2625c349da6284f252cf4c50a6519650Christian MaederunsafeConstructInjMap = InjMap
b91b82fd2625c349da6284f252cf4c50a6519650Christian Maeder
0f54077ce2753086afc4025f6d282fd66a7a04adChristian Maeder-- * the visible interface
3bd08499449d7a250c1e297c59f52555d20c5dc2Cui Jian
0f54077ce2753086afc4025f6d282fd66a7a04adChristian Maeder-- | get an empty injective map
72ab63869f1e2ade586af4acb9218b46ab25ea9bCui Jianempty :: InjMap a b
72ab63869f1e2ade586af4acb9218b46ab25ea9bCui Jianempty = InjMap Map.empty Map.empty
dee396d567b71629f09f7e0692396afff732e33bChristian Maeder
0f54077ce2753086afc4025f6d282fd66a7a04adChristian Maeder{- | insert a pair into the given injective map. An existing key and the
0f54077ce2753086afc4025f6d282fd66a7a04adChristian Maedercorresponding content will be overridden. -}
e389bfa263e2f58f594903f092731fb18f8a5392Christian Maederinsert :: (Ord a, Ord b) => a -> b -> InjMap a b -> InjMap a b
c614d41379feab88fe8298e068aa590420c4a018Christian Maederinsert a b i = let InjMap m n = delete a b i in
c614d41379feab88fe8298e068aa590420c4a018Christian Maeder InjMap (Map.insert a b m) (Map.insert b a n)
72ab63869f1e2ade586af4acb9218b46ab25ea9bCui Jian
0f54077ce2753086afc4025f6d282fd66a7a04adChristian Maeder{- | delete the pair with the given key in the injective
0f54077ce2753086afc4025f6d282fd66a7a04adChristian Maedermap. Possibly two pairs may be deleted if the pair is not a member. -}
72ab63869f1e2ade586af4acb9218b46ab25ea9bCui Jiandelete :: (Ord a, Ord b) => a -> b -> InjMap a b -> InjMap a b
ef4bd99a054aac95f1bc9191e9972baa2d4e6faaChristian Maederdelete a b (InjMap m n) =
ef4bd99a054aac95f1bc9191e9972baa2d4e6faaChristian Maeder InjMap (Map.delete (Map.findWithDefault a b n) $ Map.delete a m)
ef4bd99a054aac95f1bc9191e9972baa2d4e6faaChristian Maeder (Map.delete (Map.findWithDefault b a m) $ Map.delete b n)
dee396d567b71629f09f7e0692396afff732e33bChristian Maeder
b91b82fd2625c349da6284f252cf4c50a6519650Christian Maeder-- | delete domain entry
b91b82fd2625c349da6284f252cf4c50a6519650Christian MaederdeleteA :: (Ord a, Ord b) => a -> InjMap a b -> InjMap a b
b91b82fd2625c349da6284f252cf4c50a6519650Christian MaederdeleteA a i@(InjMap m n) = case Map.lookup a m of
b91b82fd2625c349da6284f252cf4c50a6519650Christian Maeder Just b -> case Map.lookup b n of
b91b82fd2625c349da6284f252cf4c50a6519650Christian Maeder Just e -> if e == a then InjMap (Map.delete a m) $ Map.delete b n
b91b82fd2625c349da6284f252cf4c50a6519650Christian Maeder else error "InjMap.deleteA1"
b91b82fd2625c349da6284f252cf4c50a6519650Christian Maeder Nothing -> error "InjMap.deleteA2"
b91b82fd2625c349da6284f252cf4c50a6519650Christian Maeder Nothing -> i
b91b82fd2625c349da6284f252cf4c50a6519650Christian Maeder
b91b82fd2625c349da6284f252cf4c50a6519650Christian Maeder-- | delete codomain entry
b91b82fd2625c349da6284f252cf4c50a6519650Christian MaederdeleteB :: (Ord a, Ord b) => b -> InjMap a b -> InjMap a b
b91b82fd2625c349da6284f252cf4c50a6519650Christian MaederdeleteB b = transpose . deleteA b . transpose
b91b82fd2625c349da6284f252cf4c50a6519650Christian Maeder
0f54077ce2753086afc4025f6d282fd66a7a04adChristian Maeder-- | check membership of an injective pair
0f54077ce2753086afc4025f6d282fd66a7a04adChristian Maedermember :: (Ord a, Ord b) => a -> b -> InjMap a b -> Bool
0f54077ce2753086afc4025f6d282fd66a7a04adChristian Maedermember a b (InjMap m n) = case (Map.lookup a m, Map.lookup b n) of
ef4bd99a054aac95f1bc9191e9972baa2d4e6faaChristian Maeder (Just x, Just y) | x == b && y == a -> True
ef4bd99a054aac95f1bc9191e9972baa2d4e6faaChristian Maeder _ -> False
dee396d567b71629f09f7e0692396afff732e33bChristian Maeder
c614d41379feab88fe8298e068aa590420c4a018Christian Maeder-- | transpose to avoid duplicate code
c614d41379feab88fe8298e068aa590420c4a018Christian Maedertranspose :: InjMap a b -> InjMap b a
c614d41379feab88fe8298e068aa590420c4a018Christian Maedertranspose (InjMap m n) = InjMap n m
c614d41379feab88fe8298e068aa590420c4a018Christian Maeder
b91b82fd2625c349da6284f252cf4c50a6519650Christian Maeder-- | look up the content at domain
72ab63869f1e2ade586af4acb9218b46ab25ea9bCui JianlookupWithA :: (Ord a, Ord b) => a -> InjMap a b -> Maybe b
b91b82fd2625c349da6284f252cf4c50a6519650Christian MaederlookupWithA a (InjMap m n) = case Map.lookup a m of
b91b82fd2625c349da6284f252cf4c50a6519650Christian Maeder Just b -> case Map.lookup b n of
b91b82fd2625c349da6284f252cf4c50a6519650Christian Maeder Just e -> if e == a then Just b
c614d41379feab88fe8298e068aa590420c4a018Christian Maeder else error "InjMap.lookupWith1"
c614d41379feab88fe8298e068aa590420c4a018Christian Maeder Nothing -> error "InjMap.lookupWith2"
0f54077ce2753086afc4025f6d282fd66a7a04adChristian Maeder Nothing -> Nothing
b91b82fd2625c349da6284f252cf4c50a6519650Christian Maeder-- the errors indicate that the injectivity is destroyed
72ab63869f1e2ade586af4acb9218b46ab25ea9bCui Jian
b91b82fd2625c349da6284f252cf4c50a6519650Christian Maeder-- | look up the content at codomain
0f54077ce2753086afc4025f6d282fd66a7a04adChristian MaederlookupWithB :: (Ord a, Ord b) => b -> InjMap a b -> Maybe a
c614d41379feab88fe8298e068aa590420c4a018Christian MaederlookupWithB y = lookupWithA y . transpose
6a9b85953df4e29a996536ffc7dbf7ef9dbc64c7Cui Jian
b91b82fd2625c349da6284f252cf4c50a6519650Christian Maeder-- | update codomain at domain value that must be defined
9029484754c7b2037321e7cbd077580866845265Christian MaederupdateBWithA :: (Ord a, Ord b) => a -> b -> InjMap a b -> InjMap a b
b91b82fd2625c349da6284f252cf4c50a6519650Christian MaederupdateBWithA a b m = case lookupWithA a m of
b91b82fd2625c349da6284f252cf4c50a6519650Christian Maeder Nothing -> error "InjMap.updateBWithA"
b91b82fd2625c349da6284f252cf4c50a6519650Christian Maeder _ -> insert a b m
6a9b85953df4e29a996536ffc7dbf7ef9dbc64c7Cui Jian
b91b82fd2625c349da6284f252cf4c50a6519650Christian Maeder-- | update domain at codomain value that must be defined
9029484754c7b2037321e7cbd077580866845265Christian MaederupdateAWithB :: (Ord a, Ord b) => b -> a -> InjMap a b -> InjMap a b
b91b82fd2625c349da6284f252cf4c50a6519650Christian MaederupdateAWithB b newA = transpose . updateBWithA b newA . transpose