Changeset 11757

Timestamp:

24.04.2009 16:50:10 (11 months ago)

Author:

maeder

Message:

actually rename sentences #643

Location:

trunk/OWL

Files:

• Logic_OWL.hs (modified) (1 diff)
• Morphism.hs (modified) (3 diffs)

trunk/OWL/Logic_OWL.hs

@@ -62 +62 @@
 
 instance Sentences OWL Axiom Sign OWLMorphism Entity where
-    map_sen OWL = const return -- this is still wrong for renamings!
+    map_sen OWL = mapSen
     print_named OWL namedSen =
         pretty (sentence namedSen) <>

trunk/OWL/Morphism.hs

@@ -23 +23 @@
   , statSymbMapItems
   , inducedFromMor
+  , mapSen
   ) where
 
@@ -103 +104 @@
   && Set.isSubsetOf (Set.fromList $ inducedElems mm) (symOf $ otarget m)
 
+getUri :: EntityType -> URI -> Map.Map Entity URI -> URI
+getUri ty u = fromMaybe u . Map.lookup (Entity ty u)
+
 composeMor :: OWLMorphism -> OWLMorphism -> Result OWLMorphism
 composeMor m1 m2 =
   let nm = Set.fold (\ s@(Entity ty u) -> let
-            t = case Map.lookup s $ mmaps m1 of
-              Nothing -> u
-              Just v -> v
-            r = case Map.lookup (Entity ty t) $ mmaps m2 of
-              Nothing -> t
-              Just w -> w
+            t = getUri ty u $ mmaps m1
+            r = getUri ty t $ mmaps m2
             in if r == u then id else Map.insert s r) Map.empty
-           $ symOf $ osource m1
+           . symOf $ osource m1
   in return m1
      { otarget = otarget m2
@@ -156 +156 @@
                    map (\ (s, t) -> (mS s, mS t)) ps)
 
