Skip to main content

plotting - Combining 3 graphics of different coordinate systems


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ρ[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.



Answer



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


Comments

Post a Comment

Popular posts from this blog

plotting - How to draw lines between specified dots on ListPlot?

I would like to create a plot where I have unconnected dots and some connected. So far, I have figured out how to draw the dots. My code is the following: ListPlot[{{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4,13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full] I have thought using ListLinePlot command, but I don't know how to specify to the command to draw only selected lines between the dots. Do have any suggestions/hints on how to do that? Thank you. Answer One possibility would be to use Epilog with Line : ListPlot[ {{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4, 13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full, Epilog -> { Line[ ...
Post a Comment
Read more

equation solving - Invert and fit implicitly defined curve

I need to fit an implicitly defined curve. I thought I could get some data out of Solve , and then using FindFit . Therefore, I would like to find the relation the parametric curve defined by $F(x,y)=0$: Solve[-(1/2) + 1/2 (0.41202 BesselK[0, 0.1 Sqrt[x^2 + y^2]] + (0.101483 x BesselK[1, 0.1 Sqrt[x^2 + y^2]])/Sqrt[x^2 + y^2]) == 0, y] But I can't get an output: Solve was unable to solve the system with inexact coefficients or the system obtained by direct rationalization of inexact numbers present in the system. Since many of the methods used by Solve require exact input, providing Solve with an exact version of the system may help. >> Edit: In particular, I would like to fit the data coming from the curve with the expression of another curve, and not with a function $f(x)$. In particular, since this clearly looks like a cardioid , I would like it to fit to something like it. What other strategies could I try?
Post a Comment
Read more

dynamic - How can I make a clickable ArrayPlot that returns input?

I would like to create a dynamic ArrayPlot so that the rectangles, when clicked, provide the input. Can I use ArrayPlot for this? Or is there something else I should have to use? Answer ArrayPlot is much more than just a simple array like Grid : it represents a ranged 2D dataset, and its visualization can be finetuned by options like DataReversed and DataRange . These features make it quite complicated to reproduce the same layout and order with Grid . Here I offer AnnotatedArrayPlot which comes in handy when your dataset is more than just a flat 2D array. The dynamic interface allows highlighting individual cells and possibly interacting with them. AnnotatedArrayPlot works the same way as ArrayPlot and accepts the same options plus Enabled , HighlightCoordinates , HighlightStyle and HighlightElementFunction . data = {{Missing["HasSomeMoreData"], GrayLevel[ 1], {RGBColor[0, 1, 1], RGBColor[0, 0, 1], GrayLevel[1]}, RGBColor[0, 1, 0]}, {GrayLevel[0], GrayLevel...
Post a Comment
Read more