1
$\begingroup$

I have the following equation:

eq=E0[x,y,z]+E1[x,y,z]*Cos[phi]+E2[x,y,z]*Cos[phi]^2+E3[x,y,z]*Sin[phi]

Now E0,E1,E2 and E3 are already series expansions of expressions in x,y,z. Therefore I would like to series expand the result of

Solve[D[eq,phi]==0,phi]

However, this is some giant arctan expression and Mathematica seems to take forever.

Question: Is there a more clever approach to this (not calling Series at the end only), or is there some way I can tune the Series command?

Here are the real expressions I am dealing with, if someone wants to try something out:

Ecp = (s1*s3*Abs[J]/DE^2/2 - 1/DE*s2*s3*KroneckerDelta[1, s1])*(t1^2 -
      t2^2) /. KroneckerDelta[1, s1] -> (1 + s1)/2 /. 
 t1 -> tt1*DE /. t2 -> tt2*DE /. xi -> xii*DE /. J -> Jj*DE
Ec2p = s2/DE^2*KroneckerDelta[1, s1] (t1^2 - t2^2)^2/Abs[J] /. 
  KroneckerDelta[1, s1] -> (1 + s1)/2 /. t1 -> tt1*DE /. 
t2 -> tt2*DE /. xi -> xii*DE /. J -> Jj*DE
Esp = s2*s3/DE^2*t1*t2*xi*
    Abs[J]/(Abs[xi] KroneckerDelta[-1, s1] + 
       Abs[J] KroneckerDelta[1, s1]) /. 
   KroneckerDelta[1, s1] -> (1 + s1)/2 /. 
  KroneckerDelta[-1, s1] -> (1 - s1)/2 /. t1 -> tt1*DE /. 
t2 -> tt2*DE /. xi -> xii*DE /. J -> Jj*DE
Solve[D[E00 + Cos[phi]*Ecp + Cos[phi]^2*Ec2p + Sin[phi]*Esp, phi] == 0, phi]

The small parameters are tt1,tt2,Jj,xii. Usually I then introduce a "smallness-paramter" as suggested here on SE to perform the multi series.

$\endgroup$
1
$\begingroup$

To solve this problem under the assumption that the stated quantities are small, you can insert a perturbation expansion for the unknown phi and solve for its expansion coefficients in the smallness parameter:

First I'm copying the definitions from the question to be self-contained:

Ecp = (s1*s3*Abs[J]/DE^2/2 - 
         1/DE*s2*s3*KroneckerDelta[1, s1])*(t1^2 - t2^2) /. 
      KroneckerDelta[1, s1] -> (1 + s1)/2 /. t1 -> tt1*DE /. 
    t2 -> tt2*DE /. xi -> xii*DE /. J -> Jj*DE
Ec2p = s2/DE^2*KroneckerDelta[1, s1] (t1^2 - t2^2)^2/Abs[J] /. 
      KroneckerDelta[1, s1] -> (1 + s1)/2 /. t1 -> tt1*DE /. 
    t2 -> tt2*DE /. xi -> xii*DE /. J -> Jj*DE
Esp = s2*s3/DE^2*t1*t2*xi*
        Abs[J]/(Abs[xi] KroneckerDelta[-1, s1] + 
           Abs[J] KroneckerDelta[1, s1]) /. 
       KroneckerDelta[1, s1] -> (1 + s1)/2 /. 
      KroneckerDelta[-1, s1] -> (1 - s1)/2 /. t1 -> tt1*DE /. 
    t2 -> tt2*DE /. xi -> xii*DE /. J -> Jj*DE

Now I define the derivative that you're trying to set to zero:

deriv = 
 D[E00 + Cos[phi]*Ecp + Cos[phi]^2*Ec2p + Sin[phi]*Esp, phi]

(*
==> (DE s2 s3 tt1 tt2 xii Abs[DE Jj] Cos[phi])/(
 1/2 (1 + s1) Abs[DE Jj] + 
  1/2 (1 - s1) Abs[DE xii]) - (DE^2 tt1^2 - 
    DE^2 tt2^2) (-(((1 + s1) s2 s3)/(2 DE)) + (s1 s3 Abs[DE Jj])/(
    2 DE^2)) Sin[phi] - ((1 + s1) s2 (DE^2 tt1^2 - DE^2 tt2^2)^2 Cos[
   phi] Sin[phi])/(DE^2 Abs[DE Jj])
*)

Now I make the assumption that tt1, tt2, Jj, xii are all proportional to the small parameter ϵ and that I can then also write phi = ϕ0 + ϵ ϕ1 to first order in that small parameter. The expansion of deriv in powers of ϵ has two nonvanishing terms if we go to third order. Setting these two non-vanishing terms to zero allows us to solve for the two unknowns ϕ0 and ϕ1. This solves the problem of finding phi to first order in the small parameter.

Solve[
 Thread[CoefficientList[
    Normal@Series[
      Simplify[
       deriv /. 
         Thread[{tt1, tt2, Jj, 
            xii} -> ϵ {tt1, tt2, Jj, xii}] /. 
        phi -> (ϕ0 + ϵ ϕ1), 
       DE Jj ϵ > 0 && DE xii ϵ > 0], {ϵ, 0,
        3}], ϵ] == 0], {ϕ0, ϕ1}]

(*
==> {{ϕ0 -> 
   0, ϕ1 -> -((
    4 Jj tt1 tt2 xii)/((1 + s1) (tt1^2 - tt2^2) (Jj + Jj s1 + xii - 
       s1 xii)))}, {ϕ0 -> -Pi, ϕ1 -> -((
    4 Jj tt1 tt2 xii)/((1 + s1) (tt1^2 - tt2^2) (Jj + Jj s1 + xii - 
       s1 xii)))}, {ϕ0 -> Pi, ϕ1 -> -((
    4 Jj tt1 tt2 xii)/((1 + s1) (tt1^2 - tt2^2) (Jj + Jj s1 + xii - 
       s1 xii)))}}
*)

In order to get useful results, I had to add some assumptions about certain products of your parameters being positive. You may have to check whether those assumptions are appropriate for your data.

$\endgroup$
  • $\begingroup$ I'm wondering why mathematica needs these assumptions. I would understand that unequal 0 could be required. But why the >? If I change one or both of the > to < it gives me the same result basically, so some Sign[...] should do the trick. $\endgroup$ – NOhs Jan 27 '15 at 8:57

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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