How do I convert this Nicomachus's Triangle to one with edges?

I want to put edges on this Nicomachus's Triangle

r = 7;
t = Table[2^(n - k) 3^k, {n, 0, r}, {k, 0, n}];
ColumnForm[t, Center]


Is there an easy way to do this?

Using Mr. Wizard's method

triangleForm[t : {_List ..} /; Depth@t == 3] :=
Show[Graphics[{
Red,
(Line /@ Join[#, Riffle @@@ Partition[#, 2, 1]]) &@
Table[{(1 - i + 2 j - r)/2, i - r - 1}, {i, 0, r}, {j, i, r}],
MapIndexed[Text[Panel[#, FrameMargins -> 0], {#2 - #/2, -#} & @@ #2] &,     t, {2}]
}],
TextStyle -> FontSize -> 18
]

triangleForm[t]


Something like this?

triangleForm[t : {_List ..} /; Depth@t == 3] :=
Show[Graphics[{
MapIndexed[Text[#, {#2 - #/2, -#} & @@ #2] &, t, {2}],
Red,
Line[{{1/2, -1}, {1 - #/2, -#}, {#/2, -#}, {1/2, -1}}] & @ Length[t]
}],
TextStyle -> FontSize -> 18]

triangleForm[t]


Or probably more like:

triangleForm[t : {_List ..} /; Depth@t == 3] :=
Show[Graphics[{
MapIndexed[Text[#, {#2 - #/2, -#} & @@ #2] &, t, {2}],
Red,
Line[{{1/2, 0}, {-#/2, -# - 1/2}, {1 + #/2, -# - 1/2}, {1/2, 0}}] & @ Length[t]
}],
TextStyle -> FontSize -> 18]

triangleForm[t]


With automatic image size:

r = 9;
t = Table[2^(n - k) 3^k, {n, 0, r}, {k, 0, n}];

triangleForm[t : {_List ..} /; Depth@t == 3] :=
Show[Graphics[{
MapIndexed[Text[#, {#2 - #/2, -#} & @@ #2] &, t, {2}],
Red,
Line[{{1/2, 0}, {-#/2, -# - 1/2}, {1 + #/2, -# - 1/2}, {1/2, 0}}] & @ Length[t]
}],
TextStyle -> FontSize -> 16,
ImageSize -> (Length@t + 1) * First@Rasterize[Style[t[[-1, -1]], 16], "RasterSize"]
]

triangleForm[t]


Another variation following a comment below:

r = 8;
t = Table[2^(n - k) 3^k, {n, 0, r}, {k, 0, n}];

triangleForm[t : {_List ..} /; Depth@t == 3] :=
Show[Graphics[{
Red,
(Line /@ Join[#, Riffle @@@ Partition[#, 2, 1]]) &@
Table[{(1 - i + 2 j - r)/2, i - r - 1}, {i, 0, r}, {j, i, r}],
MapIndexed[Text[Panel[#, FrameMargins -> 0], {#2 - #/2, -#} & @@ #2] &, t, {2}]
}],
TextStyle -> FontSize -> 18
]

triangleForm[t]


• @belisarius are you making the graphic large enough for all the numbers? Commented May 27, 2012 at 1:49
• Can you pre-calculate the image size? :D Commented May 27, 2012 at 1:52
• @belisarius I suppose so; let me try Commented May 27, 2012 at 1:52
• @Mr.Wizard, like the first one, but with all the inner triangles shown also. Commented May 27, 2012 at 2:09
• @Fred okay, give me a minute. :-) Commented May 27, 2012 at 2:18

Here's an alternative way to create the latter picture in Mr.Wizard's answer using Graph:

elem[n_, k_] := 2^(n - k) 3^k

Block[{e, r},
r = 7;
vertices = Flatten[Table[e[n, k], {n, 0, r}, {k, 0, n}]];
edges = Flatten[{
Table[e[n, k] \[UndirectedEdge] e[n + 1, k], {n, 0, r - 1}, {k, 0, n}],
Table[e[n, k] \[UndirectedEdge] e[n + 1, k + 1], {n, 0, r - 1}, {k, 0, n}],
Table[e[n, k] \[UndirectedEdge] e[n, k + 1], {n, 1, r}, {k, 0, n - 1}]}];
coords = Flatten[Table[{-n/2 + k, r - n}, {n, 0, r}, {k, 0, n}], 1];

Graph[vertices, edges, VertexCoordinates -> coords,
EdgeStyle -> Directive[Thick, Red],
VertexShapeFunction -> ({Black,
Inset[Framed[Style[#2 /. e -> elem, 12, FontFamily -> "Helvetica"],
Background -> White, RoundingRadius -> 3], #1]} &)]
]


• That is what I was trying to do before I gave up and asked the question. I've added it to my .nb Commented May 27, 2012 at 10:30

For $$r \in \{2 \ldots 10\}$$, you can use GraphData[{"TriangularGrid", r}] to get a graph with the desired structure:

GraphData["TriangularG*"]


{{"TriangularGrid", 2}, {"TriangularGrid", 3}, {"TriangularGrid", 4}, {"TriangularGrid", 5}, {"TriangularGrid", 6}, {"TriangularGrid", 7}, {"TriangularGrid", 8}, {"TriangularGrid", 9}, {"TriangularGrid", 10}}

For example,

GraphData[{"TriangularGrid", 4}]


We can use it to make a function to add labels and other options:

ClearAll[tF, labelingF, tGG]

tF = Flatten@Table[2^(n - k) 3^k, {n, 0, #}, {k, 0, n}] &;

labelingF = AssociationThread[Range @ Length @ #, #] & @ tF[#] &;

tGG = Module[{tg = GraphData[{"TriangularGrid", #}], lbl = labelingF[#]},
SetProperty[tg,
{VertexShapeFunction -> (Text[Framed[Style[lbl @ #2, Black],
RoundingRadius -> 5, FrameStyle -> Gray, Background -> White], #] &), ##2}]] &;


Examples:

Row[tGG[#, EdgeStyle -> Red, ImageSize -> 300] & /@ {3, 5, 7}, Spacer[10]]