TSP tours in Mathematica

numPoints=100;
points=RandomReal[1,{numPoints,2}];
pointPlot=ListPlot[points->Range[numPoints],PlotRange->{{0,1},{0,1}},AspectRatio->1]

{dist,tour}=FindShortestTour[points]

tour

Show[
Graphics[Line[points[[tour]]]],
pointPlot
]

Simplicial Complexes

Consider the following set of points in (ℝ^2). These will be the vertices (or 0-simplices) of a simplicial complex.

numPoints=10;
points={{0.26153,0.124706},{0.475356,0.338278},{0.197786,0.319451},{0.039825,0.237645},{0.145179,0.492856},{0.836802,0.665642},{0.761772,0.905109},{0.673323,0.712484},{0.927742,0.79145},{0.455305,0.639258}}
pointPlot=ListPlot[points->Range[numPoints],PlotRange->{{0,1},{0,1}},AspectRatio->1]

Now define an abstract simplicial complex:

complex=Table[{n},{n,numPoints}]

AppendTo[complex,{1,2}]

complex=Union[complex,{{2,3},{3,5},{1,3},{1,4},{3,4},{1,3,4},{6,7},{6,8},{6,9},{7,8},{8,9},{7,9},{6,7,8},{7,8,9}}]

Using the given set of points, we can draw the geometric realization of our simplicial complex:

drawGeometricRealization[complex_,points_]:=Module[
{verts={}, edges={}, faces={}},

(* make lists of simplices of each dimension *) 
Do[
If[Length[simplex]==1,AppendTo[verts,points[[simplex[[1]]]]]];
If[Length[simplex]==2,AppendTo[edges,points[[simplex]]]];
If[Length[simplex]==3,AppendTo[faces,points[[simplex]]]]
,{simplex,complex}];


Print[faces];

(* return the drawing *) 
Graphics[{Cyan,Triangle[faces],Black,Line[edges],PointSize[Medium],Point[verts]}] 
]

drawGeometricRealization[complex,points]

Closure under subsets

A simplicial complex is supposed to be closed under subsets. This means that if σ is a simplex in an abstract simplicial complex K, then every subset of σ is also a simplex in K.

Write a function that takes a family of sets K and determines whether or not it is closed under subsets.

Here is one solution:

checkClosure[complex_]:=Module[{subs},
(* loop over all simplices in the complex *) 
Do[
(* get all subsets (faces) of this simplex *) 
subs=Subsets[simp,{1,Length[simp]-1}];

(* loop over all subsets (faces) of this simplex *) 
Do[
(* if we find a subset that is not a member of the complex, then return false *) 
If[!MemberQ[complex,s],Print[s];Return[False,Module]],
{s,subs}
],
{simp,complex}];

(* if we get here, then all subsets of all simplices are members of the complex *) 
Return[True]
]

Try out our new module. It should return true for the complex we previously defined:

checkClosure[complex]

The next example should return false. The print statement helps us see which subset was not found in the complex.

checkClosure[{{1},{2},{3},{1,2},{2,3},{1,2,3}}]