3
$\begingroup$

Similar to (Changing the atom color for plotting xyz-files), I want to take a molecule and then simply change the colors of individual atoms. I don't want to change all atoms of a type to a color (say, make all carbons purple) but individual atoms and bonds.

$\endgroup$
1
  • 1
    $\begingroup$ Take a look at the InputForm of the molecule and try changing some of the options manually. $\endgroup$
    – Sektor
    Mar 10, 2015 at 20:46

1 Answer 1

5
$\begingroup$

With caffeine as the example molecule

molecule = Import["ExampleData/caffeine.xyz"]

one can find all spheres that represent the single atoms using

sphereList = Cases[molecule[[1, 4, 2]], _Sphere]
{Sphere[1,24.],Sphere[12,24.],Sphere[14,24.],Sphere[15,24.],Sphere[16,24.],Sphere[17,24.],
 Sphere[18,24.],Sphere[22,24.],Sphere[23,24.],Sphere[24,24.],Sphere[3,34.],Sphere[5,34.],
 Sphere[6,34.],Sphere[7,34.],Sphere[10,34.],Sphere[13,34.],Sphere[19,34.],Sphere[20,34.],
 Sphere[2,32.],Sphere[4,32.],Sphere[8,32.],Sphere[21,32.],Sphere[9,31.],Sphere[11,31.]}

As the new color I define

newColor = RGBColor[0, 0.58, 0]

Now one can pick a specific atom out of the list of spheres, e.g. the the rightmost atom, and change its color using

molecule /. {x___, color_RGBColor, s___Sphere, Sphere[12, 24.], z___} -> 
             {x, color, s, newColor, Sphere[12, 24.], color, z}

Caffeine1

or use a Manipulate to pick the atom and to choose the color

Manipulate[
 molecule /. {x___, color_RGBColor, s___Sphere, sphere, z___} -> 
             {x, color, s, nc, sphere, color, z},
 {sphere, sphereList}, {nc, Green}]

Caffeine2

If you want to change the color of multiple atoms:

Manipulate[
 Fold[ReplaceAll, molecule, {{x___, color_RGBColor, s___Sphere, sphereList[[#]], z___} -> 
      {x, color, s, nc, sphereList[[#]], color, z}} & /@ spheres],
 {{spheres, {1}}, Range[Length@sphereList], ControlType -> CheckboxBar}, {nc, Green}]

MultiColorCaffeine

A version to change the color of some atoms and single bonds

cylinderList = Cases[molecule[[1, 4, 2]], _Cylinder];
Manipulate[
 Fold[ReplaceAll, 
  Fold[ReplaceAll, 
   molecule, {{x___, color_RGBColor, s___Sphere, sphereList[[#]], z___} -> 
    {x, color, s, ncS, sphereList[[#]], color, z}} & /@ spheres], 
   {{x___, color_RGBColor, s___Cylinder, cylinderList[[#]], z___} -> 
    {x, color, s, ncC, cylinderList[[#]], color, z}} & /@ cylinders],
 {{cylinders, {1}}, Range[Length@cylinderList], ControlType -> CheckboxBar},   
 {{spheres, {1}}, Range[Length@sphereList], ControlType -> CheckboxBar}, 
 {ncS, Darker@Green}, {ncC, Darker@Green}]

AtomsBonds

And thanks to the comment by Michael E2 a version that changes the color of the selected atoms and their bonds

Manipulate[
 Fold[ReplaceAll, 
  molecule, {a : Sphere[#, _] | Cylinder[{#, _} | {_, #}, _] :> {nc, a}} & /@ atoms],
 {{atoms, {1}}, Range[Length@sphereList], ControlType -> CheckboxBar}, {nc, Darker@Green}]

AtomsAndBonds

$\endgroup$
5
  • 4
    $\begingroup$ Nice implementation. I wish Wolfram would admit that there exists in this world multiple bonds. It makes creating one's own molecule viewer a necessity at present. $\endgroup$ Mar 11, 2015 at 1:26
  • 1
    $\begingroup$ +1. This seems a more straightforward substitution that captures an atom and its bonds: With[{n = 8}, molecule /. a : Sphere[n, _] | Cylinder[{n, _} | {_, n}, _] :> {Purple, a}] $\endgroup$
    – Michael E2
    Mar 11, 2015 at 3:57
  • $\begingroup$ @MichaelE2 Thank you for your substitution code. I added a version of it to the code. I also added a Manipulate to choose single bonds. $\endgroup$
    – Karsten7
    Mar 11, 2015 at 4:43
  • $\begingroup$ @bobthechemist Part of the problem seems to be that the XYZ file format does not include bond information (right?). The MOL2 format does have it, but showing bond multiplcity does not seem to be possible. $\endgroup$
    – Michael E2
    Mar 11, 2015 at 14:51
  • 1
    $\begingroup$ @MichaelE2 Right, XYZ doesn't provide that information. I'm complaining about how ChemicalData knows bond multiplicity ChemicalData["Caffeine", "EdgeTypes"] but refuses to show it ChemicalData["Caffeine", "MoleculePlot"] in 3D. The "StructureDiagram" seems to be chemically correct. $\endgroup$ Mar 11, 2015 at 17:08

Your Answer

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

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