# Using Mathematica to find a Derivative

I am given a system first order differential equations: $x'=y$ and $y'=6x^2-a/2$, where $a$ is a constant and $'$ denotes $t$-derivatives.

I then make the substitution $(x,y)=(x_1y_1,y_1)$.

This implies that $x_1=\frac{x}{y}$ and $y_1=y$.

The $t$-derivatives are $$x_{1}'=\left(\frac{x}{y}\right)'=\frac{yx'-xy'}{y^2}=1-x_{1}y_{1}^{-1}(6x_{1}^2y_{1}^2-a/2)$$ and $$y_{1}'=6x_{1}^2y_{1}^2-a/2.$$

I need to continue in this fashion, that is, in the next step, for example, we let $(x_{1},y_{1})=(x_{2}y_{2},y_{2})$ and then find $x_{2}'$, $y_{2}'$, etc.

Is there a way I can compute the derivatives in Mathematica? For instance, how would I find $x_{1}'$ in Mathematica.

-

## migrated from math.stackexchange.comJul 1 at 1:45

This question came from our site for people studying math at any level and professionals in related fields.

I am not sure if I properly understood. Suppose you differentiate the first equation and, in the result, replace $y'$ by the second equation. This gives a second order differential equation for $x$; solve it and compute $y$ from $x'$. –  Claude Leibovici Jun 27 at 11:03
Dear @Claude Leibovici, Yes. But I want to deal with only first order ODEs. I have to repeat the procedure a number of times (related to blow-ups). –  Radz Jun 27 at 11:23

eq[0] = {Derivative[1][Subscript[x, 0]][t] == Subscript[y, 0][t],
Derivative[1][Subscript[y, 0]][t] == 6 Subscript[x, 0][t]^2 - a/2};
ru[n_] := Block[
{r = {Subscript[x, n - 1][t] :>
Subscript[x, n][t] Subscript[y, n][t],
Subscript[y, n - 1][t] :> Subscript[y, n][t]}},
Flatten[{r, D[#, t] & /@ r}]]
eq[n_] :=
Equal @@@
Solve[eq[n - 1] /. ru[n], {Derivative[1][Subscript[x, n]][t],
Derivative[1][Subscript[y, n]][t]}][[1]];
Table[eq[n], {n, 0, 5}] // TableForm // TraditionalForm


-
You should try not to answer with images. Please try to put as much Mathematica code as possible or $\LaTeX$. –  Öskå Jul 1 at 12:36

Dt is useful for doing substutitions. You can think of Dt[x] as the differential of x. Substitutions can be performed with ReplaceAll (/.) and rules like {x -> x1 y1, y -> y1}. Then Solve can be used to solve for Dt[x1] and Dt[y1]. Solve returns a solution in the form of a Rule, so we replace Rule with Equal to get another differential equation.

eqns = {Dt[x] == y Dt[t], Dt[y] == (6 x^2 - a/2) Dt[t]};

eqns1 = First@
Solve[eqns /. {x -> x1 y1, y -> y1}, {Dt[x1], Dt[y1]}] /.
Rule -> Equal
(*
{Dt[x1] == -((-a x1 Dt[t] - 2 y1 Dt[t] + 12 x1^3 y1^2 Dt[t])/(2 y1)),
Dt[y1] == 1/2 (-a Dt[t] + 12 x1^2 y1^2 Dt[t])}
*)


You can repeat the process manually or do them all together with Fold or FoldList. FoldList will give the sequence of differential equations, which you might want.

Fold[
First@Solve[#1 /. #2, Dt /@ Variables[Last /@ #2]] /. Rule -> Equal &,
eqns,
{{x -> x1 y1, y -> y1},
{x1 -> x2 y2, y1 -> y2}}
]
(*
{Dt[x2] == -((-Dt[t] - a x2 Dt[t] + 12 x2^3 y2^4 Dt[t])/y2),
Dt[y2] == 1/2 (-a Dt[t] + 12 x2^2 y2^4 Dt[t])}
*)


Warning: Depending on the form of the substitutions you use, Variables might not work to perfection. Manual intervention might be necessary. Or you might write a more complicated procedure for Fold in which the new variables are explicitly listed with each substitution.

-

It's a little hard to tell what you are looking for, but here is a try. The first step can be written in almost exactly the same way you have above:

x1[t] = x[t]/y[t];
y1[t] = y[t];
D[x1[t], t] /. {D[x[t], t] -> y[t], D[y[t], t] -> 6 x[t]^2 - a/2}
D[y1[t], t] /. {D[x[t], t] -> y[t], D[y[t], t] -> 6 x[t]^2 - a/2}


This returns the same equations you have for the derivatives. But now you can continue in exactly the same manner:

x2[t] = x1[t]/y1[t];
y2[t] = y1[t];
D[x2[t], t] /. {D[x1[t], t] -> y1[t], D[y1[t], t] -> 6 x1[t]^2 - a/2}
D[y2[t], t] /. {D[x1[t], t] -> y1[t], D[y1[t], t] -> 6 x1[t]^2 - a/2}


and so on. The next one would be:

x3[t] = x2[t]/y2[t];
y3[t] = y2[t];
D[x3[t], t] /. {D[x2[t], t] -> y2[t], D[y2[t], t] -> 6 x2[t]^2 - a/2}
D[y3[t], t] /. {D[x2[t], t] -> y2[t], D[y2[t], t] -> 6 x2[t]^2 - a/2}

-

### The idea:

eq = {x'[t] == y[t],
y'[t] == 6 x[t]^2 - a/2}

eq2 = eq /. x -> (x1[#] y1[#] &) /. y -> y1

{
y1[t] x1'[t] + x1[t] y1'[t] == y1[t],
y1'[t] == -(a/2) + 6 x1[t]^2 y1[t]^2
}

  Thread[
{x1'[t], y1'[t]} == First[ {x'[t], y'[t]} /. Solve[eq, {x1'[t], y1'[t]}]] ]

 x1'[t] == 1 + (a x1[t])/(2 y1[t]) - 6 x1[t]^3 y1[t]
y1'[t] == -(a/2) + 6 x1[t]^2 y1[t]^2


### General approach

You don't have to even change the names!

and if you need to do this couple of times then just use:

eq = {x'[t] == y[t], y'[t] == 6 x[t]^2 - a/2}
Do[
eq = eq /. x -> (x[#] y[#] &);
{x'[t], y'[t]} == First[ {x'[t], y'[t]} /. Solve[eq, {x'[t], y'[t]}]] ]
, {5}]

-

Here is a fully automated way of solving your problem. To streamline the notation, I redefine your initial equations using index 0.

Define the initial equations.

eqns = {Derivative[1][x[0]][t] == y[0][t], Derivative[1][y[0]][t] == 6 x[0][t]^2 - a/2};


Define the transformation rule.

transfrule = {x[n_] :> (x[n + 1][#] y[n + 1][#] &), y[n_] :> (y[n + 1][#] &)};


Iterate the transformation, and construct each new set of equations with the derivatives on the left hand side as you go along. I iterate 5 times, but choose your own number as required.

NestList[
(
eqnsnew = # /. transfrule;
derivs = eqnsnew // Cases[#, Derivative[_][_][_], \[Infinity]] & // DeleteDuplicates;
Thread[derivs == Simplify[derivs /. Solve[eqnsnew, derivs][[1]]]]
) &,
eqns,
5
]

-