1
$\begingroup$

I have 3 plots: P1, P2 and P3. I would like to create a figure with

  1. plot P2, of domain and codomain $[0,\frac12]\times [0,1]$, in the 1st quadrant;
  2. plot P1 in the 2nd quadrant, with P1's abscissa $[0,1]$ coincident with P2's y-axis $[0,1]$;
  3. an inverted (upside down) P3 plot in the 4th quadrant, with P3's abscissa $[0,\frac12]$ coincident with P1's abscissa $[0,\frac12]$.

I have drawn a crude representation here: target plot composition

I have seen this post about rotating a plot, but I am not sure how to merge with subsequent ones.

MWE to define P1, P2, P3:

(*Probability p(pi2;t), as function of (pi2,t)*) p2[pi2_, t_] := pi2 (1 - Exp[-1/(1 - 2 pi2)*t]); (*Define a function so that, given p_est(t) and (t), finds the \ corresponding Pi2 (near Pi0)*) findPi2[p_, t_, pi0_] := FindRoot[p2[pi2, t] == p, {pi2, pi0}]; (*Define the initial guess for Pi2*) pi0 = 0.45; n = 10; pList = Range[0, n]/n; (*True Parameter*)piR = 0.25; t = 0.707; pat = p2[piR, t]; probList = Table[PDF[BinomialDistribution[n, pat], j], {j, 0, n}]; piList = Quiet[ Table[findPi2[j, t, pi0], {j, pList}]] /. {pi2 -> x_} :> x; points = Transpose[{piList, probList}]; (* (x_j,y_j)=(pi_est_j,prob_j) *) point = Transpose[{pList, probList}]; (* (x_j,y_j)=(p_est_j,prob_j) *) t1 = 5; pat1 = p2[piR, t1]; probList1 = Table[PDF[BinomialDistribution[n, pat1], j], {j, 0, n}]; piList1 = Quiet[Table[findPi2[j, t1, pi0], {j, pList}]] /. {pi2 -> x_} :> x; points1 = Transpose[{piList1, probList1}]; point1 = Transpose[{pList, probList1}]; P1 = ListPlot[{point, point1}, PlotStyle -> {PointSize[Medium]}, AxesLabel -> {"p_est", "prob"}, PlotMarkers -> Automatic, PlotRange -> {{0, 1}, {0, 1.05*Max[points[[All, 2]]]}}, PlotRangePadding -> 0.01, Joined -> False, Epilog -> {{RGBColor[0.368417, 0.506779, 0.709798], Dashed, Line[{{pat, 0}, {pat, 1.05*Max[points[[All, 2]]]}}]}, {RGBColor[ 0.880722, 0.611041, 0.142051], Dashed, Line[{{pat1, 0}, {pat1, 1.05*Max[points1[[All, 2]]]}}]}}] P3 = ListPlot[{points, points1}, PlotStyle -> {PointSize[Medium]}, AxesLabel -> {"\[Pi]_est", "prob"}, PlotMarkers -> Automatic, PlotRange -> {{0, 0.5}, {0, 1.05*Max[points[[All, 2]]]}}, PlotRangePadding -> 0.01, Joined -> False, GridLines -> {{piR}, None}, GridLinesStyle -> Directive[AbsoluteThickness[0.75], Gray, Dashed]] P2 = Plot[Evaluate@Table[p2[pi2, tt], {tt, {0.707, 5}}], {pi2, 0, .5}, PlotRange -> {0, 1}, PlotRangeClipping -> False, BaseStyle -> {FontFamily -> "Times", FontSize -> 14}, PlotLegends -> Placed[LineLegend[{.707, 5}, LegendLabel -> Style["t", 14]], {.85, .85}], PlotStyle -> {Directive[Thick, Dashed], Directive[Thick, DotDashed]}, LabelStyle -> {Black}, GridLines -> {{piR}, None}, GridLinesStyle -> Directive[AbsoluteThickness[0.75], Gray, Dashed]]
Improve this question
$\endgroup$
3
  • $\begingroup$ I am available to break this task in smaller parts... e.g. start with a question for items 1. and 2., then a subsequent question for item 3. Please let me know. $\endgroup$ Commented Mar 27 at 18:47
  • $\begingroup$ I have already planned a subsequent question to connect points in the 3 plots with dashed lines, if I fail to automate such task. $\endgroup$ Commented Mar 27 at 18:48
  • $\begingroup$ You can probably do that with MA, but I think it is not the best tool for that. $\endgroup$ Commented Mar 28 at 21:38

2 Answers 2

Reset to default
3
$\begingroup$

You simply need to invert the y axis in plot P3. And to display the plots, you may use "GraphicsGrid":

