5
$\begingroup$

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?

$\endgroup$
4
  • $\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$ Dec 23 '20 at 14:00
  • $\begingroup$ @AntonAntonov I do not see a plot in the Notebook. $\endgroup$
    – Jan
    Dec 23 '20 at 14:04
  • $\begingroup$ Yes, I did not see plots in the several notebooks I downloaded from related pages. $\endgroup$ Dec 23 '20 at 14:08
  • $\begingroup$ @AntonAntonov So is it possible to make the plots ourselfs? $\endgroup$
    – Jan
    Dec 23 '20 at 14:16
10
$\begingroup$
ClearAll[points];
points[0,n_]:={{0,0}};
points[d_,n_]:=Flatten[Subdivide[##,d]&@@@
Partition[CirclePoints[d{Sin[π/n],Cos[π/n]},d,n],2,1],1];

n=5;m=6;

Graphics3D[{
Table[{Hue[i/m],Sphere[Append[#-{Sin[π/n],Cos[π/n]} i,-i]&/@points[j-1,n],0.1]},
  {i,m},{j,i}],
Table[{Hue[(i+1)/m,1,1,0.3],Polygon@TransformationFunction[
  {{i,0,0,(i-1) Sin[π/n]},{0,i,0,(i-1) Cos[π/n]},{0,0,i,i-1},{0,0,0,1}}
  ][Append[#,-2]&/@CirclePoints[-{Sin[π/n],Cos[π/n]},1,n]]},{i,1,m-1}]
}]

enter image description here enter image description here

$\endgroup$
8
$\begingroup$

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

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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