0
$\begingroup$

While trying to maximize the function fun[x_, a_, b_], over parameters $a$ and $b$, and plotting the resulting maxima with respect to $x$, I encountered the error "Constraints should be equalities, inequalities, or domain
specifications involving the variables", leading to unexpected plot

    fun[x_, a_, 
   b_] = -(b/2 + 
       1/48 a (22 - 5 Cos[2 x] + 2 Cos[4 x] - 
          3 Cos[6 x])) (((4 a + 10 a Cos[2 x] - 4 a Cos[4 x] + 
           6 a Cos[6 x] + 
           Sqrt[2] \[Sqrt](58 a^2 + 12 b^2 + 8 a^2 Cos[2 x] + 
               27 a^2 Cos[4 x] - 16 b^2 Cos[4 x] - 4 a^2 Cos[6 x] + 
               38 a^2 Cos[8 x] + 4 b^2 Cos[8 x] - 4 a^2 Cos[10 x] + 
               5 a^2 Cos[12 x])) Log[
          1/96 (48 a + 48 b - 
             Sqrt[2] \[Sqrt](58 a^2 + 12 b^2 + 
                 8 a^2 Cos[2 x] + (27 a^2 - 16 b^2) Cos[4 x] - 
                 4 a^2 Cos[6 x] + 38 a^2 Cos[8 x] + 4 b^2 Cos[8 x] - 
                 4 a^2 Cos[10 x] + 5 a^2 Cos[12 x]))])/(2 Sqrt[
         2] \[Sqrt](58 a^2 + 12 b^2 + 8 a^2 Cos[2 x] + 
            27 a^2 Cos[4 x] - 16 b^2 Cos[4 x] - 4 a^2 Cos[6 x] + 
            38 a^2 Cos[8 x] + 4 b^2 Cos[8 x] - 4 a^2 Cos[10 x] + 
            5 a^2 Cos[12 x])) + ((-4 a - 10 a Cos[2 x] + 
           4 a Cos[4 x] - 6 a Cos[6 x] + 
           Sqrt[2] \[Sqrt](58 a^2 + 12 b^2 + 8 a^2 Cos[2 x] + 
               27 a^2 Cos[4 x] - 16 b^2 Cos[4 x] - 4 a^2 Cos[6 x] + 
               38 a^2 Cos[8 x] + 4 b^2 Cos[8 x] - 4 a^2 Cos[10 x] + 
               5 a^2 Cos[12 x])) Log[
          
          1/96 (48 a + 48 b + 
             Sqrt[2] \[Sqrt](58 a^2 + 12 b^2 + 
                 8 a^2 Cos[2 x] + (27 a^2 - 16 b^2) Cos[4 x] - 
                 4 a^2 Cos[6 x] + 38 a^2 Cos[8 x] + 4 b^2 Cos[8 x] - 
                 4 a^2 Cos[10 x] + 5 a^2 Cos[12 x]))])/(2 Sqrt[
         2] \[Sqrt](58 a^2 + 12 b^2 + 8 a^2 Cos[2 x] + 
            27 a^2 Cos[4 x] - 16 b^2 Cos[4 x] - 4 a^2 Cos[6 x] + 
            38 a^2 Cos[8 x] + 4 b^2 Cos[8 x] - 4 a^2 Cos[10 x] + 
            5 a^2 Cos[12 x]))) - (b/2 + 
      1/48 a (26 + 5 Cos[2 x] - 2 Cos[4 x] + 
         3 Cos[6 x])) (((-4 a - 10 a Cos[2 x] + 4 a Cos[4 x] - 
           6 a Cos[6 x] + 
           Sqrt[2] \[Sqrt](58 a^2 + 12 b^2 + 8 a^2 Cos[2 x] + 
               27 a^2 Cos[4 x] - 16 b^2 Cos[4 x] - 4 a^2 Cos[6 x] + 
               38 a^2 Cos[8 x] + 4 b^2 Cos[8 x] - 4 a^2 Cos[10 x] + 
               5 a^2 Cos[12 x])) Log[
          1/96 (48 a + 48 b - 
             Sqrt[2] \[Sqrt](58 a^2 + 12 b^2 + 
                 8 a^2 Cos[2 x] + (27 a^2 - 16 b^2) Cos[4 x] - 
                 4 a^2 Cos[6 x] + 38 a^2 Cos[8 x] + 4 b^2 Cos[8 x] - 
                 4 a^2 Cos[10 x] + 5 a^2 Cos[12 x]))])/(2 Sqrt[
         2] \[Sqrt](58 a^2 + 12 b^2 + 8 a^2 Cos[2 x] + 
            27 a^2 Cos[4 x] - 16 b^2 Cos[4 x] - 4 a^2 Cos[6 x] + 
            38 a^2 Cos[8 x] + 4 b^2 Cos[8 x] - 4 a^2 Cos[10 x] + 
            5 a^2 Cos[12 x])) + ((4 a + 10 a Cos[2 x] - 
           4 a Cos[4 x] + 6 a Cos[6 x] + 
           Sqrt[2] \[Sqrt](58 a^2 + 12 b^2 + 8 a^2 Cos[2 x] + 
               27 a^2 Cos[4 x] - 16 b^2 Cos[4 x] - 4 a^2 Cos[6 x] + 
               38 a^2 Cos[8 x] + 4 b^2 Cos[8 x] - 4 a^2 Cos[10 x] + 
               5 a^2 Cos[12 x])) Log[
          1/96 (48 a + 48 b + 
             Sqrt[2] \[Sqrt](58 a^2 + 12 b^2 + 
                 8 a^2 Cos[2 x] + (27 a^2 - 16 b^2) Cos[4 x] - 
                 4 a^2 Cos[6 x] + 38 a^2 Cos[8 x] + 4 b^2 Cos[8 x] - 
                 4 a^2 Cos[10 x] + 5 a^2 Cos[12 x]))])/(2 Sqrt[
         2] \[Sqrt](58 a^2 + 12 b^2 + 8 a^2 Cos[2 x] + 
            27 a^2 Cos[4 x] - 16 b^2 Cos[4 x] - 4 a^2 Cos[6 x] + 
            38 a^2 Cos[8 x] + 4 b^2 Cos[8 x] - 4 a^2 Cos[10 x] + 
            5 a^2 Cos[12 x]))) + 
   a (1/48 (22 - 5 Cos[2 x] + 2 Cos[4 x] - 
         3 Cos[6 x]) (((4 + 10 Cos[2 x] - 4 Cos[4 x] + 6 Cos[6 x] + 
              Sqrt[2] \[Sqrt](58 + 8 Cos[2 x] + 27 Cos[4 x] - 
                  4 Cos[6 x] + 38 Cos[8 x] - 4 Cos[10 x] + 
                  5 Cos[12 x])) Log[
             1/96 (48 - 
                Sqrt[2] \[Sqrt](58 + 8 Cos[2 x] + 27 Cos[4 x] - 
                    4 Cos[6 x] + 38 Cos[8 x] - 4 Cos[10 x] + 
                    5 Cos[12 x]))])/(2 Sqrt[
            2] \[Sqrt](58 + 8 Cos[2 x] + 27 Cos[4 x] - 4 Cos[6 x] + 
               38 Cos[8 x] - 4 Cos[10 x] + 5 Cos[12 x])) + ((-4 - 
              10 Cos[2 x] + 4 Cos[4 x] - 6 Cos[6 x] + 
              Sqrt[2] \[Sqrt](58 + 8 Cos[2 x] + 27 Cos[4 x] - 
                  4 Cos[6 x] + 38 Cos[8 x] - 4 Cos[10 x] + 
                  5 Cos[12 x])) Log[
             1/96 (48 + 
                Sqrt[2] \[Sqrt](58 + 8 Cos[2 x] + 27 Cos[4 x] - 
                    4 Cos[6 x] + 38 Cos[8 x] - 4 Cos[10 x] + 
                    5 Cos[12 x]))])/(2 Sqrt[
            2] \[Sqrt](58 + 8 Cos[2 x] + 27 Cos[4 x] - 4 Cos[6 x] + 
               38 Cos[8 x] - 4 Cos[10 x] + 5 Cos[12 x]))) + 
      1/48 (26 + 5 Cos[2 x] - 2 Cos[4 x] + 
         3 Cos[6 x]) (((-4 - 10 Cos[2 x] + 4 Cos[4 x] - 6 Cos[6 x] + 
              Sqrt[2] \[Sqrt](58 + 8 Cos[2 x] + 27 Cos[4 x] - 
                  4 Cos[6 x] + 38 Cos[8 x] - 4 Cos[10 x] + 
                  5 Cos[12 x])) Log[
             1/96 (48 - 
                Sqrt[2] \[Sqrt](58 + 8 Cos[2 x] + 27 Cos[4 x] - 
                    4 Cos[6 x] + 38 Cos[8 x] - 4 Cos[10 x] + 
                    5 Cos[12 x]))])/(2 Sqrt[
            2] \[Sqrt](58 + 8 Cos[2 x] + 27 Cos[4 x] - 4 Cos[6 x] + 
               38 Cos[8 x] - 4 Cos[10 x] + 5 Cos[12 x])) + ((4 + 
              10 Cos[2 x] - 4 Cos[4 x] + 6 Cos[6 x] + 
              Sqrt[2] \[Sqrt](58 + 8 Cos[2 x] + 27 Cos[4 x] - 
                  4 Cos[6 x] + 38 Cos[8 x] - 4 Cos[10 x] + 
                  5 Cos[12 x])) Log[
             1/96 (48 + 
                Sqrt[2] \[Sqrt](58 + 8 Cos[2 x] + 27 Cos[4 x] - 
                    4 Cos[6 x] + 38 Cos[8 x] - 4 Cos[10 x] + 
                    5 Cos[12 x]))])/(2 Sqrt[
            2] \[Sqrt](58 + 8 Cos[2 x] + 27 Cos[4 x] - 4 Cos[6 x] + 
               38 Cos[8 x] - 4 Cos[10 x] + 5 Cos[12 x]))) - 
      1/3 I Cos[
        x] (1 + 2 Cos[
           2 x]) (-((I (-4 - 10 Cos[2 x] + 4 Cos[4 x] - 6 Cos[6 x] + 
                Sqrt[2] \[Sqrt](58 + 8 Cos[2 x] + 27 Cos[4 x] - 
                    4 Cos[6 x] + 38 Cos[8 x] - 4 Cos[10 x] + 
                    5 Cos[12 x])) (4 + 10 Cos[2 x] - 4 Cos[4 x] + 
                6 Cos[6 x] + 
                Sqrt[2] \[Sqrt](58 + 8 Cos[2 x] + 27 Cos[4 x] - 
                    4 Cos[6 x] + 38 Cos[8 x] - 4 Cos[10 x] + 
                    5 Cos[12 x])) Csc[x]^3 Log[
               1/96 (48 - 
                  Sqrt[2] \[Sqrt](58 + 8 Cos[2 x] + 27 Cos[4 x] - 
                    4 Cos[6 x] + 38 Cos[8 x] - 4 Cos[10 x] + 
                    5 Cos[12 x]))] Sec[x])/(64 Sqrt[
              2] (1 + 
                2 Cos[2 x]) \[Sqrt](58 + 8 Cos[2 x] + 27 Cos[4 x] - 
                 4 Cos[6 x] + 38 Cos[8 x] - 4 Cos[10 x] + 
                 5 Cos[12 x]))) + (I (-4 - 10 Cos[2 x] + 4 Cos[4 x] - 
              6 Cos[6 x] + 
              Sqrt[2] \[Sqrt](58 + 8 Cos[2 x] + 27 Cos[4 x] - 
                  4 Cos[6 x] + 38 Cos[8 x] - 4 Cos[10 x] + 
                  5 Cos[12 x])) (4 + 10 Cos[2 x] - 4 Cos[4 x] + 
              6 Cos[6 x] + 
              Sqrt[2] \[Sqrt](58 + 8 Cos[2 x] + 27 Cos[4 x] - 
                  4 Cos[6 x] + 38 Cos[8 x] - 4 Cos[10 x] + 
                  5 Cos[12 x])) Csc[x]^3 Log[
             1/96 (48 + 
                Sqrt[2] \[Sqrt](58 + 8 Cos[2 x] + 27 Cos[4 x] - 
                    4 Cos[6 x] + 38 Cos[8 x] - 4 Cos[10 x] + 
                    5 Cos[12 x]))] Sec[x])/(64 Sqrt[
            2] (1 + 
              2 Cos[2 x]) \[Sqrt](58 + 8 Cos[2 x] + 27 Cos[4 x] - 
               4 Cos[6 x] + 38 Cos[8 x] - 4 Cos[10 x] + 
               5 Cos[12 x]))) Sin[x]^3 + 
      1/3 I Cos[x] (1 + 2 Cos[2 x]) Sin[
        x]^3 ((8 I Sqrt[2]
             Cos[x] (1 + 2 Cos[2 x]) Log[
             1/96 (48 - 
                Sqrt[2] \[Sqrt](58 + 8 Cos[2 x] + 27 Cos[4 x] - 
                    4 Cos[6 x] + 38 Cos[8 x] - 4 Cos[10 x] + 
                    5 Cos[12 x]))] Sin[
             x]^3)/(\[Sqrt](58 + 8 Cos[2 x] + 27 Cos[4 x] - 
              4 Cos[6 x] + 38 Cos[8 x] - 4 Cos[10 x] + 
              5 Cos[12 x])) - (8 I Sqrt[2]
             Cos[x] (1 + 2 Cos[2 x]) Log[
             1/96 (48 + 
                Sqrt[2] \[Sqrt](58 + 8 Cos[2 x] + 27 Cos[4 x] - 
                    4 Cos[6 x] + 38 Cos[8 x] - 4 Cos[10 x] + 
                    5 Cos[12 x]))] Sin[
             x]^3)/(\[Sqrt](58 + 8 Cos[2 x] + 27 Cos[4 x] - 
              4 Cos[6 x] + 38 Cos[8 x] - 4 Cos[10 x] + 
              5 Cos[12 x])))) + 
   b (1/2 (1/2 Log[1/24 (13 - Cos[4 x])] + 
         1/2 Log[1/24 (11 + Cos[4 x])]) + 
      1/2 (1/2 Log[
           1/24 (13 - Cos[4 x])] - ((Csc[2 x]^2 - 
            Cos[4 x] Csc[2 x]^2) Log[1/24 (11 + Cos[4 x])])/(
         2 (-Csc[2 x]^2 + Cos[4 x] Csc[2 x]^2))) - 
      1/12 (1/4 (-Csc[2 x]^2 + Cos[4 x] Csc[2 x]^2) Log[
           1/24 (13 - Cos[4 x])] + 
         1/4 (Csc[2 x]^2 - Cos[4 x] Csc[2 x]^2) Log[
           1/24 (11 + Cos[4 x])]) Sin[2 x]^2 - 
      1/12 (Log[1/24 (13 - Cos[4 x])]/(-Csc[2 x]^2 + 
          Cos[4 x] Csc[2 x]^2) - 
         Log[1/24 (11 + Cos[4 x])]/(-Csc[2 x]^2 + 
          Cos[4 x] Csc[2 x]^2)) Sin[2 x]^2);

