We’re rewarding the question askers & reputations are being recalculated! Read more.
4

Here's a slight refactoring of the OP's solution. Expressions like #[[5]] are hard to read and therefore hard to debug. One can use a function with symbolic names for arguments to make the code easier to understand. I think it's better to return raw output data of a function and leave it formatting etc. to processing the returned data. So I moved ...


4

After studying the article and theses, as well as article Ground-state properties and elementary excitations of quantum droplets in dipolar Bose-Einstein condensates from which the ansatz was taken, I came to the conclusion that the ansatz may not have been calibrated to find the magnitude of the energy. Therefore, we calibrate the ansatz using the data in ...


4

The easiest way is, I think, to use the definition of a Bézier curve to define a ParametricRegion and then use RegionDistance to find out how well the curve approximates the points. Here's my suggestion. Define the points: n = 5; p = Table[{Cos[\[CurlyPhi]], Sin[\[CurlyPhi]]}, {\[CurlyPhi], Join[{0}, RandomReal[{0, Pi/2}, n], {Pi/2}]}]; Definition of ...


4

Can be used ParametricNDSolveValue F = 1.2; sol = ParametricNDSolveValue[{f'[ x] (1 + 20 f[x] (1 - f[x]) f[x]^2) == -f[x], f[0] == a}, f, {x, 0, 5}, {a}]; M[a_?NumericQ] := (NIntegrate[sol[a][x], {x, 0, 5}] - F)^2 sol1 = NMinimize[{M[a], 0 < a < 1}, a] (*{1.03015*10^-21, {a -> 0.69524}}*) General view of the solution and optimal ...


4

Your second part NMaximize needs a functional with numerical arguments. Try pR[w_] := NArgMax[{-p^2 + p w, p > 0 }, p] J[w_?NumericQ] := w - pR[w] NMaximize[{J[w], 0 <= w <= 100}, w , Method -> "RandomSearch" ] (*{50., {w -> 100.}}*) Don't know why the evaluation time is so long. remark: Mathematica knows to solve minmax-problems


4

FindArgMax[{x, 0 <= x <= 3 && y == 1}, {x, y}][[1]] 3.


3

Try f[w_?NumericQ, p_?NumericQ] := -p^2 + p w pR[w_?NumericQ] := Block[{p}, NArgMax[{f[w, p], p > 0}, p]] J[w_?NumericQ] := w - pR[w]^2 NMaximize[{J[w], {w > 0 , f[w, pR[w]] > 0.5}}, w ,EvaluationMonitor :> Print[{w, J[w]}] ,Method->"NelderMeat", AccuracyGoal -> 3] (*{1., {w -> 2.00012}}*) It works with slow convergence in ...


3

Try Simplify[(f[x, y] + g[x, y])/2 + Abs[f[x, y] - g[x, y]]/2,0<=x<=1&&0<=y<=1] which instantly returns 1+2 x+3 y^3 You can see that by inspection because f[x,y]>g[x,y] over the domain so the Abs does nothing and disappears and that leaves f[x,y]/2+g[x,y]/2+f/x,y]/2-g[x,y]/2==f[x,y]


3

Here's a method that is a generalization of this one and should work for arbitrary $n$ and $m$. It is very efficient, as long as you don't want to do a graphics plot as below. Let's do a random example where $m=3$ so we can visualize the polytope in 3D: n = 5; m = 3; M = RandomVariate[NormalDistribution[], {m, n}] (* {{-0.304994, -0.392532, 0.823638, -0....


3

Knowing f[x]==FF'[x] you can expand your ode and solve without need of additional NMinimize. Only additional constraints FF[5] == 1.5,FF[0] == 0 are necessary erg = NDSolveValue[{FF'[x] == f[x],f'[x] (1 + 20 f[x] (1 - f[x]) f[x]^2) == -f[x], FF[5] == 1.2,FF[0] == 0}, {f, FF}, {x, 0, 5} ] Plot[{ erg[[1]][x]} , {x, 0, 5}]


3

This looks like a bug. You can work around the issue by avoiding Indexed (I also needed to include an explicit Method option in M12):$\in$ res = NMinimize[ { Abs[{q1+2,q2,q3}].{1,2,1}, Norm[{q1,q2,q1}-{0.3,0,0.2}]<10 }, {q1,q2,q3} ∈ ImplicitRegion[a^2+b^2+c^2<100,{a,b,c}], Method->"NelderMead", StepMonitor:>Print[{q1,...


3

I led you astray with a bogus answer that I didn't think through appropriately. I've removed the previous answer and put in place a more correct approach. Here's what I missed: the variance associated with the added noise needs to be estimated with the replicate measurements. If just the mean of the replicates is used, then all of the information about ...


3

Edit: I think you need MinMax. How about this? NMaximize[{(x^2 - 2 x Sin[x] + Sin[x]^2)/x^2, 4 <= x <= 5}, x] {1.48166, {x -> 4.49341}} So $ k=1.48166$ RegionPlot[k x^2 >= (Sin[x] - x)^2, {x, -10, 10}, {k, -10, 10}, FrameLabel -> {"x", "k"}, Axes -> True, GridLines -> {None, {1.48166}}, GridLinesStyle -> Red] Your problem ...


2

There're 2 issues here: The evaluation order should be properly controlled. The argument of BezierFunction should be between $0$ and $1$, so we need to add constraints to NMinimize. The following is the fixed code, I've also adjust Method option of NMinimize a bit to obtain better result: SeedRandom[1]; n = 5; p = Table[{Cos[φ], Sin[φ]}, {φ, Join[{0}, ...


2

I am not sure whether this is what you want. Remove["Global`*"] // Quiet; F = 1.2; eq = {f'[x] (1 + 20 f[x] (1 - f[x]) f[x]^2) == -f[x], g[0] == 0, g[5] == F, g'[x] == f[x]}; {gSol, fSol} = NDSolveValue[eq, {g, f}, {x, 0, 5}]; {gSol, fSol} // ListLinePlot Remove["Global`*"] // Quiet; F = 1.2; eq = {f'[x] (1 + 20 f[x] (1 - f[x]) f[x]^2) == -f[x], f[0] ...


1

Remove the constraint w>i. NArgMax expects only constraints depending on p! pR[w_?NumericQ] :=Block[{p}, NArgMax[{f[w, p], p >= 0(*,w\[GreaterEqual]i*)}, p]] Now the NMaximize evaluates J[w_?NumericQ] := (A - a pR[w]) (w - i) NMaximize[{J[w], {w > i, f[w, pR[w]] > 0}}, w,Method ->"NelderMead",AccuracyGoal -> 3, EvaluationMonitor :> ...


1

Evidently it's having trouble with the transcendental equation. Plug in values and it can do it numerically. d = .5 h = .5 θn = 45 ° ϕn = 30 ° Minimize[U, {θ, ϕ}] (*{-0.899519, {θ -> 0.523599, ϕ -> 0.523599}}*) You need to test your own values, since I don't know what reasonable input value are.


1

I think you are asking for something like the following. Define the functions f and g f[x_, y_] := 1 + 2*x + 3*y^3 g[x_, y_] := y + x^2 Define a function that finds the maximum as a function of y. I can't see an easy way to do this for symbolic values of y, so I define a function that evaluates only when given a numerical value. h[y_?NumericQ] := ...


1

For some values of a and b there is no solutions in the range 0<x<1, so solh[a_, b_] shows {x, x}, hence further errors. You can change this to: solh[a_, b_] := With[{sol = NSolve[{h[x, a, b] == 0, 0 < x < 1}, x][[;; , 1, 2]]}, If[sol != {}, MinMax[sol], {0.00011, 0.99989}]]; Now in case of no solutions due to restrictions on x the ...


1

Have a look at the expansion of Sin[x] around x=0. It starts with x. So the subtraction of x compensates for that. The idea with small x is apparently meant by the authors of this task. The second term in the expansion is since Sin is antisymmetric around x=0 x^3. So k is for some open surrounding of x=0 approximately the second order coefficient of the ...


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