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

Improve this question
$\endgroup$
2
  • $\begingroup$ Why the Irrelevant text:... ? $\endgroup$
    – flinty
    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
    Jul 13, 2020 at 8:09

1 Answer 1

Reset to default
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

Improve this answer
$\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
    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
    Jul 13, 2020 at 6:10
  • $\begingroup$ @Akku14 - very good. $\endgroup$
    – Bob Hanlon
    Jul 13, 2020 at 14:41

Your Answer

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

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