Morphism.hs revision 19e01e1a7e319063434bd86c8ecbc5f241ef9993
8267b99c0d7a187abe6f87ad50530dc08f5d1cdcAndy GimblettModule : $Header$
e071fb22ea9923a2a4ff41184d80ca46b55ee932Till MossakowskiDescription : OWL Morphisms
020cdb5dad6b871aba61136a0e1567c00426de87Andy GimblettCopyright : (c) Dominik Luecke, 2008, Felix Gabriel Mance, 2011
020cdb5dad6b871aba61136a0e1567c00426de87Andy GimblettLicense : GPLv2 or higher, see LICENSE.txt
020cdb5dad6b871aba61136a0e1567c00426de87Andy GimblettMaintainer : f.mance@jacobs-university.de
020cdb5dad6b871aba61136a0e1567c00426de87Andy GimblettStability : provisional
020cdb5dad6b871aba61136a0e1567c00426de87Andy GimblettPortability : portable
020cdb5dad6b871aba61136a0e1567c00426de87Andy GimblettMorphisms for OWL
61051521e4d82769a47f23aecb5fb477de47d534Andy Gimblettimport Common.Utils (composeMap)
61051521e4d82769a47f23aecb5fb477de47d534Andy Gimblettimport Common.Lib.State (execState)
567db7182e691cce5816365d8c912d09ffe92f86Andy Gimblettimport Common.Lib.MapSet (setToMap)
1c7c4d95775a8ad5f7373e5cf0bad86f8301c56cAndy Gimblettimport qualified Data.Map as Map
1c7c4d95775a8ad5f7373e5cf0bad86f8301c56cAndy Gimblettimport qualified Data.Set as Set
05b3e12808da901dccd665715cb934462290d550Andy Gimblettdata OWLMorphism = OWLMorphism
05b3e12808da901dccd665715cb934462290d550Andy Gimblett { osource :: Sign
c052e3ee4a53ee3a2da829aa142fd596ef6c9e3dAndy Gimblett , otarget :: Sign
1c7c4d95775a8ad5f7373e5cf0bad86f8301c56cAndy Gimblett , mmaps :: MorphMap
1c7c4d95775a8ad5f7373e5cf0bad86f8301c56cAndy Gimblett , pmap :: StringMap
1c7c4d95775a8ad5f7373e5cf0bad86f8301c56cAndy Gimblett } deriving (Show, Eq, Ord)
1c7c4d95775a8ad5f7373e5cf0bad86f8301c56cAndy GimblettinclOWLMorphism :: Sign -> Sign -> OWLMorphism
1c7c4d95775a8ad5f7373e5cf0bad86f8301c56cAndy GimblettinclOWLMorphism s t = OWLMorphism
53f89daf88665d3ea96d871110a5c0d9d8326bd2Andy Gimblett { osource = s
1c7c4d95775a8ad5f7373e5cf0bad86f8301c56cAndy Gimblett , otarget = t
05b3e12808da901dccd665715cb934462290d550Andy GimblettisOWLInclusion :: OWLMorphism -> Bool
1c7c4d95775a8ad5f7373e5cf0bad86f8301c56cAndy GimblettisOWLInclusion m = Map.null (pmap m)
1c7c4d95775a8ad5f7373e5cf0bad86f8301c56cAndy Gimblett && Map.null (mmaps m) && isSubSign (osource m) (otarget m)
c052e3ee4a53ee3a2da829aa142fd596ef6c9e3dAndy GimblettsymMap :: MorphMap -> Map.Map Entity Entity
1c7c4d95775a8ad5f7373e5cf0bad86f8301c56cAndy GimblettsymMap = Map.mapWithKey (\ (Entity ty _) -> Entity ty)
c052e3ee4a53ee3a2da829aa142fd596ef6c9e3dAndy GimblettinducedElems :: MorphMap -> [Entity]
1c7c4d95775a8ad5f7373e5cf0bad86f8301c56cAndy GimblettinducedElems = Map.elems . symMap
a09bfcbcb0fba5663fca1968aa82daebf2e092c4Andy GimblettinducedSign :: MorphMap -> StringMap -> Sign -> Sign
a181b88611e09ffc9701a5f1022002cc0bc0c584Andy GimblettinducedSign m t s =
1c7c4d95775a8ad5f7373e5cf0bad86f8301c56cAndy Gimblett let new = execState (do
a09bfcbcb0fba5663fca1968aa82daebf2e092c4Andy Gimblett mapM_ (modEntity Set.insert) $ inducedElems m) s
05b3e12808da901dccd665715cb934462290d550Andy Gimblett in function Rename (StringMap t) new
1c7c4d95775a8ad5f7373e5cf0bad86f8301c56cAndy GimblettinducedPref :: String -> String -> Sign -> (MorphMap, StringMap)
61051521e4d82769a47f23aecb5fb477de47d534Andy Gimblett -> (MorphMap, StringMap)
61051521e4d82769a47f23aecb5fb477de47d534Andy GimblettinducedPref v u sig (m, t) =
61051521e4d82769a47f23aecb5fb477de47d534Andy Gimblett let pm = prefixMap sig
61051521e4d82769a47f23aecb5fb477de47d534Andy Gimblett then if u == v then (m, t) else (m, Map.insert v u t)
1c7c4d95775a8ad5f7373e5cf0bad86f8301c56cAndy Gimblett else error $ "unknown symbol: " ++ showDoc v "\n" ++ shows sig ""
1c7c4d95775a8ad5f7373e5cf0bad86f8301c56cAndy GimblettinducedFromMor :: Map.Map RawSymb RawSymb -> Sign -> Result OWLMorphism
1c7c4d95775a8ad5f7373e5cf0bad86f8301c56cAndy GimblettinducedFromMor rm sig = do
b22c258cca179a5ffe777b64b32e10687c5f6b2cAndy Gimblett let syms = symOf sig
b22c258cca179a5ffe777b64b32e10687c5f6b2cAndy Gimblett (mm, tm) <- foldM (\ (m, t) p -> case p of
b22c258cca179a5ffe777b64b32e10687c5f6b2cAndy Gimblett (ASymbol s@(Entity _ v), ASymbol (Entity _ u)) ->
8528886a04f14abe0ddf80f50c853cc25bc821cdAndy Gimblett then return $ if u == v then (m, t) else (Map.insert s u m, t)
876bd2c70a93981cc80f8376284616bce4a0fefcChristian Maeder else fail $ "unknown symbol: " ++ showDoc s "\n" ++ shows sig ""
1c7c4d95775a8ad5f7373e5cf0bad86f8301c56cAndy Gimblett (AnUri v, AnUri u) -> case filter (`Set.member` syms)
aa0d5f8be9950e788884f7431cf4cb7bee74788cAndy Gimblett $ map (`Entity` v) entityTypes of
aa0d5f8be9950e788884f7431cf4cb7bee74788cAndy Gimblett [] -> let v2 = showQU v
aa0d5f8be9950e788884f7431cf4cb7bee74788cAndy Gimblett u2 = showQU u
aa0d5f8be9950e788884f7431cf4cb7bee74788cAndy Gimblett in return $ inducedPref v2 u2 sig (m, t)
afc52bfaabee38c4d55cee9f35b1a0028ba3854aAndy Gimblett l -> return $ if u == v then (m, t) else
afc52bfaabee38c4d55cee9f35b1a0028ba3854aAndy Gimblett (foldr (`Map.insert` u) m l, t)
197888c54795ec1e79e77289b7e20436a6db74c0Andy Gimblett (APrefix v, APrefix u) -> return $ inducedPref v u sig (m, t)
197888c54795ec1e79e77289b7e20436a6db74c0Andy Gimblett _ -> error "OWL2.Morphism.inducedFromMor") (Map.empty, Map.empty)
a1f6118e7ce7f8892fc4299e316630ec74083f0aAndy Gimblett return OWLMorphism
a1f6118e7ce7f8892fc4299e316630ec74083f0aAndy Gimblett { osource = sig
a1f6118e7ce7f8892fc4299e316630ec74083f0aAndy Gimblett , otarget = inducedSign mm tm sig
a1f6118e7ce7f8892fc4299e316630ec74083f0aAndy Gimblett , mmaps = mm }
a1f6118e7ce7f8892fc4299e316630ec74083f0aAndy GimblettsymMapOf :: OWLMorphism -> Map.Map Entity Entity
afc52bfaabee38c4d55cee9f35b1a0028ba3854aAndy GimblettsymMapOf mor = Map.union (symMap $ mmaps mor) $ setToMap $ symOf $ osource mor
05b3e12808da901dccd665715cb934462290d550Andy Gimblettinstance Pretty OWLMorphism where
05b3e12808da901dccd665715cb934462290d550Andy Gimblett pretty m = let
05b3e12808da901dccd665715cb934462290d550Andy Gimblett s = osource m
afc52bfaabee38c4d55cee9f35b1a0028ba3854aAndy Gimblett srcD = specBraces $ space <> pretty s
afc52bfaabee38c4d55cee9f35b1a0028ba3854aAndy Gimblett t = otarget m
06dd4e7c29f33f6122a910719e3bd9062256e397Andy Gimblett in if isOWLInclusion m then
20ed727452613e36c0a95ddabf7ecc81cf941ed2Andy Gimblett if isSubSign t s then
c679188b6762edb198e353f724e77c74aa64a7e4Andy Gimblett fsep [text "identity morphism over", srcD]
fd4ad12563262ebe380d810df8f7755cfab5fb42Liam O'Reilly [ text "inclusion morphism of"
06dd4e7c29f33f6122a910719e3bd9062256e397Andy Gimblett , text "extended with"
20ed727452613e36c0a95ddabf7ecc81cf941ed2Andy Gimblett , pretty $ Set.difference (symOf t) $ symOf s ]
576a4ca6de740c90afd448607c2323477139de24Liam O'Reilly [ pretty $ mmaps m
afc52bfaabee38c4d55cee9f35b1a0028ba3854aAndy Gimblett , pretty $ pmap m
06dd4e7c29f33f6122a910719e3bd9062256e397Andy Gimblett , colon <+> srcD, mapsto <+> specBraces (space <> pretty t) ]
20ed727452613e36c0a95ddabf7ecc81cf941ed2Andy GimblettlegalMor :: OWLMorphism -> Result ()
20ed727452613e36c0a95ddabf7ecc81cf941ed2Andy GimblettlegalMor m = let mm = mmaps m in unless
afc52bfaabee38c4d55cee9f35b1a0028ba3854aAndy Gimblett (Set.isSubsetOf (Map.keysSet mm) (symOf $ osource m)
06dd4e7c29f33f6122a910719e3bd9062256e397Andy Gimblett && Set.isSubsetOf (Set.fromList $ inducedElems mm) (symOf $ otarget m))
20ed727452613e36c0a95ddabf7ecc81cf941ed2Andy Gimblett $ fail "illegal OWL2 morphism"
20ed727452613e36c0a95ddabf7ecc81cf941ed2Andy GimblettcomposeMor :: OWLMorphism -> OWLMorphism -> Result OWLMorphism
06dd4e7c29f33f6122a910719e3bd9062256e397Andy GimblettcomposeMor m1 m2 =
20ed727452613e36c0a95ddabf7ecc81cf941ed2Andy Gimblett let nm = Set.fold (\ s@(Entity ty u) -> let
20ed727452613e36c0a95ddabf7ecc81cf941ed2Andy Gimblett t = getIri ty u $ mmaps m1
06dd4e7c29f33f6122a910719e3bd9062256e397Andy Gimblett r = getIri ty t $ mmaps m2
20ed727452613e36c0a95ddabf7ecc81cf941ed2Andy Gimblett in if r == u then id else Map.insert s r) Map.empty
20ed727452613e36c0a95ddabf7ecc81cf941ed2Andy Gimblett . symOf $ osource m1
edc768ab3a40d51bf18761330cfc4b4d460c0822Andy Gimblett { otarget = otarget m2
0a83f8dcd5598436966584b858313eb5efd95d5bLiam O'Reilly , pmap = composeMap (prefixMap $ osource m1) (pmap m1) $ pmap m2
0a83f8dcd5598436966584b858313eb5efd95d5bLiam O'Reilly , mmaps = nm }
0a83f8dcd5598436966584b858313eb5efd95d5bLiam O'ReillycogeneratedSign :: Set.Set Entity -> Sign -> Result OWLMorphism
0a83f8dcd5598436966584b858313eb5efd95d5bLiam O'ReillycogeneratedSign s sign =
0a83f8dcd5598436966584b858313eb5efd95d5bLiam O'Reilly let sig2 = execState (mapM_ (modEntity Set.delete) $ Set.toList s) sign
0a83f8dcd5598436966584b858313eb5efd95d5bLiam O'Reilly in if isSubSign sig2 sign then return $ inclOWLMorphism sig2 sign else
0a83f8dcd5598436966584b858313eb5efd95d5bLiam O'Reilly fail "non OWL2 subsignatures for (co)generatedSign"
2f35e5f6757968746dbab385be21fcae52378a3fLiam O'ReillygeneratedSign :: Set.Set Entity -> Sign -> Result OWLMorphism
33bdce26495121cdbce30331ef90a1969126a840Liam O'ReillygeneratedSign s sign = cogeneratedSign (Set.difference (symOf sign) s) sign
d9c1248c7972dfdafbacb1b73b2eb965eac9ef42Liam O'ReillymatchesSym :: Entity -> RawSymb -> Bool
d9c1248c7972dfdafbacb1b73b2eb965eac9ef42Liam O'ReillymatchesSym e@(Entity _ u) r = case r of
7371f8fe3a9a286a74ea30a3cd18e7740f67d537Andy Gimblett ASymbol s -> s == e
fd4ad12563262ebe380d810df8f7755cfab5fb42Liam O'Reilly AnUri s -> s == u || namePrefix u == localPart s && null (namePrefix s)
fd4ad12563262ebe380d810df8f7755cfab5fb42Liam O'Reilly APrefix p -> p == namePrefix u
fd4ad12563262ebe380d810df8f7755cfab5fb42Liam O'ReillystatSymbItems :: [SymbItems] -> [RawSymb]
afc52bfaabee38c4d55cee9f35b1a0028ba3854aAndy GimblettstatSymbItems = concatMap
afc52bfaabee38c4d55cee9f35b1a0028ba3854aAndy Gimblett $ \ (SymbItems m us) -> case m of
afc52bfaabee38c4d55cee9f35b1a0028ba3854aAndy Gimblett AnyEntity -> map AnUri us
afc52bfaabee38c4d55cee9f35b1a0028ba3854aAndy Gimblett EntityType ty -> map (ASymbol . Entity ty) us
afc52bfaabee38c4d55cee9f35b1a0028ba3854aAndy Gimblett Prefix -> map (APrefix . showQN) us
afc52bfaabee38c4d55cee9f35b1a0028ba3854aAndy GimblettstatSymbMapItems :: [SymbMapItems] -> Result (Map.Map RawSymb RawSymb)
afc52bfaabee38c4d55cee9f35b1a0028ba3854aAndy GimblettstatSymbMapItems =
afc52bfaabee38c4d55cee9f35b1a0028ba3854aAndy Gimblett foldM (\ m (s, t) -> case Map.lookup s m of
afc52bfaabee38c4d55cee9f35b1a0028ba3854aAndy Gimblett Nothing -> return $ Map.insert s t m
afc52bfaabee38c4d55cee9f35b1a0028ba3854aAndy Gimblett Just u -> case (u, t) of
afc52bfaabee38c4d55cee9f35b1a0028ba3854aAndy Gimblett (AnUri su, ASymbol (Entity _ tu)) | su == tu ->
afc52bfaabee38c4d55cee9f35b1a0028ba3854aAndy Gimblett return $ Map.insert s t m
afc52bfaabee38c4d55cee9f35b1a0028ba3854aAndy Gimblett (ASymbol (Entity _ su), AnUri tu) | su == tu -> return m
afc52bfaabee38c4d55cee9f35b1a0028ba3854aAndy Gimblett (AnUri su, APrefix tu) | showQU su == tu ->
afc52bfaabee38c4d55cee9f35b1a0028ba3854aAndy Gimblett return $ Map.insert s t m
afc52bfaabee38c4d55cee9f35b1a0028ba3854aAndy Gimblett (APrefix su, AnUri tu) | su == showQU tu -> return m
afc52bfaabee38c4d55cee9f35b1a0028ba3854aAndy Gimblett _ -> if u == t then return m else
afc52bfaabee38c4d55cee9f35b1a0028ba3854aAndy Gimblett fail $ "differently mapped symbol: " ++ showDoc s "\nmapped to "
06dd4e7c29f33f6122a910719e3bd9062256e397Andy Gimblett ++ showDoc u " and " ++ showDoc t "")
afc52bfaabee38c4d55cee9f35b1a0028ba3854aAndy Gimblett . concatMap (\ (SymbMapItems m us) ->
c679188b6762edb198e353f724e77c74aa64a7e4Andy Gimblett let ps = map (\ (u, v) -> (u, fromMaybe u v)) us in
afc52bfaabee38c4d55cee9f35b1a0028ba3854aAndy Gimblett AnyEntity -> map (\ (s, t) -> (AnUri s, AnUri t)) ps
9f31535736c3d43a98f0157efaa7f87ea73c9be0Liam O'Reilly EntityType ty ->
06dd4e7c29f33f6122a910719e3bd9062256e397Andy Gimblett let mS = ASymbol . Entity ty
06dd4e7c29f33f6122a910719e3bd9062256e397Andy Gimblett in map (\ (s, t) -> (mS s, mS t)) ps
06dd4e7c29f33f6122a910719e3bd9062256e397Andy Gimblett map (\ (s, t) -> (APrefix (showQU s), APrefix $ showQU t)) ps)
afc52bfaabee38c4d55cee9f35b1a0028ba3854aAndy GimblettmapSen :: OWLMorphism -> Axiom -> Result Axiom
06dd4e7c29f33f6122a910719e3bd9062256e397Andy GimblettmapSen m a = do
06dd4e7c29f33f6122a910719e3bd9062256e397Andy Gimblett let new = function Rename (MorphMap $ mmaps m) a
afc52bfaabee38c4d55cee9f35b1a0028ba3854aAndy Gimblett return $ function Rename (StringMap $ pmap m) new