Hot answers tagged

14

If more ad hoc, inexact approaches are welcome, one way to generate relatively uniform density of points on a sphere is to use Monte Carlo Lloyd's algorithm (modified for the spherical case): With[{points = 200, samples = 40000, iterations = 20}, Nest[With[{randoms = Join[#, RandomPoint[Sphere[], samples]]}, Table[Normalize@Mean@Extract[randoms, ...


10

Aha~ I suppose this question is created while solving this. Am I correct @yode :P So here's an easy solution, simple, elegant, and may I say even quite fast after some optimization? pt = With[{p = Table[{x[i], y[i], z[i]}, {i, 80(*number of charges*)}]}, p /. Last@ NMinimize[ Total[1/Norm[Normalize[#1] - Normalize[#2]] & @@@ ...


8

Correct me if I'm wrong... but I suppose, pedantically speaking, there are only five solutions defined by Platonic solids, and trivial solutions for 0-3 points (extension of CirclePoints). Thus: ClearAll[spherePoints]; spherePoints[r_: 1, n_ /; 0 <= n < 4] := {##, 0} & @@@ CirclePoints[r, n]; (spherePoints[r_: 1, PolyhedronData[#, "VertexCount"]...


6

For an approximately even distribution of points on any surface with cylindrical symmetry, we can use the Golden Angle, the same way that the sunflower uses it on the plane. To place N points on the surface of a sphere, define an axis. Divide the surface into N equal area strips perpendicular to the axis. For k in 0 to N-1, on the kth strip, place a point ...


5

Here's one way to code this optimization problem in MMA (I am guessing it concerns a resource allocation problem in a broadcast multi-carrier communication channel). First, define a convenience function for the (subcarrier) capacity as follows: r[p_, h_] := (1./8.) Log[2, 1 + p h] It is also convenient to define the following two (abstract) matrices ...


4

