# Divide a triangle into four small triangles

Posted 7 years ago
18529 Views
|
9 Replies
|
2 Total Likes
|
 Hello all, I am writing to tell you my idea. The process of splitting up a triangle either in four smaller triangles, do so by the larger angle as shown below: Graphics[Line[{{0, 0}, {7, -5}, {8, 10}, {0, 0}}]] After analyze the angles of the triangle we see that the larger angle is what is at the point {0,0}, subsequently we construct a straight line to the midpoint of the opposite side to the point {0,0 } Finally we estimate the midpoints of the sides adjacent to the point {0,0 } and the join by a straight line to the midpoint of the opposite side that we calculated above ,for finally getting the following figure:If we do the same steps with each of the four triangles, we will be able to obtain more triangles 16 in totalCan anyone help me to do what I say, I have made some progress but I am having some problems in order to apply it several times on a initial triangle
9 Replies
Sort By:
Posted 7 years ago
 The second picture is wrong
Posted 7 years ago
 Thank you for sharing the error that had my picture,The problem originated in my routine that programming in mathematica here the share ang[vert_] := Module[{m1, m2, m3, \[Theta]1, \[Theta]2, \[Theta]3, masi, pmo, mitlad1, mitlad2}, m1 = (vert[[2, 2]] - vert[[1, 2]])/(vert[[2, 1]] - vert[[1, 1]]); m2 = (vert[[3, 2]] - vert[[1, 2]])/(vert[[3, 1]] - vert[[1, 1]]); m3 = (vert[[3, 2]] - vert[[2, 2]])/(vert[[3, 1]] - vert[[2, 1]]); \[Theta]1 = ArcTan[(m2 - m1)/(1 + m2*m1)]; \[Theta]3 = ArcTan[(m3 - m2)/(1 + m2*m3)]; \[Theta]2 = ArcTan[(m1 - m3)/(1 + m3*m1)]; masi = Flatten[ Position[{\[Theta]1, \[Theta]2, \[Theta]3}, Max[{\[Theta]3, \[Theta]2, \[Theta]1}]]][[1]]; Which[masi == 3, pmo = {(vert[[1, 1]] + vert[[2, 1]])/2, ( vert[[1, 2]] + vert[[2, 2]])/2}; mitlad1 = {(vert[[1, 1]] + vert[[3, 1]])/2, ( vert[[1, 2]] + vert[[3, 2]])/2}; mitlad2 = {(vert[[2, 1]] + vert[[3, 1]])/2, ( vert[[2, 2]] + vert[[3, 2]])/2}; {Line[{vert[[masi]], pmo}], Line[{mitlad1, pmo}], Line[{mitlad2, pmo}]} , masi == 2, pmo = {(vert[[1, 1]] + vert[[3, 1]])/2, ( vert[[1, 2]] + vert[[3, 2]])/2}; mitlad1 = {(vert[[1, 1]] + vert[[2, 1]])/2, ( vert[[1, 2]] + vert[[2, 2]])/2}; mitlad2 = {(vert[[2, 1]] + vert[[3, 1]])/2, ( vert[[2, 2]] + vert[[3, 2]])/2}; {Line[{vert[[masi]], pmo}], Line[{mitlad1, pmo}], Line[{mitlad2, pmo}]} , masi == 1, pmo = {(vert[[2, 1]] + vert[[3, 1]])/2, ( vert[[2, 2]] + vert[[3, 2]])/2}; mitlad1 = {(vert[[1, 1]] + vert[[2, 1]])/2, ( vert[[1, 2]] + vert[[2, 2]])/2}; mitlad2 = {(vert[[1, 1]] + vert[[3, 1]])/2, ( vert[[1, 2]] + vert[[3, 2]])/2}; {Line[{vert[[masi]], pmo}], Line[{mitlad1, pmo}], Line[{mitlad2, pmo}]} ] ] Where vert are the vertices of the triangle, and m1, m2, m3 are the slopes between points, theta1, theta2,theta3 are the internal angles of the triangle. As well when calculating ang[{{0, 0}, {7/2, -(5/2)}, {15/2, 5/2}}] I got that error,I hope someone can help me to correct this error for future things
Posted 7 years ago
 I've still an orientation error in it - but it's too late for this evening - Clear[ledesmaQuarter, triangleQ, q, q4] triangleQ[l_List] := If[Length[l] != 3, False, If[Chop[Area[Triangle[l]]] == 0, False, True] ] q4[l_List] := Block[{qS = SortBy[Partition[l, 2, 1, 1], Norm], 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 = qS[[-1, 1]]; p03 = qS[[-1, 2]]; p01 = Complement[l, qS[[-1]]][[1]]; If[Last[Cross[Join[p02 - p01, {0}], Join[p03 - p01, {0}]]] < 0, {p02, p03} = {p03, p02} ]; {p13, p12, p11} = (Plus[#[[1]], #[[2]]]/2) & /@ qS; If[Last[Cross[Join[p12 - p11, {0}], Join[p13 - p11, {0}]]] < 0, {p12, p13} = {p13, p12} ]; {{p01, p13, p11}, {p13, p02, p11}, {p11, p03, p12}, {p12, p01, p11}} ] q[l_List] := Flatten[q4 /@ l, 1] ledesmaQuarter[l_Polygon (* a triangle *), n_Integer?Positive (* 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]]] ] giving spiders as seen here Answer Posted 7 years ago  I've still an orientation error in it It was not an orientation error, but an abuse of Norm for the data structure chosen; now it runs Clear[triangleQ, q4, q, ledesmaQuarter] triangleQ[l_List] := If[Length[l] != 3, False, If[Chop[Area[Triangle[l]]] == 0, False, True] ] q4[l_List] := Block[{qS = SortBy[Partition[l, 2, 1, 1], Norm[Subtract @@ #] &], 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, 1 ;; 2]]; p01 = Complement[l, qS[[-1]]][[1]]; If[Last[Cross[Join[p02 - p01, {0}], Join[p03 - p01, {0}]]] < 0, {p02, p03} = {p03, p02} ]; {p13, p12, p11} = (Plus[#[[1]], #[[2]]]/2) & /@ qS; If[Last[Cross[Join[p12 - p11, {0}], Join[p13 - p11, {0}]]] < 0, {p12, p13} = {p13, p12} ]; {{p01, p13, p11}, {p13, p02, p11}, {p11, p03, p12}, {p12, p01, p11}} ] q[l_List] := Flatten[q4 /@ l, 1] ledesmaQuarter[l_Polygon (* a triangle *), n_Integer?Positive (* 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] ] 
Posted 7 years ago
 Udo thank you very much for your help, I have no words to thank you've solved my problem, i will be testing your code with several triangles, thank you once again, you have shown me that I have a lot to learn from Mathematica, and for advanced users such as you.
Posted 7 years ago
 How many similar triangles do you find in such an picture? Does this number depend on the section number n? Is it finite for all positive n?
Posted 7 years ago
 Hello Udo after testing your code, I have been convinced that i could not have done, but the problem arises with the triangle that i example at the beginning of this thread, since it should be as the next image and if we try with your code we get other triangles, I hope I am wrong with the way it should have the triangle in question, but doing my calculations indicates that we need to make the partition in this way, the exciting thing is that we don't encounter because doing so Mathematica, i will continue to work on that.Changing of theme of my friend Juan shared the following video, now that he learned of my problem and I would like to ask you, if is possible to do the same in Mathematica?,I share the linkvideo sharingI hope you reply
 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 triangleWith 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.