# Illustration of Motzkin numbers: how to delete duplicates

The $$n$$-th Motzkin number is the number of different ways of drawing non-intersecting chords between $$n$$ points on a circle (not necessarily touching every point by a chord -- see https://en.wikipedia.org/wiki/Motzkin_number).

When drawing these different ways one can draw circles with non-intersecting chords, but this generates duplicates (modulo rotations and symmetries).

For example the $$4$$-th Motzkin number is $$M_4=9$$, the corresponding representations being as follows. Given all possible configurations of a circle with $$n$$ points and non-intersecting chords, how to delete duplicate graphics (that are identical modulo rotations and symmetries)?

Following is the drawing code, it generates such duplicates

HasIntersectionQ[lines_] := GeneralUtilitiesScope[
If[Length@lines < 2, Return@False];
AnyTrue[Subsets[lines, {2}], LineIntersectionQ]
]
LineIntersectionQ[{a_Line, b_Line}] := GeneralUtilitiesScope[
If[Length@Union@Flatten[{First@a, First@b}, 1] != 4, Return@True];
Length@FindInstance[{x, y}\[Element]N@a && {x, y}\[Element]N@b, {x, y}] != 0
]
draw[lines_] := Graphics[{
Thickness[0.01], Circle[],
PointSize[0.05], Point /@ CirclePoints[n],
Red, Thickness[0.05], lines
}];

n = 4;
lines = Line /@ Subsets[CirclePoints[n], {2}];
draw /@ GeneralUtilitiesDiscard[Subsets[lines, Floor[n / 2]], HasIntersectionQ]

• I am confused. How is the term "Motzkin circle" meaningful? The Wiki page is about the Motzkin number. Mar 22, 2020 at 11:59
• @HenrikSchumacher, some other name: oeis.org/A185100 Mar 23, 2020 at 15:46
• Not quite an answer but if you need to directly generate non-duplicate circles you may want to have a look at Chord Diagrams for Motzkin Numbers (demonstrations.wolfram.com/ChordDiagramsForMotzkinNumbers).
– A.G.
Apr 21, 2021 at 19:15

Here's a faster alternative. We don't work with points. We work with the angles. In fact, let's not even work with angles. Let us work with the integer scale of the angle.

E.g. $$\{\cos(3\frac{2\pi}{7}),\sin(3\frac{2\pi}{7})\} \rightarrow 3\frac{2\pi}{7} \rightarrow 3$$

When we are check for two lines crossing, we have two pairs of integers: $$\{a,b\},\{p,q\}$$. From the way they are generated, we always have $$a$$ as the smallest number. Then the only non-crossing configurations are: $$a and $$a.

We can pick out unique configurations by converting the lines to a set of lengths.

ClearAll@LineIntersectionQ;
LineIntersectionQ[{{a_?NumberQ, b_}, {p_, q_}}] :=
LineIntersectionQ[{{a, b}, {p, q}}] = ! ((a < p && q < b) || b < p);
LineIntersectionQ[_] := False;
ClearAll@HasIntersectionQ;
HasIntersectionQ[a_] := AnyTrue[Subsets[a, {2}], LineIntersectionQ];

ClearAll@lengthy;
lengthy[v_, n_] :=
Sort@Map[Module[{a, b}, {a, b} = # (2 Pi)/n;
If[b - a > Pi, 2 P] - (b - a), b - a]] &, v];

ClearAll@draw;
draw[a_, n_] :=
Graphics[{CapForm["Round"], RGBColor[173, 216, 230],
Thickness[0.01], Circle[], PointSize[0.05],
Point /@ CirclePoints[{1, 0}, n], Red, Thickness[0.05],
Line /@ Map[{Cos[# (2 Pi)/n], Sin[# (2 Pi)/n]} &, a, {2}]}];

ClearAll@Motzkin;
Motzkin[n_Integer] :=
Module[{angles},
angles = Subsets[Range[0, n - 1], {2}];
angles = DeleteDuplicatesBy[angles, lengthy[#, n] &];

draw[#, n] & /@ angles
];


This can generate up to 10 points in ok time: The slowest bit remains generating all the possible subsets, then filtering them. There is a huge amount of clearly wrong combinations generated. E.g. {{0,1},{0,2}} repeats vertex 0 so shouldn't even be considered. One could put in a bunch of effort to replace Subsets with something better for this application. But given the rate at which the Motzkin numbers increase, it might not be worth it.

### Some attempts:

norm[l_] := First@Sort@Map[Sort, Table[Map[RotationMatrix[2 Pi * i / n].#&, l, {3}], {i, n}], {3}];

n = 4;
lines = Line /@ Subsets[CirclePoints[n], {2}];
MapIndexed[draw, cs = GeneralUtilitiesDiscard[Subsets[lines, Floor[n / 2]], HasIntersectionQ]];
MapIndexed[draw, cs = DeleteDuplicates[norm /@ cs]]


Seems to work for n = 4: But n = 5 fails: • What final result could be for n=5? Can you just show how it looks like? Apr 21, 2021 at 19:14

First we need to organize Module since all functions depends on n. Second, we add one filter more based on ArcLength. Finally we have

 Clear["Global*"]

f[nn_] :=
Module[{n = nn},
HasIntersectionQ[lines_] :=
GeneralUtilitiesScope[If[Length@lines < 2, Return@False];
AnyTrue[Subsets[lines, {2}], LineIntersectionQ]];
LineIntersectionQ[{a_Line, b_Line}] :=
GeneralUtilitiesScope[
If[Length@Union@Flatten[{First@a, First@b}, 1] != 4, Return@True];
Length@
FindInstance[{x, y} \[Element] N@a && {x, y} \[Element] N@b, {x,
y}] != 0];
draw[lines_] :=
Circle[], PointSize[0.05], Point /@ CirclePoints[{1, 0}, n], Red,
Thickness[0.05], lines}];
norm[l_] :=
First@Sort@
Map[Sort,
Table[Map[RotationMatrix[2 Pi*i/n] . # &, l, {3}] //
FullSimplify, {i, n}], {3}];
norm1[l_] := Sort@Map[Sort, Map[ArcLength, l], {3}];
lines = Line /@ Subsets[N@CirclePoints[{1, 0}, n], {2}];
HasIntersectionQ]; cs1 = DeleteDuplicatesBy[cs, norm];
cs2 = DeleteDuplicatesBy[cs1, norm1];
g = Map[draw, cs2]; g]


With f we can compute f, f, f For some reason the drawing code doesn't work for me.

Too much for a comment, maybe you could treat them as an image?

i = Table[ImageRotate[c0, i], {i, 0, 2 Pi, 2 Pi/n}] If you rotate by n , DeleteDuplicates[] works pretty nicely.

You can make a True / False method

images = MorphologicalComponents[#] & /@ i;

Avoiding images maybe you could use a matrix or the line and test similarity using JordanDecomposition[] , I guess you'd still need rotation though.