fun[x_?NumericQ] := 
 NMaxValue[{fun[x, a, b], {0 <= a < 1, 0 <= b < 1, a + b == 1}}, {a, 
   b}]
maxfun = fun /@ Range[0, 2 \[Pi], 0.05];
lpS3 = ListLinePlot[maxfun, DataRange -> {0, 2 \[Pi]}, 
  InterpolationOrder -> 6]

Irrelevant text: aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaabbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb

$\endgroup$
2
  • $\begingroup$ Why the Irrelevant text:... ? $\endgroup$
    – flinty
    Commented Jul 12, 2020 at 21:25
  • $\begingroup$ Because it was saying, something like, your question contains mostly the code. So I put some random text! $\endgroup$
    – Rob
    Commented Jul 13, 2020 at 8:09

1 Answer 1

2
$\begingroup$

Use the constraints to simplify the objective function. This is slow.

fun2[x_, a_, b_] = 
  fun[x, a, b] //
   Simplify[#, {0 <= a < 1, 0 <= b < 1, a + b == 1}] &;

LeafCount /@ {fun[x, a, b], fun2[x, a, b]}

(* {3175, 2278} *)

Due to the numerical complexity of the function, track and control the precision by using arbitrary-precision (i.e., specify the WorkingPrecision) rather than machine precision.

fun[x_?NumericQ] := NMaxValue[
  {fun2[x, a, b], 0 <= a < 1, 0 <= b < 1, a + b == 1}, {a, b},
  WorkingPrecision -> 15]

maxfun = fun /@ Range[0.05, 2 π, 0.05];

lpS3 = ListLinePlot[maxfun, DataRange -> {0, 2 π}, 
  InterpolationOrder -> 6]

enter image description here

EDIT: As pointed out by Akku14 the dependence on b can be eliminated since a + b == 1. This improves the accuracy of the maximization and provides a smoother curve.

fun3[x_, a_] = 
  fun[x, a, b] /. b -> 1 - a // Simplify[#, 0 <= a < 1 && 0 <= x < 2 Pi] &;

LeafCount /@ {fun[x, a, b], fun3[x, a]}

(* {3175, 2290} *)

mfun[x_?NumericQ] := NMaxValue[{fun3[x, a], {0 < a < 1}}, a,
   WorkingPrecision -> 15];

maxfun = {#, mfun[#]} & /@ Range[0, 2 π, 0.05`20];

lpS3 = ListLinePlot[maxfun, InterpolationOrder -> 6, PlotRange -> {0, .035}]

enter image description here

$\endgroup$
3
  • 1
    $\begingroup$ Dear @Bob Hanlon, making use of the condition a+b==1 gives better results. fun3[x_, a_] = fun[x, a, b] /. b -> 1 - a // Simplify[#, 0 < a < 1 && 0 < x < 2 Pi] &; . and mfun[x_?NumericQ] := NMaxValue[{fun3[x, a], {0 < a < 1}}, a]; maxfun = {#, mfun[#]} & /@ Range[0, 2 \[Pi], 0.05]; lpS3 = ListLinePlot[maxfun, InterpolationOrder -> 6, PlotRange -> {0, .035}] . $\endgroup$
    – Akku14
    Commented Jul 13, 2020 at 6:01
  • 1
    $\begingroup$ Have a nice plot Plot3D[fun3[x, a], {x, 0, 2 Pi}, {a, 0, 1}, PlotPoints -> 60] . $\endgroup$
    – Akku14
    Commented Jul 13, 2020 at 6:10
  • $\begingroup$ @Akku14 - very good. $\endgroup$
    – Bob Hanlon
    Commented Jul 13, 2020 at 14:41

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.