412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian MaederCopyright : (c) Uni Bremen 2004-2006
98890889ffb2e8f6f722b00e265a211f13b5a861Corneliu-Claudiu ProdescuLicense : GPLv2 or higher, see LICENSE.txt
4db455e0782c3be2bf1eaf8822ed20968a756444Klaus LuettichMaintainer : luecke@informatik.uni-bremen.de
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian MaederStability : provisional
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian MaederPortability : non-portable(uni)
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian Maederdisplays an ontology graph
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian Maedermodule Taxonomy.MMiSSOntologyGraph (displayClassGraph) where
4e9e95ba35a68f3c767bc0b23ebf9e904e442517Christian Maederimport qualified GUI.HTkUtils as S
ad270004874ce1d0697fb30d7309f180553bb315Christian Maederimport qualified Data.Map as Map
c87244045d76ca01e099c20ee7517e0c93b9a473Christian Maederimport qualified Taxonomy.AbstractGraphView as A
a1058b6caa394964f2c33b1a52af205a144abd38Razvan PascanudisplayClassGraph :: MMiSSOntology -> Maybe String -> IO A.OurGraph
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian MaederdisplayClassGraph onto startClass = do
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder classGraph <- case startClass of
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder Nothing -> return $ getPureClassGraph $ getClassGraph onto
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder Just className -> case gselName className $ getClassGraph onto of
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder [] -> return $ getPureClassGraph $ getClassGraph onto
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder (_, v, l, _) : _ -> return $ ([], v, l, []) & empty
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder A.makegraph (getOntologyName onto) Nothing Nothing Nothing
59df9fde01e758ecf656fcb389183f1cb9d16815Christian Maeder [GlobalMenu (Button "Button2" (putStrLn "Button2 was pressed"))]
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder (map ( \ ( nam, col) -> (getTypeLabel nam, Box $$$ Color col $$$
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder createLocalMenu onto ginfo
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder $$$ ValueTitle ( \ (name, _, _) -> return name) $$$
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder emptyNodeTypeParms :: DaVinciNodeTypeParms (String, Int, Int)
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder )) [ (OntoClass, "#e0eeee")
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder , (OntoPredicate, "#ffd300")
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder , (OntoObject, "#ffffA0") ])
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder (createEdgeTypes $ getClassGraph onto)
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder updateDaVinciGraph classGraph gid ginfo
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder setEmptyRelationSpecs gid ginfo onto
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkesetEmptyRelationSpecs :: A.Descr -> A.GraphInfo -> MMiSSOntology -> IO ()
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedersetEmptyRelationSpecs gid gv onto = do
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder (gs, _) <- readIORef gv
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder case lookup gid gs of
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder Nothing -> return ()
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder (map ( \ relname -> A.RelViewSpec relname False False)
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder $ getRelationNames onto) gv
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian MaederupdateDaVinciGraph :: Gr (String, String, OntoObjectType) String -> A.Descr
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian MaederupdateDaVinciGraph nGraph gid gv = do
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder (gs, _) <- readIORef gv
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder case lookup gid gs of
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Nothing -> return ()
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder let oldGraph = A.ontoGraph g
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder nodeMap1 <- foldM (createNode gid gv oldGraph) nMap
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder $ labNodes nGraph
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder nodeMap2 <- foldM (createLink gid gv) nodeMap1 $ labEdges nGraph
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder A.Result gid' err <- A.writeOntoGraph gid nGraph gv
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder A.writeNodeMap gid' nodeMap2 gv
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian MaedergetTypeLabel :: OntoObjectType -> String
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian MaedergetTypeLabel t = case t of
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder OntoClass -> "class"
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder OntoObject -> "object"
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder OntoPredicate -> "predicate"
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedercreateNode :: Int -> A.GraphInfo -> ClassGraph -> A.NodeMapping
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder -> LNode (String, String, OntoObjectType) -> IO A.NodeMapping
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedercreateNode gid ginfo _ nMap (nodeID, (name, _, objectType)) =
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian Maeder case Map.lookup nodeID nMap of
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder Just _ -> return nMap
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder A.addnode gid (getTypeLabel objectType) name ginfo
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian Maeder Nothing -> return (Map.insert nodeID nid nMap)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder return $ Map.insert nodeID nid nMap
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedercreateLink :: A.Descr -> A.GraphInfo -> A.NodeMapping -> LEdge String
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedercreateLink gid ginfo nMap (node1, node2, edgeLabel) = do
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder dNodeID_1 <- case Map.lookup node1 nMap of
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Nothing -> return (-1)
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder Just n -> return n
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder dNodeID_2 <- case Map.lookup node2 nMap of
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Nothing -> return (-1)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Just n -> return n
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder if dNodeID_1 == -1 || dNodeID_2 == -1 then return nMap else do
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder if elem edgeLabel ["isa", "instanceOf", "livesIn", "proves"]
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder then A.addlink gid edgeLabel edgeLabel Nothing
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder dNodeID_2 dNodeID_1 ginfo
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder else A.addlink gid edgeLabel edgeLabel Nothing
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder dNodeID_1 dNodeID_2 ginfo
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedershowRelationsForVisible :: MMiSSOntology -> A.GraphInfo -> (String, Int, Int)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedershowRelationsForVisible onto gv (_, _, gid) =
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder do (gs, _) <- readIORef gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case lookup gid gs of
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Nothing -> return ()
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder do let oldGraph = A.ontoGraph g
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder nodesInOldGraph = map fst $ labNodes oldGraph
c426779a12762e5cf5fa8faa8a3c5d04c5850d61cmaeder newGr = restrict (`elem` nodesInOldGraph) $ getClassGraph onto
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder purgeGraph gid gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke updateDaVinciGraph newGr gid gv
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedershowObjectsForVisible :: MMiSSOntology -> A.GraphInfo -> (String, Int, Int)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedershowObjectsForVisible onto gv (_, _, gid) =
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder do (gs, _) <- readIORef gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case lookup gid gs of
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Nothing -> return ()
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder do let oldGraph = A.ontoGraph g
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder classesInOldGraph =
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder map ( \ (_, _, (className, _, _), _) -> className)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder $ filter ( \ (_, _, (_, _, objectType), _)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder -> objectType == OntoClass)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder $ map (context oldGraph) $ nodes oldGraph
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder findObjectsOfClass classList (_, (_, className, _)) =
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder elem className classList
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder map fst $ filter (findObjectsOfClass classesInOldGraph)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder $ getTypedNodes [OntoObject] $ getClassGraph onto
c426779a12762e5cf5fa8faa8a3c5d04c5850d61cmaeder objectGr = restrict (`elem` objectList) (getClassGraph onto)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder updateDaVinciGraph (makeObjectGraph oldGraph
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder (getPureClassGraph (getClassGraph onto))
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder objectGr) gid gv
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedershowWholeObjectGraph :: MMiSSOntology -> A.GraphInfo -> (String, Int, Int)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedershowWholeObjectGraph onto gv (_, _, gid) =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do oldGv <- readIORef gv
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder A.Result _ err <- purgeGraph gid gv
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder let objectList = map fst $ getTypedNodes [OntoObject] $ getClassGraph onto
c426779a12762e5cf5fa8faa8a3c5d04c5850d61cmaeder objectGraph = restrict (`elem` objectList) $ getClassGraph onto
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder updateDaVinciGraph (makeObjectGraph empty
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder (getClassGraph onto) objectGraph) gid gv
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Just _ -> writeIORef gv oldGv
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Nothing -> do
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedermakeObjectGraph :: ClassGraph -> ClassGraph -> ClassGraph -> ClassGraph
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkemakeObjectGraph oldGr classGr objectGr =
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian Maeder let newGr = insNodes (labNodes objectGr) oldGr
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke newGr2 = foldl insEdgeSecurely newGr (labEdges objectGr)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder newGr3 = foldl insInstanceOfEdge newGr2 (labNodes objectGr)
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder insEdgeSecurely gr (node1, node2, label) = case match node1 gr of
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder (Nothing, _) -> gr
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder _ -> case match node2 gr of
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder (Nothing, _) -> gr
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder _ -> insEdge (node1, node2, label) gr
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder insInstanceOfEdge gr (_, (objectName, className, _)) =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case findLNode gr className of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> case findLNode classGr className of
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Nothing -> gr
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Just classNodeID -> insInstanceOfEdge1
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder (insNode (classNodeID, (className, "", OntoClass)) gr)
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian Maeder classNodeID objectName
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Just classNodeID -> insInstanceOfEdge1 gr classNodeID objectName
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke insInstanceOfEdge1 gr classNodeID objectName =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case findLNode gr objectName of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> gr
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Just objectNodeID -> insEdge
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder (objectNodeID, classNodeID, "instanceOf") gr
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedershowWholeClassGraph :: MMiSSOntology -> A.GraphInfo -> (String, Int, Int)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedershowWholeClassGraph onto gv (_, _, gid) =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do oldGv <- readIORef gv
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder A.Result _ err <- purgeGraph gid gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke updateDaVinciGraph (getPureClassGraph (getClassGraph onto)) gid gv
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Just _ -> writeIORef gv oldGv
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Nothing -> do
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedershowRelationsToNeighbors :: MMiSSOntology -> A.GraphInfo -> [String]
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder -> (String, Int, Int) -> IO ()
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedershowRelationsToNeighbors onto gv rels (name, _, gid) =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do oldGv <- readIORef gv
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder updateDaVinciGraph (reduceToNeighbors (getClassGraph onto)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder name rels) gid gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke writeIORef gv oldGv
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaederreduceToNeighbors :: ClassGraph -> String -> [String] -> ClassGraph
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaederreduceToNeighbors g name forbiddenRels =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case findLNode g name of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> g
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder let (p, v, l, s) = context g node
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder noForbidden = not . (`elem` forbiddenRels) . fst
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder p' = filter noForbidden p
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder s' = filter noForbidden s
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder ns = map snd p' ++ map snd s'
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder myInsNode gr newGr nodeID = case match nodeID newGr of
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder (Nothing, _) ->
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder ([], nodeID, lab' (context gr nodeID), []) & newGr
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder in (p', v, l, s') & foldl (myInsNode g) empty ns
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedershowAllRelations :: MMiSSOntology -> A.GraphInfo -> Bool -> [String]
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder -> (String, Int, Int) -> IO ()
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkeshowAllRelations onto gv withIncoming rels (name, _, gid) =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do oldGv <- readIORef gv
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder let newGr = reduceToRelations (getClassGraph onto)
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder empty withIncoming rels name
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke updateDaVinciGraph newGr gid gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke writeIORef gv oldGv
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaederreduceToRelations :: ClassGraph -> ClassGraph -> Bool -> [String] -> String
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder -> ClassGraph
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian MaederreduceToRelations wholeGraph g withIncoming forbiddenRels name =
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder let g1 = elfilter (not . (`elem` forbiddenRels)) wholeGraph
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke in case findLNode g1 name of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> g
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder Just selectedNode ->
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder let nodeList = if withIncoming
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke then udfs [selectedNode] g1
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke else dfs [selectedNode] g1
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder toDelete = nodes g1 \\ nodeList
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder g1' = delNodes toDelete g1
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder g2 = mergeGraphs g1' g
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder newNodesList = nodeList \\ nodes g
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder in if null newNodesList
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder else foldl (followRelationOverSubClasses wholeGraph
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder withIncoming forbiddenRels) g2 newNodesList
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaederfollowRelationOverSubClasses :: ClassGraph -> Bool -> [String] -> ClassGraph
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder -> Node -> ClassGraph
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaederfollowRelationOverSubClasses wholeGraph withIncoming forbiddenRels g node =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke let g1 = elfilter (== "isa") wholeGraph
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder in case match node g1 of
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder (Nothing, _) -> g
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder let subclasses = rdfs [node] g1
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder newNs = subclasses \\ nodes g
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder in if null newNs
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder toDelete = nodes g1 \\ subclasses
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke g2 = mergeGraphs (delNodes toDelete g1) g
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder in foldl transClosureForNode g2 newNs
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder transClosureForNode g' n =
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder let (name, _, _) = lab' $ context wholeGraph n
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder in reduceToRelations wholeGraph g' withIncoming forbiddenRels name
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedermergeGraphs :: ClassGraph -> ClassGraph -> ClassGraph
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkemergeGraphs g1 g2 =
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder insEdges (labEdges g2) $ insNodes (labNodes g2 \\ labNodes g1) g1
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedershowSuperSubClassesForVisible :: MMiSSOntology -> A.GraphInfo -> Bool -> Bool
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder -> (String, Int, Int) -> IO ()
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedershowSuperSubClassesForVisible onto gv showSuper transitive (_, _, gid) =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke do nodeList <- myGetNodes gid gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke if transitive
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke then updateDaVinciGraph
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder (foldl (getSubSuperClosure (getClassGraph onto) showSuper)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder empty nodeList) gid gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke else updateDaVinciGraph
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder (foldl (getSubSuperSingle (getClassGraph onto) showSuper)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder empty nodeList) gid gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkereduceToThisNode :: MMiSSOntology -> A.GraphInfo -> (String, Int, Int) -> IO ()
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaederreduceToThisNode onto gv (name, _, gid) = do
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder purgeGraph gid gv
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder case gselName name $ getClassGraph onto of
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder [] -> return ()
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder (_, v, l, _) : _ -> do
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder updateDaVinciGraph (([], v, l, []) & empty) gid gv
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaederpurgeThisNode :: A.GraphInfo -> (String, Int, Int) -> IO ()
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaederpurgeThisNode gv (name, _, gid) =
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder do (gs, _) <- readIORef gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case lookup gid gs of
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Nothing -> return ()
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder do let oldGraph = A.ontoGraph g
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder (_, mayNodeID) <-
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case findLNode oldGraph name of
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Nothing -> return (oldGraph, Nothing)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Just nodeID -> return (delNode nodeID oldGraph, Just nodeID)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case mayNodeID of
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Nothing -> return ()
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Just nodeID ->
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian Maeder case Map.lookup nodeID nMap of
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Nothing -> return ()
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Just node -> do
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedershowSuperSubClasses :: MMiSSOntology -> A.GraphInfo -> Bool -> Bool
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder -> (String, Int, Int) -> IO ()
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedershowSuperSubClasses onto gv showSuper transitive (name, _, gid) =
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder do if transitive
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke then updateDaVinciGraph
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder (getSubSuperClosure (getClassGraph onto) showSuper empty name)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder else updateDaVinciGraph (getSubSuperSingle (getClassGraph onto)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder showSuper empty name) gid gv
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedergetSubSuperSingle :: ClassGraph -> Bool -> ClassGraph -> String -> ClassGraph
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkegetSubSuperSingle g showSuper newGr name =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case findLNode g name of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> g
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Just nodeID ->
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder let isaPred (_, _, a) = a == "isa"
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder subClassEdges = filter isaPred $ inn g nodeID
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder ng = foldl (insPredecessorAndEdge g)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder (insertInitialNode nodeID newGr) subClassEdges
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian Maeder in if showSuper
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder then let superClassEdges = filter isaPred $ out g nodeID
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian Maeder in foldl (insSuccessorAndEdge g) ng superClassEdges
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder insertInitialNode :: Node -> ClassGraph -> ClassGraph
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder insertInitialNode nodeID gr =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case match nodeID gr of
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder (Nothing, _) -> ([], nodeID, (name, "", OntoClass), []) & gr
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder insPredecessorAndEdge :: ClassGraph -> ClassGraph -> LEdge String
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder -> ClassGraph
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder insPredecessorAndEdge oldGr newGr' (fromNode, toNode, edgeLabel) =
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder case fst $ match fromNode oldGr of
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Nothing -> newGr'
bfbd1330a39a7b36177655ddc66c8ba00ba8c1abChristian Maeder Just (_, _, nodeLabel1, _) ->
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder case match fromNode newGr' of
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder (Nothing, _) ->
bfbd1330a39a7b36177655ddc66c8ba00ba8c1abChristian Maeder ([], fromNode, nodeLabel1, [(edgeLabel, toNode)]) & newGr'
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder (Just (p, fromNodeID, nodeLabel2, s), newGr2) ->
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder (p, fromNodeID, nodeLabel2, (edgeLabel, toNode) : s) & newGr2
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder insSuccessorAndEdge :: ClassGraph -> ClassGraph -> LEdge String
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder -> ClassGraph
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder insSuccessorAndEdge oldGr newGr' (fromNode, toNode, edgeLabel) =
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder case fst $ match toNode oldGr of
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Nothing -> newGr'
bfbd1330a39a7b36177655ddc66c8ba00ba8c1abChristian Maeder Just (_, _, (nodeLabel1, _, _), _) ->
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder case match toNode newGr' of
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder (Nothing, _) ->
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder ([(edgeLabel, fromNode)], toNode, (nodeLabel1, "", OntoClass), [])
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder (Just (p, toNodeID, nodeLabel2, s), newGr2) ->
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder ((edgeLabel, fromNode) : p, toNodeID, nodeLabel2, s) & newGr2
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedergetSubSuperClosure :: ClassGraph -> Bool -> ClassGraph -> String -> ClassGraph
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkegetSubSuperClosure g showSuper newGr name =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case findLNode g name of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> g
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Just nodeID ->
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder let ng = foldl subClassClosure newGr [nodeID]
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke in if showSuper
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder then foldl (superClassClosure nodeID) ng [nodeID]
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder superClassClosure :: Node -> ClassGraph -> Node -> ClassGraph
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder superClassClosure specialNodeID ng nodeID =
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder case fst $ match nodeID g of
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Nothing -> ng
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Just (_, _, (label, _, _), outAdj) ->
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke let isaAdj = filter ((== "isa") . fst) outAdj
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder ng1 = foldl (superClassClosure specialNodeID) ng
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder $ map snd isaAdj
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder in if nodeID == specialNodeID
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder then case match specialNodeID ng1 of
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder -- This should never be the case, but we somehow have to deal with it
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder (Nothing, _) -> (isaAdj, nodeID, (label, "", OntoClass), [])
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder (Just (inAdj, _, _, _), ng2) ->
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder (inAdj, nodeID, (label, "", OntoClass), isaAdj) & ng2
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder else case match nodeID ng1 of
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder (Nothing, _) -> ([], nodeID, (label, "", OntoClass), isaAdj)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder (Just (inAdj, _, _, outAdj2), ng2) ->
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder (inAdj ++ isaAdj, nodeID, (label, "", OntoClass), outAdj2)
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder{- - subClassClosure hunts transitively all isa-Ajacencies that goes
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder into the given node (nodeID). For all nodes collected, their
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder outgoing adjacencies are ignored because we only want to show the
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder isa-Relation to the superclass. The given specialNodeID is the ID
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder of the node from which the search for subclasses startet. Because
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder this node is already in the graph, we have to delete and reinsert
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder it with its outgoing adjacencies (which consists of the
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder isa-relations to it's superclasses, build by superClassClosure
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder beforehand). - -}
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder subClassClosure :: ClassGraph -> Node -> ClassGraph
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder subClassClosure ng nodeID =
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder case fst $ match nodeID g of
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Nothing -> ng
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Just (inAdj, _, (label, _, _), _) ->
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke let isaAdj = filter ((== "isa") . fst) inAdj
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder ng1 = foldl subClassClosure ng $ map snd isaAdj
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder in case fst $ match nodeID ng1 of
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Nothing -> (isaAdj, nodeID, (label, "", OntoClass), []) & ng1
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaederhideObjectsForVisible :: A.GraphInfo -> (String, Int, Int) -> IO ()
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaederhideObjectsForVisible gv (_, _, gid) =
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder do (gs, _) <- readIORef gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case lookup gid gs of
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Nothing -> return ()
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder do let oldGraph = A.ontoGraph g
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder objectNodeIDs = map ( \ (_, v, _, _) -> v) $
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder gselType (== OntoObject) oldGraph
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder purgeGraph gid gv
c426779a12762e5cf5fa8faa8a3c5d04c5850d61cmaeder updateDaVinciGraph (restrict (`notElem` objectNodeIDs) oldGraph)
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroedercreateEdgeTypes :: ClassGraph -> [(String, DaVinciArcTypeParms A.EdgeValue)]
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedercreateEdgeTypes g = map createEdgeType
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder $ nub (map ( \ (_, _, l) -> l) $ labEdges g) ++ ["instanceOf"]
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke createEdgeType str =
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke $$$ Head "oarrow"
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke $$$ Dir "first"
c13568ba2a02ef26ef164dfa432efc0a01cfa1b8Thiemo Wiedemeyer $$$ emptyArcTypeParms :: DaVinciArcTypeParms A.EdgeValue)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke "instanceOf" ->
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian Maeder ("instanceOf",
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke $$$ Dir "first"
c13568ba2a02ef26ef164dfa432efc0a01cfa1b8Thiemo Wiedemeyer $$$ emptyArcTypeParms :: DaVinciArcTypeParms A.EdgeValue)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder _ -> -- "contains"
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke $$$ Head "arrow"
c13568ba2a02ef26ef164dfa432efc0a01cfa1b8Thiemo Wiedemeyer $$$ ValueTitle (\ (name, _, _) -> return name)
c13568ba2a02ef26ef164dfa432efc0a01cfa1b8Thiemo Wiedemeyer $$$ emptyArcTypeParms :: DaVinciArcTypeParms A.EdgeValue)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedercreateLocalMenu :: MMiSSOntology -> A.GraphInfo -> LocalMenu (String, Int, Int)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedercreateLocalMenu onto ginfo =
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder let relMenus b =
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder createRelationMenuButtons b (getRelationNames onto) onto ginfo
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder allRels f b = [ Button "All relations" $ f onto ginfo b ["isa"]
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder , Blank ] ++ relMenus b
9035db0b84603cb494e48ec767f138641d389ca0Christian Maeder superSub' f b1 = Button
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder (if b1 then "Sub/Superclasses" else "Subclasses")
9035db0b84603cb494e48ec767f138641d389ca0Christian Maeder . f onto ginfo b1
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder superSub = superSub' showSuperSubClasses
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder superSubForVis = superSub' showSuperSubClassesForVisible
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder relMen f = Menu (Just "Show relations")
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder [ Menu (Just "Outgoing") $ f False
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder , Menu (Just "Out + In") $ f True ]
9035db0b84603cb494e48ec767f138641d389ca0Christian Maeder nodeMen f b = Menu (Just $ "Show "
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder ++ if b then "transitively" else "adjacent")
9035db0b84603cb494e48ec767f138641d389ca0Christian Maeder . ([ f False b, f True b ] ++)
9035db0b84603cb494e48ec767f138641d389ca0Christian Maeder in LocalMenu $ Menu Nothing
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder [ Menu (Just "For this node")
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder [ nodeMen superSub True [relMen $ allRels showAllRelations]
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder , nodeMen superSub False
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder [relMen $ allRels ( \ o g _ -> showRelationsToNeighbors o g)]
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder , Menu (Just "For visible nodes")
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder [ nodeMen superSubForVis True []
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder , nodeMen superSubForVis False []
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder , Button "Show relations" $ showRelationsForVisible onto ginfo
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder , Button "Show objects" $ showObjectsForVisible onto ginfo
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder , Button "Hide objects" $ hideObjectsForVisible ginfo
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder , Button "Show whole class graph" $ showWholeClassGraph onto ginfo
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder , Button "Show whole object graph" $ showWholeObjectGraph onto ginfo
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder , Button "Show relations" $ showRelationDialog ginfo
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder , Button "Reduce to this node" $ reduceToThisNode onto ginfo
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder , Button "Delete this node" $ purgeThisNode ginfo
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedercreateRelationMenuButtons :: Bool -> [String] -> MMiSSOntology -> A.GraphInfo
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder -> [MenuPrim a ((String, Int, Int) -> IO ())]
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedercreateRelationMenuButtons withIncomingRels relNames onto ginfo =
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder map createButton relNames
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder createButton name = Button name
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder $ showAllRelations onto ginfo withIncomingRels
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder $ delete name $ relNames ++ ["isa"]
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedermyDeleteNode :: A.Descr -> A.GraphInfo -> A.Result
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder -> (Int, (String, DaVinciNode (String, Int, Int)))
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian MaedermyDeleteNode gid gv _ node = A.delnode gid (fst node) gv
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederpurgeGraph :: Int -> A.GraphInfo -> IO A.Result
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian MaederpurgeGraph gid gv =
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder do (gs, _) <- readIORef gv
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian Maeder case lookup gid gs of
da955132262baab309a50fdffe228c9efe68251dCui Jian foldM (myDeleteNode gid gv) (A.Result 0 Nothing)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Nothing -> return $ A.Result 0 $ Just $
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder "Graph id " ++ show gid ++ " not found"
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroedermyGetNodes :: Int -> A.GraphInfo -> IO [String]
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian MaedermyGetNodes gid gv =
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder do (gs, _) <- readIORef gv
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian Maeder case lookup gid gs of
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Just g -> return $ map ( \ (_, (name, _, _)) -> name)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Nothing -> return []
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedergetPureClassGraph :: ClassGraph -> ClassGraph
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian MaedergetPureClassGraph g =
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder let classNodeList = map fst
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder $ getTypedNodes [OntoClass, OntoPredicate] g
c426779a12762e5cf5fa8faa8a3c5d04c5850d61cmaeder in restrict (`elem` classNodeList) g
c426779a12762e5cf5fa8faa8a3c5d04c5850d61cmaederrestrict :: DynGraph gr => (Node -> Bool) -> gr a b -> gr a b
c426779a12762e5cf5fa8faa8a3c5d04c5850d61cmaederrestrict f = ufold cfilter empty
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder where cfilter (p, v, l, s) g =
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder if f v then (p', v, l, s') & g else g
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder where p' = filter (f . snd) p
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder s' = filter (f . snd) s
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedergetTypedNodes :: [OntoObjectType] -> ClassGraph
a6f3aafabdb36f0bb079e09de67818fde83f2c92Klaus Luettich -> [LNode (String, String, OntoObjectType)]
9035db0b84603cb494e48ec767f138641d389ca0Christian MaedergetTypedNodes ts = map labNode' . gselType (`elem` ts)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedershowRelationDialog :: A.GraphInfo -> (String, Int, Int) -> IO ()
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroedershowRelationDialog gv (_ , _, gid) =
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder do (gs, _) <- readIORef gv
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke case lookup gid gs of
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Nothing -> return ()
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder specEntries = S.row $ map relSpecToFormEntry rvs
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder form = firstRow S.// specEntries
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder S.doForm "Show relations" form
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder firstRow = S.newFormEntry "" () S.\\ S.newFormEntry "Show" ()
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder S.\\ S.newFormEntry "Transitive" ()
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian Maeder relSpecToFormEntry (A.RelViewSpec relname b1 b2) =
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder S.newFormEntry relname () S.\\ S.newFormEntry "" b1