P3 = ListPlot[{# {1, -1} & /@ points, # {1, -1} & /@ points1}, PlotStyle -> {PointSize[Medium]}, AxesLabel -> {"\[Pi]_est", "prob"}, PlotMarkers -> Automatic, PlotRange -> {{0, 0.5}, {0, -1.05*Max[points[[All, 2]]]}}, PlotRangePadding -> 0.01, Joined -> False, Epilog -> {Gray, Dashed, Line[{{piR, 0}, {piR, 1.05*Max[points[[All, 2]]]}}]}]; GraphicsGrid[{{P1, P2}, {, P3}}]

enter image description here

Improve this answer
$\endgroup$
3
  • $\begingroup$ +1. Thanks for the answer. I'm sorry if I wasn't clear. I would like to merge the x-axis of P1 and P3 with the axes of P2. $\endgroup$ Commented Mar 28 at 11:16
  • $\begingroup$ In the copy-pasting to create an MWE I messed up plot P1, please note the correct X-Range and X-Axis label, which may have obscured my original intent. $\endgroup$ Commented Mar 28 at 11:17
  • $\begingroup$ To invert the y-axis of P3, I ended up using ScalingFunctions and "Reverse, which keep the positive sign. Thanks again for the time and effort. $\endgroup$ Commented Mar 28 at 17:34
2
$\begingroup$

ResourceFunction PlotGrid does the trick! Thanks.

  1. Draw each Plot separately.
  2. Ensure matching Axes.
  3. Use Frame->True on each separate Plot.
  4. Join the Plots with ResourceFunction["PlotGrid"][{{P1, P2}, {, P3}}]
  5. Decorate to taste.

The following Graphic:

P1 P2 P3 in GridPlot

Is produced with the code:

$Version "13.0.1 for Microsoft Windows (64-bit) (January 28, 2022)" (*My functions*) p2[pi2_, t_] := pi2 (1 - Exp[-1/(1 - 2 pi2)*t]); findPi2[p_, t_, pi0_] := FindRoot[p2[pi2, t] == p, {pi2, pi0}]; (*Initial guess for Pi2*) pi0 = 0.45; (*My data*) n = 10; pList = Range[0, n]/n; (*True Parameter*)piR = 0.25; t = 0.707; pat = p2[piR, t]; probList = Table[PDF[BinomialDistribution[n, pat], j], {j, 0, n}]; piList = Quiet[ Table[findPi2[j, t, pi0], {j, pList}]] /. {pi2 -> x_} :> x; points = Transpose[{piList, probList}]; (* (x_j,y_j)=(pi_est_j,prob_j) *) point = Transpose[{pList, probList}]; (* (x_j,y_j)=(p_est_j,prob_j) *) t1 = 5; pat1 = p2[piR, t1]; probList1 = Table[PDF[BinomialDistribution[n, pat1], j], {j, 0, n}]; piList1 = Quiet[Table[findPi2[j, t1, pi0], {j, pList}]] /. {pi2 -> x_} :> x; points1 = Transpose[{piList1, probList1}]; point1 = Transpose[{pList, probList1}]; rotatedPoint = point /. {x_, y_} :> {y, x}; rotatedPoint1 = point1 /. {x_, y_} :> {y, x}; (*My plots*) P1Rotated = ListPlot[{rotatedPoint, rotatedPoint1}, PlotStyle -> {PointSize[Medium]}, PlotMarkers -> Automatic, PlotRange -> {{0, 1.05*Max[points[[All, 2]]]}, {0, 1}}, PlotRangeClipping -> False, ScalingFunctions -> {"Reverse", Identity}, Joined -> False, Frame -> True, PlotRangeClipping -> False, Joined -> False, Frame -> True, AspectRatio -> 3, Epilog -> {{RGBColor[0.368417, 0.506779, 0.709798], Dashed, Line[{{-1.05*Max[points[[All, 2]]], pat}, {0, pat}}]}, {RGBColor[ 0.880722, 0.611041, 0.142051], Dashed, Line[{{-1.05*Max[points1[[All, 2]]], pat1}, {0, pat1}}]}}]; P3Inv = ListPlot[{points, points1}, PlotStyle -> {PointSize[Medium]}, PlotMarkers -> Automatic, PlotRange -> {{0, 0.5}, {0, 1.05*Max[points[[All, 2]]]}}, PlotRangeClipping -> False, ScalingFunctions -> {Identity, "Reverse"}, Joined -> False, Frame -> True, AspectRatio -> 1/3, GridLines -> {{piR}, None}, GridLinesStyle -> Directive[AbsoluteThickness[0.75], Gray, Dashed]]; P2 = Plot[Evaluate@Table[p2[pi2, tt], {tt, {0.707, 5}}], {pi2, 0, .5}, PlotRange -> {0, 1}, PlotRangeClipping -> True, BaseStyle -> {FontFamily -> "Times", FontSize -> 12, Gray}, PlotLegends -> Placed[LineLegend[{.707, 5}, LegendLabel -> Style["t", 14]], {.75, .75}], PlotStyle -> {Directive[Thick, Dashed], Directive[Thick, DotDashed]}, Frame -> True, FrameTicks -> {{None, All}, {Automatic, All}}, GridLines -> {{piR}, None}, GridLinesStyle -> Directive[AbsoluteThickness[0.75], Gray, Dashed], AspectRatio -> 1, Epilog -> {{RGBColor[0.368417, 0.506779, 0.709798], Dashed, Line[{{0, pat}, {piR, pat}}]}, {RGBColor[0.880722, 0.611041, 0.142051], Dashed, Line[{{0, pat1}, {piR, pat1}}]}}] (*Creat a Grid of Plots with shared Frame Ticks*) ResourceFunction["PlotGrid"][ {{Frame[P1Rotated], Frame[P2, AspectRatio -> 1]}, {, Frame[P3Inv, AspectRatio -> 1/3]}}, FrameLabel -> {{"p_est", "p_est"}, {"\[Pi]_est", "\[Pi]_est"}}, LabelStyle -> Directive[Bold, 14]]
Improve this answer
$\endgroup$
2
  • 1
    $\begingroup$ FYI, PlotGrid can automatically ensure that the plot ranges are equal using the PlotRange option, e.g. PlotRange->Max. $\endgroup$ Commented Mar 28 at 22:50
  • $\begingroup$ Thanks for the info, and for the function. $\endgroup$ Commented Mar 28 at 23:33

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.