ProteinData["SERPINA1", "MoleculePlot"] gives the detailed Graphics3D plot below. I'd like to make many small copies of this object and place them in a single Graphics3D scene, but I'm running into performance problems because the molecule graphics-object is a pretty complicated mesh.

Are there general methods of reducing the quality/detail of graphics objects like the one below that would allow me to place many of these in a single scene?

enter image description here


2 Answers 2


This plot is very complex one, as each from ProteinData. If you want to loose some weight I can help with the following tricks.

But even with this I don't think you will be able to put large number of the elements with in one plot.

plot = ProteinData["SERPINA1", "MoleculePlot"];

In order to have an idea how the structure of this data looks you can use this:

(plot // First) /. List[(_?NumericQ) ..] :> Sequence[]

No we know what we can get rid of:

reduced = First @ plot /. {Specularity[___] :> Sequence[], 
                           (VertexNormals -> _) :> Sequence[], 
                           (VertexColors -> _) :> Sequence[], 
                           EdgeForm[__] :> Sequence[], 
                           RGBColor[_, _, _] :> Sequence[], 
                           AbsoluteThickness[_] :> Sequence[]};

To improve performance with 3D plots which include duplicate objects the best way is to use GeometricTransoformation + TranslationTransform(for example). It is described well in this fenomenal training by Yu-Sung Chang around 28th minute mark.

            Flatten[Table[TranslationTransform[10000. {i, j, k}], 
                          {i, 2}, {j, 2}, {k, 2}]]]}
           , Lighting -> None]

enter image description here

I was able to rotate this quite smoothly with an old pc with on board graphics card!

To go even further I tried to delete half of elements in the molecule, maybe it is not what you need but maybe you can use it:

i = 1;
new = reduced /. x : GraphicsComplex[___] :> (++i; If[OddQ@i, x, Sequence[]])

            Flatten[Table[TranslationTransform[10000. {i, j, k}],
                          {i, 3}, {j, 3}, {k, 3}]]]
           }, Lighting -> None]

enter image description here

27 elements and I'm able to rotate it easily while for this many copies it is not so obvious that they are reduced by half.


Never used ProteinData, but can you try this and see if it speeds thing a little?

g = ProteinData["SERPINA1", "MoleculePlot"];
Block[{$PerformanceGoal = "Speed"}, g]

For me, it seems the plot was a little faster to move around with the mouse with this vs. "Quality" (but you can try it yourself and see). If this seems faster, then you can put all the graphics in that Block to that this option affects all rendering inside.

  • $\begingroup$ I'm still thinking if this works. If you try Block[{$PerformanceGoal = "Speed"}, g] === g it yellds True so it seem's not, but then I'm thinking, well, maybe it is about rendering so it will not be seen in the structure of the code. But when I try Block[{$PerformanceGoal = "Speed"}, Plot3D[Sin[x y], {x, -1, 1}, {y, -1, 1}]] === Plot3D[Sin[10 x y], {x, -1, 1}, {y, -1, 1}] it yellds False so it seems SameQ is a good way to test this. And it means that this is not working :/ $\endgroup$
    – Kuba
    Sep 18, 2013 at 8:55

Your Answer

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

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