Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

The command

ColorData["Atoms", "Panel"]

generates a periodic table.

As I don't want to reinvent the wheel, I asked myself how to change the color of each cell in the periodic table, (hydrogen -> pink, iron, gray etc.). I want to do it in the simples way. How can I do that?

Since

ElementData[Element, "IconColor"]

is protected I dont have any idea.

share|improve this question
    
ColorData["Atoms","Panel"] and ElementData[element,"IconColor"] are not the same colors in general. There are slight differences. –  hieron Aug 12 at 6:36

4 Answers 4

up vote 14 down vote accepted
myAtoms = {"H", "Li", "Na"};
defCols = myAtoms /. ColorData["Atoms", "ColorRules"];
newCols = {Pink, Yellow, LightBlue};
ColorData["Atoms", "Panel"] /. Thread[defCols -> newCols]

Mathematica graphics

Edit:

Changing the font color isn't related to the ColorRules, but to the special formatting used by the Panel. So it's cumbersome, but you can see that Mma uses a similar approach to the following, since the only font colors that get changed are those of the three elements I selected:

newCols = {Red, Darker@Darker@Yellow, Blue};
nt = ColorData["Atoms", "Panel"] /. Thread[defCols -> newCols];

gl = GrayLevel;
nt /. {r : RGBColor@c__, e_[{r1__, Inset[Style[r2__, gl@_], r3__]}, r0__]} :> 
      {r, e[{r1, Inset[Style[r2, ColorConvert[r, "Grayscale"] /. gl@a_ :> gl@UnitBox@a], r3]}, r0]}

Mathematica graphics

share|improve this answer
    
Welcome back with a +1 :) –  RunnyKine Aug 11 at 2:00
1  
@RunnyKine Thanks! Too much boring work lately –  belisarius Aug 11 at 2:00
2  
Leave those boring stuff and come have fun here. –  RunnyKine Aug 11 at 2:02
    
Thanks @belisarius. I Tried Hcolor = "Cr" /. ColorData["Atoms", "ColorRules"]; Ocolor = "Os" /. ColorData["Atoms", "ColorRules"]; ColorData["Atoms", "Panel"] /. {Hcolor :> Pink,Hcolor :> Pink} To change more than one color. Is it an uggly way? –  Zhozer Aug 11 at 2:06
    
@Zhozer See edit –  belisarius Aug 11 at 2:11

I know you said you didn't want to reinvent the wheel, but sometimes, it's fun to do so. The code below creates a palette with a Periodic Table and a few buttons to make useful tool tips. It shows how one might change the colors based on properties grabbed from ElementData. Note that this code was written for version 9, and if you wish to use it in version 10, you must first execute:

SetSystemOptions[SystemOptions["DataOptions"] /. True -> False]

Pardon some of the obfuscatory symbols; the code originates from my (failed) attempt to create a tweetable interactive periodic table.

