I found the picutures below from the Pyramidal Number page on MathWorld

enter image description here enter image description here

My question is, how can I write Mathematica code that gives these figures, such that I can set the first layer to be a triangle or square for example and that I can specify how many layers it needs to plot?

  • $\begingroup$ It looks like there are notebooks in the linked pages, e.g. TetrahedralNumber, but the codes are obsolete. (Notebooks are usually/often provided at MathWorld's pages.) $\endgroup$ Commented Dec 23, 2020 at 14:00
  • $\begingroup$ @AntonAntonov I do not see a plot in the Notebook. $\endgroup$ Commented Dec 23, 2020 at 14:04
  • $\begingroup$ Yes, I did not see plots in the several notebooks I downloaded from related pages. $\endgroup$ Commented Dec 23, 2020 at 14:08
  • $\begingroup$ @AntonAntonov So is it possible to make the plots ourselfs? $\endgroup$ Commented Dec 23, 2020 at 14:16

2 Answers 2



Table[{Hue[i/m],Sphere[Append[#-{Sin[π/n],Cos[π/n]} i,-i]&/@points[j-1,n],0.1]},
  {{i,0,0,(i-1) Sin[π/n]},{0,i,0,(i-1) Cos[π/n]},{0,0,i,i-1},{0,0,0,1}}

enter image description here enter image description here


Something to start you out:

fig[n_, 1, {c_, h_}] := {{0, 0, 0}}

fig[n_, m_, {c_, h_}] := PadRight[Standardize[Flatten[Table[
    With[{cp = N[CirclePoints[{0, -c k/2 Csc[π/n]}, {c k/2 Csc[π/n], π/2}, n]]},
         Transpose[{1 - Range[k]/k, Range[k]/k}] . # & /@
         If[k < m - 1, Partition[Rest[cp], 2, 1], Partition[cp, 2, 1, 1]]],
    {k, m - 1}], 2], Mean, 1 &], {Automatic, 3}, N[h (1 - m)]]

With[{n = 6, m = 5}, 
     Graphics3D[Table[{Directive[ColorData[61, k], AbsolutePointSize[14]],
                       Point[fig[n, k, {1, 4/5}]]}, {k, m}]]]

figurate number pyramid


Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.