With[{n = {3, 4, 5, 6, 7, 20}}, Partition[show[points[#]] & /@ n, 3]] // GraphicsGrid With the code below, with piecewise spring forces (exclusively repulsive) and Cartesian vectors. A different model for force and switch to spherical vectors would probably be wise. show[points_] := Graphics3D[{ Opacity[.5], Sphere[], Opacity[1], PointSize[...


4

Method -> "PrincipalAxis" gives a result: {0.236921, {q -> {-2.27053, -1.95057, -2.27053, -2.30068, -2.30068}}} According to the documentation Direct search methods which do not require derivatives can be helpful in these cases This also means NMinimize might be a good option.


4

The following is an adaptation of my answer to this question, which focused on the 3D linear least-squares problem. (* Rules to get constants out of sums (or integrals etc) *) outrules = { Sum[f_ + g_, it : {x_Symbol, __}] :> Sum[f, it] + Sum[g, it], Sum[c_ f_, it : {x_Symbol, __}] :> c Sum[f, it] /; FreeQ[c, x], Sum[c_, it : {x_Symbol, __}] :...


2

I guess you could just do the minimization numerically. f[a_, alpha_, b_, beta_, tau_, t1_, t2_] := (2 (3 a^2 + 3 a alpha t1 + alpha^2 t1^2))/t1^3 + (2 (3 b^2 - 3 b beta t2 + beta^2 t2^2))/t2^3 - (1 - t1 - t2) tau fmin[a_, alpha_, b_, beta_, tau_] := NMinValue[{f[a, alpha, b, beta, tau, t1, t2], t1 >= 0 && t2 >= 0 && t1 + ...


2

Just add: NMaximize[{Norm[EField[x, y]], {x, y} ∈ solution["ElementMesh"]}, {x, y}] Which gives: {58.362, {x -> 2.95481, y -> 0.186586}} Showing everything together: {eMax, {xMax, yMax}} = NMaximize[{Norm[EField[x, y]], {x, y} ∈ solution["ElementMesh"]}, {x, y}] /. sol : {__Rule} :> Values[sol] Show[ DensityPlot[solution[x, y], {x, y} ∈ ...


2

I haven't really checked if this produces sensible results. Module[{shops, products, singlePrices, deliveryCosts, amount}, shops = 5; products = 10; (* Bogus data. *) singlePrices = Table[RandomVariate[NormalDistribution[n, 1/5], shops], {n, products}]; deliveryCosts = RandomVariate[NormalDistribution[5, 1], shops]; amount = ...


2

As I understand your question your are trying to use NMaximize where you want to constrain a parameter to belong to a custom domain. One way to do it is to use Or on the individual elements of the domain list. dom = {1, 2, 3, 4}; Or @@ Map[a == # &, dom] (* a == 1 || a == 2 || a == 3 || a == 4 *) Use this in NMaximize as a constraint. NMaximize[{a^...


2

If you introduce a spherical coordinates parametrization $a=\sin(q)$, $b=\cos(q)\cos(\phi)$, $c=\cos(q)\sin(\phi)$, you can write your problem in much simpler terms: f1 = 1/2 (1 + Sqrt[Sin[q]^2 + k^2 Cos[q]^2]) f2 = 1/2 (1 + Sin[q]^2 + k Cos[q]^2) where $k=\exp(\gamma(t))$ Now for a given value of $k=\exp(\gamma(t))$ you can do the 1d numerical ...


2

Let us simplify your formulas manually first. Let us denote $e^{-\gamma(t)}$ by e, and $a^2, b^2, c^2$ by a2, b2, c2. Then f1 = 1/2 (1 + Sqrt[a2 + b2 e^2 + c2 e^2]); f2 = 1/2 (1 + a2 + e (b2 + c2)); You want to maximize f1 - f2 with the constraints $a^2+b^2+c^2=1$ and $a,b,c \in [0,1]$. From your notation, I also assume that $0 < e^{-\gamma(t)} <...


1

For a given a, b, and t and changing gamma, we can see that the diference between the two functions stops changing for large values of gamma. f1[a_, b_, c_, t_] := 1/2 (1 + Sqrt[ a^2 + (b Exp[-\[Gamma] (t)])^2 + (c Exp[-\[Gamma] (t)])^2]) f2[a_, b_, c_, t_] := 1/2 (1 + a^2 + Exp[-\[Gamma] (t)] (b^2 + c^2)) v = {10., 15., 7.} {a, ...


1

Try this $Assumptions = {w, x, y, z} \[Element] Reals; f = {1/2 (-x - y + Sqrt[4 w^2 + x^2 - 2 x y + y^2]), 1/2 (-x - y - Sqrt[4 w^2 + x^2 - 2 x y + y^2]), -z, x + y - Sqrt[4 w^2 + x^2 - 2 x y + y^2], x + y + Sqrt[4 w^2 + x^2 - 2 x y + y^2], 2 z}; Table[c = f[[i]]; d = Drop[f, {i}]; Simplify[Reduce[And@@Map[c<=#&, d], {w, x, y, z}]], {i, 1, ...


1

Not a real answer, too long to put in a comment... What I would suggest is to use smaller precision goals and restrain NIntegrate's adaptive algorithm. This way you can get an answe in a relatively short time, analyze does it make sense, and continue with refinements that require more computational time. The code below produces results under 35s on my ...


1

Consider pre-evaluating your region descriptor conditions: regiondescriptor = Tr[{{0.09, 0}, {0, 7}}.{{x1^2, x1*x2}, {x1*x2, x2^2}}] <= 1 && Tr[{{7, 0}, {0, 0.09}}.{{x1^2, x1*x2}, {x1*x2, x2^2}}] <= 1 && Tr[{{1.05, -0.95}, {-0.95, 1.05}}.{{x1^2, x1*x2}, {x1*x2, x2^2}}] <= 1 && Tr[{{1.05, 0.95}, {0.95, 1.05}}.{{x1^2, ...


1

Your problem is caused by your trying to use T both as vector and scalar at the same time. That is bound to cause problems. happy fish indicated a quick-and-dirty fix in a comment to your question. Here is an attempt to produce a solution the roots out the structural problem. T = 100; (* modified *) tc = {126.1, 190.6}; pc = {33.94, 46.04}; ω = {0.040, 0....


1

You can find and exclude the part of the domain where the integrand is discontinuous. To find where the integrand is discontinuous, look for where the argument of Arg is real and negative, since Arg has a branch cut discontinuity there: z[\[Gamma]_,\[Beta]_,\[Omega]_]:=(Times@@(secondOrderDelayedAllPass[#,\[Omega]]&/@\[Gamma]))* ...



Only top voted, non community-wiki answers of a minimum length are eligible