8a77240a809197c92c0736c431b4b88947a7bac1Christian Maeder{- |

6d9f68d2b5fafea0b5e0fc59a1d557174e032c02Christian MaederModule : ./OWL2/Medusa.hs

e9458b1a7a19a63aa4c179f9ab20f4d50681c168Jens ElknerDescription : Convert OWL2 ontology to Medusa data structure

de6a40dbdd4712e5a9398b8519a59b1eaeab2f5aChristian MaederCopyright : (c) Till Mossakowski, Uni Magdeburg 2016

6d9f68d2b5fafea0b5e0fc59a1d557174e032c02Christian MaederLicense : GPLv2 or higher, see LICENSE.txt

98890889ffb2e8f6f722b00e265a211f13b5a861Corneliu-Claudiu Prodescu

6d9f68d2b5fafea0b5e0fc59a1d557174e032c02Christian MaederMaintainer : till@iws.cs.ovgu.de

3f69b6948966979163bdfe8331c38833d5d90ecdChristian MaederStability : provisional

6d9f68d2b5fafea0b5e0fc59a1d557174e032c02Christian MaederPortability : portable

6d9f68d2b5fafea0b5e0fc59a1d557174e032c02Christian Maeder

6d9f68d2b5fafea0b5e0fc59a1d557174e032c02Christian MaederConvert an OWL2 ontology to Medusa data structure,

f3a94a197960e548ecd6520bb768cb0d547457bbChristian Maedersee https://github.com/ConceptualBlending/monster_render_system

6d9f68d2b5fafea0b5e0fc59a1d557174e032c02Christian Maeder-}

6d9f68d2b5fafea0b5e0fc59a1d557174e032c02Christian Maeder

6d9f68d2b5fafea0b5e0fc59a1d557174e032c02Christian Maedermodule OWL2.Medusa where

6d9f68d2b5fafea0b5e0fc59a1d557174e032c02Christian Maeder

6d9f68d2b5fafea0b5e0fc59a1d557174e032c02Christian Maederimport OWL2.AS

6d9f68d2b5fafea0b5e0fc59a1d557174e032c02Christian Maederimport OWL2.Sign

6d9f68d2b5fafea0b5e0fc59a1d557174e032c02Christian Maederimport OWL2.MS

6d9f68d2b5fafea0b5e0fc59a1d557174e032c02Christian Maeder

7c2d602a73afe304ac0ca225ecff42b2ae8bdab3Christian Maederimport Common.AS_Annotation

6d9f68d2b5fafea0b5e0fc59a1d557174e032c02Christian Maederimport Common.IRI as IRI

6d9f68d2b5fafea0b5e0fc59a1d557174e032c02Christian Maederimport Common.Id (stringToId)

6d9f68d2b5fafea0b5e0fc59a1d557174e032c02Christian Maederimport Common.Result

6d9f68d2b5fafea0b5e0fc59a1d557174e032c02Christian Maeder

ad270004874ce1d0697fb30d7309f180553bb315Christian Maederimport Data.Maybe

6d9f68d2b5fafea0b5e0fc59a1d557174e032c02Christian Maederimport qualified Data.Set as Set

6d9f68d2b5fafea0b5e0fc59a1d557174e032c02Christian Maeder

6d9f68d2b5fafea0b5e0fc59a1d557174e032c02Christian Maederdata Medusa = Medusa {

6d9f68d2b5fafea0b5e0fc59a1d557174e032c02Christian Maeder indivs :: Set.Set (IRI, IRI),

6d9f68d2b5fafea0b5e0fc59a1d557174e032c02Christian Maeder relations :: Set.Set (IRI, IRI, IRI, IRI)}

616b72452ce5a75ade1a11ccc2c9671b3444558eChristian Maeder

616b72452ce5a75ade1a11ccc2c9671b3444558eChristian Maeder-- | given an OWL ontology (iri and theory), compute the medusa data

6d9f68d2b5fafea0b5e0fc59a1d557174e032c02Christian Maedermedusa :: IRI.IRI -> (Sign, [Named Axiom])

6d9f68d2b5fafea0b5e0fc59a1d557174e032c02Christian Maeder -> Result Medusa

7c2d602a73afe304ac0ca225ecff42b2ae8bdab3Christian Maedermedusa _ (sig, nsens) = do

6d9f68d2b5fafea0b5e0fc59a1d557174e032c02Christian Maeder let inds = individuals sig

6d9f68d2b5fafea0b5e0fc59a1d557174e032c02Christian Maeder getC = getClass (map sentence nsens)

7c2d602a73afe304ac0ca225ecff42b2ae8bdab3Christian Maeder getR tInds = getMeetsFacts (map sentence nsens) tInds

6d9f68d2b5fafea0b5e0fc59a1d557174e032c02Christian Maeder allInds = Set.map (\ i -> (i,getC i)) inds

