3
$\begingroup$

I'm trying to do something like this for higher orders.

enter image description here

What I've done is using a code available on internet to generate the Sierpinski points, and then TriangleCenter to obtain the medium points but in a manual way. For l=4, for example, this become very tedious to do manually

sierpinski[{a_, b_, c_}] := 
  With[{ab = (a + b)/2, bc = (b + c)/2, 
    ca = (a + c)/2}, {{a, ab, ca}, {ab, b, bc}, {ca, bc, c}}];

pts = {{0, 0}, {1, 0}, {1/2, Sqrt[3]/2}} // N;
l = 2;
d = Nest[Join @@ sierpinski /@ # &, {pts}, 
  l]; 

SGg = DeleteDuplicates[Sort[Flatten[d, 1]]];

(*L=1*)
(*MEDIUM={TriangleCenter[{SGg[[1]],SGg[[2]],SGg[[3]]},"Centroid"],\
TriangleCenter[{SGg[[3]],SGg[[5]],SGg[[6]]},"Centroid"],\
TriangleCenter[{SGg[[2]],SGg[[4]],SGg[[5]]},"Centroid"]};*)

(*L=2*)
MEDIUM = {TriangleCenter[{SGg[[1]], SGg[[2]], SGg[[3]]}, "Centroid"], 
   TriangleCenter[{SGg[[3]], SGg[[5]], SGg[[7]]}, "Centroid"], 
   TriangleCenter[{SGg[[7]], SGg[[10]], SGg[[12]]}, "Centroid"], 
   TriangleCenter[{SGg[[14]], SGg[[15]], SGg[[12]]}, "Centroid"], 
   TriangleCenter[{SGg[[2]], SGg[[4]], SGg[[5]]}, "Centroid"], 
   TriangleCenter[{SGg[[10]], SGg[[13]], SGg[[14]]}, "Centroid"], 
   TriangleCenter[{SGg[[4]], SGg[[6]], SGg[[8]]}, "Centroid"], 
   TriangleCenter[{SGg[[8]], SGg[[11]], SGg[[13]]}, "Centroid"], 
   TriangleCenter[{SGg[[6]], SGg[[9]], SGg[[11]]}, "Centroid"]};

SG = Union[SGg, MEDIUM]; 

How could I optimize this?

$\endgroup$
7
  • $\begingroup$ The question arises: what for? $\endgroup$
    – user64494
    Mar 17 at 16:13
  • $\begingroup$ even the simplest way TriangleCenter[SGg[[{3,5,7}]], "Centroid"] $\endgroup$ Mar 17 at 16:14
  • 2
    $\begingroup$ then TriangleCenter[SGg[[#]], "Centroid"] &/@{{1,2,3},{3,5,7}} etc. $\endgroup$ Mar 17 at 16:15
  • $\begingroup$ Hmm this is pretty cool. If I SortBy Last, and make a list Table[{i,i+1,i+17},{i,1,16}] for l=4 it works well for the first line. $\endgroup$ Mar 17 at 16:18
  • $\begingroup$ I see two options: (1) Analyze the iterated construction of sierpinski and modify it to handle the nested triangles (1,3,9,27,...) as they are created, or (2) Write your own routine: start with just one triangle, get mid points, then construct the next level of three triangles, get midpoints, then for each of these, construct the nine interior triangles of each of those and so on. I think (2) is best way to go although will take some time. $\endgroup$
    – josh
    Mar 17 at 20:26

2 Answers 2

4
$\begingroup$

If I interpret your code correctly, then d contains the coordinates of the vertices of all triangles. To start from there, you may map "TriangleCenter" onto d and then apply "Point" to the result.

Further. To draw the triangles, you may either map "Triangle" on d:

l = 3;
d = Nest[Join @@ sierpinski /@ # &, {pts}, l];
Graphics[{Green, Triangle /@ d, Red, Point[TriangleCenter /@ d]}]

enter image description here

Or you may draw the polygon that makes up the triangle. However, for this you need to add the last stroke that closes the triangle:

Graphics[{Line@Append[#, #[[1]]] & /@ d, Point[TriangleCenter /@ d]}]

enter image description here

$\endgroup$
6
$\begingroup$

One way is to retrieve the MeshCellCentroid property for each SierpinskiMesh cell.

mesh = SierpinskiMesh[3];

centers = AnnotationValue[{mesh, 2}, MeshCellCentroid];

Show[mesh, Graphics[Point[centers]]]


Per the comments, we can get exact centers by injecting an undocumented option into MeshRegion. As with anything undocumented, no promises that this will work in future versions.

Internal`InheritedBlock[{MeshRegion},
  Unprotect[MeshRegion];
  MeshRegion[args__] /; FreeQ[{args}, WorkingPrecision -> _, {1}] := 
     MeshRegion[args, WorkingPrecision -> ∞];

  mesh = SierpinskiMesh[3];
]

centers = AnnotationValue[{mesh, 2}, MeshCellCentroid];

centers[[1 ;; 3]]
{{1/16, 1/(16 Sqrt[3])}, {3/16, 1/(16 Sqrt[3])}, {1/8, 1/(4 Sqrt[3])}}
$\endgroup$
4
  • 1
    $\begingroup$ Can you automatically generate exact coordinates rather then approximated ones? E.g. the "first" point should be {1/16, 1/(16 Sqrt[3])}. $\endgroup$
    – Artes
    Mar 18 at 13:40
  • $\begingroup$ @Artes see my edit. $\endgroup$
    – Greg Hurst
    Mar 18 at 13:58
  • $\begingroup$ Thanks, nice (+1), although I prefer a more specific approach not relying on internal "hacks". $\endgroup$
    – Artes
    Mar 18 at 14:16
  • $\begingroup$ With this edit I could get the {x,y} points thanks! But the solution given by Daniel Huber was right under my nose and I didnt saw it! I got surprised. $\endgroup$ Mar 25 at 19:38

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.