CreatePalette[Manipulate[
  Column[{
    Evaluate[Grid[Table[{i, j}, {i, 7}, {j, 18}]]] /.
      Thread[
       Evaluate[
         Partition[
          MapThread[ElementData[#1, #2] &, 
           Transpose[Tuples[{Range[112], {"Period", "Group"}}]]], 
          2]] -> Evaluate[
         Item[Tooltip[ElementData[#, "Symbol"], 
             ElementData[#, popup]], Background -> color[#], 
            Frame -> True] & /@ Range[112]]] /. {{_, _} -> ""},
    Grid[{Item[
         Tooltip[ElementData[#, "Symbol"], ElementData[#, popup]], 
         Background -> color[#]] & /@ Range[57, 70], 
      Item[Tooltip[ElementData[#, "Symbol"], ElementData[#, popup]], 
         Background -> color[#]] & /@ Range[89, 102]}, Frame -> All]
    }, Alignment -> Center, Spacings -> {0, 1}, 
   BaseStyle -> {FontSize -> 10}],
  {{popup, "Name", "Show me the:"}, {"Name", 
    "AtomicNumber" -> "Atomic number", "AtomicMass" -> "Atomic mass", 
    "ElectronConfigurationString" -> 
     "\!\(\*SuperscriptBox[\(e\), \(-\)]\) config"}},
  {{color, bcd, "Color by"}, {ncd -> Tooltip["None", "No color"], 
    bcd -> Tooltip["Block", "s,p,d,f"], 
    pcd -> Tooltip["Phase", "Solid, Liquid, Gas"], 
    mcd -> Tooltip["Metal", "Metal, Nonmetal, Metalloid"]}},
  Initialization :> {
    ncd[x_] := White;
    bcd[x_] := 
     ColorData[11][
      ElementData[x, "Block"] /. {"s" -> 1, "p" -> 2, "d" -> 3, 
        "f" -> 4}];
    pcd[x_] := 
     ColorData[13][
      Switch[ElementData[x, "Phase"], "Gas", 6, "Liquid", 2, "Solid", 
       1, _, 5]];
    mcd[x_] := 
     Which[#[[1]], LightBlue, #[[2]], LightGreen, #[[3]], LightRed] &[
      MemberQ[ElementData[x, "Memberships"], #] & /@ {"Metal", 
        "Nonmetal", "Metalloid"} ];
    }], WindowTitle -> "Periodic Table"]

enter image description here

The part that is relevant to you is in the Initialization rule where I define ncd, bcd, pcd, and mcd. ncd sets all elements to the same color, bcd uses the block pulled from ElementData, and the last two pull characteristics from ElementData as well, using that information in slightly different ways. Hope this is helpful to someone.

share|improve this answer
2  
+1 goo.gl/JDBEHG –  belisarius Aug 11 at 4:31
    
@bobthechemist, can you find a way to display all or most of the features at the same time? –  alancalvitti Aug 11 at 18:05
    
@alancalvitti I'm not sure I follow. If you mean coming up with color scales for all of the properties provided by ElementData then yes, in principle, but that would require a a bit of thought. A generic elementcolordata function would need to handle missing data, devise a way to sort non-numeric data, and probably decide whether linear or logarithmic color scaling is appropriate. –  bobthechemist Aug 11 at 18:48
    
@bobthechemist, btw, +1, not necessarily by color but any other visualization method, eg icons or other graphical markup. Also there seem to be alternative periodic tables and layouts, including spiral based. Jan Boeyens describes 4 tables in his Chemistry from First Principles. It would be nice to relate them. –  alancalvitti Aug 11 at 20:17
    
@alancalvitti I see. Yes, I have given some alternate visualizations some thought, but non of that is ready for prime time yet. –  bobthechemist Aug 11 at 20:57

This example picks the colors according to atomic weight, which are loaded from ElementData[]. Like belisarius's answer, it generates a list of rules to replace colors

Rules created in the first line

which is then applied to the pane.

Rule @@@ Transpose[{ColorData["Atoms", "ColorList"] , 
   ColorData["NeonColors"][QuantityMagnitude@ElementData[#,"AtomicMass"]/200] &
   /@ Flatten@ColorData["Atoms", "Range"]}]
ColorData["Atoms", "Panel"] /. %

Resulting pane

share|improve this answer
    
Thanks, @sjdh. :) –  Zhozer Aug 20 at 16:08

It seems to me that there are two natural approaches: (1) modifying color rules before the panel is created or (2) post-processing the output to replace recognizable colors. belisarius already showed a method for the second so I shall address the first.

This method is more robust than the post-processing one. See the final example below.

Modifying the color rules

The color rules are loaded through this call:

DataPaclets`ColorDataDump`getColorSchemeData["Atoms"]

From the definition:

DataPaclets`ColorDataDump`colorSchemes

The data looks like this:

enter image description here

For easy replacement of colors I propose:

subColors[cdat_List, {rules__} | rules_Rule] :=
  MapAt[ReplacePart[MapAt[PositionIndex @ cdat[[4]], 1] /@ {rules}], cdat, 5]

(Ignore any messages; I recommend putting Off[Pattern::patv] in your kernel init.m.)

This allows us to replace rules in the data with e.g.

subColors[data, {"H" -> Pink, "Fe" -> Gray}]

We can now use this replacement function in a wrapper function like this:

SetAttributes[withScheme, HoldFirst]

withScheme[body_, scheme_, rules_] :=
  With[{CS := DataPaclets`ColorDataDump`colorSchemes},
    ColorData[1, 1] (*preload*);
    Internal`InheritedBlock[{CS, ColorData},
      CS = MapAt[subColors[#, rules] &, CS, Position[CS, {{scheme, ___}, __}]];
      body
    ]
  ]

Now:

withScheme[
  ColorData["Atoms", "Panel"],
  "Atoms",
  {"H" -> Pink, "Fe" -> Gray, "Ti" -> Red, "Hs" -> Blue}
]

enter image description here

This is intended for use with any Named color scheme. Because colors are modified before they are used this will even affect applications of the colors where they are later modified, e.g. with Darker:

withScheme[
 Graphics[{ColorData["Crayola", "SkyBlue"] ~Darker~ #, Rectangle[]}] & /@ {.1, .5, .8},
 "Crayola",
 "SkyBlue" -> Red
]

enter image description here

share|improve this answer
    
Note: Caching bug corrected. –  Mr.Wizard Aug 12 at 3:28
    
Thanks, @Mr. Wizard. :) –  Zhozer Aug 20 at 16:08
1  
@Zhozer You're welcome. I was wondering if anyone had noticed this answer. –  Mr.Wizard Aug 20 at 18:34

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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