Etydhv

the problem is to find cycle from A to B back to A, so that the path B-A would use minimum edges from path A-B. The graph is undirected and can have cycles.

The paths don't have to be shortest, they just need to use the least amount of already used edges on the way from src -> dst. Basically, I always want to take different path back from dst to src, or at least with minimum already used edges on src -> dst.

Example

Graph is undirected, this is just for representing how the path goes.

Node 0 is src and node 4 is dst.

Solution is given bY

src -> dst = 0 -> 2 -> 3 -> 4

dst -> src = 4 -> 5 -> 3 -> 2 -> 1 -> 0

The least possible shared edges in this case is one (edge 2 - 3 )

I was thinking about finding all paths from A to B, then comparing each pair and then choosing the pair with least common edges, but there is probably better approach.

If the graph is 2-edge-connected then it's easy: find a path A->B, delete it, then find one B->A in the remaining graph.

verticesToEdges[verts_] := UndirectedEdge @@@ Partition[verts, 2, 1]

findABCycle[g_, a_, b_] :=
 With[path1 = verticesToEdges@FindShortestPath[g, a, b],
 Join[path1, 
 verticesToEdges@FindShortestPath[EdgeDelete[g, path1], b, a]]
 ]

Demo:

SeedRandom[123]
g = RandomGraph[10, 20, VertexLabels -> Automatic];

a = 7; b = 8;
HighlightGraph[g, findABCycle[g, a, b], a, b]

If the graph is not bi-edge-connected, we must break it into bi-edge-connected components and do the operation on each component. The edges not in any of these components are called bridges. These are the ones that may need to be repeated (if they fall on the path between A and B).

