3
$\begingroup$

I am trying to solve the minimax problem that I posted below. If I set c1 to 1.0 NMinimize gives me a result as expected. If I however change it slightly, even by a miniscule amount I get error messages. One of those says that the function value is not a number at {a,b,r1} = {1.14946,0.984114,0.0875131}. If I plug these values into the max function manually though, I get a result. In other error messages it complains that the comparison of some numbers is invalid and shows values containing complex numbers and minus infinity, but I don't know how it is getting these numbers. I don't know if NMinimize generates its result differently as it would be if I just test varying parameters manually, but I cannot get it to work correctly. So why does NMinimize not work if I set c1 to a value different than 1?

ClearAll["Global`*"] r[a_, b_, u_] := {a Cos[u], b Sin[u]} chord[c_, u1_, u2_] := EuclideanDistance[r[c, 1, u1], r[c, 1, u2]] rad2D[width_, rad_] := ArcLength[r[width, 1, u], {u, 0, rad}] arc[width_, rad1_, rad2_] := ArcLength[r[width, 1, u], {u, rad1, rad2}] edge[width_, u_] := EuclideanDistance[{0, 0}, r[width, 1, u]] E0r[a_, b_, c_, r_] := edge[c, r] + arc[c, a - b + r, Pi + r] + chord[c, a - b + r, a + r] E1r[a_, b_, c_, r_] := edge[c, r] + arc[c, a + r, Pi + r] + chord[c, a + r, -a + r] E2r[a_, b_, c_, r_] := edge[c, r] + arc[c, a + r, Pi + r] + chord[c, a - b + r, a + r] + SP[a, b, c, r] + chord[c, a - b + r, a - b + SP[a, b, c, r] + r] equation[a_, b_, c_, r_, g_] := arc[c, -a + b + r, a + r] - (chord[c, -a + r, b - a + r] + arc[c, b - a - g + r, b - a + r]) SP[a_?NumericQ, b_?NumericQ, c_, r_?NumericQ] := p /. FindRoot[equation[a, b, c, r, p], {p, a - b}, Evaluated -> False] c1 := 1.1 NMinimize[{Max[E0r[a, b, c1, r1], E1r[a, b, c1, r1], E2r[a, b, c1, r1]], a > Pi/3 && Cos[a] + Cos[a - b/2] > 1}, {{a, 1.1, 1.2}, {b, 0.9, 1.0}, {r1, 0.0, Pi/2}}]
Improve this question
$\endgroup$
5
  • $\begingroup$ Not an answer, but a couple of observations: Note that some of your functions take a long time to evaluate, for example ContourPlot[E2r[a, b, 1, 1], {a, Pi/3, 4 Pi}, {b, -2 Pi, 2 Pi}] . You can save some time by not repeatedly computing arclength, but just doing it once: arcSymbolic = Simplify[ ArcLength[ {width Cos[u], Sin[u]}, {u, 0, rad}], Assumptions -> width > 0] and then arclength = Function[{width,rad},Evaluate[arcSymbolic]] and then arclength[1,2] will be much faster. $\endgroup$ Commented Jul 23, 2022 at 15:34
  • $\begingroup$ I tried working on your code, but gave up because I couldn't follow which variable was doing what. I'd recommend more descriptive variable names such as a -> semiAxis1 etc. Not that it matters, but it is just helpful $\endgroup$ Commented Jul 23, 2022 at 15:38
  • $\begingroup$ You might find RegionPlot[ a > Pi/3 && Cos[a] + Cos[a - b/2] > 1, {a, Pi/3, 4 Pi}, {b, -2 Pi, 2 Pi}] to be visually helpful. $\endgroup$ Commented Jul 23, 2022 at 15:41
  • $\begingroup$ Also, I am not finding the variable specification {{a, 1.1, 1.2}, {b, 0.9, 1.0}, {r1, 0.0, Pi/2} } in the documentation. What are you trying to do here? Give it initial values (if so, see Method) or give a constraint? $\endgroup$ Commented Jul 23, 2022 at 15:56
  • $\begingroup$ Will keep that in mind to give variables better names in the future! Yes, I am trying to give them initial values, as for similar problems NMinimize was unable to find initial values and that had helped before. $\endgroup$ Commented Jul 23, 2022 at 18:49

2 Answers 2

Reset to default
6
$\begingroup$

A liberal sprinkling of _?NumericQ makes the problem go away:

ClearAll["Global`*"] r[a_, b_, u_] := {a Cos[u], b Sin[u]} chord[c_, u1_, u2_] := EuclideanDistance[r[c, 1, u1], r[c, 1, u2]] rad2D[width_?NumericQ, rad_?NumericQ] := ArcLength[r[width, 1, u], {u, 0, rad}] arc[width_, rad1_?NumericQ, rad2_?NumericQ] := ArcLength[r[width, 1, u], {u, rad1, rad2}] edge[width_, u_] := EuclideanDistance[{0, 0}, r[width, 1, u]] E0r[a_, b_, c_, r_] := edge[c, r] + arc[c, a - b + r, Pi + r] + chord[c, a - b + r, a + r] E1r[a_, b_, c_, r_] := edge[c, r] + arc[c, a + r, Pi + r] + chord[c, a + r, -a + r] E2r[a_, b_, c_, r_] := edge[c, r] + arc[c, a + r, Pi + r] + chord[c, a - b + r, a + r] + SP[a, b, c, r] + chord[c, a - b + r, a - b + SP[a, b, c, r] + r] equation[a_?NumericQ, b_?NumericQ, c_?NumericQ, r_?NumericQ, g_?NumericQ] := arc[c, -a + b + r, a + r] - (chord[c, -a + r, b - a + r] + arc[c, b - a - g + r, b - a + r]) SP[a_?NumericQ, b_?NumericQ, c_, r_?NumericQ] := p /. FindRoot[equation[a, b, c, r, p], {p, a - b}, Evaluated -> False]

