Skip to main content
Mathematica

Return to Answer

added 3 characters in body
Source Link
mrz
mrz
  • 11.8k
  • 2
  • 26
  • 85
ec = FindEulerianCycle[gFindEulerianCycle[edges, All];
Short[%] (* not displayed here *)

Length[ec0]Length[ec]

Out[128]= 44

ec = FindEulerianCycle[g, All];
Short[%] (* not displayed here *)

Length[ec0]

Out[128]= 44

ec = FindEulerianCycle[edges, All];
Short[%] (* not displayed here *)

Length[ec]

Out[128]= 44
added 30 characters in body
Source Link
Dr. Wolfgang Hintze
Dr. Wolfgang Hintze
  • 13.1k
  • 19
  • 48

We find 44 Eulerian paths.

We find 44 Eulerian paths.

added 5191 characters in body
Source Link
Dr. Wolfgang Hintze
Dr. Wolfgang Hintze
  • 13.1k
  • 19
  • 48
ep23 = Select[ep3, #[[2]] == 3 &]

(* Out[153]= {
{2, 3, 5, 4, 3, 1, 4, 2, 1}, {2, 3, 5, 4, 3, 1, 2, 4, 1}, 
{2, 3, 5, 4, 2, 1, 4, 3, 1}, {2, 3, 5, 4, 2, 1, 3, 4, 1}, 
{2, 3, 5, 4, 1, 3, 4, 2, 1}, {2, 3, 5, 4, 1, 2, 4, 3, 1}, 
{2, 3, 4, 5, 3, 1, 4, 2, 1}, {2, 3, 4, 5, 3, 1, 2, 4, 1}, 
{2, 3, 4, 2, 1, 4, 5, 3, 1}, {2, 3, 4, 2, 1, 3, 5, 4, 1}, 
{2, 3, 4, 1, 3, 5, 4, 2, 1}, {2, 3, 4, 1, 2, 4, 5, 3, 1}, 
{2, 3, 1, 4, 5, 3, 4, 2, 1}, {2, 3, 1, 4, 3, 5, 4, 2, 1}, 
{2, 3, 1, 2, 4, 5, 3, 4, 1}, {2, 3, 1, 2, 4, 3, 5, 4, 1}}
*)

Length[ep23]

(* Out[154]= 16 *) 

ep24 = Select[ep3, #[[2]] == 4 &]

(* Out[152]= {
{2, 4, 5, 3, 4, 1, 3, 2, 1}, {2, 4, 5, 3, 4, 1, 2, 3, 1}, 
{2, 4, 5, 3, 2, 1, 4, 3, 1}, {2, 4, 5, 3, 2, 1, 3, 4, 1}, 
{2, 4, 5, 3, 1, 4, 3, 2, 1}, {2, 4, 5, 3, 1, 2, 3, 4, 1}, 
{2, 4, 3, 5, 4, 1, 3, 2, 1}, {2, 4, 3, 5, 4, 1, 2, 3, 1}, 
{2, 4, 3, 2, 1, 4, 5, 3, 1}, {2, 4, 3, 2, 1, 3, 5, 4, 1}, 
{2, 4, 3, 1, 4, 5, 3, 2, 1}, {2, 4, 3, 1, 2, 3, 5, 4, 1}, 
{2, 4, 1, 3, 5, 4, 3, 2, 1}, {2, 4, 1, 3, 4, 5, 3, 2, 1}, 
{2, 4, 1, 2, 3, 5, 4, 3, 1}, {2, 4, 1, 2, 3, 4, 5, 3, 1}}
*)

Length[ep24]

(* Out[155]= 16 *)

In[152]:= ep24 = Select[ep3, #[[2]] == 4 &]Graphically these are

Out[152]= {{2, 4, 5, 3, 4, 1, 3, 2, 1}, {2, 4, 5, 3, 4, 1, 2, 3, 1}, {2, 4, 5, 3, 2, 1, 4, 3, 1}, {2, 4, 5, 3, 2, 1, 3, 4, 1}, {2, 4, 5, 3, 1, 4, 3, 2, 1}, {2, 4, 5, 3, 1, 2, 3, 4, 1}, {2, 4, 3, 5, 4, 1, 3, 2, 1}, {2, 4, 3, 5, 4, 1, 2, 3, 1}, {2, 4, 3, 2, 1, 4, 5, 3, 1}, {2, 4, 3, 2, 1, 3, 5, 4, 1}, {2, 4, 3, 1, 4, 5, 3, 2, 1}, {2, 4, 3, 1, 2, 3, 5, 4, 1}, {2, 4, 1, 3, 5, 4, 3, 2, 1}, {2, 4, 1, 3, 4, 5, 3, 2, 1}, {2, 4, 1, 2, 3, 5, 4, 3, 1}, {2, 4, 1, 2, 3, 4, 5, 3, 1}}

pnts = {{0, 0}, {1, 0}, {1, 1}, {0, 1}, {1/2, 1 + Sqrt[3]/2}};

GraphicsGrid[
 Partition[Table[
   Show[Graphics[
     Line[Table[{Random[]/5, Random[]/5} + pnts[[ep21[[k, i]]]], {i, 1, 
        9}]]]], {k, 1, Length[ep21]}], 6], ImageSize -> 800]

In[155]:= Length[ep24]enter image description here

Out[155]= 16

GraphicsGrid[
 Partition[
  Table[Show[
    Graphics[
     Line[Table[{Random[]/5, Random[]/5} + pnts[[ep23[[k, i]]]], {i, 
        1, 9}]]]], {k, 1, Length[ep23]}], 8], ImageSize -> 800]

Graphically these areenter image description here

In[117]:= pnts = {{0, 0}, {1, 0}, {1, 1}, {0, 1}, {1/2, 1 + Sqrt[3]/2}};

GraphicsGrid[
 Partition[
  Table[Show[
    Graphics[
     Line[Table[{Random[]/5, Random[]/5} + pnts[[ep24[[k, i]]]], {i, 
        1, 9}]]]], {k, 1, Length[ep24]}], 8], ImageSize -> 800]

In[160]:= GraphicsGrid[ Partition[Table[ Show[Graphics[ Line[Table[{Random[]/5, Random[]/5} + pnts[[ep21[[k, i]]]], {i, 1, 9}]]]], {k, 1, Length[ep21]}], 6], ImageSize -> 800]enter image description here

ep23 = Select[ep3, #[[2]] == 3 &]

(* Out[153]= {
{2, 3, 5, 4, 3, 1, 4, 2, 1}, {2, 3, 5, 4, 3, 1, 2, 4, 1}, 
{2, 3, 5, 4, 2, 1, 4, 3, 1}, {2, 3, 5, 4, 2, 1, 3, 4, 1}, 
{2, 3, 5, 4, 1, 3, 4, 2, 1}, {2, 3, 5, 4, 1, 2, 4, 3, 1}, 
{2, 3, 4, 5, 3, 1, 4, 2, 1}, {2, 3, 4, 5, 3, 1, 2, 4, 1}, 
{2, 3, 4, 2, 1, 4, 5, 3, 1}, {2, 3, 4, 2, 1, 3, 5, 4, 1}, 
{2, 3, 4, 1, 3, 5, 4, 2, 1}, {2, 3, 4, 1, 2, 4, 5, 3, 1}, 
{2, 3, 1, 4, 5, 3, 4, 2, 1}, {2, 3, 1, 4, 3, 5, 4, 2, 1}, 
{2, 3, 1, 2, 4, 5, 3, 4, 1}, {2, 3, 1, 2, 4, 3, 5, 4, 1}}
*)

Length[ep23]

(* Out[154]= 16 *)

In[152]:= ep24 = Select[ep3, #[[2]] == 4 &]

Out[152]= {{2, 4, 5, 3, 4, 1, 3, 2, 1}, {2, 4, 5, 3, 4, 1, 2, 3, 1}, {2, 4, 5, 3, 2, 1, 4, 3, 1}, {2, 4, 5, 3, 2, 1, 3, 4, 1}, {2, 4, 5, 3, 1, 4, 3, 2, 1}, {2, 4, 5, 3, 1, 2, 3, 4, 1}, {2, 4, 3, 5, 4, 1, 3, 2, 1}, {2, 4, 3, 5, 4, 1, 2, 3, 1}, {2, 4, 3, 2, 1, 4, 5, 3, 1}, {2, 4, 3, 2, 1, 3, 5, 4, 1}, {2, 4, 3, 1, 4, 5, 3, 2, 1}, {2, 4, 3, 1, 2, 3, 5, 4, 1}, {2, 4, 1, 3, 5, 4, 3, 2, 1}, {2, 4, 1, 3, 4, 5, 3, 2, 1}, {2, 4, 1, 2, 3, 5, 4, 3, 1}, {2, 4, 1, 2, 3, 4, 5, 3, 1}}

In[155]:= Length[ep24]

Out[155]= 16

Graphically these are

In[117]:= pnts = {{0, 0}, {1, 0}, {1, 1}, {0, 1}, {1/2, 1 + Sqrt[3]/2}};

In[160]:= GraphicsGrid[ Partition[Table[ Show[Graphics[ Line[Table[{Random[]/5, Random[]/5} + pnts[[ep21[[k, i]]]], {i, 1, 9}]]]], {k, 1, Length[ep21]}], 6], ImageSize -> 800]

ep23 = Select[ep3, #[[2]] == 3 &]

(* Out[153]= {
{2, 3, 5, 4, 3, 1, 4, 2, 1}, {2, 3, 5, 4, 3, 1, 2, 4, 1}, 
{2, 3, 5, 4, 2, 1, 4, 3, 1}, {2, 3, 5, 4, 2, 1, 3, 4, 1}, 
{2, 3, 5, 4, 1, 3, 4, 2, 1}, {2, 3, 5, 4, 1, 2, 4, 3, 1}, 
{2, 3, 4, 5, 3, 1, 4, 2, 1}, {2, 3, 4, 5, 3, 1, 2, 4, 1}, 
{2, 3, 4, 2, 1, 4, 5, 3, 1}, {2, 3, 4, 2, 1, 3, 5, 4, 1}, 
{2, 3, 4, 1, 3, 5, 4, 2, 1}, {2, 3, 4, 1, 2, 4, 5, 3, 1}, 
{2, 3, 1, 4, 5, 3, 4, 2, 1}, {2, 3, 1, 4, 3, 5, 4, 2, 1}, 
{2, 3, 1, 2, 4, 5, 3, 4, 1}, {2, 3, 1, 2, 4, 3, 5, 4, 1}}
*)

Length[ep23]

(* Out[154]= 16 *) 

ep24 = Select[ep3, #[[2]] == 4 &]

(* Out[152]= {
{2, 4, 5, 3, 4, 1, 3, 2, 1}, {2, 4, 5, 3, 4, 1, 2, 3, 1}, 
{2, 4, 5, 3, 2, 1, 4, 3, 1}, {2, 4, 5, 3, 2, 1, 3, 4, 1}, 
{2, 4, 5, 3, 1, 4, 3, 2, 1}, {2, 4, 5, 3, 1, 2, 3, 4, 1}, 
{2, 4, 3, 5, 4, 1, 3, 2, 1}, {2, 4, 3, 5, 4, 1, 2, 3, 1}, 
{2, 4, 3, 2, 1, 4, 5, 3, 1}, {2, 4, 3, 2, 1, 3, 5, 4, 1}, 
{2, 4, 3, 1, 4, 5, 3, 2, 1}, {2, 4, 3, 1, 2, 3, 5, 4, 1}, 
{2, 4, 1, 3, 5, 4, 3, 2, 1}, {2, 4, 1, 3, 4, 5, 3, 2, 1}, 
{2, 4, 1, 2, 3, 5, 4, 3, 1}, {2, 4, 1, 2, 3, 4, 5, 3, 1}}
*)

Length[ep24]

(* Out[155]= 16 *)

Graphically these are

pnts = {{0, 0}, {1, 0}, {1, 1}, {0, 1}, {1/2, 1 + Sqrt[3]/2}};

GraphicsGrid[
 Partition[Table[
   Show[Graphics[
     Line[Table[{Random[]/5, Random[]/5} + pnts[[ep21[[k, i]]]], {i, 1, 
        9}]]]], {k, 1, Length[ep21]}], 6], ImageSize -> 800]

enter image description here

GraphicsGrid[
 Partition[
  Table[Show[
    Graphics[
     Line[Table[{Random[]/5, Random[]/5} + pnts[[ep23[[k, i]]]], {i, 
        1, 9}]]]], {k, 1, Length[ep23]}], 8], ImageSize -> 800]

enter image description here

GraphicsGrid[
 Partition[
  Table[Show[
    Graphics[
     Line[Table[{Random[]/5, Random[]/5} + pnts[[ep24[[k, i]]]], {i, 
        1, 9}]]]], {k, 1, Length[ep24]}], 8], ImageSize -> 800]

enter image description here

added 5191 characters in body
Source Link
Dr. Wolfgang Hintze
Dr. Wolfgang Hintze
  • 13.1k
  • 19
  • 48
added 5191 characters in body
Source Link
Dr. Wolfgang Hintze
Dr. Wolfgang Hintze
  • 13.1k
  • 19
  • 48
edited body
Source Link
Dr. Wolfgang Hintze
Dr. Wolfgang Hintze
  • 13.1k
  • 19
  • 48
Source Link
Dr. Wolfgang Hintze
Dr. Wolfgang Hintze
  • 13.1k
  • 19
  • 48