From: Tuukka Lehtonen 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=refs%2Fchanges%2F03%2F2303%2F1;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 (cherry picked from commit 6dec5182c23ab01df1adbdcc1276b99b8968b786) --- 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 -> 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 -> 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 -> 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 -> () +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)")