Disconnected subgraph analysis for district network diagrams

[simantics/district.git] / org.simantics.district.network / scl / Simantics / District / Algorithm.scl

diff --git a/org.simantics.district.network/scl/Simantics/District/Algorithm.scl b/org.simantics.district.network/scl/Simantics/District/Algorithm.scl
index 3cd5c431e5d1b724da6e9246ea92c8cabeb012fb..f8852bdba69f2a97e69e33781f9065fb2d695aff 100644 (file)
--- a/org.simantics.district.network/scl/Simantics/District/Algorithm.scl
+++ b/org.simantics.district.network/scl/Simantics/District/Algorithm.scl
@@ -1,9 +1,19 @@
-type Subgraph = [([Resource], [Resource])]
-data Subgraphs = Subgraphs Resource Subgraph
+import "Simantics/Model"
+import "http://www.simantics.org/DistrictNetwork-1.0" as DN
+
+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
@@ -15,12 +25,16 @@ floodFill fromVertex = do
                                 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
@@ -31,7 +45,7 @@ findDisconnectedSubnetworksFromDiagram networkDiagram = let
 
     loop Nothing       = ()
     loop (Just vertex) = do
-        subgraph = floodFill vertex
+        subgraph = floodFill edgeFilter vertex
         MList.add result subgraph
         (vs, es) = subgraph
         MSet.removeAll vertexSet vs
@@ -40,38 +54,33 @@ findDisconnectedSubnetworksFromDiagram networkDiagram = let
             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
@@ -97,6 +106,9 @@ reportDisconnectedSubnetworks vertexThreshold (Subgraphs diagram subgraphs) = do
     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)")