Symbolical mathematical problem (mathematica)

I got given this question in my tutorial for which I could do parts a) and b). Do you have any ideas for part c)?

Question : Symbolically solve the following equation for the quantity r=y/x:

3/y^4==3/x^4+a/(x+2y)^4

(a) Use Map or Thread to perform the substitution y->r x to both sides of the equation.

 ans:    
    3/(r^4 x^4) == 3/x^4 + a/(x + 2 r x)^4

(b) Plot the solutions for a\[Element]{-1,1}. For a\[Element]{-1,1}, how many solutions are real valued? Does this number depend on a ?

 ans: Graph and开发者_如何学C 4 solutions and no its doesn't depend on `a`. 

(c) Construct numerical solutions by letting a run between -1 and 1 with steps of 0.02 in your solutions obtained above. Use Cases to choose solutions whenever they are real, and using ListPlot, plot all the real solutions occurring in the interval a\[Element]{-1,1}.

Ans : no idea.

You can shortcut a) and b) by using Eliminate. You can also ask Mathematica to solve equations over reals. (In v8):

In[538]:= eq = 
 Eliminate[3/y^4 == 3/x^4 + a/(x + 2 y)^4 && r == y/x, {x, y}]

Out[538]= -24 r - 72 r^2 - 96 r^3 + (-45 + a) r^4 + 24 r^5 + 72 r^6 + 
  96 r^7 + 48 r^8 == 3

In[539]:= r /. Solve[eq && -1 < a < 1, r, Reals]

Out[539]= {ConditionalExpression[
  Root[-3 - 24 #1 - 72 #1^2 - 96 #1^3 + (-45 + a) #1^4 + 24 #1^5 + 
     72 #1^6 + 96 #1^7 + 48 #1^8 &, 1], -1 < a < 0 || 
   0 < a < Root[-184528125 + 267553125 #1 + 11238750 #1^2 + 
       110250 #1^3 - 225 #1^4 + #1^5 &, 1] || 
   Root[-184528125 + 267553125 #1 + 11238750 #1^2 + 110250 #1^3 - 
       225 #1^4 + #1^5 &, 1] < a < 1], 
 ConditionalExpression[
  Root[-3 - 24 #1 - 72 #1^2 - 96 #1^3 + (-45 + a) #1^4 + 24 #1^5 + 
     72 #1^6 + 96 #1^7 + 48 #1^8 &, 2], -1 < a < 0 || 
   0 < a < Root[-184528125 + 267553125 #1 + 11238750 #1^2 + 
       110250 #1^3 - 225 #1^4 + #1^5 &, 1] || 
   Root[-184528125 + 267553125 #1 + 11238750 #1^2 + 110250 #1^3 - 
       225 #1^4 + #1^5 &, 1] < a < 1], 
 ConditionalExpression[
  Root[-3 - 24 #1 - 72 #1^2 - 96 #1^3 + (-45 + a) #1^4 + 24 #1^5 + 
     72 #1^6 + 96 #1^7 + 48 #1^8 &, 3], 
  0 < a < Root[-184528125 + 267553125 #1 + 11238750 #1^2 + 
      110250 #1^3 - 225 #1^4 + #1^5 &, 1]], 
 ConditionalExpression[
  Root[-3 - 24 #1 - 72 #1^2 - 96 #1^3 + (-45 + a) #1^4 + 24 #1^5 + 
     72 #1^6 + 96 #1^7 + 48 #1^8 &, 4], 
  0 < a < Root[-184528125 + 267553125 #1 + 11238750 #1^2 + 
      110250 #1^3 - 225 #1^4 + #1^5 &, 1]]}

You can then plot the resulting solution:

The Out[539] gives you exact algebraic solutions along with conditions when they are real. So the maximum number of real solutions is 4 and occurs when a is between zero and Root[-184528125 + 267553125 #1 + 11238750 #1^2 + 110250 #1^3 - 225 #1^4 + #1^5 &, 1]

Now, let's get to part c). You should use NSolve to construct all solutions. Then, as suggested Cases to extract real solutions, and then ListPlot:

Table[Thread[{a, 
    Cases[r /. NSolve[eq, r], r_ /; Im[r] == 0]}], {a, -1, 1, 
   0.02}] // ListPlot