6d9f68d2b5fafea0b5e0fc59a1d557174e032c02Christian Maeder relTuples = foldl Set.union Set.empty $

6d9f68d2b5fafea0b5e0fc59a1d557174e032c02Christian Maeder map (getR allInds) $ Set.toList inds

6d9f68d2b5fafea0b5e0fc59a1d557174e032c02Christian Maeder images = Set.foldl Set.union Set.empty $

6d9f68d2b5fafea0b5e0fc59a1d557174e032c02Christian Maeder Set.map (\(i1, _, i2, _) -> Set.fromList [i1, i2]) relTuples

bba825b39570777866d560bfde3807731131097eKlaus Luettich return $ Medusa {

578b677874296e4ba48e57b5e4b4b0270d995603Christian Maeder indivs = Set.filter (\(i,_) -> Set.member i images) allInds ,

578b677874296e4ba48e57b5e4b4b0270d995603Christian Maeder relations = relTuples

83b3260413a3b1b7dee1f9c4d3249dec994a875cMihai Codescu }

7c2d602a73afe304ac0ca225ecff42b2ae8bdab3Christian Maeder

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroedercheckMapMaybe :: (a -> Maybe b) -> [a] -> Maybe b

checkMapMaybe f x =

case mapMaybe f x of

(c:_) -> Just c

[] -> Nothing

-- | get the class of an individual

getClass :: [Axiom] -> IRI -> IRI

getClass axs n = case checkMapMaybe (getClassAux n) axs of

Just c -> c

Nothing -> nullIRI { iriPath = stringToId "unknown", isAbbrev = True }

getClassAux :: IRI -> Axiom -> Maybe IRI

getClassAux ind ax =

case axiomTopic ax of

SimpleEntity e | cutIRI e == ind ->

case axiomBit ax of

ListFrameBit (Just Types) (ExpressionBit classes) -> firstClass classes

_ -> Nothing

_ -> Nothing

-- for each individual "p1" that has a fact "meets p2"

-- look for individuals "i1" and "i2" such that

-- i1 has_fiat_boundary p1 and i2 has_fiat_boundary p2

-- and return i1 type(p1) i2 type(p2)

getMeetsFacts :: [Axiom] -> Set.Set (IRI, IRI) -> IRI ->

Set.Set (IRI, IRI, IRI, IRI)

getMeetsFacts axs tInds n =

Set.fromList $ mapMaybe (getMeetsFactsAux axs tInds n) axs

getMeetsFactsAux :: [Axiom] -> Set.Set (IRI, IRI) -> IRI -> Axiom ->

Maybe (IRI, IRI, IRI, IRI)

getMeetsFactsAux axs tInds point1 ax =

case axiomTopic ax of

SimpleEntity e | cutIRI e == point1 ->

case axiomBit ax of

ListFrameBit Nothing (IndividualFacts [([],

(ObjectPropertyFact Positive

(ObjectProp ope) point2))

]) ->

if show (iriPath ope) == "meets" then

getFiatBoundaryFacts axs tInds point1 point2

else Nothing

_ -> Nothing

_ -> Nothing

getFiatBoundaryFacts :: [Axiom] -> Set.Set (IRI, IRI) -> IRI -> IRI ->

Maybe (IRI, IRI, IRI, IRI)

getFiatBoundaryFacts axs tInds point1 point2 =

let i1 = checkMapMaybe (getFiatBoundaryFactsAux point1) axs

i2 = checkMapMaybe (getFiatBoundaryFactsAux point2) axs

typeOf ind =

case Set.toList $ Set.filter (\(x, _) -> x == ind) tInds of

[(_, t)] -> t

_ -> error $ "could not determine the type of " ++ show ind

in case (i1, i2) of

(Just ind1, Just ind2) ->

Just (ind1, typeOf point1, ind2, typeOf point2)

_ -> Nothing

getFiatBoundaryFactsAux :: IRI -> Axiom -> Maybe IRI

getFiatBoundaryFactsAux point ax =

case axiomTopic ax of

SimpleEntity e ->

case axiomBit ax of

ListFrameBit Nothing (IndividualFacts facts) ->

loopFacts facts e point

_ -> Nothing

_ -> Nothing

loopFacts :: AnnotatedList Fact -> Entity -> IRI -> Maybe IRI

loopFacts [] _ _ = Nothing

loopFacts (afact:facts') e point =

case afact of

([], (ObjectPropertyFact Positive (ObjectProp ope) point')) ->

if (show (iriPath ope) == "has_fiat_boundary") &&

(iriPath point == iriPath point') then Just $ cutIRI e

else loopFacts facts' e point

_ -> loopFacts facts' e point

-- | retrieve the first class of list, somewhat arbitrary

firstClass :: AnnotatedList ClassExpression -> Maybe IRI

firstClass ((_,Expression c):_) = Just c

firstClass _ = Nothing