Plotting multivalued function using ParametricPlot

Question

I'm having a bit of trouble making a ParametricPlot from two curves. I defined two functions p and g as:

Clear[p, g];
g[t_] := t*(1000 - t)/(500^2);
solns[t_] := 
Solve[((1 + 1*(.33)*.05*p^2 + 
      11*.33*(.05^2)*.66*p^4)/(1 + (.33)*.05*
       p^2 + .33*(.05^2)*.66*p^4 + .008*.33*.33*(.05^3)*.66*p^6))/
  g[t] - p == 0, p];
p[t_] := p /. solns[t];

Notice that the function $p$ can take on 1-3 values for certain t:

  Plot[{g[t], p[t]}, {t, 0, 1000}]

However, using the command

  ParametricPlot[{g[t], p[t]}, {t, 0, 1000}]

gives some random curve on an x-axis from 3-9 that doesn't have these values. The x-axis should also be going from 0 to 1 for $0\leq t\leq 1000$ because the x-component is defined by $g$. Could anybody tell me what's going on here, and show me how to make an actual parametric plot? Thanks in advance.

Answer 1

Notwithstanding your observation about it, g[t]varies from 0 to 1.

Plot[g[t], {t, 0, 1000}]

Morever, as you can see below, the only three components of p[t] real valued in some interval are the last three:

GraphicsGrid[
 Table[{Plot[Re[p[t][[n]]], {t, 0, 1000},
    PlotStyle -> {Thick, Red}, AxesOrigin -> {0, 0},
    PlotLabel -> Style["Re[ p [[" <> ToString@n <> "]]", Bold]],
   Plot[Im[p[t][[n]]], {t, 0, 1000},
    PlotStyle -> {Thick, Blue}, AxesOrigin -> {0, 0},
    PlotLabel -> Style["Im[ p [[" <> ToString@n <> "]]", Bold]]},
  {n, 1, 7}], Frame -> All]

So, far from efficient, but you could do:

Framed@ParametricPlot[Reverse /@ Thread[{p[t][[5;;7]], g[t]}], {t, 0, 1000}, 
                                PlotRange -> {{0, 1}, {0, 100}}, AspectRatio -> 1]