So this works:

objective[a_?NumericQ, b_?NumericQ, c1_?NumericQ, r1_?NumericQ] := Max[E0r[a, b, c1, r1], E1r[a, b, c1, r1], E2r[a, b, c1, r1]]

and to monitor progress:

Dynamic[currentValue]

this will return in answer, but it takes a while:

With[{c = 1}, NMinimize[{objective[a, b, c, r1], a > Pi/3 && Cos[a] + Cos[a - b/2] > 1}, {{a, 1.1, 1.2}, {b, 0.9, 1.0}, {r1, 0.0, Pi/2} }, EvaluationMonitor :> (currentValue = objective[a, b, c, r1])] ]

This no longer throws errors, but I lost patience waiting:

With[{c = 1.1}, NMinimize[{objective[a, b, c, r1], a > Pi/3 && Cos[a] + Cos[a - b/2] > 1}, {{a, 1.1, 1.2}, {b, 0.9, 1.0}, {r1, 0.0, Pi/2} }, EvaluationMonitor :> (currentValue = objective[a, b, c, r1])] ]

The comments above about computing something symbolically first will--I think--speed things up.

Improve this answer
$\endgroup$
1
  • $\begingroup$ This solution, combined with using -EllipticE[rad1, 1 - width^2] + EllipticE[rad2, 1 - width^2] to calculate the ArcLength as provided in the other answer did the job. $\endgroup$ Commented Jul 23, 2022 at 18:59
6
$\begingroup$ 
$Version (* "13.1.0 for Mac OS X x86 (64-bit) (June 16, 2022)" *) Clear["Global`*"] r[a_, b_, u_] := {a Cos[u], b Sin[u]} chord[c_, u1_, u2_] := EuclideanDistance[r[c, 1, u1], r[c, 1, u2]] rad2D[width_, rad_] := ArcLength[r[width, 1, u], {u, 0, rad}]

The ArcLength can be evaluated symbolically in terms of EllipticE

arc[width_, rad1_, rad2_] = ArcLength[r[width, 1, u], {u, rad1, rad2}] (* -EllipticE[rad1, 1 - width^2] + EllipticE[rad2, 1 - width^2] *) edge[width_, u_] := EuclideanDistance[{0, 0}, r[width, 1, u]] E0r[a_, b_, c_, r_] := edge[c, r] + arc[c, a - b + r, Pi + r] + chord[c, a - b + r, a + r] E1r[a_, b_, c_, r_] := edge[c, r] + arc[c, a + r, Pi + r] + chord[c, a + r, -a + r] E2r[a_, b_, c_, r_] := edge[c, r] + arc[c, a + r, Pi + r] + chord[c, a - b + r, a + r] + SP[a, b, c, r] + chord[c, a - b + r, a - b + SP[a, b, c, r] + r]

Since you are only dealing with real numbers, Abs[x] == Sqrt[x^2]

equation[a_, b_, c_, r_, g_] = arc[c, -a + b + r, a + r] - (chord[c, -a + r, b - a + r] + arc[c, b - a - g + r, b - a + r]) /. Abs[x_] :> Sqrt[x^2] // FullSimplify; SP[a_?NumericQ, b_?NumericQ, c_?NumericQ, r_?NumericQ] := p /. FindRoot[equation[a, b, c, r, p], {p, a - b}, Evaluated -> False] With[{c1 = 1}, NMinimize[{Max[E0r[a, b, c1, r1], E1r[a, b, c1, r1], E2r[a, b, c1, r1]], a > Pi/3, Cos[a] + Cos[a - b/2] > 1}, {{a, 11/10, 12/10}, {b, 9/10, 1}, {r1, 0, Pi/2}}]] (* {4.81854, {a -> 1.14193, b -> 0.925792, r1 -> 0.994877}} *) With[{c1 = 11/10}, NMinimize[{Max[E0r[a, b, c1, r1], E1r[a, b, c1, r1], E2r[a, b, c1, r1]], a > Pi/3, Cos[a] + Cos[a - b/2] > 1}, {{a, 11/10, 12/10}, {b, 9/10, 1}, {r1, 0, Pi/2}}]] (* {5.0505, {a -> 1.0472, b -> 0.868468, r1 -> 1.1101}} *)
Improve this answer
$\endgroup$
1
  • 1
    $\begingroup$ It might be worth noting that the value of $a$ that minimizes the function when $c_1=1.1$ is essentially the lower limit for $a$: $\pi/3$. $\endgroup$ Commented Jul 23, 2022 at 19:11

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.