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

Question

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]

http://math.stackexchange.com/questions/150259/question-about-the-collatz-conjecture-nicomachuss-triangle-and-more

Answer 1

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]

Answer 2

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