# Find the central point in each Sierpinski triangle

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

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?

• The question arises: what for? Mar 17 at 16:13
• even the simplest way TriangleCenter[SGg[[{3,5,7}]], "Centroid"] Mar 17 at 16:14
• then TriangleCenter[SGg[[#]], "Centroid"] &/@{{1,2,3},{3,5,7}} etc. Mar 17 at 16:15
• 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. Mar 17 at 16:18
• 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.
– josh
Mar 17 at 20:26

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


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


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.

InternalInheritedBlock[{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])}}

• Can you automatically generate exact coordinates rather then approximated ones? E.g. the "first" point should be {1/16, 1/(16 Sqrt[3])}`. Mar 18 at 13:40
• @Artes see my edit. Mar 18 at 13:58
• Thanks, nice (+1), although I prefer a more specific approach not relying on internal "hacks". Mar 18 at 14:16
• 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. Mar 25 at 19:38