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}}]
$\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$ 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$ 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$ 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$ 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$
    – Wurzel
    Jul 23, 2022 at 18:49

2 Answers 2

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.

$\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$
    – Wurzel
    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}} *)
$\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$
    – JimB
    Jul 23, 2022 at 19:11

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.