# 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. ;) – Mazura Sep 11 '14 at 0:56
• There is a formula [n(n+2)(2n+1)]/8 Where n is no of rows – Ritik Feb 9 '18 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 – Mariano Alvaro Mar 30 '18 at 22:36

Edit faster version..

 n = 10
pt = Flatten[Table[ {(j - i/2 - 1/2), -i (Sqrt/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[#[] - #[]] ==
Norm[#[] - #[]] ==
Norm[#[] - #[]] &] & /@ 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! – ybeltukov Sep 13 '14 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, {3}],
Norm[#[] - #[]] == Norm[#[] - #[]] == Norm[#[] - #[]] &&
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}],
Norm[#[] - #[]] == Norm[#[] - #[]] ==
Norm[#[] - #[]] &];
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. – Guillochon Sep 10 '14 at 18:59
• That's a good point. – paw Sep 10 '14 at 19:01
• Why did you specify AspectRatio -> 1? That makes the triangles not remain equilateral. – Rahul Sep 10 '14 at 19:05
• @Rahul thanks, fixed. – paw Sep 10 '14 at 19:08
• Nice capture of the hidden symmetry (rotated triangles)! – ybeltukov Sep 13 '14 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[] - #[]} Sqrt/2},
With[{np = nrst[p1][]},
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 '14 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 '14 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! – ybeltukov Sep 10 '14 at 20:36
• @paw Yes, indeed! It is an interesting filter. – ybeltukov Sep 10 '14 at 20:37
• I think you can replace Unevaluated@Sequence[] with ##&[] or Sequence@@{}. The former is obviously more terse. – RunnyKine Sep 10 '14 at 20:53