Periodic system with atomic numbers

It is easy to get a nice plot of the periodic system with the command

ColorData["Atoms", "Panel"]

But this gives only the names of the elements, nothing else, as illustrated below.

Is there any way to get also the atomic numbers above the elements? I tried to find an option in the on-line help, but typing “Atoms” did not give any entry. Any advice on where to look for such an option (and even if the colouring the boxes can be customised) is highly appreciated.
Thanks

I wrote this some time ago to put in the function repository, but have not done so yet because I wanted to add more functionality. To call the plot use

PeriodicTable\[\]

Just click on any element to view its box in larger detail. The function is defined as follows:

layout = {
  {1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2},
  {3, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5, 6, 7, 8, 9, 10},
  {11, 12, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 13, 14, 15, 16, 17, 18},
  {19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36},
  {37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54},
  {55, 56, 0, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86},
  {87, 88, 0, 104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118},
  {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
  {0, 0, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 0},
  {0, 0, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, 0}
};
hydrogenColor = RGBColor[130 / 255., 223 / 255., 142 / 255.];
alkaliColor = RGBColor[217 / 255., 114 / 255., 64 / 255.];
alkalineColor = RGBColor[252 / 255., 169 / 255., 90 / 255.];
transitionMetalColor = RGBColor[242 / 255., 200 / 255., 104 / 255.];
lanthanideColor = RGBColor[232 / 255., 209 / 255., 118 / 255.];
actinideColor = RGBColor[219 / 255., 203 / 255., 136 / 255.];
metalColor = RGBColor[252 / 255., 159 / 255., 116 / 255.];
semimetalColor = RGBColor[140 / 255., 207 / 255., 242 / 255.];
nonmetalColor = RGBColor[82 / 255., 162 / 255., 203 / 255.];
nobleGasColor = RGBColor[230 / 255., 222 / 255., 195 / 255.];
defaultcolors = {
  "H" -> hydrogenColor, "He" -> nobleGasColor, "Li" -> alkaliColor, "Be" -> alkalineColor,
  "B" -> semimetalColor, "C" -> nonmetalColor, "N" -> nonmetalColor, "O" -> nonmetalColor,
  "F" -> nonmetalColor, "Ne" -> nobleGasColor, "Na" -> alkaliColor, "Mg" -> alkalineColor,
  "Al" -> metalColor, "Si" -> semimetalColor, "P" -> nonmetalColor, "S" -> nonmetalColor,
  "Cl" -> nonmetalColor, "Ar" -> nobleGasColor, "K" -> alkaliColor, "Ca" -> alkalineColor,
  "Sc" -> transitionMetalColor, "Ti" -> transitionMetalColor, "V" -> transitionMetalColor,
  "Cr" -> transitionMetalColor, "Mn" -> transitionMetalColor, "Fe" -> transitionMetalColor,
  "Co" -> transitionMetalColor, "Ni" -> transitionMetalColor, "Cu" -> transitionMetalColor,
  "Zn" -> transitionMetalColor, "Ga" -> metalColor, "Ge" -> semimetalColor, "As" -> semimetalColor,
  "Se" -> nonmetalColor, "Br" -> nonmetalColor, "Kr" -> nobleGasColor, "Rb" -> alkaliColor,
  "Sr" -> alkalineColor, "Y" -> transitionMetalColor, "Zr" -> transitionMetalColor,
  "Nb" -> transitionMetalColor, "Mo" -> transitionMetalColor, "Tc" -> transitionMetalColor,
  "Ru" -> transitionMetalColor, "Rh" -> transitionMetalColor, "Pd" -> transitionMetalColor,
  "Ag" -> transitionMetalColor, "Cd" -> transitionMetalColor, "In" -> metalColor, "Sn" -> metalColor,
  "Sb" -> semimetalColor, "Te" -> semimetalColor, "I" -> nonmetalColor, "Xe" -> nobleGasColor,
  "Cs" -> alkaliColor, "Ba" -> alkalineColor, "Hf" -> transitionMetalColor, "Ta" -> transitionMetalColor,
  "W" -> transitionMetalColor, "Re" -> transitionMetalColor, "Os" -> transitionMetalColor,
  "Ir" -> transitionMetalColor, "Pt" -> transitionMetalColor, "Au" -> transitionMetalColor,
  "Hg" -> transitionMetalColor, "Tl" -> metalColor, "Pb" -> metalColor, "Bi" -> metalColor,
  "Po" -> semimetalColor, "At" -> nonmetalColor, "Rn" -> nobleGasColor, "Fr" -> alkaliColor,
  "Ra" -> alkalineColor, "Rf" -> transitionMetalColor, "Db" -> transitionMetalColor,
  "Sg" -> transitionMetalColor, "Bh" -> transitionMetalColor, "Hs" -> transitionMetalColor,
  "Mt" -> transitionMetalColor, "Ds" -> transitionMetalColor, "Rg" -> transitionMetalColor,
  "Cn" -> transitionMetalColor, "Nh" -> metalColor, "Fl" -> metalColor, "Mc" -> metalColor,
  "Lv" -> metalColor, "Ts" -> nonmetalColor, "Og" -> nobleGasColor, "La" -> lanthanideColor,
  "Ce" -> lanthanideColor, "Pr" -> lanthanideColor, "Nd" -> lanthanideColor, "Pm" -> lanthanideColor,
  "Sm" -> lanthanideColor, "Eu" -> lanthanideColor, "Gd" -> lanthanideColor, "Tb" -> lanthanideColor,
  "Dy" -> lanthanideColor, "Ho" -> lanthanideColor, "Er" -> lanthanideColor, "Tm" -> lanthanideColor,
  "Yb" -> lanthanideColor, "Lu" -> lanthanideColor, "Ac" -> actinideColor, "Th" -> actinideColor,
  "Pa" -> actinideColor, "U" -> actinideColor, "Np" -> actinideColor, "Pu" -> actinideColor,
  "Am" -> actinideColor, "Cm" -> actinideColor, "Bk" -> actinideColor, "Cf" -> actinideColor,
  "Es" -> actinideColor, "Fm" -> actinideColor, "Md" -> actinideColor, "No" -> actinideColor,
  "Lr" -> actinideColor
};
Needs @ "Chemistry`";
selected = 1;
h = Length[layout] + 1;
elementBox[None] := "";
elementBox[atnum_, opts___] := Module[
  {
    sym = FromAtomicNumber @ atnum,
    name = Capitalize @ ElementData[atnum, "Name"],
    color,
    mass = QuantityMagnitude @ ElementData[atnum, "AtomicMass"]
  },
  color = sym /. defaultcolors;
  EventHandler[
    Graphics[
      {
        {
          color,
          EdgeForm @ Directive @ Black,
          Rectangle[{0, 0}, {1, 1.25}]
        },
        Inset[Style[atnum, Black, FontSize -> Scaled[0.25]], {0.5, 1.1}],
        Inset[Style[sym, Black, FontSize -> Scaled[0.5]], {0.5, 0.7}],
        Inset[Style[mass, Black, FontSize -> Scaled[0.18]], {0.5, 0.35}],
        Inset[Style[name, Black, FontSize -> Scaled[0.13]], {0.5, 0.15}]
      },
      opts
    ],
    {"MouseClicked" :> (selected = atnum)}
  ]
];
PeriodicTable\[\] := (
  selected = None;
  Graphics[
    {
      Inset[
        Dynamic[elementBox @ selected, TrackedSymbols :> {selected}],
        {3, 9},
        {Center, Center},
        {2.5, 2.5}
      ],
      MapIndexed[
        Function[
          If[UnsameQ[#, 0],
            Inset[
              elementBox @ #,
              {0, h} + {0.75, -0.94} * Reverse[#2],
              {Center, Center},
              {1, 1}
            ],
            Nothing
          ]
        ],
        layout, {2}
      ]
    },
    ImageSize -> 700
  ]
)

Many thanks, this was lots of pieces of good advice!

Fantastic, thanks very much!

Hi Lissa,

ColorData does support generating the periodic table for the “Atoms” named scheme.

ColorData[]
(* {"Gradients", "Indexed", "Named", "Physical"} *}

ColorData["Named"]
(* {"Atoms", "Crayola", "GeologicAges", "HTML", "Legacy", "WebSafe"} *)

ColorData["Atoms", "Image"] (* Generates periodic table *)