1 import "Simantics/Model"
2 import "http://www.simantics.org/DistrictNetwork-1.0" as DN
6 importJava "org.simantics.utils.strings.AlphanumComparator" where
7 @JavaName CASE_INSENSITIVE_COMPARATOR
8 alphanumericComparator :: Comparator String
10 type Subgraph = ([Resource], [Resource])
11 type Subgraphs = (Resource, [Subgraph])
12 type ElementFilter = (Resource -> <ReadGraph> Boolean)
15 floodFill :: ElementFilter -> Resource -> <ReadGraph, Proc> Subgraph
16 floodFill edgeFilter fromVertex = do
17 processVertex fromVertex
18 (MSet.toList vertices, MSet.toList edges)
20 edgesOf vertex = (vertex # DN.HasStartVertex_Inverse, vertex # DN.HasEndVertex_Inverse)
21 vertices = MSet.create ()
22 edges = MSet.create ()
23 processVertex vertex = if MSet.add vertices vertex then do
24 (starts, ends) = edgesOf vertex
25 for starts processEdgeStart
26 for ends processEdgeEnd
28 processEdgeStart edge = if MSet.add edges edge && edgeFilter edge then
29 for (edge # DN.HasEndVertex) processVertex
31 processEdgeEnd edge = if MSet.add edges edge && edgeFilter edge then
32 for (edge # DN.HasStartVertex) processVertex
36 findDisconnectedSubnetworksFromDiagram :: ElementFilter -> Resource -> <ReadGraph, Proc> Subgraphs
37 findDisconnectedSubnetworksFromDiagram edgeFilter networkDiagram = let
38 all = networkDiagram # L0.ConsistsOf
39 vertices = filter (flip isInstanceOf DN.Vertex) all
40 edges = filter (flip isInstanceOf DN.Edge) all
41 vertexSet = MSet.fromList vertices
42 edgeSet = MSet.fromList edges
43 result = MList.create ()
44 take1 set = MSet.mapFirst Just vertexSet
47 loop (Just vertex) = do
48 subgraph = floodFill edgeFilter vertex
49 MList.add result subgraph
51 MSet.removeAll vertexSet vs
52 MSet.removeAll edgeSet es
53 if not (MSet.isEmpty vertexSet) then
54 loop (take1 vertexSet)
57 //print "Total number of vertices: \(length vertices)"
58 //print "Total number of edges: \(length edges)"
59 loop (take1 vertexSet)
60 if MSet.size edgeSet > 0 then
61 MList.add result ([], MSet.toList edgeSet)
63 //print "Found \(MList.size result) disconnected sub-networks"
64 (networkDiagram, (MList.freeze result))
67 Finds disconnected district subnetworks from the provided district network diagram.
68 The input can be either the network diagram resource or the configuration composite
69 resource of the network diagram.
71 See [reportDisconnectedSubnetworks](#reportDisconnectedSubnetworks) for reporting the
74 findDisconnectedSubnetworks :: ElementFilter -> Resource -> <ReadGraph, Proc> Subgraphs
75 findDisconnectedSubnetworks edgeFilter networkDiagramOrComposite = findDisconnectedSubnetworksFromDiagram edgeFilter (toDiagram networkDiagramOrComposite)
77 toDiagram d = if isInstanceOf d DN.Diagram then d
78 else match (possibleObject d MOD.CompositeToDiagram) with
79 Just dia -> toDiagram dia
80 Nothing -> fail "Provided diagram is not a district network diagram or configuration composite: \(possibleUriOf d)"
82 reportDisconnectedSubnetworks :: Integer -> Subgraphs -> <ReadGraph, Proc> ()
83 reportDisconnectedSubnetworks vertexThreshold (diagram, subgraphs) = do
84 print "## Disconnected sub-network analysis of district network \(relativeUri diagram)"
85 print "* Detailed reporting vertex count threshold is <= \(vertexThreshold)"
86 for subgraphs reportGraph
88 rootUri = match possibleIndexRoot diagram with
90 Just root -> uriOf (parent root)
91 relativeUri r = drop (length rootUri) (uriOf r)
93 showVertex v = nameOf v
95 edgeEnds e = (possibleObject e DN.HasStartVertex, possibleObject e DN.HasEndVertex)
96 showEdgeEnds (Nothing, Nothing) = "(null, null)"
97 showEdgeEnds (Just s, Nothing) = "(\(nameOf s), null)"
98 showEdgeEnds (Nothing, Just e) = "(null, \(nameOf e))"
99 showEdgeEnds (Just s, Just e) = "(\(nameOf s), \(nameOf e))"
100 showEdge e = (nameOf e) + " - " + (showEdgeEnds (edgeEnds e))
101 sortStrings l = sortWithComparator alphanumericComparator l
103 reportGraph (vs, es) | length vs > vertexThreshold = reportShort vs es
104 | otherwise = reportFull vs es
105 reportSubgraphTitle vs es = print "\n### Disconnected sub-network of \(length vs) vertices and \(length es) edges"
106 reportShort vs es = do
107 reportSubgraphTitle vs es
108 print "* Details not reported because vertex count exceeds threshold"
109 mapFirst (\s -> do print "* v0: \(s)"; Just s)
110 (sortStrings (map showVertex vs))
112 reportFull vs es = do
113 reportSubgraphTitle vs es
114 forI (sortStrings (map showVertex vs)) (\i s -> print "* v\(i): \(s)")
116 forI (sortStrings (map showEdge es)) (\i s -> print "* e\(i): \(s)")