# Using one complicated equation to reduce another

(Relative noob here so don't assume much!)

I need to use a vector equation (with $N-1$ entries) in the general form

$y_j(x_{i,j},x_{i,j+1},x_{i,j-1})=0, i=1...3, j=1...N-1; x_{i,0}=x_{i,N}=0$,

which depends fairly complicatedly on the $x_{i,j}$s (etc), to solve another vector equation

$w_j(x_{i,j}, x_{i,j+1}, x_{i,j-1}, z_{i,j}, z_{i,j+1}, z_{i,j-1}, r_1,r_2,p_0,p_1)=0, i=1...3, j=1...N-1;$

$z_{i,0}=z_{i,N}=0$,

which is fairly fiendish but (when properly factorised) contains several occurrences of $y_j$, that I can therefore eliminate. How do I use $y_j$ to reduce $w_j$? I have tried using Reduce[expr,var,varlist], but I don't want to rearrange the equation 'equal to' anything; I'd rather it equal 0 at the end, but just with the $y$ bits removed; and I also can't really tell what I'm supposed to put into 'varlist' - is it all the argument, including subscripted ones?

EDIT - other things I have tried that didn't work:

• Eliminate[{y==0, w==0}, {Subscript[x,i,j] (etc over j)}] - didn't produce anything, had to abort
• Collect[w==0,y] - just spat out $w=0$ fully expanded

EDIT2 - Yves - ok, here it comes!

Definitions:

m[r_] := Sum[Subscript[m, i]*r^i, {i, 0, 5}] s[r_] := Sum[Subscript[s, i]*r^i, {i, 0, 5}] \[Omega][r_] := Sum[Subscript[\[Omega], i, j]*r^i, {i, 0, 5}] \[Omega]0[r_] := \[Omega][r] /. j -> j - 1 \[Omega]1[r_] := \[Omega][r] /. j -> j + 1 w[r_] := 1 - \[Omega][r]^2 + 1/2*(\[Omega]1[r]^2 + \[Omega]0[r]^2) \[Alpha][r_] := Sum[Subscript[\[Alpha], i, j]*r^i, {i, 0, 5}] \[Alpha]1[r_] := \[Alpha][r] /. j -> j + 1 \[Mu][r_] := Expand[1 - 2 m[r]/r - r^2/(l^2)]

Conditions:

Subscript[\[Omega],0,j] := Sqrt[j*(n-j)] Subscript[\[Omega],1,j] := 0 Subscript[\[Omega],i,0] := 0 Subscript[\[Omega],i,n] := 0 Subscript[\[Alpha],i,0] := 0 Subscript[\[Alpha],i,n] := 0 Subscript[m,0]:=0 Subscript[m,1]:=0 Subscript[m,2]:=0 Subscript[s,1]:=0

Equation:

Expand[Coefficient[-\[Mu][r]*D[\[Mu][r], r]*s[r]^2*D[\[Omega][r], r] -\[Mu[r]^2*s[r]*D[s[r], r]*D[\[Omega][r] - 1/4*\[Omega][r]*(\[Alpha][r] - \[Alpha]1[r])^2 -\[Mu][r]*s[r]^2/r^2*\[Omega][r]*w[r] - \[Mu][r]^2*s[r]^2*D[D[\[Omega][r], r], r], r, 2]]==0

Constraint:

Expand[Coefficient[-\[Mu][r]*D[\[Mu][r], r]*s[r]^2*D[\[Omega][r], r] -\[Mu[r]^2*s[r]*D[s[r], r]*D[\[Omega][r] - 1/4*\[Omega][r]*(\[Alpha][r] - \[Alpha]1[r])^2 -\[Mu][r]*s[r]^2/r^2*\[Omega][r]*w[r] - \[Mu][r]^2*s[r]^2*D[D[\[Omega][r], r], r], r, 0]]==0

which outputs as

2*Subscript[\[Omega][r],2,j]+Subscript[\[Omega][r],2,j-1]*Subscript[\[Omega][r],0,j-1]*Subscript[\[Omega][r],0,j]+Subscript[\[Omega][r],2,j+1]*Subscript[\[Omega][r],0,j+1]*Subscript[\[Omega][r],0,j]-2*Subscript[\[Omega][r],2,j]*Subscript[\[Omega][r],0,j]^2==0

As you'll see, with these above conditions, the constraint reduces down quite a lot, and if you examine the equation, it contains a few mentions of the constraint, or has some of the terms which you could use to replace the constraint with the others.

This was one attempt:

Eliminate[{Expand[Coefficient[-\[Mu][r]*D[\[Mu][r], r]*s[r]^2*D[\[Omega][r], r] -\[Mu][r]^2*s[r]*D[s[r], r]*D[\[Omega][r], r] -1/4*\[Omega][r]*(\[Alpha][r] - \[Alpha]1[r])^2-\[Mu][r]*s[r]^2/r^2*\[Omega][r]*w[r] -\[Mu][r]^2*s[r]^2*D[D[\[Omega][r], r], r], r, 2] = 0, r, 2], Expand[Coefficient[-\[Mu][r]*D[\[Mu][r], r]*s[r]^2*D[\[Omega][r], r] -\[Mu][r]^2*s[r]*D[s[r], r]*D[\[Omega][r], r] -1/4*\[Omega][r]*(\[Alpha][r] - \[Alpha]1[r])^2 -\[Mu][r]*s[r]^2/r^2*\[Omega][r]*w[r] -\[Mu][r]^2*s[r]^2*D[D[\[Omega][r], r], r], r, 0] = 0], l != 0, Subscript[s, 0]! == 0, j != 0, j != n}, {Subscript[\[Omega], 2, j], Subscript[\[Omega], 2, j - 1], Subscript[\[Omega], 2, j + 1]}]

Output:

Set::write: Tag Plus in 1/4 (-Sqrt[j (Times[<<2>>]+n)]... Subscript[\[Omega], 4,1+j]) is Protected. >> Set::write: Tag Plus in 0+0+0-2 Subsuperscript[s, 0, 2]... Subscript[\[Omega], 2,1+j]) is Protected. >> Eliminate::eqf: 0 is not a well-formed equation. >>

And another:

Collect[Expand[Coefficient[-\[Mu][r]*D[\[Mu][r], r]*s[r]^2*D[\[Omega][r], r] -\[Mu][r]^2*s[r]*D[s[r], r]*D[\[Omega][r], r] -1/4*\[Omega][r]*(\[Alpha][r] - \[Alpha]1[r])^2 -\[Mu][r]*s[r]^2/r^2*\[Omega][r]*w[r] -\[Mu][r]^2*s[r]^2*D[D[\[Omega][r], r], r], r, 2]], Expand[Coefficient[-\[Mu][r]*D[\[Mu][r], r]*s[r]^2*D[\[Omega][r], r] -\[Mu[r]^2*s[r]*D[s[r], r]*D[\[Omega][r], r] -1/4*\[Omega][r]*(\[Alpha][r] - \[Alpha]1[r])^2 -\[Mu][r]*s[r]^2/r^2*\[Omega][r]*w[r] -\[Mu][r]^2*s[r]^2*D[D[\[Omega][r], r], r], r, 0]]]

(did nothing i.e. returned output fully expanded.)

-
Please post the actual working code and all necessary definitions you used to get your (undesirable) results. –  Yves Klett Aug 25 '14 at 10:01
Take a look at Replace. It might be what you are looking for if you actually have a form that already contains the y_j directly. After replacing you might want to apply Simplify or FullSimplify. –  Wizard Aug 25 '14 at 13:45
Wizard - it doesn't always contain it directly though, in some places it does but in others the terms of the constraint are separated and multiplied by factors. –  Pan Daemonium Aug 25 '14 at 19:25