From: Tuukka Lehtonen <tuukka.lehtonen@semantum.fi>
Date: Thu, 11 Oct 2018 12:05:01 +0000 (+0300)
Subject: Added Simantics/District/Algorithm SCL module
X-Git-Url: https://gerrit.simantics.org/r/gitweb?a=commitdiff_plain;h=6dec5182c23ab01df1adbdcc1276b99b8968b786;p=simantics%2Fdistrict.git

Added Simantics/District/Algorithm SCL module

For now it only contains functions `findDisconnectedSubnetworks`,
`reportDisconnectedSubnetworks` for finding and reporting disconnected
subgraphs within a district network diagram. This helps in finding
possible errors in models generated from this district network model.

gitlab #11

Change-Id: I848f91b3e90684085b83bfa5c559f61f4a33ad7c
---

diff --git a/org.simantics.district.network/scl/Simantics/District/Algorithm.md b/org.simantics.district.network/scl/Simantics/District/Algorithm.md
new file mode 100644
index 00000000..c11f0e89
--- /dev/null
+++ b/org.simantics.district.network/scl/Simantics/District/Algorithm.md
@@ -0,0 +1,4 @@
+# Simantics/District/Algorithm
+
+::value[findDisconnectedSubnetworks]
+::value[reportDisconnectedSubnetworks]
diff --git a/org.simantics.district.network/scl/Simantics/District/Algorithm.scl b/org.simantics.district.network/scl/Simantics/District/Algorithm.scl
new file mode 100644
index 00000000..3cd5c431
--- /dev/null
+++ b/org.simantics.district.network/scl/Simantics/District/Algorithm.scl
@@ -0,0 +1,104 @@
+type Subgraph = [([Resource], [Resource])]
+data Subgraphs = Subgraphs Resource Subgraph
+
+@private
+floodFill :: Resource -> <ReadGraph, Proc> Subgraph
+floodFill fromVertex = do
+    processVertex fromVertex
+    (MSet.toList vertices, MSet.toList edges)
+  where
+    edgesOf vertex = (vertex # DN.HasStartVertex_Inverse, vertex # DN.HasEndVertex_Inverse)
+    vertices              = MSet.create ()
+    edges                 = MSet.create ()
+    processVertex vertex  = if MSet.add vertices vertex then do
+                                (starts, ends) = edgesOf vertex
+                                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 ()
+
+@private
+findDisconnectedSubnetworksFromDiagram :: Resource -> <ReadGraph, Proc> Subgraphs
+findDisconnectedSubnetworksFromDiagram networkDiagram = let
+    all       = networkDiagram # L0.ConsistsOf
+    vertices  = filter (flip isInstanceOf DN.Vertex) all
+    edges     = filter (flip isInstanceOf DN.Edge) all
+    vertexSet = MSet.fromList vertices
+    edgeSet   = MSet.fromList edges
+    result    = MList.create ()
+    take1 set = MSet.mapFirst Just vertexSet
+
+    loop Nothing       = ()
+    loop (Just vertex) = do
+        subgraph = floodFill vertex
+        MList.add result subgraph
+        (vs, es) = subgraph
+        MSet.removeAll vertexSet vs
+        MSet.removeAll edgeSet   es
+        if not (MSet.isEmpty vertexSet) then
+            loop (take1 vertexSet)
+        else ()
+  in do
+    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)
+
+"""
+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
+"""
+findDisconnectedSubnetworks :: Resource -> <ReadGraph, Proc> Subgraphs
+findDisconnectedSubnetworks networkDiagramOrComposite = findDisconnectedSubnetworksFromDiagram (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
+    print "## Disconnected sub-network analysis of district network \(relativeUri diagram)"
+    print "* Detailed reporting vertex count threshold is <= \(vertexThreshold)"
+    for subgraphs reportGraph
+  where
+    rootUri = match possibleIndexRoot diagram with
+                  Nothing -> ""
+                  Just root -> uriOf (parent root)
+    relativeUri r = drop (length rootUri) (uriOf r)
+
+    showVertex v = nameOf v
+
+    edgeEnds e = (possibleObject e DN.HasStartVertex, possibleObject e DN.HasEndVertex)
+    showEdgeEnds (Nothing, Nothing) = "(null, null)"
+    showEdgeEnds (Just s, Nothing)  = "(\(nameOf s), null)"
+    showEdgeEnds (Nothing, Just e)  = "(null, \(nameOf e))"
+    showEdgeEnds (Just s, Just e)   = "(\(nameOf s), \(nameOf e))"
+    showEdge e = (nameOf e) + " - " + (showEdgeEnds (edgeEnds e))
+    sortStrings l = sortWithComparator alphanumericComparator l
+
+    reportGraph (vs, es) | length vs > vertexThreshold = reportShort vs es
+                         | otherwise                   = reportFull vs es
+    reportSubgraphTitle vs es = print "\n### Disconnected sub-network of \(length vs) vertices and \(length es) edges"
+    reportShort vs es = do
+        reportSubgraphTitle vs es
+        print "* Details not reported because vertex count exceeds threshold"
+    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)")