Mathematica 绘制完全图并查找哈密顿回路

下面链接给出了一种绘制完全图的方式，本文对齐进行了扩展和完善。https://jingyan.baidu.com/article/48a420571ed475a925250449.html

pts = Table[ReIm[E^(I*2n*Pi/12)],{n,0,11}]

lines = Subsets[pts,{2}];

Length[lines]

Graphics[Line[#] &/@ lines]

注意：省略*，有时会导致错误，没有进行计算，只是返回一个表达式。

Wqt[m_]:=

Graphics[

Line[#] &/@

Subsets[

Table[ReIm[

E^(I*2n*Pi/m)],{n,0,m-1}

],{2}

]

]

Wqt[5]

     上面的方法只是画出完全图来，而不是构造一个图的对象。没有办法再继续做图的分析，比如，寻找哈密顿回路。下面代码构造了12阶完全图，比上面方法更简单。

pts = Table[i,{i,1,12}]

lines = Subsets[pts,{2}];

Length[lines]

g = Graph[lines ]

FindHamiltonianCycle[g,3]

一般的完全图构造函数Wqt定义

Wqt[m_]:=Graph[Subsets[Table[i,{i,1,m}],{2}],VertexLabels->"Name"]

g = Wqt[5]

FindHamiltonianCycle[g,3]

     3阶完全图，求6条哈密顿回路，只返回1条，说明只返回了不重复的。5阶只返回了12条不重复的。

      最直接的是采用系统自带的CompleteGraph函数。

g=CompleteGraph[3]

FindHamiltonianCycle[g,3]