Message Boards Message Boards

0
|
271 Views
|
3 Replies
|
1 Total Likes
View groups...
Share
Share this post:

Finding Upper Bounds on Complex Function Extrema

Posted 24 days ago

Hello together,

I am new to Mathematica and would like to find an upper bound on the number of extrema for a complex function, defined in terms of the variable h:

g[h, l, d]:=100*sqrt[((cos[d]*sin[h]/arccos[cos[d]*cos[h]*cos[l] + sin[d]*sin[l]] + ...;

The formula here is abbreviated since it’s quite large.

I've attempted to find possible extrema in terms of h using:

Solve[{D[g[h],h]==0},h];

However, Solve is not capable to find any solution. What else can I try?

Thank you very much for your help in advance. :-)

Greetings, Patrick

POSTED BY: Patrick DS.
3 Replies

What else can I try?

Well, a good start could be to use a correct syntax! Mathematica is case sensitive!, So, your function definition should rather read like so:

  g[h_, l_, d_] := 100*Sqrt[((Cos[d]*Sin[h]/ArcCos[Cos[d]*Cos[h]*Cos[l] + Sin[d]*Sin[l]] + ...))];

And then you can try to call

Solve[{D[g[h,l,d],h]==0},h];

because a function g[h] is not defined.

POSTED BY: Henrik Schachner
Posted 21 days ago

Thank you for your response. I’ve corrected the syntax and attempted to derive the function with respect to h. This function is the general form of the one I presented previously:

f[h_,l_,d_,x_,y_]:=Sqrt[(200*Sqrt[-Cos[d]^2*Cos[h]^2*Cos[l]^2 - 2*Cos[d]*Cos[h]*Cos[l]*Sin[d]*Sin[l] - Sin[d]^2*Sin[l]^2 + 1]*(Cos[d]^2*Cos[h]*Cos[l]*Sin[h] + Cos[d]*Sin[d]*Sin[h]*Sin[l])*x*ArcCos[Cos[d]*Cos[h]*Cos[l] + Sin[d]*Sin[l]]^2 + 10000*(Cos[d]^2*Cos[h]^2*Cos[l]^2 + 2*Cos[d]*Cos[h]*Cos[l]*Sin[d]*Sin[l] + Sin[d]^2*Sin[l]^2 - 1)*ArcCos[Cos[d]*Cos[h]*Cos[l] + Sin[d]*Sin[l]]^3 + ((Cos[d]^2*Cos[h]^2*Cos[l]^2 + 2*Cos[d]*Cos[h]*Cos[l]*Sin[d]*Sin[l] + Sin[d]^2*Sin[l]^2 - 1)*ArcCos[Cos[d]*Cos[h]*Cos[l] + Sin[d]*Sin[l]]^3 - (2*Cos[d]^4*Cos[h]^2*Cos[l]^2*Sin[h]^2 + 4*Cos[d]^3*Cos[h]*Cos[l]*Sin[d]*Sin[h]^2*Sin[l] + 2*Cos[d]^2*Sin[d]^2*Sin[h]^2*Sin[l]^2 - Cos[d]^2*Sin[h]^2)*ArcCos[Cos[d]*Cos[h]*Cos[l] + Sin[d]*Sin[l]])*x^2 - ((Cos[d]^2*Cos[h]^2*Cos[l]^2 + 2*Cos[d]*Cos[h]*Cos[l]*Sin[d]*Sin[l] + Sin[d]^2*Sin[l]^2)*ArcCos[Cos[d]*Cos[h]*Cos[l] + Sin[d]*Sin[l]]^3 - (2*Cos[d]^4*Cos[h]^2*Cos[l]^2*Sin[h]^2 + 4*Cos[d]^3*Cos[h]*Cos[l]*Sin[d]*Sin[h]^2*Sin[l] + 2*Cos[d]^2*Sin[d]^2*Sin[h]^2*Sin[l]^2 - Cos[d]^2*Sin[h]^2)*ArcCos[Cos[d]*Cos[h]*Cos[l] + Sin[d]*Sin[l]])*y^2 - 2*(100*Sqrt[-Cos[d]^2*Cos[h]^2*Cos[l]^2 - 2*Cos[d]*Cos[h]*Cos[l]*Sin[d]*Sin[l] - Sin[d]^2*Sin[l]^2 + 1]*(Cos[d]*Cos[h]*Cos[l] + Sin[d]*Sin[l])*Sqrt[-(Cos[d]^2*Sin[h]^2 - ArcCos[Cos[d]*Cos[h]*Cos[l] + Sin[d]*Sin[l]]^2)/ArcCos[Cos[d]*Cos[h]*Cos[l] + Sin[d]*Sin[l]]^2]*ArcCos[Cos[d]*Cos[h]*Cos[l] + Sin[d]*Sin[l]]^3 + ((Cos[d]^3*Cos[h]^2*Cos[l]^2*Sin[h] + 2*Cos[d]^2*Cos[h]*Cos[l]*Sin[d]*Sin[h]*Sin[l] + Cos[d]*Sin[d]^2*Sin[h]*Sin[l]^2 - Cos[d]*Sin[h])*(-(Cos[d]^2*Sin[h]^2 - ArcCos[Cos[d]*Cos[h]*Cos[l] + Sin[d]*Sin[l]]^2)/ArcCos[Cos[d]*Cos[h]*Cos[l] + Sin[d]*Sin[l]]^2)^(3/2)*ArcCos[Cos[d]*Cos[h]*Cos[l] + Sin[d]*Sin[l]]^2 + (Cos[d]^5*Cos[h]^2*Cos[l]^2*Sin[h]^3 + 2*Cos[d]^4*Cos[h]*Cos[l]*Sin[d]*Sin[h]^3*Sin[l] + Cos[d]^3*Sin[d]^2*Sin[h]^3*Sin[l]^2 - Cos[d]^3*Sin[h]^3 - (3*Cos[d]^3*Cos[h]^2*Cos[l]^2*Sin[h] + 6*Cos[d]^2*Cos[h]*Cos[l]*Sin[d]*Sin[h]*Sin[l] + 3*Cos[d]*Sin[d]^2*Sin[h]*Sin[l]^2 - 2*Cos[d]*Sin[h])*ArcCos[Cos[d]*Cos[h]*Cos[l] + Sin[d]*Sin[l]]^2)*Sqrt[-(Cos[d]^2*Sin[h]^2 - ArcCos[Cos[d]*Cos[h]*Cos[l] + Sin[d]*Sin[l]]^2)/ArcCos[Cos[d]*Cos[h]*Cos[l] + Sin[d]*Sin[l]]^2])*x)*y)/((Cos[d]^2*Cos[h]^2*Cos[l]^2 + 2*Cos[d]*Cos[h]*Cos[l]*Sin[d]*Sin[l] + Sin[d]^2*Sin[l]^2 - 1)*ArcCos[Cos[d]*Cos[h]*Cos[l] + Sin[d]*Sin[l]]^3)];

solutions = Solve[{D[f[h,l,d,x,y],h]==0, -Pi < l, l < Pi, -Pi/4 < d, d < Pi/4}, h];

However, Solve and Reduce do not produce useful outputs or do not halt. Is there an automated way to detect substitution patterns, or could I use a mathematical trick to estimate the upper bound on the number of extrema for any initial values of l,d,x,y with l∈[−π,π] and d∈[−π/4,π/4]?

POSTED BY: Patrick DS.

Since you are looking for extrema, I would perhaps remove the Sqrt that envelops the function. Even then, the problem seems too complicated to be solved symbolically. I would make some conjectures based on numerical data, like this:

Table[Length[Union@NSolve[{D[f[h, l, d, 1, 1], h] == 0,
     -Pi < h < Pi}, h, Reals]],
 {l, -Pi, Pi, Pi/2}, {d, -Pi/4, Pi/4, Pi/8}]
POSTED BY: Gianluca Gorni
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract