Randomly generate points on a van der Waals surface - Mathematica Stack Exchange most recent 30 from mathematica.stackexchange.com 2019-10-17T23:44:32Z https://mathematica.stackexchange.com/feeds/question/102490 https://creativecommons.org/licenses/by-sa/4.0/rdf https://mathematica.stackexchange.com/q/102490 4 Randomly generate points on a van der Waals surface dr.blochwave https://mathematica.stackexchange.com/users/13162 2015-12-20T15:18:03Z 2016-07-07T12:28:02Z <p>I'm looking to randomly place an atom $\mathbf{A}$ onto a van der Waals surface formed by atoms $\mathbf{B}$, such that the distance between the randomly-generated atom $\mathbf{A}$ and the nearest surface atom $\mathbf{B}_i$ is equal to the sum of the van der Waals radii $r$. Essentially, the problem boils down to a sphere rolling around on an uneven surface.</p> <p>I can generate a van der Waals surface for graphene with the following code:</p> <pre><code>latticeGenerate[basisvec_List, numofcell_List, base_List] := Module[{x, y, basex, basey}, {x, y} = Transpose[Tuples[Range /@ numofcell].basisvec]; {basex, basey} = Transpose[base]; Transpose[{Join @@ ((x + #) &amp; /@ basex), Join @@ ((y + #) &amp; /@ basey)}]] </code></pre> <p>Defining the C-C bond length and van der Waals radius,</p> <pre><code>a = 1.4145; rc = 1.675; carbonXYZ = Flatten[{#, 0}] &amp; /@ latticeGenerate[{{3 a, 0}, {0, Sqrt a}}, {5,7}, {{0, 0}, {a, 0}, {-a/2, Sqrt a/2}, {3 a/2, Sqrt a/2}}]; vdWsurf = Sphere[carbonXYZ, rc]; Graphics3D[{Gray, vdWsurf}, PlotRangePadding -&gt; 2, Lighting -&gt; "Neutral"] </code></pre> <p>I'd then like to place an atom with radius 2.5 at random on the top of this surface, e.g.</p> <p><a href="https://i.stack.imgur.com/Oo0zI.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/Oo0zI.png" alt="enter image description here"></a></p> <p>I did think about a naive approach using <code>FindInstance[]</code>, but this just runs for a long time without a result:</p> <pre><code>ra = 2.5; minDist[pt_] := Min[Sqrt[(#.#)] &amp; /@ (Transpose[Transpose[carbonXYZ] - pt])] FindInstance[minDist[{x, y, z}] == (ra + rc) &amp;&amp; 5 &lt; x &lt; 15 &amp;&amp; 5 &lt; y &lt; 15 &amp;&amp; 0 &lt; z &lt; 5, {x, y, z}, Reals] </code></pre> <p>Could the <code>Region[]</code> functionality of <em>Mathematica</em> be exploited here? I'm looking to generate lots of these systems, so speed is of the essence! Perhaps <code>RandomPoint[]</code> can be utilised in this case?</p> https://mathematica.stackexchange.com/questions/102490/-/102498#102498 4 Answer by bill s for Randomly generate points on a van der Waals surface bill s https://mathematica.stackexchange.com/users/1783 2015-12-20T16:19:05Z 2015-12-20T18:13:56Z <p>One possibility is to set it up as a minimization problem. For example:</p> <pre><code>NMinimize[(minDist[{x, y, z}] - (ra + rc))^2, 5&lt;x&lt;15 &amp;&amp; 5&lt;y&lt;15 &amp;&amp; 0&lt;z&lt;5, {x, y, z}] {2.43076*10^-21, {x -&gt; 7.32182, y -&gt; 13.4219, z -&gt; 4.14947}} </code></pre> <p>You can find minima in different locations by changing the constraints:</p> <pre><code>NMinimize[(minDist[{x, y, z}] - (ra + rc))^2, 5&lt;x&lt;6 &amp;&amp; 5&lt;y&lt;15 &amp;&amp; 0&lt;z&lt; 5, {x, y, z}] {7.66876*10^-19, {x -&gt; 5.50514, y -&gt; 13.7025, z -&gt; 4.0791}} </code></pre> <p>Alternatively, <code>FindMinimum</code> seems faster, and allows you to directly give an initial point:</p> <pre><code>FindMinimum[{(minDist[{x, y, z}] - (ra + rc))^2, 5&lt;x&lt;15 &amp;&amp; 5&lt;y&lt;15 &amp;&amp; 0&lt;z&lt;5}, {{x, 10}, {y, 10}, {z, 2.5}}] {1.21243*10^-12, {x -&gt; 10.2024, y -&gt; 10.4351, z -&gt; 4.11543}} </code></pre> <p>In line with Oleksandr's comments, you can also try</p> <pre><code>FindMinimum[(minDist[{x, y, z}] - (ra + rc))^2, {{x, 8.}, {y, 10}, {z, 3.5}}, Method -&gt; "PrincipalAxis"] </code></pre> <p>Try out the different methods, some of which may give you warnings (and require adjusting various parameters).</p> https://mathematica.stackexchange.com/questions/102490/-/120178#120178 2 Answer by dr.blochwave for Randomly generate points on a van der Waals surface dr.blochwave https://mathematica.stackexchange.com/users/13162 2016-07-07T12:28:02Z 2016-07-07T12:28:02Z <p>Answer courtesy of Rahul:</p> <pre><code>s = DiscretizeRegion[ ImplicitRegion[ Min[EuclideanDistance[{x, y, z}, #] &amp; /@ carbonXYZ] == rc + ra, {x, y, z}], {{-1, 28}, {-2, 23}, {-5, 5}}, MaxCellMeasure -&gt; 0.1] RandomPoint[s] </code></pre>