# Plot two functions with different orders of magnitude into one graph

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 p2

Plot of p1 and p2

• Why not multiplying your analytic approximation by 100 and explaining it in the caption Commented Mar 13, 2017 at 8:38

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 /.