Skip to main content
Mathematica

Return to Answer

deleted 99 characters in body
Source Link
Mr.Wizard
Mr.Wizard
  • 273.1k
  • 34
  • 595
  • 1.4k
y[t_] := Sin[Pi t]/(Pi t);
yRoots = t /. {ToRules@Reduce[{y[t] == 0, 0 <= t <= 6}, t]};
yDRoots = t /. {ToRules@N@Reduce[{y'[t] == 0, 0 <= t <= 6}, y]}
ranges = Prepend[yDRoots, 0];
\[Theta][t_]θ[t_] := Piecewise[
    Table[{ArcTan[y[t]/(t^2 y'[t])] + k Pi, ranges[[k]] < t <= ranges[[k + 1]]},
    {k, Length@ranges - 1}]];
\[Rho][t_]ρ[t_] := Sqrt[(y[t])^2 + (t^2 y'[t])^2];

d = 10^-7; (* A small delta is defined so that lines at points of yDRoots appear in the correct interval *)

p1 = Plot[\[Theta][t]Plot[θ[t], {t, 0, 5}, 
   Ticks -> {None, Table[{k Pi, k "\[Pi]""π"}, {k, 0, 4}]}, 
   AxesLabel -> {"t", "\[Theta]""θ"}, AxesStyle -> Directive[14], 
   AxesOrigin -> {0, 0}, PlotRange -> Full, ImagePadding -> 20,
   Epilog -> {
     {Red, AbsolutePointSize@5, Point[{#, \[Theta][#]θ[#]} & /@ yRoots]},
     {Gray, Dashed, Line[{{#, \[Theta][#]θ[#]}, {#, -100}} & /@ yRoots], 
                    Line[{{0, \[Theta][#]θ[#]}, {#, \[Theta][#]θ[#]}} & /@ yRoots]},
     {Green, AbsolutePointSize@5, Point[{#, \[Theta][#]θ[#]} & /@ (yDRoots + d)]},
     {Gray, Dashed, Line[{{#, \[Theta][#]θ[#]}, {#, -100}} & /@ (yDRoots + d)]}
   }];
p2 = Plot[y[t], {t, 0, 5}, Ticks -> {Table[{k, ""}, {k, 1, 5}], {1}}, 
   AxesLabel -> {"t", "y"}, AxesStyle -> Directive[14], 
   AxesOrigin -> {0, 0}, PlotRange -> Full, ImagePadding -> 20,
   Epilog -> {
     {Red, AbsolutePointSize@5, Point[{#, y[#]} & /@ yRoots]},
     {Green, AbsolutePointSize@5, Point[{#, y[#]} & /@ yDRoots]},
     {Gray, Dashed, Line[{{#, 0}, {#, 100}} & /@ yRoots]},
     {Gray, Dashed, Line[{{#, y[#]}, {#, 0}} & /@ yDRoots]}
   }];
p3 = PolarPlot[\[Rho][t]PolarPlot[ρ[t], {t, 0, 5}, Ticks -> None, 
   AxesLabel -> {"\[Theta]""θ", "\[Rho]""ρ"}, AxesStyle -> Directive[14], 
   AxesOrigin -> {0, 0}, ImagePadding -> 20, 
   PlotRange -> {{-1, 1}, {-1, 1}}*.35,
   Epilog -> {
     {Green, AbsolutePointSize@5, Point[(\[Rho][#]*ρ[#]*{Cos[#], Sin[#]}) & /@ yDRoots]},
     {Gray, Dashed, Line[{{0, 0}, \[Rho][#]*ρ[#]*{Cos[#], Sin[#]}} & /@ yDRoots]}
     }];

(* define origo points for p1 and p3 (p2 is derived from these) *)
o1 = {.1, .5};
o3 = {.75, .25};
o2 = {First@o1, Last@o3};
Graphics[{
  Inset[p1, ImageScaled@o1, {0, 0}, 1],
  Inset[p2, ImageScaled@o2, {0, 0}, 1],
  Inset[p3, ImageScaled@o3, {0, 0}, 1]
  }, ImageSize -> 500, PlotRange -> All]

y[t_] := Sin[Pi t]/(Pi t);
yRoots = t /. {ToRules@Reduce[{y[t] == 0, 0 <= t <= 6}, t]};
yDRoots = t /. {ToRules@N@Reduce[{y'[t] == 0, 0 <= t <= 6}, y]}
ranges = Prepend[yDRoots, 0];
\[Theta][t_] := Piecewise[
    Table[{ArcTan[y[t]/(t^2 y'[t])] + k Pi, ranges[[k]] < t <= ranges[[k + 1]]},
    {k, Length@ranges - 1}]];
\[Rho][t_] := Sqrt[(y[t])^2 + (t^2 y'[t])^2];

d = 10^-7; (* A small delta is defined so that lines at points of yDRoots appear in the correct interval *)

p1 = Plot[\[Theta][t], {t, 0, 5}, 
   Ticks -> {None, Table[{k Pi, k "\[Pi]"}, {k, 0, 4}]}, 
   AxesLabel -> {"t", "\[Theta]"}, AxesStyle -> Directive[14], 
   AxesOrigin -> {0, 0}, PlotRange -> Full, ImagePadding -> 20,
   Epilog -> {
     {Red, AbsolutePointSize@5, Point[{#, \[Theta][#]} & /@ yRoots]},
     {Gray, Dashed, Line[{{#, \[Theta][#]}, {#, -100}} & /@ yRoots], 
                    Line[{{0, \[Theta][#]}, {#, \[Theta][#]}} & /@ yRoots]},
     {Green, AbsolutePointSize@5, Point[{#, \[Theta][#]} & /@ (yDRoots + d)]},
     {Gray, Dashed, Line[{{#, \[Theta][#]}, {#, -100}} & /@ (yDRoots + d)]}
   }];
p2 = Plot[y[t], {t, 0, 5}, Ticks -> {Table[{k, ""}, {k, 1, 5}], {1}}, 
   AxesLabel -> {"t", "y"}, AxesStyle -> Directive[14], 
   AxesOrigin -> {0, 0}, PlotRange -> Full, ImagePadding -> 20,
   Epilog -> {
     {Red, AbsolutePointSize@5, Point[{#, y[#]} & /@ yRoots]},
     {Green, AbsolutePointSize@5, Point[{#, y[#]} & /@ yDRoots]},
     {Gray, Dashed, Line[{{#, 0}, {#, 100}} & /@ yRoots]},
     {Gray, Dashed, Line[{{#, y[#]}, {#, 0}} & /@ yDRoots]}
   }];
p3 = PolarPlot[\[Rho][t], {t, 0, 5}, Ticks -> None, 
   AxesLabel -> {"\[Theta]", "\[Rho]"}, AxesStyle -> Directive[14], 
   AxesOrigin -> {0, 0}, ImagePadding -> 20, 
   PlotRange -> {{-1, 1}, {-1, 1}}*.35,
   Epilog -> {
     {Green, AbsolutePointSize@5, Point[(\[Rho][#]*{Cos[#], Sin[#]}) & /@ yDRoots]},
     {Gray, Dashed, Line[{{0, 0}, \[Rho][#]*{Cos[#], Sin[#]}} & /@ yDRoots]}
     }];

(* define origo points for p1 and p3 (p2 is derived from these) *)
o1 = {.1, .5};
o3 = {.75, .25};
o2 = {First@o1, Last@o3};
Graphics[{
  Inset[p1, ImageScaled@o1, {0, 0}, 1],
  Inset[p2, ImageScaled@o2, {0, 0}, 1],
  Inset[p3, ImageScaled@o3, {0, 0}, 1]
  }, ImageSize -> 500, PlotRange -> All]

y[t_] := Sin[Pi t]/(Pi t);
yRoots = t /. {ToRules@Reduce[{y[t] == 0, 0 <= t <= 6}, t]};
yDRoots = t /. {ToRules@N@Reduce[{y'[t] == 0, 0 <= t <= 6}, y]}
ranges = Prepend[yDRoots, 0];
θ[t_] := Piecewise[
    Table[{ArcTan[y[t]/(t^2 y'[t])] + k Pi, ranges[[k]] < t <= ranges[[k + 1]]},
    {k, Length@ranges - 1}]];
ρ[t_] := Sqrt[(y[t])^2 + (t^2 y'[t])^2];

d = 10^-7; (* A small delta is defined so that lines at points of yDRoots appear in the correct interval *)

p1 = Plot[θ[t], {t, 0, 5}, 
   Ticks -> {None, Table[{k Pi, k "π"}, {k, 0, 4}]}, 
   AxesLabel -> {"t", "θ"}, AxesStyle -> Directive[14], 
   AxesOrigin -> {0, 0}, PlotRange -> Full, ImagePadding -> 20,
   Epilog -> {
     {Red, AbsolutePointSize@5, Point[{#, θ[#]} & /@ yRoots]},
     {Gray, Dashed, Line[{{#, θ[#]}, {#, -100}} & /@ yRoots], 
                    Line[{{0, θ[#]}, {#, θ[#]}} & /@ yRoots]},
     {Green, AbsolutePointSize@5, Point[{#, θ[#]} & /@ (yDRoots + d)]},
     {Gray, Dashed, Line[{{#, θ[#]}, {#, -100}} & /@ (yDRoots + d)]}
   }];
p2 = Plot[y[t], {t, 0, 5}, Ticks -> {Table[{k, ""}, {k, 1, 5}], {1}}, 
   AxesLabel -> {"t", "y"}, AxesStyle -> Directive[14], 
   AxesOrigin -> {0, 0}, PlotRange -> Full, ImagePadding -> 20,
   Epilog -> {
     {Red, AbsolutePointSize@5, Point[{#, y[#]} & /@ yRoots]},
     {Green, AbsolutePointSize@5, Point[{#, y[#]} & /@ yDRoots]},
     {Gray, Dashed, Line[{{#, 0}, {#, 100}} & /@ yRoots]},
     {Gray, Dashed, Line[{{#, y[#]}, {#, 0}} & /@ yDRoots]}
   }];
p3 = PolarPlot[ρ[t], {t, 0, 5}, Ticks -> None, 
   AxesLabel -> {"θ", "ρ"}, AxesStyle -> Directive[14], 
   AxesOrigin -> {0, 0}, ImagePadding -> 20, 
   PlotRange -> {{-1, 1}, {-1, 1}}*.35,
   Epilog -> {
     {Green, AbsolutePointSize@5, Point[(ρ[#]*{Cos[#], Sin[#]}) & /@ yDRoots]},
     {Gray, Dashed, Line[{{0, 0}, ρ[#]*{Cos[#], Sin[#]}} & /@ yDRoots]}
     }];

(* define origo points for p1 and p3 (p2 is derived from these) *)
o1 = {.1, .5};
o3 = {.75, .25};
o2 = {First@o1, Last@o3};
Graphics[{
  Inset[p1, ImageScaled@o1, {0, 0}, 1],
  Inset[p2, ImageScaled@o2, {0, 0}, 1],
  Inset[p3, ImageScaled@o3, {0, 0}, 1]
  }, ImageSize -> 500, PlotRange -> All]
added 106 characters in body
Source Link
István Zachar
István Zachar
  • 47.2k
  • 20
  • 145
  • 293
y[t_] := Sin[Pi t]/(Pi t);
aryRoots = {1.415,t 2/.495, 3.526,{ToRules@Reduce[{y[t] 4.462,== 5.4210, 0 <= t <= 6.477}, t]};
rryDRoots = Join[{0}, Table[tt /. FindRoot[D[y[t], t]{ToRules@N@Reduce[{y'[t] == 0, {0 <= t, ar[[k]]<= 6}], {k,y]}
ranges 1,= Length[ar]}]Prepend[yDRoots, {7}];0];
\[Theta][t_] := Piecewise[Table[Piecewise[
    Table[{ArcTan[y[t]/(t^2 y'[t])] + k Pi, rr[[k]]ranges[[k]] <=< t <<= rr[[kranges[[k + 1]]},
    {k, 1, Length[rr]Length@ranges - 1}]];
\[Rho][t_] := Sqrt[(y[t])^2 + (t^2 y'[t])^2];

(* a simpler way tod calculate= roots10^-7; (*)
yRoots =A tsmall /.delta {ToRules@Reduce[{y[t]is ==defined 0,so 0that <lines tat <=points 5},of t]};
yDRoots = t /. {ToRules@N@Reduce[{y'[t] == 0, 0appear <in tthe <=correct 5},interval y]};*)

p1 = Plot[\[Theta][t], {t, 0, 5}, 
   Ticks -> {None, Table[{k Pi, k "\[Pi]"}, {k, 0, 4}]}, 
   AxesLabel -> {"t", "\[Theta]"}, AxesStyle -> Directive[14], 
   AxesOrigin -> {0, 0}, PlotRange -> Full, ImagePadding -> 20,
   Epilog -> {
     {Red, AbsolutePointSize@5, Point@N[Transpose@Point[{yRoots#, \[Theta]\[Theta][#]} & /@ yRoots}]yRoots]},
     {Gray, Dashed, Line[{{#, \[Theta]@#\[Theta][#]}, {#, -100}} & /@ yRoots], 
                    Line[{{0, \[Theta][#]}, {#, \[Theta][#]}} & /@ yRoots]},
     {Green, AbsolutePointSize@5, Point[{#, \[Theta][#]} & /@ (yDRoots + d)]},
     {Gray, Dashed, Line[{{#, \[Theta][#]}, {#, -100}} & /@ (yDRoots + d)]}
   }];
p2 = Plot[y[t], {t, 0, 5}, Ticks -> {Table[{k, ""}, {k, 1, 5}], {1}}, 
   AxesLabel -> {"t", "y"}, AxesStyle -> Directive[14], 
   AxesOrigin -> {0, 0}, PlotRange -> Full, ImagePadding -> 20,
   Epilog -> {
     {Red, AbsolutePointSize@5, Point@N[Transpose@Point[{yRoots#, yy[#]} & /@ yRoots}]yRoots]},
     {Green, AbsolutePointSize@5, Point@N[Transpose@Point[{yDRoots#, yy[#]} & /@ yDRoots}]yDRoots]},
     {Gray, Dashed, Line[{{#, 0}, {#, 100}} & /@ yRoots]},
     {Gray, Dashed, Line[{{#, y@#y[#]}, {#, 0}} & /@ yDRoots]}
     }];
p3 = PolarPlot[\[Rho][t], {t, 0, 5}, Ticks -> None, 
   AxesLabel -> {"\[Theta]", "\[Rho]"}, AxesStyle -> Directive[14], 
   AxesOrigin -> {0, 0}, ImagePadding -> 20, 
   PlotRange -> {{-1, 1}, {-1, 1}}*.35,
   Epilog -> {
     {Green, AbsolutePointSize@5, Point[(\[Rho]@#*\[Rho][#]*{Cos@#Cos[#], Sin@#Sin[#]}) & /@ yDRoots]},
     {Gray, Dashed, Line[{{0, 0}, \[Rho]@#*\[Rho][#]*{Cos@#Cos[#], Sin@#Sin[#]}} & /@ yDRoots]}
     }];

(* define origo points for p1 and p3 (p2 is derived from these) *)
o1 = {.1, .65};
o3 = {.875, .25};
o2 = {First@o1, Last@o3};
Graphics[{
  {Inset[p1, ImageScaled@o1, {0, 0}], 1],
   Inset[p2, ImageScaled@o2, {0, 0}], 1],
   Inset[p3, ImageScaled@o3, {0, 0}]}, 1]
  }, ImageSize -> 500, AspectRatioPlotRange -> 1]All]

enter image description hereenter image description here

y[t_] := Sin[Pi t]/(Pi t);
ar = {1.415, 2.495, 3.526, 4.462, 5.421, 6.477};
rr = Join[{0}, Table[t /. FindRoot[D[y[t], t] == 0, {t, ar[[k]]}], {k, 1, Length[ar]}], {7}];
\[Theta][t_] := Piecewise[Table[{ArcTan[y[t]/(t^2 y'[t])] + k Pi, rr[[k]] <= t < rr[[k + 1]]}, {k, 1, Length[rr] - 1}]];
\[Rho][t_] := Sqrt[(y[t])^2 + (t^2 y'[t])^2];

(* a simpler way to calculate roots *)
yRoots = t /. {ToRules@Reduce[{y[t] == 0, 0 < t <= 5}, t]};
yDRoots = t /. {ToRules@N@Reduce[{y'[t] == 0, 0 < t <= 5}, y]};

p1 = Plot[\[Theta][t], {t, 0, 5}, 
   Ticks -> {None, Table[{k Pi, k "\[Pi]"}, {k, 0, 4}]}, 
   AxesLabel -> {"t", "\[Theta]"}, AxesStyle -> Directive[14], 
   AxesOrigin -> {0, 0}, PlotRange -> Full, ImagePadding -> 20,
   Epilog -> {
     {Red, AbsolutePointSize@5, Point@N[Transpose@{yRoots, \[Theta] /@ yRoots}]},
     {Gray, Dashed, Line[{{#, \[Theta]@#}, {#, -100}} & /@ yRoots]}
     }];
p2 = Plot[y[t], {t, 0, 5}, Ticks -> {Table[{k, ""}, {k, 1, 5}], {1}}, 
   AxesLabel -> {"t", "y"}, AxesStyle -> Directive[14], 
   AxesOrigin -> {0, 0}, PlotRange -> Full, ImagePadding -> 20,
   Epilog -> {
     {Red, AbsolutePointSize@5, Point@N[Transpose@{yRoots, y /@ yRoots}]},
     {Green, AbsolutePointSize@5, Point@N[Transpose@{yDRoots, y /@ yDRoots}]},
     {Gray, Dashed, Line[{{#, 0}, {#, 100}} & /@ yRoots]},
     {Gray, Dashed, Line[{{#, y@#}, {#, 0}} & /@ yDRoots]}
     }];
p3 = PolarPlot[\[Rho][t], {t, 0, 5}, Ticks -> None, 
   AxesLabel -> {"\[Theta]", "\[Rho]"}, AxesStyle -> Directive[14], 
   AxesOrigin -> {0, 0}, ImagePadding -> 20, 
   PlotRange -> {{-1, 1}, {-1, 1}}*.35,
   Epilog -> {
     {Green, AbsolutePointSize@5, Point[(\[Rho]@#*{Cos@#, Sin@#}) & /@ yDRoots]},
     {Gray, Dashed, Line[{{0, 0}, \[Rho]@#*{Cos@#, Sin@#}} & /@ yDRoots]}
     }];

(* define origo points for p1 and p3 (p2 is derived from these) *)
o1 = {.1, .6};
o3 = {.8, .25};
o2 = {First@o1, Last@o3};
Graphics[{
  {Inset[p1, ImageScaled@o1, {0, 0}], 
   Inset[p2, ImageScaled@o2, {0, 0}], 
   Inset[p3, ImageScaled@o3, {0, 0}]}
  }, ImageSize -> 500, AspectRatio -> 1]

enter image description here

y[t_] := Sin[Pi t]/(Pi t);
yRoots = t /. {ToRules@Reduce[{y[t] == 0, 0 <= t <= 6}, t]};
yDRoots = t /. {ToRules@N@Reduce[{y'[t] == 0, 0 <= t <= 6}, y]}
ranges = Prepend[yDRoots, 0];
\[Theta][t_] := Piecewise[
    Table[{ArcTan[y[t]/(t^2 y'[t])] + k Pi, ranges[[k]] < t <= ranges[[k + 1]]},
    {k, Length@ranges - 1}]];
\[Rho][t_] := Sqrt[(y[t])^2 + (t^2 y'[t])^2];

d = 10^-7; (* A small delta is defined so that lines at points of yDRoots appear in the correct interval *)

p1 = Plot[\[Theta][t], {t, 0, 5}, 
   Ticks -> {None, Table[{k Pi, k "\[Pi]"}, {k, 0, 4}]}, 
   AxesLabel -> {"t", "\[Theta]"}, AxesStyle -> Directive[14], 
   AxesOrigin -> {0, 0}, PlotRange -> Full, ImagePadding -> 20,
   Epilog -> {
     {Red, AbsolutePointSize@5, Point[{#, \[Theta][#]} & /@ yRoots]},
     {Gray, Dashed, Line[{{#, \[Theta][#]}, {#, -100}} & /@ yRoots], 
                    Line[{{0, \[Theta][#]}, {#, \[Theta][#]}} & /@ yRoots]},
     {Green, AbsolutePointSize@5, Point[{#, \[Theta][#]} & /@ (yDRoots + d)]},
     {Gray, Dashed, Line[{{#, \[Theta][#]}, {#, -100}} & /@ (yDRoots + d)]}
   }];
p2 = Plot[y[t], {t, 0, 5}, Ticks -> {Table[{k, ""}, {k, 1, 5}], {1}}, 
   AxesLabel -> {"t", "y"}, AxesStyle -> Directive[14], 
   AxesOrigin -> {0, 0}, PlotRange -> Full, ImagePadding -> 20,
   Epilog -> {
     {Red, AbsolutePointSize@5, Point[{#, y[#]} & /@ yRoots]},
     {Green, AbsolutePointSize@5, Point[{#, y[#]} & /@ yDRoots]},
     {Gray, Dashed, Line[{{#, 0}, {#, 100}} & /@ yRoots]},
     {Gray, Dashed, Line[{{#, y[#]}, {#, 0}} & /@ yDRoots]}
   }];
p3 = PolarPlot[\[Rho][t], {t, 0, 5}, Ticks -> None, 
   AxesLabel -> {"\[Theta]", "\[Rho]"}, AxesStyle -> Directive[14], 
   AxesOrigin -> {0, 0}, ImagePadding -> 20, 
   PlotRange -> {{-1, 1}, {-1, 1}}*.35,
   Epilog -> {
     {Green, AbsolutePointSize@5, Point[(\[Rho][#]*{Cos[#], Sin[#]}) & /@ yDRoots]},
     {Gray, Dashed, Line[{{0, 0}, \[Rho][#]*{Cos[#], Sin[#]}} & /@ yDRoots]}
     }];

(* define origo points for p1 and p3 (p2 is derived from these) *)
o1 = {.1, .5};
o3 = {.75, .25};
o2 = {First@o1, Last@o3};
Graphics[{
  Inset[p1, ImageScaled@o1, {0, 0}, 1],
  Inset[p2, ImageScaled@o2, {0, 0}, 1],
  Inset[p3, ImageScaled@o3, {0, 0}, 1]
  }, ImageSize -> 500, PlotRange -> All]

enter image description here

Source Link
István Zachar
István Zachar
  • 47.2k
  • 20
  • 145
  • 293

This is just a crude approximation of what you expect using Inset, but it becomes rather complicated to track subplot coordinates when Insetted in a larger Graphics environment.

My method requires the individual plots to be tampered with:

  • give identical ImagePadding values for each subplot;
  • draw grid lines as Epilog primitives (otherwise GridLines would go from edge to edge, crowding the plots);
  • restrict the PlotRange of p3, as it is way too big for the other plots if scaled correctly.

Still I have no idea how to:

  • calculate the scaling factor of p3 programmatically (though the fourth argument of Inset could be used for scaling if the right ratio is known);
  • draw lines over the whole image (i.e. lines connecting points of p1 and p2) using the subplots' own coordinates.

The code:

y[t_] := Sin[Pi t]/(Pi t);
ar = {1.415, 2.495, 3.526, 4.462, 5.421, 6.477};
rr = Join[{0}, Table[t /. FindRoot[D[y[t], t] == 0, {t, ar[[k]]}], {k, 1, Length[ar]}], {7}];
\[Theta][t_] := Piecewise[Table[{ArcTan[y[t]/(t^2 y'[t])] + k Pi, rr[[k]] <= t < rr[[k + 1]]}, {k, 1, Length[rr] - 1}]];
\[Rho][t_] := Sqrt[(y[t])^2 + (t^2 y'[t])^2];

(* a simpler way to calculate roots *)
yRoots = t /. {ToRules@Reduce[{y[t] == 0, 0 < t <= 5}, t]};
yDRoots = t /. {ToRules@N@Reduce[{y'[t] == 0, 0 < t <= 5}, y]};

p1 = Plot[\[Theta][t], {t, 0, 5}, 
   Ticks -> {None, Table[{k Pi, k "\[Pi]"}, {k, 0, 4}]}, 
   AxesLabel -> {"t", "\[Theta]"}, AxesStyle -> Directive[14], 
   AxesOrigin -> {0, 0}, PlotRange -> Full, ImagePadding -> 20,
   Epilog -> {
     {Red, AbsolutePointSize@5, Point@N[Transpose@{yRoots, \[Theta] /@ yRoots}]},
     {Gray, Dashed, Line[{{#, \[Theta]@#}, {#, -100}} & /@ yRoots]}
     }];
p2 = Plot[y[t], {t, 0, 5}, Ticks -> {Table[{k, ""}, {k, 1, 5}], {1}}, 
   AxesLabel -> {"t", "y"}, AxesStyle -> Directive[14], 
   AxesOrigin -> {0, 0}, PlotRange -> Full, ImagePadding -> 20,
   Epilog -> {
     {Red, AbsolutePointSize@5, Point@N[Transpose@{yRoots, y /@ yRoots}]},
     {Green, AbsolutePointSize@5, Point@N[Transpose@{yDRoots, y /@ yDRoots}]},
     {Gray, Dashed, Line[{{#, 0}, {#, 100}} & /@ yRoots]},
     {Gray, Dashed, Line[{{#, y@#}, {#, 0}} & /@ yDRoots]}
     }];
p3 = PolarPlot[\[Rho][t], {t, 0, 5}, Ticks -> None, 
   AxesLabel -> {"\[Theta]", "\[Rho]"}, AxesStyle -> Directive[14], 
   AxesOrigin -> {0, 0}, ImagePadding -> 20, 
   PlotRange -> {{-1, 1}, {-1, 1}}*.35,
   Epilog -> {
     {Green, AbsolutePointSize@5, Point[(\[Rho]@#*{Cos@#, Sin@#}) & /@ yDRoots]},
     {Gray, Dashed, Line[{{0, 0}, \[Rho]@#*{Cos@#, Sin@#}} & /@ yDRoots]}
     }];

(* define origo points for p1 and p3 (p2 is derived from these) *)
o1 = {.1, .6};
o3 = {.8, .25};
o2 = {First@o1, Last@o3};
Graphics[{
  {Inset[p1, ImageScaled@o1, {0, 0}], 
   Inset[p2, ImageScaled@o2, {0, 0}], 
   Inset[p3, ImageScaled@o3, {0, 0}]}
  }, ImageSize -> 500, AspectRatio -> 1]

enter image description here