1 import "Simantics/Model"
2 import "http://www.simantics.org/DistrictNetwork-1.0" as DN
9 importJava "org.simantics.utils.strings.AlphanumComparator" where
10 @JavaName CASE_INSENSITIVE_COMPARATOR
11 alphanumericComparator :: Comparator String
13 type Subgraph = ([Resource], [Resource])
14 type Subgraphs = (Resource, [Subgraph])
15 type ElementFilter = (Resource -> <ReadGraph> Boolean)
18 floodFill :: ElementFilter -> Resource -> <ReadGraph, Proc> Subgraph
19 floodFill edgeFilter fromVertex = do
20 processVertex fromVertex
21 (MSet.toList vertices, MSet.toList edges)
23 edgesOf vertex = (vertex # DN.HasStartVertex_Inverse, vertex # DN.HasEndVertex_Inverse)
24 vertices = MSet.create ()
25 edges = MSet.create ()
26 processVertex vertex = if MSet.add vertices vertex then do
27 (starts, ends) = edgesOf vertex
28 for starts processEdgeStart
29 for ends processEdgeEnd
31 processEdgeStart edge = if MSet.add edges edge && edgeFilter edge then
32 for (edge # DN.HasEndVertex) processVertex
34 processEdgeEnd edge = if MSet.add edges edge && edgeFilter edge then
35 for (edge # DN.HasStartVertex) processVertex
39 findDisconnectedSubnetworksFromDiagram :: ElementFilter -> Resource -> <ReadGraph, Proc> Subgraphs
40 findDisconnectedSubnetworksFromDiagram edgeFilter networkDiagram = let
41 all = networkDiagram # L0.ConsistsOf
42 vertices = filter (flip isInstanceOf DN.Vertex) all
43 edges = filter (flip isInstanceOf DN.Edge) all
44 vertexSet = MSet.fromList vertices
45 edgeSet = MSet.fromList edges
46 result = MList.create ()
47 take1 set = MSet.mapFirst Just vertexSet
50 loop (Just vertex) = do
51 subgraph = floodFill edgeFilter vertex
52 MList.add result subgraph
54 MSet.removeAll vertexSet vs
55 MSet.removeAll edgeSet es
56 if not (MSet.isEmpty vertexSet) then
57 loop (take1 vertexSet)
60 //print "Total number of vertices: \(length vertices)"
61 //print "Total number of edges: \(length edges)"
62 loop (take1 vertexSet)
63 if MSet.size edgeSet > 0 then
64 MList.add result ([], MSet.toList edgeSet)
66 //print "Found \(MList.size result) disconnected sub-networks"
67 (networkDiagram, (MList.freeze result))
70 Finds disconnected district subnetworks from the provided district network diagram.
71 The input can be either the network diagram resource or the configuration composite
72 resource of the network diagram.
74 See [reportDisconnectedSubnetworks](#reportDisconnectedSubnetworks) for reporting the
77 findDisconnectedSubnetworks :: ElementFilter -> Resource -> <ReadGraph, Proc> Subgraphs
78 findDisconnectedSubnetworks edgeFilter networkDiagramOrComposite = findDisconnectedSubnetworksFromDiagram edgeFilter (toDiagram networkDiagramOrComposite)
80 toDiagram d = if isInstanceOf d DN.Diagram then d
81 else match (possibleObject d MOD.CompositeToDiagram) with
82 Just dia -> toDiagram dia
83 Nothing -> fail "Provided diagram is not a district network diagram or configuration composite: \(possibleUriOf d)"
85 reportDisconnectedSubnetworks :: Integer -> Subgraphs -> <ReadGraph, Proc> ()
86 reportDisconnectedSubnetworks vertexThreshold (diagram, subgraphs) = do
87 print "## Disconnected sub-network analysis of district network \(relativeUri diagram)"
88 print "* Detailed reporting vertex count threshold is <= \(vertexThreshold)"
89 for subgraphs reportGraph
91 rootUri = match possibleIndexRoot diagram with
93 Just root -> uriOf (parent root)
94 relativeUri r = drop (length rootUri) (uriOf r)
96 showVertex v = nameOf v
98 edgeEnds e = (possibleObject e DN.HasStartVertex, possibleObject e DN.HasEndVertex)
99 showEdgeEnds (Nothing, Nothing) = "(null, null)"
100 showEdgeEnds (Just s, Nothing) = "(\(nameOf s), null)"
101 showEdgeEnds (Nothing, Just e) = "(null, \(nameOf e))"
102 showEdgeEnds (Just s, Just e) = "(\(nameOf s), \(nameOf e))"
103 showEdge e = (nameOf e) + " - " + (showEdgeEnds (edgeEnds e))
104 sortStrings l = sortWithComparator alphanumericComparator l
106 reportGraph (vs, es) | length vs > vertexThreshold = reportShort vs es
107 | otherwise = reportFull vs es
108 reportSubgraphTitle vs es = print "\n### Disconnected sub-network of \(length vs) vertices and \(length es) edges"
109 reportShort vs es = do
110 reportSubgraphTitle vs es
111 print "* Details not reported because vertex count exceeds threshold"
112 mapFirst (\s -> do print "* v0: \(s)"; Just s)
113 (sortStrings (map showVertex vs))
115 reportFull vs es = do
116 reportSubgraphTitle vs es
117 forI (sortStrings (map showVertex vs)) (\i s -> print "* v\(i): \(s)")
119 forI (sortStrings (map showEdge es)) (\i s -> print "* e\(i): \(s)")
122 Get a set of the edges that are at the middle points of each span between branch points.
124 midBranchEdges :: Resource -> <ReadGraph> [Resource]
125 midBranchEdges networkDiagram = runProc let
126 for edges storeDistance
128 filter isMiddle edges
130 all = if isInstanceOf networkDiagram DIA.Diagram
131 then networkDiagram # L0.ConsistsOf
132 else singleObject networkDiagram MOD.CompositeToDiagram # L0.ConsistsOf
133 vertices = filter (flip isInstanceOf DN.Vertex) all
134 edges = filter (flip isInstanceOf DN.Edge) all
135 edgeLen = fromJust . (index $ flip map edges \e -> do
136 v1 = singleObject e DN.HasStartVertex
137 v2 = singleObject e DN.HasEndVertex
138 [x1, y1] = relatedValue v1 DIA.HasLocation :: [Double]
139 [x2, y2] = relatedValue v2 DIA.HasLocation :: [Double]
140 (e, sqrt ((x2 - x1)^2 + (y2 - y1)^2)))
141 distances = runProc $ MMap.create () :: MMap.T Resource Double
142 isBranchPoint v = length (v # DN.HasEndVertex_Inverse) != 1 || length (v # DN.HasStartVertex_Inverse) != 1
143 setDistance e d = MMap.put distances e d
144 getDistance e = fromJust $ MMap.get distances e
145 forward r1 r2 e cont = do
146 v = singleObject e r1
150 setDistance e (l / 2)
153 e2 = singleObject v r2
154 forward r1 r2 e2 (\d2 -> do
155 setDistance e (d2 + l/2)
157 backward r1 r2 e d = do
159 setDistance e $ min (d + l/2) (getDistance e)
160 v = singleObject e r1
161 if isBranchPoint v then () else backward r1 r2 (singleObject v r2) (d + l)
162 storeDistance e = if MMap.containsKey distances e
166 forwardTo e (const ())
168 forwardFrom e (const ())
170 setDistance e (min d1 d2)
171 backwardFrom e (d1 - l/2)
172 backwardTo e (d2 - l/2)
174 forwardTo = forward DN.HasEndVertex DN.HasStartVertex_Inverse
175 forwardFrom = forward DN.HasStartVertex DN.HasEndVertex_Inverse
176 backwardTo = backward DN.HasEndVertex DN.HasStartVertex_Inverse
177 backwardFrom = backward DN.HasStartVertex DN.HasEndVertex_Inverse
179 v1 = singleObject e DN.HasStartVertex
180 v2 = singleObject e DN.HasEndVertex
183 (isBranchPoint v1 || d > getDistance (singleObject v1 DN.HasEndVertex_Inverse)) &&
184 (isBranchPoint v2 || d > getDistance (singleObject v2 DN.HasStartVertex_Inverse))