6
$\begingroup$

Inspired by David G. Stork’s post https://mathematica.stackexchange.com/a/84097/10361, I tried to have the molecules perform a random walk

xt = Accumulate[Prepend[RandomReal[{-1, 1}, {200, 30, 3}], RandomReal[{-5, 5}, {30, 3}]]];

like so:

h[x_] := Translate[Rotate[First@ChemicalData["Water", "MoleculePlot"],RandomReal[{0, \[Pi]}], {8, .5, 0}], x];
an[t_] :=Graphics3D[h[100*xt[[t]]],PlotRange -> {{-1000, 1000}, {-1000, 1000}, {-1000, 1000}}];
Animate[an[n], {n, 1, 100, 1}]

It works, but all the molecules have the same orientation at any time, and I think I see why, but I am not sure how to work around it. (I.e., to give them random rotations individually at each step). Any good ideas?

Improve this question
$\endgroup$
2
  • 1
    $\begingroup$ A more realistic, but more complicated approach, would be: Start with random positions and give every molecule a random (or better: Boltzmann distributed) velocity and a random (or better: Boltzmann distributed) angular velocity . Then propagate until 2 molecules have a distance less than some threshold. Then give these 2 molecules new velocities and angular velocities under the restriction of momentum and angular momentum conservation. For a start, you may only implement translation and add rotation if this works. $\endgroup$
    – Daniel Huber
    Mar 18, 2021 at 11:19
  • $\begingroup$ It is already adequate for a coarse grained description of translational diffusion, and how it is actually often done in practice in e.g. stat. mech. Anyway, this is just for fancy ppt visualization. Thanks! $\endgroup$
    – Sooner
    Mar 18, 2021 at 13:50

1 Answer 1

Reset to default
9
$\begingroup$

all the molecules have the same orientation at any time, and I think I see why

Because at each timestep you are are computing only a single angle and using it to rotate every molecule.

In this approach I use NestList to accumulate a list of TransformationFunction objects. The key here is that Composition[TransformationFunction[..], TransformationFunction[...]] will evaluate to a single transformation. So at each step I take the previous transformation and compose it with a random translation and a random rotation.

randomInitialTransform[] := Composition[
    TranslationTransform[RandomReal[{-5, 5}, 3]],
    RotationTransform[RandomReal @ {-Pi, Pi}, RandomReal[{-1,1}, 3]]
];
randomStep[inputTransform_] := Composition[
    (*small random translation*)
    TranslationTransform @ RandomReal[{-0.1, 0.1}, 3],
    (*small random rotation*)
    RotationTransform[RandomReal @ {-0.1, 0.1}, RandomReal[{-1,1}, 3]],
    inputTransform
]

randomTrajectory[n_] := NestList[randomStep, randomInitialTransform[], n];

Now make a table of trajectories, and grab the GraphicsComplex from a molecule plot:

trajectoryList = Table[randomTrajectory @ 200, 30];
graphicsComplex = First @ MoleculePlot3D[Molecule @ "water", PlotTheme -> "Tubes"];

The next part is to use GeometricTransformation, and give a list of transforms as the second argument. For example to visualize all steps of a single trajectory use

Graphics3D[GeometricTransformation[graphicsComplex, randomTrajectory[200]]]

enter image description here

To visualize a snapshot of the ensemble use something like

snapShot[n_] := Graphics3D[
    GeometricTransformation[graphicsComplex, trajectoryList[[All, n]]],
    PlotRange -> {{-6, 6}, {-6, 6}, {-6, 6}}
]

enter image description here

Improve this answer
$\endgroup$
1
  • $\begingroup$ It works with Export but not with Animate. Which is good enough for me. Also, in Version 11.0, had to use graphicsComplex = Scale[First@ChemicalData["Water", "MoleculePlot"], 0.005]; $\endgroup$
    – Sooner
    Mar 18, 2021 at 13:52

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.