Message Boards Message Boards

Divide a triangle into four small triangles

Posted 10 years ago

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:

first step

If we do the same steps with each of the four triangles, we will be able to obtain more triangles 16 in total

second step

Can 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

POSTED BY: Luis Ledesma
9 Replies
Posted 10 years ago

Udo,Thank you for tell me anything about where the error arose that i had with the triangle of example, I would also like to thank you for spending a lot of your valuable time to program in Mathematica the idea that i shared, it is quite true that it is a very difficult thing to do for someone who is learning Mathematica but with the assistance of someone experienced as your one arrives to see the light to these problems, I believe that we can end this thread and share ideas later in this community, thanks again.

I have seen the post of Vitaly and i thought it was very interesting but i need analysis with more calm and begin to find the possible connections with the video that you shared, that's what I'll be doing very soon.

Luis Ledesma

POSTED BY: Luis Ledesma

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

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.

POSTED BY: Udo Krause
Posted 10 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 corect

and if we try with your code we get other triangles,

testing triangle 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 link

video sharing

I hope you reply

POSTED BY: Luis Ledesma
Posted 10 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 BY: Luis Ledesma

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 BY: Udo Krause

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]
  ]

bildchen

POSTED BY: Udo Krause

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

spiders because of  misorientation

POSTED BY: Udo Krause
Posted 10 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 BY: Luis Ledesma

The second picture is wrong

wrong second step

POSTED BY: Udo Krause
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract