7
$\begingroup$

How do I modify the following program to create a nice coloured molecular plot of C60 or fullerene as shown in the attached figure

enter image description here

This figure was retrieved from http://asserttrue.blogspot.com.au/2013/03/olive-oil-fullerene-and-lifespan.html#

pos = {{4.20790955, 1.12423579, 5.0724025}, {5.92255243, 0.30577656, 
    3.09053347}, {2.53625794, -0.58931105, 6.15449739}, 
       {5.89150423, -2.19125067,  2.27598598}, {6.07911622, -2.76287388, -0.40300296}, {6.14208189, 2.34350589, 1.26288498}, 
       {6.32168145, 1.79658139, -1.30022597}, {6.28972619, -0.81331917, -2.15152863}, {-0.85451519, 2.59699373, 6.10424958}, 
       {0.89249869, 4.38777367, 4.97351314}, {-0.0510226, 0.16353689, 
    6.68186323}, {3.36781297, 3.66786366, 4.46912637}, 
       {4.56285678, 4.42127851, 2.11483015}, {-1*0.4993034, 
    5.8930727, 3.14654495}, {0.64416979, 6.61402206, 0.89416165}, 
       {3.23137475, 5.86189222, 
    0.36707927}, {-4.0468482, -1.59965305, 5.07597408}, {-4.88658574, 
    0.94354019, 4.47250898}, 
       {-1.6827443, -1.98120762, 6.15625484}, {-3.32578546, 
    2.99557474, 4.97542176}, {-3.10623709, 5.03232141, 3.14743312}, 
       {-6.29775752, 0.83554235, 2.119271}, {-6.08784676, 2.78439786, 
    0.37044299}, {-4.45682426, 4.92933134, 0.89618365}, 
       {-0.95746747, -5.66581425, 
    3.40868774}, {-3.4282275, -5.26727104, 
    2.27991661}, {-0.10387824, -4.05947157, 5.30402621}, 
       {-4.93898784, -3.27912812, 
    3.09521999}, {-6.32980727, -1.77424483, 
    1.26783606}, {-3.2399919, -5.83991471, -0.39909123}, 
       {-4.57094481, -4.40022696, -2.14742792}, {-6.15020772, 
-2.32243545, -1.29533158}, {4.14416909, -3.98220068, 3.40634448}, 
       {3.25204835, -5.66116553, 
    1.42568487}, {2.50352789, -3.19913602, 
    5.30279789}, {0.75764784, -6.48459473, 1.4268754}, 
       {-0.65282474, -6.59204455, -0.92630589}, {4.44820711, \
-4.90778847, -0.92840348}, {3.0986026, -5.01057066, -3.17986082}, 
       {0.4916878, -5.87162431, -3.17872698}, {-4.21537397, \
-1.1041291, -5.10475461}, {-3.37499392, -3.64732234, -4.50151628}, 
       {-0.8993395, -4.36660874, -5.00582745}, {-2.5441003, 
    0.61009804, -6.18628259}, {-4.15359883, 4.00310105, -3.4385832}, 
       {-5.90029145, 
    2.21167861, -2.30835699}, {-5.93067825, -0.2855187, -3.12307455}, \
{-2.51263637, 3.22020647, -5.33473426}, 
       {0.94767869, 5.68830199, -3.44022726}, {-0.76728544, 
    6.50657224, -1.4586417}, {-3.26164816, 5.6827084, -1.45786691}, 
       {0.09442961, 4.08156247, -5.33543346}, {4.03843892, 
    1.62287778, -5.10734353}, {4.93027621, 3.30214499, -3.126854}, 
       {3.41902454, 5.29011783, -2.3116829}, {1.67416495, 
    2.00384654, -6.18737863}, {0.847561, -2.57503512, -6.13588359}, 
       {3.3185856, -2.97318149, -5.00728254}, {4.87893235, \
-0.92061781, -4.50446425}, {0.0434637, -0.14161607, -6.7131004}}; 
atype = {"C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", 
   "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", 
       "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", 
   "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", 
   "C", "C", "C", "C", "C", "C", "C", "C", "C", "C"}; 
dataC = AssociationThread[Range[Length[atype]], 
   Transpose[{atype, pos}]]; 
writeXYZ[file_String, data_] := 
 Module[{str = OpenWrite[file, FormatType -> OutputForm], 
   len = Length[data]}, 
     Scan[
   WriteLine[str, #1] & , {ToString[len], 
    "            Coordinates (Angstroms)"}]; 
      Scan[Write[str, "    ", data[#1][[1]], 
     PaddedForm[data[#1][[2, 1]], {14, 6}], 
     PaddedForm[data[#1][[2, 2]], {10, 6}], 
            PaddedForm[data[#1][[2, 3]], {10, 6}]] & , Range[len]]; 
  Close[str]]
writeXYZ["testC.xyz", dataC]; 
Import["testC.xyz", "XYZ"]
$\endgroup$
  • $\begingroup$ There is a nice built-in function ChemicalData["FullereneC60", "MoleculePlot"] $\endgroup$ – ybeltukov Sep 19 '14 at 20:59
  • $\begingroup$ Not to mention: demonstrations.wolfram.com/… $\endgroup$ – Igor Rivin Sep 19 '14 at 21:01
  • $\begingroup$ @ybeltukov Yes that built-in function is gd, but really need differentiation in bonds/atoms via colours $\endgroup$ – thils Sep 19 '14 at 21:16
  • 1
    $\begingroup$ The output from the built-in MoleculePlot is just a Graphics3D expression with spheres for the atoms and cylinders for the bonds. So use something like % /. {c_Cylinder :> Style[c, Red], s_Sphere :> Style[s, Blue]} $\endgroup$ – Simon Woods Sep 19 '14 at 21:30
  • $\begingroup$ As written, your coordinates are actually in Bohr, so you need to convert to angstroms. This uses your coordinates, but doesn't get differently colored bonds: ImportString[ ExportString[Transpose[Join[{atype}, Transpose@(0.529177 pos)]], "Table"], "XYZ"] /. {Cylinder[a__] :> {Yellow, Cylinder[a]}, Sphere[a__] :> {Blue, Sphere[a]}} $\endgroup$ – Jason B. Feb 18 '16 at 14:30
11
$\begingroup$

One can colorize bonds by finding 5-cycles in the bounding graph

pts = QuantityMagnitude@ChemicalData["FullereneC60", "AtomPositions"];
graph = UndirectedGraph@Graph@ChemicalData["FullereneC60", "EdgeRules"];
ring5 = List @@@ Flatten@FindCycle[graph, {5}, 12];
remain = Complement[List @@@ EdgeList[graph], ring5, ring5[[All, {2, 1}]]];

Graphics3D@GraphicsComplex[pts, {Blue, Ball[Range@60, 30], Red, Tube[ring5, 10], Yellow, 
   Tube[remain, 10]}]

enter image description here

For version 9 and earlier you should delete QuantityMagnitude@.


After tuning the lightning

Graphics3D[GraphicsComplex[pts, {Specularity[White, 20], Lighter@Blue, Ball[Range@60, 30], 
  Red, Tube[ring5, 10], Yellow, Tube[remain, 10]}], Boxed -> False, 
 Background -> Black, Lighting -> {{"Ambient", GrayLevel[0.2]}, {"Directional", 
    GrayLevel[0.8], {{0, 0, 0}, {-1, 0, -1.5}}}}]

enter image description here

$\endgroup$
  • $\begingroup$ How to add lighting effects...see original pic $\endgroup$ – thils Sep 19 '14 at 21:45
  • 1
    $\begingroup$ @thils See my update :) $\endgroup$ – ybeltukov Sep 19 '14 at 22:03
  • 1
    $\begingroup$ NB in v9 FindCycle[] is still a Combinatorica function $\endgroup$ – Dr. belisarius Sep 19 '14 at 22:55

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.