5
$\begingroup$

I want to plot the theoretical expression and the approximated expression of a given quantity $r$, you can see that the theoretical expression is calculated by mathematica (r1) while the approximation is what I input myself (r2), they have different orders of magnitude, r1 is of order 10^-7 around the domain of (400,500) while r2 is of order 10^-9 around the domain (1,400) then drops to 10^-10 around (400,500). I don't know how to make them appear together since r1 is so much larger compared to r2 so I intentionally let the domain of r1 to be around (400,500) because I think at that range it would be smaller but their graphs still won't appear (I need to see them at the same time to compare them). Is there any way to adjust the parameters of the plot so that I can see them together? I have tried to look at some of the threads but my problem is that I need to evaluate $r1$ for $t=10^6$

*For $r1$ I just happen to use DiscretePlot but it doesn't matter if I use Plot

Mp = 2.4353*10^18 ;(* Reduced Planck mass = 2.4353*10^18 GeV *)
m = 1.8*10^13 ;(* Inflaton mass = 1.8*10^13 GeV *)
Rm = (1.8*10^13)/(2.4353*10^18); (* Rescaled inflaton mass *)
tfin = 10^7; 
sol = ParametricNDSolve[{dy'[t] + 3 H[t] (1 + Q) dy[t] + Rm^2 y[t] == 0, H[t] == Sqrt[(0.5 dy[t]^2 + 0.5 Rm^2 y[t]^2 + \[Rho][t])/3], \[Rho]'[t] + 4 H[t] \[Rho][t] == 3 H[t] Q dy[t]^2, y'[t] == dy[t], y[0] == -11, dy[0] == 0.657, \[Rho][0] == Rm^4}, {y, dy, H, \[Rho]}, {t, 0, tfin}, {Q}]
ysol[Q_] := y[Q][t] /. sol;
ypsol[Q_] := dy[Q][t] /. sol;
Hsol[Q_] := H[Q][t] /. sol;
\[Rho]sol[Q_] := \[Rho][Q][t] /. sol;
r1[Q_] := (313*ypsol[Q]^2)/((1 + Q)^(1/2) Hsol[Q] \[Rho]sol[Q]^(1/4)) ;
r2[Q_] := (3.53*10^-5) (1/((Q) (1 + Q)^5)^(1/3));
p1 = DiscretePlot[Evaluate[r1[Q] /. t -> 10^6], {Q, 400, 500},PlotStyle -> Red, PlotRange -> All]
p2 = Plot[r2[Q], {Q, 1, 500},PlotStyle -> Blue]
Show[p1, p2, AspectRatio -> 4/3, PlotRange -> {{1, 500}, {4*10^-10, 10^-7}}]

Plot of p1

Plot of p1

Plot of p2

Plot of p2

p1p2

Plot of p1 and p2

$\endgroup$
1
  • $\begingroup$ Why not multiplying your analytic approximation by 100 and explaining it in the caption $\endgroup$
    – yarchik
    Mar 13 '17 at 8:38
6
$\begingroup$

Using the two-axis function here.

TwoAxisPlot[{f_, g_}, {x_, x1_, x2_}] := Module[
  {fgraph, ggraph, frange, grange, fticks, gticks},
  {fgraph, ggraph} = MapIndexed[Plot[#, {x, x1, x2}, Axes -> True, 
      PlotStyle -> ColorData[1][#2[[1]]], PlotRange -> Full] &, {f, g}];
  {frange, grange} = (PlotRange /. AbsoluteOptions[#, PlotRange])[[2]] & /@
    {fgraph, ggraph};
  fticks = N@FindDivisions[frange, 5];
  gticks = Quiet@Transpose@{fticks, ToString[NumberForm[#, 2],
          StandardForm] & /@ Rescale[fticks, frange, grange]};
  Show[fgraph /.
   (* adding style modifications *)
   {Opacity[1.] -> Opacity[0.5], AbsoluteThickness[1.6] -> AbsoluteThickness[10]},
  ggraph /. Graphics[graph_, s___] :> Graphics[
     GeometricTransformation[graph, 
      RescalingTransform[{{0, 1}, grange},
       {{0, 1}, frange}]], s], Axes -> False, Frame -> True,
  FrameStyle -> {ColorData[1] /@ {1, 2}, {Automatic, Automatic}},
  FrameTicks -> {{fticks, gticks}, {Automatic, Automatic}}]] 

Labeled[
 TwoAxisPlot[{r1[Q] /. t -> 10^6, r2[Q]}, {Q, 400, 500}],
 {Rotate["r1[Q]/.t\[Rule]10^6", Pi/2], Rotate["r2[Q]", Pi/2]}, {Left, Right}]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.