bridges[g_] :=
 Complement[
 Sort /@ EdgeList[g],
 Flatten[Sort /@ EdgeList@Subgraph[g, #] & /@ KEdgeConnectedComponents[g, 2]]
 ]

(Note: IGraph/M has the faster and more convenient IGBridges.)

Demo:

g = Graph[1 [UndirectedEdge] 2, 2 [UndirectedEdge] 3, 3 [UndirectedEdge] 4, 
 1 [UndirectedEdge] 4, 2 [UndirectedEdge] 4, 3 [UndirectedEdge] 5, 
 5 [UndirectedEdge] 6, 6 [UndirectedEdge] 7, 7 [UndirectedEdge] 8, 
 5 [UndirectedEdge] 8, VertexLabels -> Automatic]

(Note: I actually constructed this graph in IGraph/M using IGShorthand["1-2-3-4-1,2-4,3-5-6-7-8-5"]. So much more convenient!)

The bridge is 3-5.

bridgeList = bridges[g]

Let us choose A and B:

a = 1; b = 6;

Find a shortest path:

path = verticesToEdges@FindShortestPath[g, a, b]

Any bridges along the path will need to be traversed twice, no matter what. We now separate the edges along this path into bridges and non-bridges, then determine at which vertices we are jumping from one bi-edge-connected component to the next.

ClearAll[bridgeQ]
bridgeQ[e_] := bridgeQ[e] = MemberQ[Join[bridgeList, Reverse /@ bridgeList], e]

segments = GroupBy[path, bridgeQ]

jumps = Level[segments[True], 2]

(* 3, 5 *)

Find A->B path in bi-connected components:

directionAB = 
 verticesToEdges@FindShortestPath[g, ##] & @@@ Partition[
 Join[a, jumps, b],
 2
 ]

Now the opposite way:

g2 = EdgeDelete[g, Flatten[directionAB]];

directionBA = verticesToEdges@FindShortestPath[g2, ##] & @@@ Partition[
 Reverse@Join[a, jumps, b],
 2
 ]

Now put it all together:

Flatten@Riffle[directionAB, segments[True]],
 Riffle[directionBA, Reverse /@ segments[True]]

HighlightGraph[g, result, a, b, VertexSize -> Medium]

Wrap it all up:

findAvoidingRoundtrip[g_, a_, b_] := 
 Module[bridgeList, bridgeQ, path, segments, jumps, directionAB, directionBA, g2,
 bridgeList = bridges[g];
 path = verticesToEdges@FindShortestPath[g, a, b];

 Set[bridgeQ[#], True] & /@ Join[bridgeList, Reverse /@ bridgeList];
 bridgeQ[_] = False;

 segments = GroupBy[path, bridgeQ];

 jumps = Level[segments[True], 2];

 directionAB = 
 verticesToEdges@FindShortestPath[g, ##] & @@@ 
 Partition[Join[a, jumps, b], 2];
 g2 = EdgeDelete[g, Flatten[directionAB]];
 directionBA = 
 verticesToEdges@FindShortestPath[g2, ##] & @@@ 
 Partition[Reverse@Join[a, jumps, b], 2];

 Flatten@Riffle[directionAB, segments[True]], 
 Riffle[directionBA, Reverse /@ segments[True]]
 ]

Here's a demo on a larger graph. This time I will use IGraph/M for constructing the example, simply for convenience.

Generate a nice graph suitable for this problem:

bigGraph = GridGraph[10, 10];
bigGraph = 
 SetProperty[bigGraph, VertexCoordinates -> GraphEmbedding[bigGraph]];

IGSeedRandom[12]
g = IGTakeSubgraph[bigGraph, IGRandomEdgeWalk[bigGraph, 1, 100], 
 VertexLabels -> Automatic]

Highlight the path:

a = 72; b = 56;
HighlightGraph[
 g,
 Join[findAvoidingRoundtrip[g, a, b], a, b],
 GraphHighlightStyle -> "Thick"
 ]

findAvoidingRoundtrip[g, a, b]

The idea is to construct a new graph G2 where all edges that are already used in the forward path are given a large weight. Then we look for a return path in this new graph by using FindShortestPath. This shortest path will try to use as few of the high-weight edges as possible.

Start with a random graph G and a given forward path between A and B:

G = RandomGraph[UniformGraphDistribution[200, 300]];
A = 1;
B = 2;
forwardPath = FindShortestPath[G, A, B];

First, convert the forward path (list of vertices) to a list of edges, using Szabolcs' helper function verticesToEdges:

verticesToEdges[verts_] := UndirectedEdge @@@ Partition[verts, 2, 1]
forwardEdges = verticesToEdges[forwardPath];

Next, construct a graph where the edges of the forward path have a large weight (here the square of the total number of edges in the graph G), all with lots of help from Szabolcs:

G2 = SetProperty[G, EdgeWeight ->
 Thread[Join[forwardEdges, Reverse/@forwardEdges] -> Length[EdgeRules[G]]^2]];

Notice that we're working around a bug here: quoting Szabolcs, "if when setting edge weights, an undirected edge is specified in the reverse direction compared to how it appears in the path, the edge weight will not be set."

Finally, compute the return path as the shortest path in this edge-weighted graph G2:

returnPath = FindShortestPath[G2, B, A];

Make a nice plot (with more help from Szabolcs):

returnEdges = verticesToEdges[returnPath];
Pforward = HighlightGraph[G, Style[forwardEdges, Green, Thickness[0.01]]];
Preturn = HighlightGraph[G, Style[returnEdges, Red, Thickness[0.005]]];
Show[G, Pforward, Preturn, ImageSize -> Full]

All together in one function:

findDifferentReturn[G_Graph, forwardPath_List] := 
 FindShortestPath[
 SetProperty[G, 
 EdgeWeight -> Thread[Join[#, Reverse /@ #] &[
 UndirectedEdge @@@ Partition[forwardPath, 2, 1]]
 -> Length[EdgeRules[G]]^2]],
 Last[forwardPath], First[forwardPath]]

Finally, according to the comments by Szabolcs we can use this function to construct a cycle that is optimally avoiding itself:

findEdgeAvoidingCycle[G_Graph, A_Integer, B_Integer] := 
 With[fp = FindShortestPath[G, A, B],
 fp, findDifferentReturn[G, fp]]

Try it out with the given example:

GG = Graph[UndirectedEdge @@@ 0,2, 0,1, 1,2, 2,3, 3,4, 3,5, 4,5]

findEdgeAvoidingCycle[GG, 0, 4]

0, 2, 3, 4, 4, 5, 3, 2, 1, 0