19
$\begingroup$

I have 3 graphics in different coordinate systems and I want to join them in as in the following figure. Sample Figure
This is just a sample figure, not the real one.

My functions are as follows.

y[t_]=Sin[Pi t]/(Pi t);
ar={1.415,2.495,3.526,4.462,5.421,6.477} (* Aproximate roots of y'[t] *);
rr=Join[{0},Table[t/.FindRoot[D[y[t],t]==0,{t,ar[[k]]}],{k,1,Length[ar]}],{7}] (* Real roots y'[t] *);
θ[t_]=Piecewise[Table[{ArcTan[y[t]/(t^2 y'[t])]+k Pi,rr[[k]]<=t<rr[[k+1]]},{k,1,Length[rr]-1}]] (* Phase function *);
ρ[t_]=Sqrt[(y[t])^2 + (t^2 y'[t])^2] (* Amplitude function*) ;

The first graphic is generated by

p1=Plot[θ[t],{t,0,5},Ticks->{None,Table[{k π,k "π"}, {k,0,4}]},AxesLabel->{"t","θ"},AxesStyle->Directive[14],AxesOrigin->{0,0},PlotRange->Full]

p1

the second graphic is generated by

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]

p2

the third and last one is generated by

p3=PolarPlot[ρ[t],{t,0,5},Ticks->None,AxesLabel->{"θ","ρ"},AxesStyle->Directive[14],AxesOrigin->{0,0}]

p3

Properties of the graphic is as follows.
1. Origins of p1 and p2 must be on the same vertical line, and the origins of p2 and p3 must be on the same horizontal line (as shown on the sample figure).
2. The horizontal lines passing at the points $\pi$, $2\pi$, $3\pi$, $4\pi$ located on the $\theta$-axis of p1 and the vertical lines passing at the zeros of the curve (which are explicitly $1,2,\cdots$ since $y(t)=\sin(\pi t)/(\pi t)=0$ at such points) in p2 must intersect on the curve in p1 (see the sample figure).
3.The list of extreme points of the curve in p2 are listed in rr, i.e., if $t$ is in rr then $y'(t)=0$ and thus $\rho(t)=|y(t)|$. For such points the distance from $t$-axis to the function $y$ in p2 is equal to the length from the Origin to the corresponding peak point of the curve in p3. This requires scaling of p3 so that the lengths are equal.

It would be very good to have them just in the right position, I guess I can draw the lines myself...

Many thanks.
bkarpuz

Edit. After reading Yves Klett's comment decided to show what I have tried. I did everything manually as I don't really understand the command Inset very well.

p1 = Plot[θ[t], {t, 0.7, 4.2}, Ticks -> {None, None}, 
   AxesLabel -> {"\!\(\*
StyleBox[\"t\",\nFontSlant->Italic]\)", "\!\(\*TagBox[
StyleBox[\"θ\",\nFontSize->14,\nFontSlant->Italic],
(StyleForm[#, 14, Italic]& )]\)"}, AxesStyle -> Directive[14], 
   AxesOrigin -> {0, 0}, PlotRange -> {{0, 4.5}, {0, 14}}, 
   AspectRatio -> 1];
p2 = Show[
   Plot[y[t], {t, 0.7, 4.2}, Ticks -> {Table[{k, ""}, {k, 1, 5}], {}},
     AxesLabel -> {"\!\(\*
StyleBox[\"t\",\nFontSlant->Italic]\)", "\!\(\*TagBox[
StyleBox[\"y\",\nFontSize->14,\nFontSlant->Italic],
(StyleForm[#, 14, Italic]& )]\)"}, AxesStyle -> Directive[14], 
    AxesOrigin -> {0, 0}, PlotRange -> {{0, 4.5}, {-2, 2}}, 
    AspectRatio -> 1], 
   ListPlot[Table[{rr[[k]], y[rr[[k]]]}, {k, 2, 4}], Filling -> Axis, 
    PlotStyle -> PointSize[Small]]];
pl = Table[{rr[[k]], ρ[rr[[k]]]}, {k, 2, 4}];
p3 = Show[
   PolarPlot[ρ[t], {t, 0.7, 4.2}, Ticks -> None, 
    AxesLabel -> {"θ", "ρ"}, AxesStyle -> Directive[14], 
    PlotStyle -> PointSize[Tiny], AspectRatio -> 1], 
   Table[ListPolarPlot[{{0, 0}, pl[[k]]}, Joined -> True, 
     PlotStyle -> {PointSize[Tiny], 
       Directive[Hue[0.67, 0.6, 0.6], Opacity[0.2]]}], {k, 1, 
     Length[pl]}], ListPolarPlot[pl]];

The figures are drawn above

Show[Graphics[{Inset[p2, {0, -0.35}, Right, 0.8], 
   Inset[p1, {0, 0.55}, Right, 0.8], 
   Inset[p3, {0.24, -0.415}, Left, 0.6]}, PlotRange -> 1], 
 Graphics[{Dotted, Line[{{-0.6215, -0.41}, {-0.6215, 0.3152}}], 
   Line[{{-0.4634, -0.41}, {-0.4634, 0.4762}}], 
   Line[{{-0.30515, -0.41}, {-0.30515, 0.6326}}]}], 
 Graphics[{Dotted, Line[{{-0.7778, 0.3152}, {-0.6215, 0.3152}}], 
   Line[{{-0.7778, 0.4762}, {-0.4634, 0.4762}}], 
   Line[{{-0.7778, 0.6326}, {-0.30515, 0.6326}}]}], 
 Graphics[{Point[{-0.6215, 0.3152}], Point[{-0.4634, 0.4762}], 
   Point[{-0.30515, 0.6326}]}], 
 Graphics[{Text[StyleForm["π", 14], {-0.8, 0.3152}, {1, 0}], 
   Text[StyleForm["2π", 14], {-0.8, 0.4762}, {1, 0}], 
   Text[StyleForm["3π", 14], {-0.8, 0.6326}, {1, 0}],}]]

I obtained all the points in the last part from the plain figure by Get Coordinates and drew the lines. On the other hand, to fit the Origins of p1 and p2, I drew them with Ticks->None and then put the Ticks manually on the figure obtained by Inset. However, the figure still seems to be inconvenient with p3 as it does not satisfy Property 3 (scaling) mentioned above.

Improve this question
$\endgroup$
9
  • $\begingroup$ To motivate any takers, showing what you already tried might be a good move. You might also want to try and break down your problem into smaller, concise tasks if possible(for me reading all your explications proved too tiresome). $\endgroup$
    – Yves Klett
    Commented Dec 17, 2012 at 15:31
  • $\begingroup$ Thank you very much for your interest Yves Klett but I can not split my problem into smaller pieces since my only problem is to join these 3 different coordinates. $\endgroup$
    – bkarpuz
    Commented Dec 17, 2012 at 15:59
  • $\begingroup$ rr = Join[{0}, Table[t /. FindRoot[D[y[t], t] == 0, {t, ar[[k]]}], {k, 1, Length[ar]}], {7}] (Real roots y'[t]); this line gives many errors. Could you check ? $\endgroup$
    – s.s.o
    Commented Dec 17, 2012 at 16:06
  • $\begingroup$ Oh, s.s.o please replace Sin(Pi t) with Sin[Pi t]. Updated the code in the original post. $\endgroup$
    – bkarpuz
    Commented Dec 17, 2012 at 16:10
  • 2
    $\begingroup$ Probably related: Vertically aligning two separate plots and Aligning plot axes in a graphics object $\endgroup$
    – Yves Klett
    Commented Dec 17, 2012 at 16:44

2 Answers 2

Reset to default
13
$\begingroup$

Here I join 3 figures with lines in a tricky way, where I plot vertical and horizontal lines separately and set them by Inset at appropriate positions in such a way that the lines vanish when they touch the end figures.
Figure~1

y[t_] := Sin[π t]/(π t);
p[t_] = t^2;
a = 0.7;
b = 5.2;
yRoots = t /. {ToRules@Reduce[{y[t] == 0, 0 <= t <= 5}, t]};
yDRoots = t /. {ToRules@N@Reduce[{y'[t] == 0, 0 <= t <= 5}, y]};
ranges = Append[Prepend[yDRoots, 0], 6];
θ[t_] := Piecewise[Table[{ArcTan[y[t]/(p[t] y'[t])] + k Pi, ranges[[k]] < t <= ranges[[k + 1]]}, {k, Length@ranges - 1}]];
ρ[t_] := Sqrt[(y[t])^2 + (p[t] y'[t])^2];
ε = 1/(10^7);
p1 = Plot[θ[t], {t, a, b}, Ticks -> {None, Join[Table[{k Pi, k π}, {k, 0, 5}], Table[{(2 k - 1) Pi/2, (2 k - 1) Pi/2}, {k, 1, 5}]]}, AxesLabel -> {"t", "θ"}, AxesStyle -> Directive[14], AxesOrigin -> {0, 0}, PlotRange -> {{0, 5.3}, {0, 16}}, AspectRatio -> 1, ImagePadding -> 20, 
   Epilog -> {{Red, AbsolutePointSize@5, Point[{#, θ[#]}&/@yRoots]},
     {Blue, AbsolutePointSize@5, Point[{#, θ[#]}&/@(yDRoots + ε)]},
     {Black, AbsolutePointSize@5,Point[{{a, θ[a]}, {b, θ[b]}}]},
     {Gray, Dashed, Line[{{0, θ[#]}, {#, θ[#]}, {#, -100}}&/@yRoots], Line[{{0, θ[#]}, {#, θ[#]}}&/@yRoots]},
     {Gray, Dashed, Line[{{0, θ[#]}, {#, θ[#]}, {#, -100}}&/@(yDRoots+ε)]}}];
p2 = Plot[y[t], {t, a, b}, Ticks -> {Table[{k, ""}, {k, 1, 5}], {{1, ""}}}, AxesLabel -> {"t", "y"}, AxesStyle -> Directive[14], AxesOrigin -> {0, 0}, PlotRange -> {{0, 5.3}, {-0.3, 1}}, AspectRatio -> 1, ImagePadding -> 20, 
   Epilog -> {{Red, AbsolutePointSize@5, Point[{#, y[#]} & /@ yRoots]},
     {Blue, AbsolutePointSize@5, Point[{#, y[#]} & /@ yDRoots]},
     {Black, AbsolutePointSize@5, Point[{{a, y[a]}, {b, y[b]}}]},
     {Gray, Dashed, Line[{{#, 0}, {#, 100}} & /@ yRoots]},
     {Gray, Dashed, Line[{{100, y[#]}, {#, y[#]}, {#, 100}} & /@ yDRoots]}}];
p3 = ParametricPlot[{ρ[t] Cos[θ[t]], ρ[t] Sin[θ[t]]}, {t, a, b}, Ticks -> None, AxesLabel -> None, AxesStyle -> Directive[14], AxesOrigin -> {0, 0}, ImagePadding -> 20, PlotRange -> {{-6, 6}, {-0.3, 1}}, AspectRatio -> 1, 
   Epilog -> {{Red, AbsolutePointSize@5, Point[(ρ[#]*{Cos[θ[#]], Sin[θ[#]]})&/@yRoots]},
     {Blue, AbsolutePointSize@5,Point[(ρ[#]*{Cos[θ[#]], Sin[θ[#]]}) & /@ (yDRoots + ε)]},
     {Black, AbsolutePointSize@5, Point[{ρ[a]*{Cos[θ[a]], Sin[θ[a]]}, ρ[b]*{Cos[θ[b]], Sin[θ[b]]}}]},
     {Gray, Dashed,Line[{({-100, ρ[#]*Sin[θ[#]]}), (ρ[#]*{Cos[θ[#]],Sin[θ[#]]})}&/@(yDRoots + ε)]},
     {Gray, Dotted, Line[{{0, 0}, (ρ[a]*{Cos[θ[a]],Sin[θ[a]]})}]}}];
(* Vertical lines *)
pvl = Plot[2, {t, a, b}, Axes -> None, AxesOrigin -> {0, 0}, PlotRange -> {{0, 5.3}, {-1, 1}}, AspectRatio -> 1,  ImagePadding -> 20, 
   Epilog -> {{Gray, Dashed, Line[{{#, 0.66}, {#, 1}} & /@ yRoots]},
     {Gray, Dashed, Line[{{#, 0.66}, {#, 1}} & /@yDRoots]}}];
(* Horizontal lines *)
phl = Plot[2, {t, a, b}, Axes -> None, AxesOrigin -> {0, 0}, PlotRange -> {{0, 5.3}, {-0.3, 1}}, AspectRatio -> 1, ImagePadding -> 20, 
  Epilog -> {{Gray, Dashed, Line[{{0.03, y[#]}, {0.9, y[#]}} & /@yDRoots]}}];
(* Put the images together *)
Graphics[{Inset[p1, ImageScaled@{.05, 0.52}, {0, 0}, 1], 
  Inset[pvl, ImageScaled@{.05, .31}, {0, 0}, 1], 
  Inset[p2, ImageScaled@{.05, .12}, {0, 0}, 1], 
  Inset[phl, ImageScaled@{.48, .12}, {0, 0}, 1], 
  Inset[p3, ImageScaled@{.77, .12}, {0, 0}, 1]}, ImageSize -> 800, PlotRange -> All]

Using GraphicsGrid this can be done easier as follows by replacing the code under the last comments in the above with the following.

GraphicsGrid[{{p1,Null,Null},{pvl,Null,Null},{p2,phl,p3}},ImageSize->600,Spacings->-66]

Thank you for the interest, and any other solutions are welcome.
bkarpuz

Improve this answer
$\endgroup$
7
$\begingroup$

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);
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]

enter image description here

Improve this answer
$\endgroup$
2
  • $\begingroup$ First of all, thank you very much for the effort István Zachar. I tried to add the same green points and corresponding grey lines for p1 but it seems that there is a problem in the definition of the function $\theta$. How it can be fixed? $\endgroup$
    – bkarpuz
    Commented Dec 18, 2012 at 12:06
  • $\begingroup$ @bkarpuz Yes, you have to add a small number to each y' root so that the appropriate line appears in the correct interval. Please see edit. $\endgroup$
    – István Zachar
    Commented Dec 18, 2012 at 13:23

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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