Finding local minima of this transcendental equation

Question

I'm trying to find all the local minima of the following function, symbolically:

d[k_] := 400*Cos[k*L]^2 + a^2*k^2*(144 + 25*a^2*k^2)*Sin[k*L]^2 - a*k*240*Sin[2*k*L]

Where 0<a<<L and k>0.

Unfortunately using the derivative method with Solve[D[d[k], k] == 0 && D[D[d[k], k], k] > 0 && k > 0 && 0<a<L, k] doesn't seem to work (same for Reduce) unless I assign specific numerical values to a and L and restrict k to a specific interval. If I do that I get numbers out, however, I really need a solution for all k>0 in terms of generic a and L.

This is for an engineering project so I am happy to make some algebraic approximations using e.g the fact that a<<L, if that leads to a simpler, solvable form. However I'm pretty stumped. Any suggestions?

Answer 1

First try NMinimize to get an impression where to look for.

d[k_, a_, L_] = 
    400*Cos[k*L]^2 + a^2*k^2*(144 + 25*a^2*k^2)*Sin[k*L]^2 - 
    a*k*240*Sin[2*k*L] // Simplify

NMinimize[{d[k, a, L], 0 < a < L && k > 0 && L > 0}, {k, a, L}]

(*   {2.75304*10^-10, {k -> 1.17341, a -> 0.00155245, L -> 1.33773}}   *)

Guess that d >= 0 and get the proof.

Reduce[ForAll[{k, a, L}, 0 < a < L && k > 0 && L > 0, 
   d[k, a, L] >= 0]]

(*   True   *)

Solve shows you a has to be zero. Get posiible k depending on L.

sol = Solve[d[k, a, L] == 0, {a, k}, Reals]

(*   {{a -> ConditionalExpression[0, C[1] \[Element] Integers], 
 k -> ConditionalExpression[(-(\[Pi]/2) + 2 \[Pi] C[1])/L, 
C[1] \[Element] Integers]}, {a -> 
ConditionalExpression[0, C[1] \[Element] Integers], 
 k -> ConditionalExpression[(\[Pi]/2 + 2 \[Pi] C[1])/L, 
C[1] \[Element] Integers]}}   *)

Table[k /. sol /. C[1] -> i, {i, -3, 3}] // Flatten

Manipulate[
  Plot[d[k, 0, L], {k, 0, 10}, PlotRange -> 10, 
Ticks -> {Range[-5 Pi, 5 Pi, Pi/2], Automatic}], {{L, 1}, 0, 10}]

Look how minimum of d approximates to above shown k values for a going to zero.

Manipulate[
 ContourPlot[d[k, a, L] == 2 10^-1, {a, 0, 1}, {k, 0, 5}, 
PlotPoints -> 100, 
FrameTicks -> {Automatic, Range[-5 Pi, 5 Pi, Pi/4]}], {{L, 2}, 0, 
6}]

Edit

You can't ge a simple solution but only in terms of Root expressions for given a and L. Do

min[a_, L_] := Minimize[{d[k, a, L], 0 < k < 20}, k] 

min[1/10, Pi] // N 

(*   {0.00014474, {k -> 0.490632}}   *)

Edit 2

Now i found an analytic expression for minimum of d and for corresponding a in form of root expressions. In order to get minimum, a strictly depends on k and L. For intermediate calculations define kl == k*L

f[kl_, a_, L_] = d[k, a, L] /. k -> kl/L // Simplify

(*   400 Cos[kl]^2 + (
    a kl (a kl (25 a^2 kl^2 + 144 L^2) Sin[kl]^2 - 
240 L^3 Sin[2 kl]))/L^4   *)

fmin = Minimize[{f[kl, a, L], 0 < kl < 20 && a > 0 && L > 0}, a] // 
  Simplify

dmin[k_, L_] = fmin[[1, 2]] /. kl -> k L

(*   Root[-40000000000 Cos[k L]^6 Sin[k L]^2 + 
41472000000 Cos[k L]^4 Sin[k L]^4 - 
10749542400 Cos[k L]^2 Sin[k L]^6 - 
46656000000 Cos[k L]^2 Sin[k L]^2 Sin[2 k L]^2 + 
2687385600 Sin[k L]^4 Sin[2 k L]^2 + 
8748000000 Sin[
 2 k L]^4 + (300000000 Cos[k L]^4 Sin[k L]^2 - 
  207360000 Cos[k L]^2 Sin[k L]^4 + 26873856 Sin[k L]^6  + 
  116640000 Sin[k L]^2 Sin[2 k L]^2) #1 + (-750000 Cos[k  L]^2 Sin[
    k L]^2 + 259200 Sin[k L]^4) #1^2 + 625 Sin[k L]^2 #1^3 &, 1]   *)

amin[k_, L_] = fmin[[2, 1, 2, 1, 2, 1]] /. kl -> k L

(*   Root[400 Cos[k L]^2 - 
Root[-40000000000 Cos[k L]^6 Sin[k L]^2 + 
  41472000000 Cos[k L]^4 Sin[k L]^4 - 
  10749542400 Cos[k L]^2 Sin[k L]^6 - 
  46656000000 Cos[k L]^2 Sin[k L]^2 Sin[2 k L]^2 + 
  2687385600 Sin[k L]^4 Sin[2 k L]^2 + 
  8748000000 Sin[
    2 k L]^4 + (300000000 Cos[k L]^4 Sin[k L]^2 - 
     207360000 Cos[k L]^2 Sin[k L]^4 + 26873856 Sin[k L]^6 + 
     116640000 Sin[k L]^2 Sin[2 k L]^2) #1 + (-750000 Cos[
       k L]^2 Sin[k L]^2 + 259200 Sin[k L]^4) #1^2 + 
  625 Sin[k L]^2 #1^3 &, 1] - 240 k Sin[2 k L] #1 + 
  144 k^2 Sin[k L]^2 #1^2 + 25 k^4 Sin[k L]^2 #1^4 &, 1]   *)

Plot[{dmin[k, 2], amin[k, 2]}, {k, 0, 6}, PlotRange -> 10^-1, 
  PlotStyle -> {Blue, Red}, 
  Ticks -> {Range[-5 Pi, 5 Pi, Pi/4], Automatic}]

If you want minimum for given a,L, do

min[a_, L_] := Minimize[{d[k, a, L], 0 < k < 20}, k]

min[1/10, 2]

Get root expression for dmin and k.