5
$\begingroup$

I have been making these mathematica 3D objects that involve a molecule with some sort of surface displayed above them. This is done fairly easily by:

Molecule=Graphics3D[{{x,y,z},...},Sphere[1, .24]...,Cylinder[{1, 2}, .15]]
PES=ListPlot3D[{{x,y,z},...}]
Show[Molecule,PES]

A python script was pretty easy to whip this up for molecules; for me its better then the wolfram chemistry database because it is in better units (angstroms) and can be oriented easier. It works great, the objects manipulate smoothly. Now I wanted to do something that would have a very nice end product. Following the work of an online demonstration I started with the initialization code: 

Molecule[coord_, conf_, col_, rad_, bondstyle_] := 
  Module[{intconf, atomplot, tuples, bonds, bondplot}, 
   intconf = 
    ReplacePart[conf, 
     Flatten@Table[# -> ii & /@ (Flatten@
          Position[conf, DeleteDuplicates[conf][[ii]]]), {ii, 1, 
        Length@DeleteDuplicates[conf]}]];
   atomplot = {col[[intconf[[#]]]], 
       Sphere[coord[[#]], rad[[intconf[[#]]]]]} & /@ 
     Range[Length[intconf]];
   tuples = 
    Select[Subsets[
      Range[Length[
        coord]], {2}], ((conf[[#[[1]]]] =!= "H" || 
          conf[[#[[2]]]] =!= "H") && 
        Norm[coord[[#[[1]]]] - coord[[#[[2]]]]] <= 
         bondstyle[[1]]) &];
   bonds = coord[[#]] & /@ tuples;
   bondplot = 
    Table[{col[[intconf[[tuples[[#, ii]]]]]], 
        Tube[{bonds[[#, ii]], .5*Total[bonds[[#]]]}, 
         bondstyle[[2]]]} & /@ Range[Length[bonds]], {ii, 1, 2}];
   {atomplot, bondplot}];
coord["Acrolein"] := {{-1.4373, -1.1224, 0.4127}, {0.1565, 
    0.3728, -0.3457}, {-1.1456, -0.2881, -0.399}, {1.0519, 0.0649, 
    0.6058}, {0.4003, 
    1.1146, -1.0773}, {-1.8435, -0.0263, -1.1667}, {0.8173, -0.6754, 
    1.3418}, {2.0003, 0.5599, 0.6283}};
conf["Acrolein"] := {"O", "C", "C", "C", "H", "H", "H", "H"};

I decided to use this since I can use Map to manipulate the position and scale of the object. Its really just a way to replace my python script. Surfaces were again easy to create with the Map just used to duplicate quadrants:

AcrWater=Import["xyzlist.csv"
surface["Acrolein", "Water"] = 
  ListPlot3D[Union[AcrWater, Map[#*{1, -1, 1} &, AcrWater]], 
   Mesh -> 3, ColorFunction -> "Rainbow", PlotStyle -> Opacity[0.9]];

This next part was just done in my experiments to make the graphics smoother:

graphic["Acrolein", "Water"] = 
  Show[

Graphics3D[{Specularity[White, 100], 
     Molecule[coord["Acrolein"], conf["Acrolein"], 
      ColorData["Atoms", #] & /@ 
       DeleteDuplicates[
        conf["Acrolein"]], {.4, .4, .4, .4}, {1.5, .193}]}],

   surface["Acrolein", "Water"],

   ImageSize -> {600, 600}, Background -> White, ViewPoint -> Top, 
   Axes -> True, Lighting -> "Neutral"];

Finally the manipulate argument:

Manipulate[
 graphic[substance, 
  solvent], {{substance, "Acrolein", "Molecule"}, {"Acrolein"}},
 {{solvent, "1C", "Solvent"}, {"Water"}}]

All of this works great together! The only problem is that manipulating the final product is incredibly slow even on a new, well equipped machine with the antialiasing all the way down. There in total will be about 30 different combinations and only implementing a single one shows significant degradation in the overall feel of the demonstration; adding more is even worse. This seems strange when it is done the previous way there is no noticeable lag even with much larger systems. My question is where is the major slowdown in this. It was my understanding that the vector objects were first evaluated then simply displayed by the manipulate command. If there is not an easy workaround is there another way to do this that can avoid the slowdown problem.

Edit: Thank you for the tips so far dynamic and tracked symbols certainly made marked improvements. Here is a chunk of working code that will mimic what I am trying to do. This is a single example with with only 25 points for the surface (real surfaces will have 1000-2000). I am not entirely sure how to do it but a better way to recreate the surface using the proper notation of the data is [x,y,sin[x+y]] where and x and y run from 0-3 in steps of .1. Instead of Dynamic I also tried the Refresh command to no avail.:

Molecule[coord_, conf_, col_, rad_, bondstyle_] := 
  Module[{intconf, atomplot, tuples, bonds, bondplot}, 
   intconf = 
    ReplacePart[conf, 
     Flatten@Table[# -> ii & /@ (Flatten@
          Position[conf, DeleteDuplicates[conf][[ii]]]), {ii, 1, 
        Length@DeleteDuplicates[conf]}]];
   atomplot = {col[[intconf[[#]]]], 
       Sphere[coord[[#]], rad[[intconf[[#]]]]]} & /@ 
     Range[Length[intconf]];
   tuples = 
    Select[Subsets[
      Range[Length[
        coord]], {2}], ((conf[[#[[1]]]] =!= "H" || 
          conf[[#[[2]]]] =!= "H") && 
        Norm[coord[[#[[1]]]] - coord[[#[[2]]]]] <= 
         bondstyle[[1]]) &];
   bonds = coord[[#]] & /@ tuples;
   bondplot = 
    Table[{col[[intconf[[tuples[[#, ii]]]]]], 
        Tube[{bonds[[#, ii]], .5*Total[bonds[[#]]]}, 
         bondstyle[[2]]]} & /@ Range[Length[bonds]], {ii, 1, 2}];
   {atomplot, bondplot}];
coord["Acrolein"] := {{-1.4373, -1.1224, 0.4127}, {0.1565, 
    0.3728, -0.3457}, {-1.1456, -0.2881, -0.399}, {1.0519, 0.0649, 
    0.6058}, {0.4003, 
    1.1146, -1.0773}, {-1.8435, -0.0263, -1.1667}, {0.8173, -0.6754, 
    1.3418}, {2.0003, 0.5599, 0.6283}};
conf["Acrolein"] := {"O", "C", "C", "C", "H", "H", "H", "H"};

AcrWater := 
 Table[Sin[j + i] + 2, {i, 0, 2 Pi, Pi/4}, {j, 0, 2 Pi, Pi/4}]

surface["Acrolein", "Water"] := 
  ListPlot3D[AcrWater, Mesh -> 3, ColorFunction -> "Rainbow", 
   PlotStyle -> Opacity[0.9]];

graphic["Acrolein", "Water"] := 
  Dynamic[Show[
    Graphics3D[{Specularity[White, 100], 
      Molecule[coord["Acrolein"], conf["Acrolein"], 
       ColorData["Atoms", #] & /@ 
        DeleteDuplicates[
         conf["Acrolein"]], {.4, .4, .4, .4}, {1.5, .193}]}], 
    surface["Acrolein", "Water"], ImageSize -> {600, 600}, 
    Background -> White, ViewPoint -> Top, Axes -> True, 
    Lighting -> "Neutral"], None];

Manipulate[
 graphic[substance, 
  solvent], {{substance, "Acrolein", 
   "Molecule"}, {"Acrolein"}}, {{solvent, "Water", 
   "Solvent"}, {"Water"}}, TrackedSymbols :> {substance, solvent}]
Improve this question
$\endgroup$
2
  • 1
    $\begingroup$ I can't try this out because the code isn't complete, but I'm fairly certain that the issue is because Manipulate evaluates at each change of the slider, when it doesn't necessarily have to. Throwing in a Dynamic somewhere to what really needs to be updated will fix things. You might get some ideas from Vitaliy's answer here. Especially, note this: "Note, Dynamic is necessary to make it NOT lag and redraw all 3D graphics every time you change something inside Manipulate. Dynamic isolates tracked variables." $\endgroup$
    – rm -rf ♦
    May 24, 2012 at 22:12
  • $\begingroup$ Posted a working code. I tried the dynamic and Memorization techniques which helped some, but it still very slow with a larger number of points; the example posted is for 81. An interesting revelation is if only the surface or the substance is shown there is no lag. It seems that the root of the problem comes from trying to graph both in the same box. $\endgroup$
    – Ophion
    May 28, 2012 at 17:36

1 Answer 1

Reset to default
5
$\begingroup$

I feel you pain. And the problem is, that it's hard to replicate the slowdown in simplified self-contained examples. My advice is as follows:

  • Put in a couple of Print statments to see how many times your code is re-evaluated. You'll probably be surprised, that it's a lot more than you thought.

  • Use Memoization whenever possible (but since graphic is defined with Set you should be ok...).

  • Use TrackedSymbols :> {substance, solvent} to prevent needless re-evaluation.

If you manage to produce a working example that demonstrates the problem, then I can be more specific.

Improve this answer
$\endgroup$
3
  • $\begingroup$ Posted a full example. The techniques you stated helped some, but still not to a workable extent. Can you expand on where to add the print statements? $\endgroup$
    – Ophion
    May 28, 2012 at 21:04
  • $\begingroup$ @Ophion Your example works very well on my machine. Do you mean that the rotation of the 3D graph is slow, or switching between different solvents/molecules? If it's the 3D graph, you can try turning of anti-aliasing under Exit->Prefrences->Apperance (set it to not anti aliasing) $\endgroup$
    – Ajasja
    May 29, 2012 at 11:34
  • $\begingroup$ Yes, the rotation of the 3D graph is extremely slow especially when the surfaces have more points (2000+). Turning off anti-aliasing is the first thing I tried to almost no effect. Each individual component runs smoothly but when using show to combine the two it slows down considerably. If I use a prebuilt molecule and surface then use show there is no slowdown of the rotation. However using prebuilt molecules and surfaces in addition to the manipulate command slows the demonstration. I am trying to eliminate this problem- its most likely an issue with re-evaluating the vector image. $\endgroup$
    – Ophion
    May 29, 2012 at 13:11

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.