# How many triangles are there?

Some time ago I found a puzzle and it stopped my work until I solved it.

One of the possible solutions:

Let us sum upright and upside down triangles whose top lies in the $i$-th row. $$N=\sum_{i=1}^n N_i^\Delta + N_i^\nabla.$$

For upright triangles we should multiply the number of possible sizes $n-i+1$ by the number of possible horizontal positions $i$ $$N_i^\Delta = (n-i+1)i.$$ An upside down triangle with size $l$ at $i$-th row have $n-i-l+1$ positions and the size $l$ limited by $\min(i,n-i)$, therefore $$N_i^\nabla = \sum_{l=1}^{\min(i,n-i)}(n-i-l+1).$$

Finally, we have $$N=\sum_{i=1}^n\Bigl((n-i+1)i+\sum_{l=1}^{\min(i,n-i)}(n-i-l+1)\Bigr).$$

For $n=28$ rows we get $N=5985$ triangles.

My question is: could you suggest a less trivial solution, which can reveal the power of the different sides of Mathematica? I mean look at this problem from different sides: finding a sequence, image-processing, finding a cycles in a graph and so on.

• Don't forget the five in the legend, the two green ones on each side, and the three A's in the title. ;) Sep 11, 2014 at 0:56
• There is a formula [n(n+2)(2n+1)]/8 Where n is no of rows Feb 9, 2018 at 10:44
• A trivial solution would be adding the first 28 triangle numbers (from 1 to 406 which total is 4060), that represents the number of triangles up. The you have to add the same triangle numbers but skipping one (1, 6, 15, 28..378, which total is 1925) that represents the triangles down) So total number of triangles are 4060+1925=5985 Mar 30, 2018 at 22:36

Edit faster version..

 n = 10
pt = Flatten[Table[ {(j - i/2 - 1/2), -i (Sqrt[3]/2)}, { i, n}, {j, i} ], 1];
isegs = GatherBy[ Select[ Subsets[pt, {2}] ,
IntegerQ[(3/Pi) ArcTan @@ (Subtract @@ #)] & ], Norm[Subtract @@ #] & ];
all = Flatten[
Union@Select[Union@Flatten[#, 1] & /@ Subsets[#, {2}] ,
Length[#] == 3 &&
Norm[#[[2]] - #[[1]]] ==
Norm[#[[3]] - #[[1]]] ==
Norm[#[[2]] - #[[3]]] &] & /@ isegs, 1];

Export["test.gif", Graphics[{Polygon[# ],Point@pt}] & /@ all ]


 Length@all


235

This returns the 5985 value in reasonable time. Note by the way for a large enough grid you pick up integer length point distances that are not aligned with the grid.

• Thank your for participating, your visualization is really nice! Sep 13, 2014 at 22:00

I don't really know what kind of answer you expect here. Your answer is obviously the smart way.

Brute force is always an option though:

trianglePoints[n_] := Module[{p = {}, s = 1},
Do[Do[AppendTo[p, {a + b/2, Sqrt[0.75] b}], {b, 0, n + 1 - s}];
s++;, {a, 1, n + 1}]; p]

res = Select[Subsets[trianglePoints[28], {3}],
Norm[#[[1]] - #[[2]]] == Norm[#[[1]] - #[[3]]] == Norm[#[[2]] - #[[3]]] &&
Length@DeleteDuplicates@Flatten@#[[{1, 3}]] == 3 &];
Length@res


5985

By the way, there are many more equilateral triangles to find. Check this example:

res2 = Select[Subsets[trianglePoints[3], {3}],
Norm[#[[1]] - #[[2]]] == Norm[#[[1]] - #[[3]]] ==
Norm[#[[2]] - #[[3]]] &];
Grid[
Partition[
Graphics[{GrayLevel[0.5],
Triangle[{{1, 0}, {3, 4*Sqrt[0.75]}, {5, 0}}],
RGBColor[RandomReal[], RandomReal[], RandomReal[]],
Triangle[#]}] & /@ res2
, 4]]


• Given that lines are drawn already on the original puzzle, I would think it's asking only to count the triangles that can be formed with the existent lines. Sep 10, 2014 at 18:59
• That's a good point.
– paw
Sep 10, 2014 at 19:01
• Why did you specify AspectRatio -> 1? That makes the triangles not remain equilateral.
– user484
Sep 10, 2014 at 19:05
• @Rahul thanks, fixed.
– paw
Sep 10, 2014 at 19:08
• Nice capture of the hidden symmetry (rotated triangles)! Sep 13, 2014 at 22:02

# MorphologicalBranchPoints

By "less trivial" I mean everything related to the problem. Let me give an example. One can consider this problem as an image-processing problem and calculate the number of triangles directly from the picture (the cropped one).

thin = Thinning@ColorNegate@Binarize@Import@"http://i.stack.imgur.com/vhqI9.png"


points = Dilation[#, 1] &@MorphologicalBranchPoints@thin


p = ComponentMeasurements[MorphologicalComponents@points,"Centroid"][[All, 2]];
Graphics@Point[p]


We get nice positions of the corners. Now it remains to find all possible equilateral triangles with one horizontal side. Here 10 is the threshold in pixels

nrst = Nearest[p];

snap = With[{p1 = +##/2 + {0, #2[[1]] - #[[1]]} Sqrt[3]/2},
With[{np = nrst[p1][[1]]},
If[Norm[np - p1] < 10, {np, ##, np}, Unevaluated@Sequence[]]]] &;

triangles =
Flatten[{snap @@ #, snap @@ Reverse@##} & /@
Select[Subsets[p, {2}], Abs[#[[1, 2]] - #[[2, 2]]] < 10 &], 1];

Graphics@Line@triangles


Length@triangles


5985

• Great answer to your own question ! Maybe you want to thank the other participants ?
– eldo
Sep 10, 2014 at 20:20
• simpler way to get the points from the image: p = ComponentMeasurements[Binarize@CornerFilter@Import@"http://i.stack.imgur.com/vhqI9.png" //ImageAdjust, "Centroid"][[All, 2]];
– paw
Sep 10, 2014 at 20:21
• @eldo, I ask this question not for the answer as a number or a formula. I ask it for different ideas and approaches. It is very fascinating and allows to learn something new for me and another participants. My answer is just an example. It is not a "final answer". It would be great to take another answers! Sep 10, 2014 at 20:36
• @paw Yes, indeed! It is an interesting filter. Sep 10, 2014 at 20:37
• I think you can replace Unevaluated@Sequence[] with ##&[] or Sequence@@{}. The former is obviously more terse. Sep 10, 2014 at 20:53