+
+"""
+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))