Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

CONTEXT

Let us consider a bit of the Universe in which we draw spheres

(see a high resolution image here). Astronomers have shown that the density within these spheres could be predicted quite accurately: here is the measured (in red) and predicted (in green) distribution of the density within $50^3$ such spheres at half the age of the Universe: .

Our next purpose is to extend the theory to concentric two or more shells.

In practice, in order to estimate the mildly nonlinear cosmic density of the Universe within concentric shells, I need to find perturbatively the Legendre Transform of a function of two variables in a singular regime (see below).

$$\phi(\lambda_1,\lambda_2)={\rm LT}(\psi(\rho_1,\rho_2))\equiv \sup_{\rho_1,\rho_2}\left[\lambda_1 \rho_1+\lambda_2 \rho_2-\psi(\rho_1,\rho_2)\right]$$

which in turns involves inverting the system $$\partial_\rho \psi =\lambda \quad \quad \quad (1) $$ for $\rho_1,\rho_2$ , and integrating for $\phi(\lambda_1,\lambda_2)$ the system $$ \quad \partial_\lambda \phi =\rho \,. \quad \quad (2) $$ This can in principle be done perturbatively. In my context, it needs to be done in the regime where ${\rm det}| \partial^2_\rho \psi|=0$. I.e. I am interested in Taylor expanding the Legendre transform of $\psi$ near a point (chosen to be zero for simplicity) where one of the eigenvalues of $\partial^2_\rho \psi$ is zero. In physical terms it corresponds to the rare event tail of the density of the Universe in these shells, if you care to know!

ATEMPT

