mjhjmtu

Consider a set of edges composing a directed graph. For example:

edges = DirectedEdge[1, 2], DirectedEdge[2, 3], DirectedEdge[4, 3], DirectedEdge[3, 5], DirectedEdge[5, 6], DirectedEdge[6, 7];
Graph[edges]

I would like to have a function stripOff that iteratively strips off the outer edges that are simply connected to the rest, and returns them together with the remaining graph:

incoming1, outgoing1, remains1= stripOff[edges]
Graph[remains1]

DirectedEdge[1, 2],DirectedEdge[4, 3] ,

DirectedEdge[6, 7] ,

DirectedEdge[2, 3], DirectedEdge[3, 5], DirectedEdge[5, 6]

In the next iteration step it should give

incoming2, outgoing2, remains2= stripOff[remains1]
Graph[remains2]

DirectedEdge[2, 3] ,

DirectedEdge[5, 6] ,

DirectedEdge[3, 5]

And finally in the last iteration step

incoming3, outgoing3, remains3= stripOff[remains2]

DirectedEdge[3, 5] ,

,

Is there a quick way to construct such a stripOff function in mathematica? Thanks for any suggestion!

EDIT:

Note that I am trying to iteratively strip off external legs of the graph, which are connected to a vertex only on one side, not on both.

Even though the graph

edges = DirectedEdge[1, 2], DirectedEdge[2, 3], DirectedEdge[4, 3], DirectedEdge[5, 4];
Graph[edges]

contains a sink in the middle, the function should not cut the graph in two, but only stip off outer legs:

incoming, outgoing, remains= stripOff[edges]

DirectedEdge[1, 2] ,

DirectedEdge[5, 4] ,

DirectedEdge[2, 3], DirectedEdge[4, 3]

g = Graph[edges, VertexLabels -> Automatic]

source[g_?GraphQ] := Pick[VertexList[g], VertexInDegree[g], 0]
sink[g_?GraphQ] := Pick[VertexList[g], VertexOutDegree[g], 0]

strip[g_] :=
 With[so = source[g], si = sink[g],
 Flatten[IncidenceList[g, #] & /@ so], 
 Flatten[IncidenceList[g, #] & /@ si], 
 VertexDelete[g, Join[so, si]]
 ]

There are minor issues, such as returning an edge twice at the last step, but that should be easy (if tedious) to fix.

sourceEdges = IncidenceList[#, GeneralUtilities`GraphSources @ # ]&;
sinkEdges = Complement[IncidenceList[#, GeneralUtilities`GraphSinks @ #], 
 sourceEdges @ #]&; 
rest = Complement[#, sourceEdges@#, sinkEdges@#] &;
f = Rest @ NestWhileList[sourceEdges @ #[[3]], sinkEdges @ #[[3]], rest @ #[[3]]&,
 , , #, #[[3]] =!= &]&;

f @ edges

1 -> 2, 4 -> 3, 6 -> 7, 2 -> 3, 3 -> 5, 5 -> 6,

2 -> 3, 5 -> 6, 3 -> 5,

3 -> 5, ,

You can also use GraphComputation`SourceVertexList and GraphComputation`SinkVertexList for GeneralUtilities`GraphSources and GeneralUtilities`GraphSinks, respectively.