-
+mapEntity :: Map.Map Entity URI -> Entity -> Entity
+mapEntity m (Entity ty u) = Entity ty $ getUri ty u m
+
+mapAnno :: Map.Map Entity URI -> Annotation -> Annotation
+mapAnno m ann = case ann of
+  Annotation a e -> Annotation a $ mapEntity m e
+  _ -> ann
+
+mapSen :: OWLMorphism -> Axiom -> Result Axiom
+mapSen m = return . mapAxiom (mmaps m)
+
+mapAxiom :: Map.Map Entity URI -> Axiom -> Axiom
+mapAxiom m axm = case axm of
+  PlainAxiom as a -> PlainAxiom (map (mapAnno m) as) $ mapPlainAxiom m a
+  EntityAnno (EntityAnnotation as e bs) ->
+    EntityAnno $ EntityAnnotation (map (mapAnno m) as) (mapEntity m e)
+      $ map (mapAnno m) bs
+
+mapObjExpr :: Map.Map Entity URI -> ObjectPropertyExpression
+           -> ObjectPropertyExpression
+mapObjExpr m ope = case ope of
+  OpURI u -> OpURI $ getUri ObjectProperty u m
+  InverseOp o -> InverseOp $ mapObjExpr m o
+
+mapDRange :: Map.Map Entity URI -> DataRange -> DataRange
+mapDRange m dr = case dr of
+    DRDatatype u -> DRDatatype $ getUri Datatype u m
+    DataComplementOf d -> DataComplementOf $ mapDRange m d
+    DataOneOf _ -> dr
+    DatatypeRestriction d l -> DatatypeRestriction (mapDRange m d) l
+
+mapDataExpr :: Map.Map Entity URI -> DataPropertyExpression
+            -> DataPropertyExpression
+mapDataExpr m dpe = getUri DataProperty dpe m
+
+getClassUri :: URI -> Map.Map Entity URI -> URI
+getClassUri = getUri OWLClass
+
+getIndUri :: URI -> Map.Map Entity URI -> URI
+getIndUri = getUri Individual
+
+mapCard :: (a -> b) -> (c -> d) -> Cardinality a c -> Cardinality b d
+mapCard f g (Cardinality ty i a mb) =
+  Cardinality ty i (f a) $ fmap g mb
+
+mapDescr :: Map.Map Entity URI -> Description -> Description
+mapDescr m desc = case desc of
+    OWLClassDescription u -> OWLClassDescription $ getClassUri u m
+    ObjectJunction ty ds -> ObjectJunction ty $ map (mapDescr m) ds
+    ObjectComplementOf d -> ObjectComplementOf $ mapDescr m d
+    ObjectOneOf is -> ObjectOneOf $ map (flip getIndUri m) is
+    ObjectValuesFrom ty o d -> ObjectValuesFrom ty (mapObjExpr m o)
+      $ mapDescr m d
+    ObjectExistsSelf o -> ObjectExistsSelf $ mapObjExpr m o
+    ObjectHasValue o i -> ObjectHasValue (mapObjExpr m o) $ getIndUri i m
+    ObjectCardinality c -> ObjectCardinality
+      $ mapCard (mapObjExpr m) (mapDescr m) c
+    DataValuesFrom ty d ds dr -> DataValuesFrom ty (mapDataExpr m d)
+      (map (mapDataExpr m) ds) $ mapDRange m dr
+    DataHasValue d c -> DataHasValue (mapDataExpr m d) c
+    DataCardinality c -> DataCardinality
+       $ mapCard (mapDataExpr m) (mapDRange m) c
+
+mapSubObjExpr :: Map.Map Entity URI -> SubObjectPropertyExpression
+              -> SubObjectPropertyExpression
+mapSubObjExpr m ope = case ope of
+  OPExpression o -> OPExpression $ mapObjExpr m o
+  SubObjectPropertyChain os -> SubObjectPropertyChain
+    $ map (mapObjExpr m) os
+
+mapDataDomOrRange :: Map.Map Entity URI -> DataDomainOrRange
+                  -> DataDomainOrRange
+mapDataDomOrRange m ddr = case ddr of
+  DataDomain d -> DataDomain $ mapDescr m d
+  DataRange d -> DataRange $ mapDRange m d
+
+mapAssertion :: Map.Map Entity URI -> (a -> b) -> (c -> d)
+             -> Assertion a c -> Assertion b d
+mapAssertion m f g (Assertion a ty i b) =
+  Assertion (f a) ty (getIndUri i m) $ g b
+
+mapPlainAxiom :: Map.Map Entity URI -> PlainAxiom -> PlainAxiom
+mapPlainAxiom m pax = case pax of
+    SubClassOf s t -> SubClassOf (mapDescr m s) $ mapDescr m t
+    EquivOrDisjointClasses ty ds -> EquivOrDisjointClasses ty
+      $ map (mapDescr m) ds
+    DisjointUnion u ds -> DisjointUnion (getClassUri u m)
+      $ map (mapDescr m) ds
+    SubObjectPropertyOf so o -> SubObjectPropertyOf (mapSubObjExpr m so)
+      $ mapObjExpr m o
+    EquivOrDisjointObjectProperties ty os -> EquivOrDisjointObjectProperties ty
+      $ map (mapObjExpr m) os
+    ObjectPropertyDomainOrRange odr o d -> ObjectPropertyDomainOrRange odr
+      (mapObjExpr m o) $ mapDescr m d
+    InverseObjectProperties o p -> InverseObjectProperties (mapObjExpr m o)
+      $ mapObjExpr m p
+    ObjectPropertyCharacter c o -> ObjectPropertyCharacter c $ mapObjExpr m o
+    SubDataPropertyOf d e -> SubDataPropertyOf (mapDataExpr m d)
+      $ mapDataExpr m e
+    EquivOrDisjointDataProperties ty ds -> EquivOrDisjointDataProperties ty
+      $ map (mapDataExpr m) ds
+    DataPropertyDomainOrRange dd d -> DataPropertyDomainOrRange
+      (mapDataDomOrRange m dd) $ mapDataExpr m d
+    FunctionalDataProperty d -> FunctionalDataProperty $ mapDataExpr m d
+    SameOrDifferentIndividual ty is -> SameOrDifferentIndividual ty
+      $ map (flip getIndUri m) is
+    ClassAssertion i d -> ClassAssertion (getIndUri i m) $ mapDescr m d
+    ObjectPropertyAssertion a -> ObjectPropertyAssertion
+      $ mapAssertion m (mapObjExpr m) (flip getIndUri m) a
+    DataPropertyAssertion a -> DataPropertyAssertion
+      $ mapAssertion m (mapDataExpr m) id a
+    Declaration (Entity ty u) -> Declaration $ Entity ty $ getUri ty u m
+