Following this question I know how to do invert (1) for $\rho(\lambda)$ in 1D (one shell) for the regular

 nn = 3;
 ρofλr = InverseSeries[Series[ψ'[ρ], {ρ, 0,nn}]] /. ρ -> λ /. ψ'[0] -> 0 /. 
   Derivative[n_][ψ][0] :>  Subscript[ψ, n] // Normal

reg

(note the division by ψ''[0])

and the singular case (for which ψ''[0]=0)

 nn = 3;
  ρofλs = InverseSeries[Series[ψ'[ρ], {ρ, 0,nn}]/. ψ''[0]-> 0] /. ρ -> λ /. ψ'[0] -> 0 /. 
    Derivative[n_][ψ][0] :>  Subscript[ψ, n] // Normal

reg

note the square root. It is clear from this expansion that the Legendre transform, ϕ[λ] will have a very different algebraic form in the singular case compared to the regular case.

 ϕ[λ_]=Integrate[ρofλ,λ]

But this is not enough for concentric shells: I need to be able to carry out such Legendre transform when one coordinate is singular.

SOLUTION to first order and for the regular case only

The following works for the regular case only. Let us expand the first system

   nn=1;
   eqn = Thread[{λ1, λ2} == 
   Series[{Derivative[1, 0][ψ][ ρ1,  ρ2], 
   Derivative[0, 1][ψ][ ρ1,  ρ2]}, { ρ1, 0, 
   nn}, { ρ2, 0, nn}]] // Normal;

and reoder it in power of ϵ

  eqn2 = eqn /. 
  Derivative[i_, j_][ψ][0, 
   0] -> ϵ^(i + j - 1) Derivative[i, j][ψ][0, 0] // 
 Series[#, {ϵ, 0, 1}] & // Simplify;

Solve for ρ1,ρ2

 sol = Solve[Normal[eqn2], { ρ1,  ρ2}][[1]] /. 
 Derivative[n_, p_][ψ][__] :>  Subscript[ψ, n, p] // 
 FullSimplify;

We can then integrate the system (2):

 eqn3 = {D[ϕ[λ1, λ2], λ1] == ρ1,D[ϕ[λ1, λ2], λ2] ==  ρ2} /. sol
 ϕ[λ1, λ2]/. DSolve[eqn3,ϕ[λ1, λ2], {λ1, λ2}][[1, 1]] // Apart

But this is not good enough because I am interested in a singular expansion, i.e. near a point where the Jacobian $\partial^2 \psi \partial \rho_i \partial \rho_j$ has zero determinant! (when the above first order solution becomes singular because ψ02 ψ20 -ψ11^2 =0)

QUESTION

I am interested in doing this in 2D (or 3D...) for the singular case, i.e. when the Jacobian $\partial^2_\rho \psi$ has one null eigenvalue.

The main difficulty is that InverseSeries does not work for series of two variables.

The gist of the problem is the following: assuming x1, x2 y1 and y2 are small, how does one invert pertubatively

 y1= x1+ x1^2 + x2^2 + x1 x2 + x2^3...
 y2= x2^2 + x1^2 +x1 x2 + x1^3 +... 

in order to write

 x1= y1+...
 x2= sqrt(y2)+...

This might sound like a technical question, but the core of the problem is fairly general: how does one InverseSeries of multiple variables and multiple equations? in Mathematica. Any suggestions would be very welcome!

share|improve this question
1  
"The mildly nonlinear cosmic density of the Universe within concentric shells" has been estimated a few years ago :)sacred-texts.com/astro/cwiu/img/00700.jpg –  belisarius May 8 '13 at 15:23
    
well yes I guess I want to revisit this expansion :-) –  chris May 8 '13 at 15:31
    
In the help for Series it says that when dealing with multivariable series, it "successively finds series expansions with respect to x, then y, etc." So if you want to invert this process, maybe you could attack it by using InverseSeries one variable at a time. –  bill s May 9 '13 at 18:46
    
the pb is that the ordering of the series in not one variable at a time(?) –  chris May 9 '13 at 18:49
    
In general, one would invert with the linear term. If that's zero, then you'd invert with the quadratic. If that's singular, then on to the cubic. So maybe the thing to do in your case is write out that cubic term. –  bill s May 9 '13 at 19:19

2 Answers 2

up vote 4 down vote accepted
+250

Algebraically, the way to construct the inverse of a series is straightforward. The basic iterative step is to add the next degree terms and solve for the coefficients.

If we have $u = U(x, y)$, $v = V(x, y)$, then we are looking for $x = X(u, v)$, $y = Y(u, v)$ such that $u = U(X(u,v), Y(u,v))$ and $v = V(X(u,v), Y(u,v))$ identically. If the coefficients of the partial series $$ X_n(u,v) = \sum_{k=0}^n\sum_{i=0}^k a_{i,k-i} u^i v^{k-i}, \quad Y_n(u,v) = \sum_{k=0}^n\sum_{i=0}^k b_{i,k-i} u^i v^{k-i} $$ have been determined, then plug $$ x = X_n(u,v) + \sum_{i=0}^{n+1} a_{i,n+1-i} u^i v^{n+1-i}, \quad y = Y_n(u,v) + \sum_{i=0}^{n+1} b_{i,n+1-i} u^i v^{n+1-i} $$ into $$ u = U(X(u,v), Y(u,v)), \quad v = V(X(u,v), Y(u,v)) $$ and set the coefficients of the monomials $u^iv^j$ to zero and solve for the unknown $a$ and $b$.

That's the inductive step, more or less, but how to get started? The original question assumes (justifiably -- by a translation, if necessary) that $(0,0)$ is mapped to $(0,0)$. If the linear terms form an invertible system, then the inductive step can be applied repeatedly up to the desired degree. In the case of the question, the assumptions are that the linear system is nonzero but degenerate ($U_x \ne 0$, $U_y=0$) and the second order system is parabolic, aligned in an independent direction ($U_{yy}(0,0) \ne 0$, $U_{xx}=U_{xy}=0$). In this case, the solutions will be power series in $u$, $\sqrt{v}$.

The function series2DSolveParabolic constructs the series solution up to whatever degree desired. Notes on the code can be found below the example.

terms[poly_, deg_, vars_] := FromCoefficientRules[
   Select[CoefficientRules[poly, vars], Total@First@# <= deg &], vars];

series2D[series2DData[f_, {x_, y_}, dataRules_], n_] := 
  terms[Normal@Series[f[x, y], {x, 0, n}, {y, 0, n}] /. dataRules, 
    n, {x, y}];
series2D[series2DSolData[a_, {u_, v_}], n_] := Sum[u^i*v^(-i + k)*a[i, -i + k],
  {k, 1, n}, {i, 0, k}];

solveCoeff[terms_, pat_] := Solve[Thread[terms == 0], Cases[terms, pat, Infinity]];

series2DSolveParabolic[{u_ == U0_series2DData, v_ == V0_series2DData}, {x_, y_}, deg_] :=
  Module[{a, b, X0, Y0, r},
   a[0, 0] = b[0, 0] = 0;
   X0 = series2DSolData[a, {u, r}];
   Y0 = series2DSolData[b, {u, r}];
   Do[
    solveCoeff[
      DeleteCases[
       Flatten[CoefficientList[#, {u, r}] & /@ {
          u - terms[series2D[U0, n] /.
            {x -> series2D[X0, n], y -> series2D[Y0, n]}, n, {u, r}],
          r^2 - terms[series2D[V0, n + 1] /.
            {x -> series2D[X0, n + 1], y -> series2D[Y0, n + 1]}, n + 1, {u, r}]}],
       _?NumericQ], _a | _b] /. Rule -> Set,
    {n, 1, deg}];

   {x -> Sum[a[i, j - i] u^i v^((j - i)/2), {j, 0, deg}, {i, 0, j}],
    y -> Sum[b[i, j - i] u^i v^((j - i)/2), {j, 0, deg}, {i, 0, j}]}
   ];

Example (a bit messy):

    series2DSolveParabolic[
     {u == series2DData[U, {x, y}, {U[0, 0] -> 0, Derivative[0, 1][U][0, 0] -> 0}],
      v == series2DData[V, {x, y},
        {V[0, 0] -> 0, Derivative[1, 0][V][0, 0] -> 0, 
         Derivative[0, 1][V][0, 0] -> 0, 
         Derivative[1, 1][V][0, 0] -> 0, 
         Derivative[2, 0][V][0, 0] -> 0}]},
        {x, y}, 2]

(* {x -> u/Derivative[1, 0][U][0, 0] -
         (v*Derivative[0, 2][U][0, 0])/
           (Derivative[0, 2][V][0, 0] * Derivative[1, 0][U][0, 0]) -
         (Sqrt[2]*u*Sqrt[v] * Derivative[1, 1][U][0, 0]) /
           (Sqrt[Derivative[0, 2][V][0, 0]] * Derivative[1, 0][U][0, 0]^2) -
         (u^2 * Derivative[2, 0][U][0, 0]) / (2*Derivative[1, 0][U][0, 0]^3), 
   y -> (Sqrt[2]*Sqrt[v]) / Sqrt[Derivative[0, 2][V][0, 0]] -
         (v * Derivative[0, 3][V][0, 0]) / (3*Derivative[0, 2][V][0, 0]^2) -
         (u * Sqrt[v]*Derivative[1, 2][V][0, 0]) / 
           (Sqrt[2]*Derivative[0, 2][V][0, 0]^(3/2) * Derivative[1, 0][U][0, 0]) -
         (u^2*Derivative[2, 1][V][0, 0]) /
           (2 * Derivative[0, 2][V][0, 0]*Derivative[1, 0][U][0, 0]^2)}  *)

$$\left\{x\to -\frac{u^2 U^{(2,0)}(0,0)}{2 U^{(1,0)}(0,0)^3}-\frac{\sqrt{2} u \sqrt{v} U^{(1,1)}(0,0)}{U^{(1,0)}(0,0)^2 \sqrt{V^{(0,2)}(0,0)}}+\frac{u}{U^{(1,0)}(0,0 )}-\frac{v U^{(0,2)}(0,0)}{U^{(1,0)}(0,0) V^{(0,2)}(0,0)}\right.,$$ $$\left.y\to -\frac{u^2 V^{(2,1)}(0,0)}{2 U^{(1,0)}(0,0)^2 V^{(0,2)}(0,0)}-\frac{u \sqrt{v} V^{(1,2)}(0,0)}{\sqrt{2} U^{(1,0)}(0,0) V^{(0,2)}(0,0)^{3/2}}-\frac{v V^{(0,3)}(0,0)}{3 V^{(0,2)}(0,0)^2}+\frac{\sqrt{2} \sqrt{v}}{\sqrt{V^{(0,2)}(0,0)}}\right\}$$

Notes on the code:

terms[poly, deg, vars] -- return the terms of the polynomial whose total degree is at most deg

series2DData[f, {x, y}, dataRules] -- represents a series in the variables x and y, with conditions on the derivatives of f given in dataRules

series2DSolData[c, {x, y},] -- represents a series in the variables x and y with coefficients c[i, j].

series2D[ser, n] -- returns the n-th degree Taylor polynomial of the series ser; ser may be either series2DData or series2DSolData

solveCoeff[terms, pat] -- sets the terms equal to zero and solves for the coefficients represented by the pattern pat.

series2DSolveParabolic[{u == uSeries, v == vSeries}, vars, deg] solves the system of equations for power series of vars in terms of the variables {u, v} up to degree deg. Note that the equation are not really treated as equations. The variables u and v have to be symbols and be the left-hand sides. Note also that internally in the Do loop, r represents Sqrt[v], and that the exponent is off by one (goes up to n+1); this has to do with the recursive procedure starting with degree 1 in x and degree 2 in y.


Here's a function that will invert power series if the linear terms are nonsingular.

series2DSolve[{u_ == U0_series2DData, v_ == V0_series2DData}, {x_, y_}, deg_] :=
  Module[{a, b, X0, Y0},
   a[0, 0] = b[0, 0] = 0;
   X0 = series2DSolData[a, {u, v}];
   Y0 = series2DSolData[b, {u, v}];
   Do[
    solveCoeff[
      DeleteCases[
       Flatten[CoefficientList[#, {u, v}] & /@ {
          u -> terms[series2D[U0, n] /. {x -> series2D[X0, n], y -> series2D[Y0, n]},
                 n, {u, v}],
          v -> terms[series2D[V0, n] /. {x -> series2D[X0, n], y -> series2D[Y0, n]},
                 n, {u, v}]}],
        _?NumericQ], _a | _b] /. 
     Rule -> Set,
    {n, 1, deg}];

   {x -> Sum[a[i, j - i] u^i v^(j - i), {j, 0, deg}, {i, 0, j}],
    y -> Sum[b[i, j - i] u^i v^(j - i), {j, 0, deg}, {i, 0, j}]}
   ];

Example

f[x_, y_] := Log[1 + x];
g[x_, y_] := Sin[y];
series2DSolve[
 {u == series2DData[f, {x, y}, {}],
  v == series2DData[g, {x, y}, {}]},
 {x, y}, 5]
  (* {x -> u + u^2/2 + u^3/6 + u^4/24 + u^5/120, y -> v + v^3/6 + (3 v^5)/40} *)

Normal@Series[ArcSin[v], {v, 0, 6}]
  (* v + v^3/6 + (3 v^5)/40 *)

The methods used are from basic algebra. There could be, there ought to be, or perhaps there are built-in functions to do some or all of the above.

share|improve this answer
    
Brilliant! I need to check a few things before granting the bounty. If you want non-anonymous credits in the scientific publication I ll need to know who you really are :-) –  chris May 13 '13 at 7:10

This isn't really a full answer, but it's too long to fit in the comment box. It sounds like what you want is a Taylor series in 2D. Wikipedia gives this:

enter image description here

In order to apply this in your case, you would need to specify the point {a,b} about which you are expanding. Presumably your f[a,b]=0 and the first derivative terms are also zero, so you would look at the squared terms. If this is also zero, then you go to the higher terms (which are also written out at wikipedia).

Here's a place where the vector version is stated, in this formulation, f can be a function from $R^2$ to $R^2$. This is the case you have since you have two input variables and two output varables.

share|improve this answer
    
That's the starting point. One has two such expansions, say $f$ and $g$ and we want $x=x(f,g)$ and $y=y(f,g)$ in the regime where $f_x(a,b)=0$. –  chris May 11 '13 at 13:02

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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