Return to Answer

As this article,I think we want to find all of the Eulerian path.But Mathematica have no such function to do this directly.So I will delete the edge 1 <-> 2 first,then use FindEulerianCycle like follow:

• ###Make a intermediate graph without edge 1 <-> 2:

    pts = {{0, 0}, {1, 0}, {1, 1}, {0, 1}, {1/2, 1 + Sqrt[3]/2}};
    g = EdgeDelete[
    g1=Graph[{1 <-> 2, 2 <-> 3, 3 <-> 4, 1 <-> 3, 1 <-> 4, 2 <-> 4, 
    4 <-> 5, 3 <-> 5}, VertexCoordinates -> pts, 
    VertexLabels -> "Name"], 1 <-> 2]
  

• Find all of the Eulerian path:

    paths=Prepend[#, 1 <-> 2] & /@ FindEulerianCycle[g, All]
  

MapIndexed[
 Export[ToString@First[#2] <> ".gif", #, "DisplayDurations" -> 0.5] &,
  FoldList[HighlightGraph[#1, #2, GraphHighlightStyle -> "Thick"] &, 
    g1, #] & /@ paths]

PS: I found the vertex $3$ and $4$ is completely equivalent.So you can find another $6$ path.Actually I think this is a bug of FindEulerianCycle which cannot find another $6$ path.(I have reported it to W.R. as CASE:3741151.If I get any useful response,I will update it to here.)

As this article,I think we want to find all of the Eulerian path.But Mathematica have no such function to do this directly.So I will delete the edge 1 <-> 2 first,then use FindEulerianCycle like follow:

• ###Make a intermediate graph without edge 1 <-> 2:

    pts = {{0, 0}, {1, 0}, {1, 1}, {0, 1}, {1/2, 1 + Sqrt[3]/2}};
    g = EdgeDelete[
    g1=Graph[{1 <-> 2, 2 <-> 3, 3 <-> 4, 1 <-> 3, 1 <-> 4, 2 <-> 4, 
    4 <-> 5, 3 <-> 5}, VertexCoordinates -> pts, 
    VertexLabels -> "Name"], 1 <-> 2]
  

• Find all of the Eulerian path:

    paths=Prepend[#, 1 <-> 2] & /@ FindEulerianCycle[g, All]
  

MapIndexed[
 Export[ToString@First[#2] <> ".gif", #, "DisplayDurations" -> 0.5] &,
  FoldList[HighlightGraph[#1, #2, GraphHighlightStyle -> "Thick"] &, 
    g1, #] & /@ paths]

PS: I found the vertex $3$,$4$,$1$ and $2$ is completely equivalent.I think this is a bug of FindEulerianCycle which cannot find another $18$ path at least.(I have reported it to W.R. as CASE:3741151.If I get any useful response,I will update it to here.)

As this article,I think we want to find all of the Eulerian path.But Mathematica have no such function to do this directly.So I will delete the edge 1 <-> 2 first,then use FindEulerianCycle like follow:

• ###Make a intermediate graph without edge 1 <-> 2:

    pts = {{0, 0}, {1, 0}, {1, 1}, {0, 1}, {1/2, 1 + Sqrt[3]/2}};
    g = EdgeDelete[
    g1=Graph[{1 <-> 2, 2 <-> 3, 3 <-> 4, 1 <-> 3, 1 <-> 4, 2 <-> 4, 
    4 <-> 5, 3 <-> 5}, VertexCoordinates -> pts, 
    VertexLabels -> "Name"], 1 <-> 2]
  

• Find all of the Eulerian path:

    paths=Prepend[#, 1 <-> 2] & /@ FindEulerianCycle[g, All]
  

MapIndexed[
 Export[ToString@First[#2] <> ".gif", #, "DisplayDurations" -> 0.5] &,
  FoldList[HighlightGraph[#1, #2, GraphHighlightStyle -> "Thick"] &, 
    g1, #] & /@ paths]

PS: I found the vertex $3$ and $4$ is completely equivalent.So you can find another $6$ path.Actually I think this is a bug of FindEulerianCycle which cannot find another $6$ path.(I have report it to wolfram as CASE:3741151.If I get any useful response,I will update it to here.)

As this article,I think we want to find all of the Eulerian path.But Mathematica have no such function to do this directly.So I will delete the edge 1 <-> 2 first,then use FindEulerianCycle like follow:

• ###Make a intermediate graph without edge 1 <-> 2:

    pts = {{0, 0}, {1, 0}, {1, 1}, {0, 1}, {1/2, 1 + Sqrt[3]/2}};
    g = EdgeDelete[
    g1=Graph[{1 <-> 2, 2 <-> 3, 3 <-> 4, 1 <-> 3, 1 <-> 4, 2 <-> 4, 
    4 <-> 5, 3 <-> 5}, VertexCoordinates -> pts, 
    VertexLabels -> "Name"], 1 <-> 2]
  

• Find all of the Eulerian path:

    paths=Prepend[#, 1 <-> 2] & /@ FindEulerianCycle[g, All]
  

MapIndexed[
 Export[ToString@First[#2] <> ".gif", #, "DisplayDurations" -> 0.5] &,
  FoldList[HighlightGraph[#1, #2, GraphHighlightStyle -> "Thick"] &, 
    g1, #] & /@ paths]

PS: I found the vertex $3$ and $4$ is completely equivalent.So you can find another $6$ path.Actually I think this is a bug of FindEulerianCycle which cannot find another $6$ path.(I have reported it to W.R. as CASE:3741151.If I get any useful response,I will update it to here.)

As this article,I think we want to find all of the Eulerian path.But Mathematica have no such function to do this directly.So I will delete the edge 1 <-> 2 first,then use FindEulerianCycle like follow:

• ###Make a intermediate graph without edge 1 <-> 2:

  pts = {{0, 0}, {1, 0}, {1, 1}, {0, 1}, {1/2, 1 + Sqrt[3]/2}}; g = EdgeDelete[ Graph[{1 <-> 2, 2 <-> 3, 3 <-> 4, 1 <-> 3, 1 <-> 4, 2 <-> 4, 4 <-> 5, 3 <-> 5}, VertexCoordinates -> pts, VertexLabels -> "Name"], 1 <-> 2]

• Find all of the Eulerian path:

    paths=Prepend[#, 1 <-> 2] & /@ FindEulerianCycle[g, All]
  

MapIndexed[
 Export[ToString@First[#2] <> ".gif", #, "DisplayDurations" -> 0.5] &,
  FoldList[HighlightGraph[#1, #2, GraphHighlightStyle -> "Thick"] &, 
    g1, #] & /@ paths]

PS: I found the vertex $3$ and $4$ is completely equivalent.So you can find another $6$ path.(Actually I think this is a bug of FindEulerianCycle which cannot find another $6$ path.)

As this article,I think we want to find all of the Eulerian path.But Mathematica have no such function to do this directly.So I will delete the edge 1 <-> 2 first,then use FindEulerianCycle like follow:

• ###Make a intermediate graph without edge 1 <-> 2:

    pts = {{0, 0}, {1, 0}, {1, 1}, {0, 1}, {1/2, 1 + Sqrt[3]/2}};
    g = EdgeDelete[
    g1=Graph[{1 <-> 2, 2 <-> 3, 3 <-> 4, 1 <-> 3, 1 <-> 4, 2 <-> 4, 
    4 <-> 5, 3 <-> 5}, VertexCoordinates -> pts, 
    VertexLabels -> "Name"], 1 <-> 2]
  

• Find all of the Eulerian path:

    paths=Prepend[#, 1 <-> 2] & /@ FindEulerianCycle[g, All]
  

MapIndexed[
 Export[ToString@First[#2] <> ".gif", #, "DisplayDurations" -> 0.5] &,
  FoldList[HighlightGraph[#1, #2, GraphHighlightStyle -> "Thick"] &, 
    g1, #] & /@ paths]

PS: I found the vertex $3$ and $4$ is completely equivalent.So you can find another $6$ path.Actually I think this is a bug of FindEulerianCycle which cannot find another $6$ path.(I have report it to wolfram as CASE:3741151.If I get any useful response,I will update it to here.)