X-Git-Url: https://gerrit.simantics.org/r/gitweb?a=blobdiff_plain;f=org.simantics.district.network%2Fscl%2FSimantics%2FDistrict%2FAlgorithm.scl;h=c03ea7964ebc379a32ebc96a2547f3921a8391cd;hb=29af77f249a4842bfd3f9280755121c9c98b32a1;hp=3cd5c431e5d1b724da6e9246ea92c8cabeb012fb;hpb=6dec5182c23ab01df1adbdcc1276b99b8968b786;p=simantics%2Fdistrict.git diff --git a/org.simantics.district.network/scl/Simantics/District/Algorithm.scl b/org.simantics.district.network/scl/Simantics/District/Algorithm.scl index 3cd5c431..c03ea796 100644 --- a/org.simantics.district.network/scl/Simantics/District/Algorithm.scl +++ b/org.simantics.district.network/scl/Simantics/District/Algorithm.scl @@ -1,9 +1,22 @@ -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 -> Boolean) @private -floodFill :: Resource -> Subgraph -floodFill fromVertex = do +floodFill :: ElementFilter -> Resource -> Subgraph +floodFill edgeFilter fromVertex = do processVertex fromVertex (MSet.toList vertices, MSet.toList edges) where @@ -15,12 +28,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 -> Subgraphs -findDisconnectedSubnetworksFromDiagram networkDiagram = let +findDisconnectedSubnetworksFromDiagram :: ElementFilter -> Resource -> 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 +48,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 +57,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 -> Subgraphs -findDisconnectedSubnetworks networkDiagramOrComposite = findDisconnectedSubnetworksFromDiagram (toDiagram networkDiagramOrComposite) +findDisconnectedSubnetworks :: ElementFilter -> Resource -> 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 -> () -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,8 +109,90 @@ 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)") 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 -> [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 -> [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))