This example goes wrong. Thank you for pointing that out. That happened because SortBy
ignores the numerical value
In[27]:= qS = SortBy[Partition[{{4, 5}, {0, 0}, {15/2, 5/2}}, 2, 1, 1], Norm[Subtract @@ #] &]
Out[27]= {{{0, 0}, {15/2, 5/2}}, {{15/2, 5/2}, {4, 5}}, {{4, 5}, {0, 0}}}
In[28]:= qS = EuclideanDistance @@@ SortBy[Partition[{{4, 5}, {0, 0}, {15/2, 5/2}}, 2, 1, 1], Norm[Subtract @@ #] &]
Out[28]= {5 Sqrt[5/2], Sqrt[37/2], Sqrt[41]}
In[29]:= N[qS]
Out[29]= {7.90569, 4.30116, 6.40312}
In[30]:= LeafCount /@ qS
Out[30]= {9, 7, 5}
Sort
on the set {5 Sqrt[5/2], Sqrt[37/2], Sqrt[41]}
respects neither the numerical value nor the LeafCount
.
In[31]:= Sort[{5 Sqrt[5/2], Sqrt[37/2], Sqrt[41]}]
Out[31]= {5 Sqrt[5/2], Sqrt[37/2], Sqrt[41]}
In[32]:= OrderedQ[Sort[{5 Sqrt[5/2], Sqrt[37/2], Sqrt[41]}]]
Out[32]= True
In[33]:= OrderedQ [LeafCount /@ {5 Sqrt[5/2], Sqrt[37/2], Sqrt[41]}]
Out[33]= False
this is a bit over-canonical but it is as it is. Well. Let's change the norm again to fix that
Clear[ledesmaQuarter, triangleQ, q, q4, orie]
orie[p1_List, p2_List, p3_List] := If[Det[{p1 - p3, p2 - p3}] > 0, {p1, p2}, {p2, p1}]
q4[l_List] :=
Block[{qS = Sort[Partition[l, 2, 1, 1], (EuclideanDistance @@ #1) < (EuclideanDistance @@ #2) &],
p01, p02, p03, p11, p12, p13},
(* triangle has points p01,p02,p03 *)
(* orient the triangle *)
(* the biggest angle (vertex p01) is opposite to the longest edge,
find it's midpoint: p11 *)
(* get the midpoint of the legs of the biggest angle: p12, p13 *)
{p02, p03} = qS[[-1]]; p01 = Complement[l, qS[[-1]]][[1]];
{p02, p03} = orie[p02, p03, p01];
{p13, p12, p11} = (Plus[#[[1]], #[[2]]]/2)& /@ qS;
{p12, p13} = orie[p12, p13, p11];
{{p01, p13, p11}, {p13, p02, p11}, {p11, p03, p12}, {p12, p01, p11}}
]
q[l_List] := Flatten[q4 /@ l, 1]
triangleQ[l_List] := If[Length[l] != 3, False,
If[Chop[Area[Triangle[l]]] == 0, False,
True]
]
ledesmaQuarter[l_Polygon (* a triangle *),
n_Integer?NonNegative(* number of sections *)] :=
Module[{l0 = Sequence @@ l},
If[! triangleQ[l0],
Print["Polygon ", l, " is not a triangle."];
Return[$Failed]
];
Graphics[Line[Join[#, {First[#]}]& /@ Nest[q, {l0}, n]], Frame -> True]
]
and look again at the test triangle
![test triangle](/c/portal/getImageAttachment?filename=comm394537_3.PNG&userId=28832)
With respect to the interesting triangulation video made by your friend, have you seen Vitaliy's post Your own personal digital Rosetta Comet, especially the MeshRegion
? I presume it's possible to redo your friend's program in Mathematica, but I'm not going to proof that.