26
$\begingroup$

I have been recently using Mathematica for composing animations that are part of the supplementary information of my papers.

I am currently trying to build an animation that involves a viral particle. I am having problem representing a viral particle.

Does anyone know a 3D surface that looks like virus? I found a reasonable candidate from this.

Here is the code:

State = {0, Sqrt[7], 0, 0, 0, 0, -Sqrt[11], 0, 0, 0, 0, -Sqrt[7], 0};
nState = State/Norm[State]; Lam = {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
For[i = 1, i < 14, i++,
 Lam[[i]] = 
  Sqrt[Binomial[12, i - 1]]*(Cos[theta/2]^(13 - i))*E^(I*phi*(i - 1))*(Sin[theta/2]^(i - 1))]
sproduct = Norm[nState.Lam];
SphericalPlot3D[(sproduct^2) + 0.005, theta, phi, PlotPoints -> {50, 50}, Boxed -> False]

Virus-like plot

The problem is, the virus that I try to animate is more globular than the plot above; so I prefer to use different 3D plot. Does anyone know any other 3D surface that looks like a viral particle?

This is the picture of the viral particle that I desire

sphericalVirus

Thank you.

Improve this question
$\endgroup$
3
26
$\begingroup$

Found this somewhere:

ϕ = GoldenRatio; s = 1.75;
ContourPlot3D[
 -(4*(ϕ^2*x^2 - y^2)*(ϕ^2*y^2 - z^2)*(ϕ^2*z^2 - x^2) -
 (1 + 2 ϕ)*(x^2 + y^2 + z^2 - 1)^2) == 1.1, {x, -s, s}, {y, -s, s},
 {z, -s, s}, ContourStyle -> White, Boxed -> False, Axes -> False, 
 SphericalRegion -> True, Mesh -> 5, BoundaryStyle -> None, PlotPoints -> 45,
 MeshFunctions -> (#1^2 + #2^2 + #3^2 &),
 MeshShading -> Function[{i}, ColorData[35][i]],
 MeshStyle -> {{Brown, Thickness[0.005]}}]

enter image description here

Improve this answer
$\endgroup$
1
  • 7
    $\begingroup$ Eeek! Now I need to go and wash my hands :D $\endgroup$ – Yves Klett Feb 16 '15 at 19:58
26
$\begingroup$

Usually viruses have icosahedron symmetry. So I propose to generate a random chain of balls and translate it appropriately

n = 2000;
f = GaussianFilter[#, 5] &;
p = f@RandomReal[{3.0, 4.0}, n] #/Sqrt@Total[#^2, {2}] &@
  Accumulate@Prepend[0.08 f@RandomReal[NormalDistribution[], {n - 1, 3}], 
    Normalize@RandomReal[NormalDistribution[], 3]];
r = f@RandomReal[{0.06, 0.14}, n];
Graphics3D[{{#, GeometricTransformation[#, RotationTransform[π/2 - ArcTan[1/2], 
    {Sin@#, Cos@#, 0}].RotationTransform[π/5, {0, 0, 1}] & /@ 
           Range[2 π/5, 2 π, 2 π/5]]} &@{#, 
        GeometricTransformation[#, RotationTransform[π/5, {0, 0, 
            1}].RotationTransform[π, {1, 0, 0}]]} &@
     GeometricTransformation[#, RotationTransform[#, {0, 0, 1}] & /@ 
       Range[2 π/5, 2 π, 2 π/5]] &@{Specularity[0.2, 
     20], {Hue[10 #2, 0.6], Sphere@##} & @@@ Transpose@{p, r}}}, 
 Boxed -> False, Lighting -> "Neutral"]

Here are some results

enter image description here

Improve this answer
$\endgroup$
21
$\begingroup$

Another way to tackle this is to download 3D mesh files of actual viruses. Here is a page with many such files. First you grab the links to STL files:

virusLinks = 
 Import["https://www.rbvi.ucsf.edu/Outreach/technotes/ModelGallery/index.html", 
   "Hyperlinks"] // Select[StringEndsQ@".stl"]
(* 
{https://www.rbvi.ucsf.edu/Outreach/technotes/ModelGallery/4.5S.stl,
https://www.rbvi.ucsf.edu/Outreach/technotes/ModelGallery/FfhM3.stl,
https://www.rbvi.ucsf.edu/Outreach/technotes/ModelGallery/single-3fold-ring.stl,
https://www.rbvi.ucsf.edu/Outreach/technotes/ModelGallery/single-3fold.stl,
https://www.rbvi.ucsf.edu/Outreach/technotes/ModelGallery/STL/clathrin.stl,
https://www.rbvi.ucsf.edu/Outreach/technotes/ModelGallery/STL/dengue_8A_IAU_1p58.stl,
https://www.rbvi.ucsf.edu/Outreach/technotes/ModelGallery/STL/FMDV_5A.stl,
https://www.rbvi.ucsf.edu/Outreach/technotes/ModelGallery/STL/hepB.stl,
https://www.rbvi.ucsf.edu/Outreach/technotes/ModelGallery/STL/MurinePolyoma.stl,
https://www.rbvi.ucsf.edu/Outreach/technotes/ModelGallery/STL/HRV1-4A-02-3-4.stl,
https://www.rbvi.ucsf.edu/Outreach/technotes/ModelGallery/STL/rotavirus-6A.stl,
https://www.rbvi.ucsf.edu/Outreach/technotes/ModelGallery/STL/noda_4A.stl,
https://www.rbvi.ucsf.edu/Outreach/technotes/ModelGallery/STL/ParvoB19_5A.stl,
https://www.rbvi.ucsf.edu/Outreach/technotes/ModelGallery/STL/4tna_15_80.stl}*)

Now you can import these as Graphics3D objects. Here is the parvovirus B19:

Normal@Import[virusLinks[[-2]], {"STL", "Graphics3D"}]

enter image description here

and here's a hack method method suggested by J.M. to plot the imported GraphicsComplex with a custom color function

plotvirus[link_] := 
 With[{virus = Import[link, {"STL", "GraphicsComplex"}]}, 
  Graphics3D[
   Append[ MapAt[Insert[#, EdgeForm[], 1] &, virus, {2}], 
    VertexColors -> (ColorData[
        "GreenPinkTones"] /@ (Rescale[
         Norm /@ Standardize[First[virus], Mean, 1 &]]))], 
   Boxed -> False]]

For some reason I like the green-pink tones. Here is a plot of the murine polyomavirus

enter image description here

These plots will really slow down your computer (at least they do for me), since they have hundreds of thousands of vertices. I had to rasterize them in order to create this image:

enter image description here

Improve this answer
$\endgroup$
2
  • $\begingroup$ Try Select[Import["https://www.rbvi.ucsf.edu/Outreach/technotes/ModelGallery/index.html", "Hyperlinks"], StringMatchQ[#, "*.stl"] &]. ;) $\endgroup$ – J. M.'s torpor♦ Aug 12 '16 at 17:06
  • $\begingroup$ You can try this for the coloring: parvo = Import["https://www.rbvi.ucsf.edu/Outreach/technotes/ModelGallery/STL/ParvoB19_5A.stl", "GraphicsComplex"]; Graphics3D[Append[MapAt[Insert[#, EdgeForm[], 1] &, parvo, {2}], VertexColors -> (Hue /@ Rescale[Norm /@ Standardize[First[parvo], Mean, 1 &]])], Boxed -> False]. $\endgroup$ – J. M.'s torpor♦ Aug 13 '16 at 0:52
15
$\begingroup$

Simple solution with numerous spheres:enter image description here

n = 10000;
r1 = RandomReal[{2, 2.1}, n];
r2 = RandomReal[{0.1, 0.12}, n];
aa = RandomReal[{-(Pi/2), Pi/2}, n];
bb = RandomReal[{0, 2 2Pi}, n];
s[p_, r_] := {Hue[10 r], Sphere[p, r]};
p[r_, a_, b] := r {Cos[a] Sin[b], Cos[a] Cos[b], Sin[a]};
Graphics3D[{Specularity[White, 30], MapThread[s, {MapThread[p, {r1, aa, bb}], r2}]}, Boxed -> False]
Improve this answer
$\endgroup$
9
$\begingroup$

Late to the viral party... here's an approach that uses SphericalPlot3D to generate the basic shape. The parameter called "pointiness" changes the pointiness of the spikes. 

Manipulate[
 SphericalPlot3D[1+Sin[15 ϕ] Sin[13 θ]/pointiness, {θ, 0, π}, {ϕ, 0, 2 π}, 
 ColorFunction -> (ColorData["DarkRainbow"][#6] &), Mesh -> None, 
 PlotPoints -> 35, Boxed -> False, Axes -> False, 
 PlotRange -> All], {pointiness, 0.1, 5}]

enter image description here enter image description here

Improve this answer
$\endgroup$
8
$\begingroup$

This might qualify, too:

Graphics3D[{Orange, First@PolyhedronData["MathematicaPolyhedron"]}, 
 Boxed -> False, Lighting -> "Neutral", Background -> Black]

virus?

Improve this answer
$\endgroup$
2
  • 1
    $\begingroup$ old Mathematica Logo looks like virus~~~Errr~~ $\endgroup$ – Harry Feb 17 '15 at 4:53
  • 6
    $\begingroup$ "Harry, are you installing viruses on the computer again?!" $\endgroup$ – Kroltan Feb 17 '15 at 12:26
7
$\begingroup$

The Interpolation approach:

data = Flatten[{{{#1, 2 #2}, 1} & @@@ 
RandomReal[{0, Pi}, {2000, 2}], {{#1, 2 #2}, 
  1 + RandomReal[]/3} & @@@ RandomReal[{0, Pi}, {100, 2}]}, 1];

dataf = Interpolation[data, InterpolationOrder -> 1];

SphericalPlot3D[dataf[θ, ϕ], {θ, 0, Pi}, {ϕ, 0, 2 Pi}, 
PlotStyle -> Directive[Orange, Opacity[0.7], Specularity[White, 10]],
Mesh -> None, PlotPoints -> 30, Boxed -> False, 
ColorFunction -> 
Function[{x, y, z, θ, ϕ, r}, Hue[3 (r - 1)]]];

the image:

enter image description here

Improve this answer
$\endgroup$
1
  • 6
    $\begingroup$ Post-apocalyptic Mathematica logo...? $\endgroup$ – Jens Feb 17 '15 at 6:14

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.