-type Subgraph = [([Resource], [Resource])]
-data Subgraphs = Subgraphs Resource Subgraph
+import "Simantics/Model"
+import "http://www.simantics.org/DistrictNetwork-1.0" as DN
+import "Map" as Map
+import "MMap" as MMap
+
+import "Comparator"
+
+@private
+importJava "org.simantics.utils.strings.AlphanumComparator" where
+ @JavaName CASE_INSENSITIVE_COMPARATOR
+ alphanumericComparator :: Comparator String
+
+type Subgraph = ([Resource], [Resource])
+type Subgraphs = (Resource, [Subgraph])
+type ElementFilter = (Resource -> <ReadGraph> Boolean)
@private
-floodFill :: Resource -> <ReadGraph, Proc> Subgraph
-floodFill fromVertex = do
+floodFill :: ElementFilter -> Resource -> <ReadGraph, Proc> Subgraph
+floodFill edgeFilter fromVertex = do
processVertex fromVertex
(MSet.toList vertices, MSet.toList edges)
where
for starts processEdgeStart
for ends processEdgeEnd
else ()
- processEdgeStart edge = if MSet.add edges edge then for (edge # DN.HasEndVertex) processVertex else ()
- processEdgeEnd edge = if MSet.add edges edge then for (edge # DN.HasStartVertex) processVertex else ()
+ processEdgeStart edge = if MSet.add edges edge && edgeFilter edge then
+ for (edge # DN.HasEndVertex) processVertex
+ else ()
+ processEdgeEnd edge = if MSet.add edges edge && edgeFilter edge then
+ for (edge # DN.HasStartVertex) processVertex
+ else ()
@private
-findDisconnectedSubnetworksFromDiagram :: Resource -> <ReadGraph, Proc> Subgraphs
-findDisconnectedSubnetworksFromDiagram networkDiagram = let
+findDisconnectedSubnetworksFromDiagram :: ElementFilter -> Resource -> <ReadGraph, Proc> Subgraphs
+findDisconnectedSubnetworksFromDiagram edgeFilter networkDiagram = let
all = networkDiagram # L0.ConsistsOf
vertices = filter (flip isInstanceOf DN.Vertex) all
edges = filter (flip isInstanceOf DN.Edge) all
loop Nothing = ()
loop (Just vertex) = do
- subgraph = floodFill vertex
+ subgraph = floodFill edgeFilter vertex
MList.add result subgraph
(vs, es) = subgraph
MSet.removeAll vertexSet vs
loop (take1 vertexSet)
else ()
in do
- print "Total number of vertices: \(length vertices)"
- print "Total number of edges: \(length edges)"
+ //print "Total number of vertices: \(length vertices)"
+ //print "Total number of edges: \(length edges)"
loop (take1 vertexSet)
if MSet.size edgeSet > 0 then
MList.add result ([], MSet.toList edgeSet)
else ()
- print "Found \(MList.size result) disconnected sub-networks"
- Subgraphs networkDiagram (MList.freeze result)
+ //print "Found \(MList.size result) disconnected sub-networks"
+ (networkDiagram, (MList.freeze result))
"""
Finds disconnected district subnetworks from the provided district network diagram.
The input can be either the network diagram resource or the configuration composite
resource of the network diagram.
-See [reportDisconnectedSubnetworks](#reportDisconnectedSubnetworks) for reporting
+See [reportDisconnectedSubnetworks](#reportDisconnectedSubnetworks) for reporting the
+result by printing.
"""
-findDisconnectedSubnetworks :: Resource -> <ReadGraph, Proc> Subgraphs
-findDisconnectedSubnetworks networkDiagramOrComposite = findDisconnectedSubnetworksFromDiagram (toDiagram networkDiagramOrComposite)
+findDisconnectedSubnetworks :: ElementFilter -> Resource -> <ReadGraph, Proc> Subgraphs
+findDisconnectedSubnetworks edgeFilter networkDiagramOrComposite = findDisconnectedSubnetworksFromDiagram edgeFilter (toDiagram networkDiagramOrComposite)
where
toDiagram d = if isInstanceOf d DN.Diagram then d
else match (possibleObject d MOD.CompositeToDiagram) with
Just dia -> toDiagram dia
Nothing -> fail "Provided diagram is not a district network diagram or configuration composite: \(possibleUriOf d)"
-import "Comparator"
-@private
-importJava "org.simantics.utils.strings.AlphanumComparator" where
- @JavaName CASE_INSENSITIVE_COMPARATOR
- alphanumericComparator :: Comparator String
-
reportDisconnectedSubnetworks :: Integer -> Subgraphs -> <ReadGraph, Proc> ()
-reportDisconnectedSubnetworks vertexThreshold (Subgraphs diagram subgraphs) = do
+reportDisconnectedSubnetworks vertexThreshold (diagram, subgraphs) = do
print "## Disconnected sub-network analysis of district network \(relativeUri diagram)"
print "* Detailed reporting vertex count threshold is <= \(vertexThreshold)"
for subgraphs reportGraph
reportShort vs es = do
reportSubgraphTitle vs es
print "* Details not reported because vertex count exceeds threshold"
+ mapFirst (\s -> do print "* v0: \(s)"; Just s)
+ (sortStrings (map showVertex vs))
+ print "* ..."
reportFull vs es = do
reportSubgraphTitle vs es
forI (sortStrings (map showVertex vs)) (\i s -> print "* v\(i): \(s)")
print ""
forI (sortStrings (map showEdge es)) (\i s -> print "* e\(i): \(s)")
+
+"""
+Get a set of vertices that acts as break points between network branches.
+"""
+branchPoints :: Resource -> <ReadGraph> [Resource]
+branchPoints networkDiagram = runProc let
+ in
+ filter isBranchPoint vertices
+ where
+ all = if isInstanceOf networkDiagram DIA.Diagram
+ then networkDiagram # L0.ConsistsOf
+ else singleObject networkDiagram MOD.CompositeToDiagram # L0.ConsistsOf
+ vertices = filter (flip isInstanceOf DN.Vertex) all
+ isBranchPoint v = length (v # DN.HasEndVertex_Inverse) != 1 || length (v # DN.HasStartVertex_Inverse) != 1
+
+"""
+Get a set of the edges that are at the middle points of each span between branch points.
+"""
+midBranchEdges :: Resource -> <ReadGraph> [Resource]
+midBranchEdges networkDiagram = runProc let
+ for edges storeDistance
+ in
+ filter isMiddle edges
+ where
+ all = if isInstanceOf networkDiagram DIA.Diagram
+ then networkDiagram # L0.ConsistsOf
+ else singleObject networkDiagram MOD.CompositeToDiagram # L0.ConsistsOf
+ vertices = filter (flip isInstanceOf DN.Vertex) all
+ edges = filter (flip isInstanceOf DN.Edge) all
+ edgeLen = fromJust . (index $ flip map edges \e -> do
+ v1 = singleObject e DN.HasStartVertex
+ v2 = singleObject e DN.HasEndVertex
+ [x1, y1] = relatedValue v1 DIA.HasLocation :: [Double]
+ [x2, y2] = relatedValue v2 DIA.HasLocation :: [Double]
+ (e, sqrt ((x2 - x1)^2 + (y2 - y1)^2)))
+ distances = runProc $ MMap.create () :: MMap.T Resource Double
+ isBranchPoint v = length (v # DN.HasEndVertex_Inverse) != 1 || length (v # DN.HasStartVertex_Inverse) != 1
+ setDistance e d = MMap.put distances e d
+ getDistance e = fromJust $ MMap.get distances e
+ forward r1 r2 e cont = do
+ v = singleObject e r1
+ l = edgeLen e
+ if isBranchPoint v
+ then do
+ setDistance e (l / 2)
+ cont l
+ else do
+ e2 = singleObject v r2
+ forward r1 r2 e2 (\d2 -> do
+ setDistance e (d2 + l/2)
+ cont (d2 + l))
+ backward r1 r2 e d = do
+ l = edgeLen e
+ setDistance e $ min (d + l/2) (getDistance e)
+ v = singleObject e r1
+ if isBranchPoint v then () else backward r1 r2 (singleObject v r2) (d + l)
+ storeDistance e = if MMap.containsKey distances e
+ then ()
+ else do
+ l = edgeLen e
+ forwardTo e (const ())
+ d1 = getDistance e
+ forwardFrom e (const ())
+ d2 = getDistance e
+ setDistance e (min d1 d2)
+ backwardFrom e (d1 - l/2)
+ backwardTo e (d2 - l/2)
+ where
+ forwardTo = forward DN.HasEndVertex DN.HasStartVertex_Inverse
+ forwardFrom = forward DN.HasStartVertex DN.HasEndVertex_Inverse
+ backwardTo = backward DN.HasEndVertex DN.HasStartVertex_Inverse
+ backwardFrom = backward DN.HasStartVertex DN.HasEndVertex_Inverse
+ isMiddle e = let
+ v1 = singleObject e DN.HasStartVertex
+ v2 = singleObject e DN.HasEndVertex
+ d = getDistance e
+ in
+ (isBranchPoint v1 || d > getDistance (singleObject v1 DN.HasEndVertex_Inverse)) &&
+ (isBranchPoint v2 || d > getDistance (singleObject v2 DN.HasStartVertex_Inverse))
Code Review / simantics / district.git / blobdiff