1
$\begingroup$

How can I get Mathematica to eliminate $x_1$ in the equations in the first box to achieve the equation in the second box?

eguations.png

My code:

Reduce[{
  f[t] - k[1] x[1] - B[1] D[x[2], t] - B[3] D[x[1] - x[2], t] == m[1] D[x[1], {t, 2}],
  B[3] D[x[1] - x[2], t] - B[2] D[x[2], t] - k[2] x[2] == m[2] D[x[2], {t, 2}]},
  {f[t], k[1], k[2], x[2], t, B[1], B[2], B[3], m[1], m[2]}] 

Mathematica' s answer:

(x[1] == 0 && f[t] == 0 && k[2] == 0) || (x[1] == 0 && f[t] == 0 && 
   x[2] == 0) || (x[1] != 0 && k[1] == f[t]/x[1] && 
   k[2] == 0) || (x[1] != 0 && k[1] == f[t]/x[1] && x[2] == 0)
$\endgroup$
4
  • 1
    $\begingroup$ Upvoting in part to counter the weight of existing votes. Note sure why this is getting the downvotes though. User might be new to mathematica but it's far from a trivial problem under consideration (at least, for me it's far). $\endgroup$ Jul 26, 2013 at 16:46
  • $\begingroup$ @DanielLichtblau I agree. While somewhat of a duplicate (as you point out), it isn't a simple problem and should be addressed. The OP does have simple errors in his code, but those are addressable and not directly related to the underlying issue. So, I'm upvoting, also. $\endgroup$
    – rcollyer
    Jul 26, 2013 at 16:49
  • $\begingroup$ @DanielLichtblau I think most of the downvotes were cast for the first version of this post... seems appropriate in that context :) $\endgroup$
    – rm -rf
    Jul 26, 2013 at 20:34
  • $\begingroup$ @rm -rf Ah, I see your point. $\endgroup$ Jul 26, 2013 at 21:52

1 Answer 1

4
$\begingroup$

(1) You need to make the functions that depend on t explicit.

(2) You need to do differential elimination. This involves prolonging (taking derivatives). More on this below.

(3) This question, while perfectly reasonable, is something of a duplicate (though the earlier variants might not be so easy to locate in MSE). They are here and here. [Note to moderators: given the relative obscurity of the prior posts I think it's fine to keep this question as well.]

I show a bare-bones version for your equations. In general one would use a loop to iterate prolongations interspersed with projections, until obtaining a result that fully eliminates all derivatives one is trying to remove.

eqs = {f[t] - k1 x1[t] - B1 D[x2[t], t] - B3 D[x1[t] - x2[t], t] == 
    m1 D[x1[t], {t, 2}], 
   B3 D[x1[t] - x2[t], t] - B2 D[x2[t], t] - k2 x2[t] == 
    m2 D[x2[t], {t, 2}]};

eqs2 = Join[eqs, D[eqs, t]];
eqs3 = Join[eqs2, D[eqs, {t, 2}]];

Eliminate[eqs3, {x1[t], D[x1[t], t], D[x1[t], {t, 2}], 
  D[x1[t], {t, 3}], D[x1[t], {t, 4}]}]

(* Out[19]= k1*k2*x2[t] + B2*k1*Derivative[1][x2][t] + 
     B3*k1*Derivative[1][x2][t] + B3*k2*Derivative[1][x2][t] + 
     B1*B3*Derivative[2][x2][t] + B2*B3*Derivative[2][x2][t] + 
     k2*m1*Derivative[2][x2][t] + k1*m2*Derivative[2][x2][t] + 
     B2*m1*Derivative[3][x2][t] + B3*m1*Derivative[3][x2][t] + 
     B3*m2*Derivative[3][x2][t] + m1*m2*Derivative[4][x2][t] == 
   B3*Derivative[1][f][t] *)
$\endgroup$
1
  • 1
    $\begingroup$ I would also run Collect[%, Derivative[_][_][t]] on the result to simplify it. $\endgroup$
    – rcollyer
    Jul 26, 2013 at 16:57

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.