6
$\begingroup$

Is it possible to plot that kind of graph in Mathematica? (picture attached) Would be nice to have something like this

If yes, it can be used to visualise a simple "balance system" of the form: X = f[e]; x = g[r]; X = -x.

Usually we have two separate plots, but it would be nice to combine them as shown above. Let's deal with linear functions for simplicity. With some abuse of conventions:

X[ϵ_] := 1 - 0.5 ϵ    
x[r_] := -0.5 + 0.5 r    

Then:

plotX = Plot[X[ϵ], {ϵ, -1, 1}, PlotRange -> {-1, 3}, ImagePadding -> 25]    
plotx = Plot[x[r], {r, -1, 1}, PlotRange -> {-1, 3}, ImagePadding -> 25, PlotStyle -> Red]     

I have found several solutions how to combine them on the site, but they seem to solve "problems" separately. Overlay seemed simplest. But that is still far from satisfaction.

Overlay[{plotX, plotx}]    

The tricky (for me) things about the plot are:

  1. horizontal axis is common but reverted for a down-looking plot.
  2. down-looking axis (r) is supposed to grow down (or reversed ticks, at least).
  3. magnitudes of variables ϵ and r are different,
  4. labels as reflected are also required.
$\endgroup$
  • $\begingroup$ Welcome to Mathematica.SE! I suggest the following: 1) As you receive help, try to give it too, by answering questions in your area of expertise. 2) Read the faq! 3) When you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge. Also, please remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign! $\endgroup$ – user9660 Jan 9 '15 at 9:33
  • $\begingroup$ Perhaps, there could be 2 alternatives. 1) Play with Axes properties, but I’ve failed to manage them on positive and negative part independently (Reverse directions, switch on / off). 2) Combine 2 graphs with a Grid :that and that like), but with the down plot reversed. Any suggestion, @Öskå ? $\endgroup$ – garej Jan 9 '15 at 13:42
  • $\begingroup$ @garej I'm sorry I was a bit too hasty indeed, you can't play with left/right (or top/bottom) axes independently indeed. $\endgroup$ – Öskå Jan 9 '15 at 13:45
  • $\begingroup$ Anyway, @Öskå, thank you for your helpful editing and remarks! $\endgroup$ – garej Jan 9 '15 at 13:51
  • $\begingroup$ Is it normal that you have no ticks on your plot? $\endgroup$ – Öskå Jan 9 '15 at 14:53
5
$\begingroup$

Here is a version that takes as a reference a Plot of the two functions. It will only work if the x-range and the y-range are of the same magnitude. If not the placement of the axes labels will be screwed.

(* Plot the original function *)
X[ϵ_] := 1 - 0.5 ϵ
x[r_] := -0.5 + 0.5 r
p = Plot[{X[r], x[r]}, {r, -1, 1}];
(* Get the attributes of the plot p *)
pl = Cases[p, Line[x_] :> x, Infinity];
pc = Cases[p, _?ColorQ, Infinity][[;; -2]];
pr = PlotRange /. Quiet@AbsoluteOptions[p, PlotRange];
pat = First@Cases[p, AbsoluteThickness[x_] :> x, Infinity];
axeso = AxesOrigin /. Quiet@AbsoluteOptions[p, AxesOrigin];
axes = Flatten[{Thread@{Array[axeso &, {2}], Thread@{First@pr, axeso}}, 
                Thread@{Array[axeso &, {2}], Thread@{axeso, Last@pr}}}, 1];
(* labels *)
labelxplus = {"-X", "+X"}; labelxminus = {"-(-X)", "+(-X)"};
labelyplus = {"r", "ε"}; labelyminus = {"-r", "-ε"};
labels = {labelxminus, labelyminus, labelxplus, labelyplus};
disp = #[Rescale[#@axeso, #@pr] & /@ {Last, First}, .05] & /@ {Subtract, Plus};
tips = {1 - 0.925, .925};
(* rebuild the plot *)
postlabels = {{#, First@First@disp } & /@ tips, {Last@First@disp , #} & /@ tips, 
              {#, First@Last@disp } & /@ tips, {Last@Last@disp, # } & /@ tips};
Graphics[{
  Thread@{{Red, Blue, Red, Blue}, Arrow /@ axes}, 
  Thread@{pc, AbsoluteThickness@pat, Line /@ pl},
  Text[#1, #2] & @@@ Thread@{Flatten@labels, Scaled /@ Flatten[postlabels, 1]}
  },
 Frame -> True, AspectRatio -> 1/GoldenRatio]

Mathematica graphics

Now with p = Plot[{x, x/2, Sin@x}, {x, -10, 10}];:

Mathematica graphics

As mentioned in the beginning, if the axes ranges are not of the same magnitude, the labels might overlap or get out of the frame. For example with p = Plot[{x, x^2}, {x, -100, 100}];:

Mathematica graphics

$\endgroup$
3
$\begingroup$
Xf[ϵ_] := 1 - 0.5 ϵ
xf[r_] := -.5 + 0.5 r;

blueaxis = {Directive[Blue, Thick, Arrowheads[{0, .05}]], Arrow @@ # &};
redaxis = {Directive[Red, Thick, Arrowheads[{-.05, 0}]], Arrow @@ # &};
txtF = Text[Style[#, 20, Italic], #2] &;
axeslabels = txtF @@@ Transpose[{{"ε", "r", "+X", "-X", "-(-X)", 
      "+(-X)"}, {{.1, 2.7}, {-.1, -.7}, {.8, .3}, {-.8, .3}, {.8, -.3}, {-.8, -.3}}}];

ParametricPlot[{{0, 3 ConditionalExpression[x, x >= 0]}, {0,  ConditionalExpression[x, x < 0]}, 
   {ConditionalExpression[x, x >= 0], 0}, { ConditionalExpression[x, x < 0], 0}, 
   {x, Xf[x]}, {x, xf[x]}}, {x, -1, 1}, 
 PlotRange -> {{-1, 1}, {-3, 3}}, Axes -> False, 
 PlotStyle -> {blueaxis, redaxis, blueaxis, redaxis, Orange, Purple}, 
 Epilog -> {axeslabels}, AspectRatio -> 1/GoldenRatio, ImageSize -> 500]

enter image description here

Update: Post-processing an input plot to the add colored axes and axes labels:

axesF = With[{pr = PlotRange[#]}, With[{labels = txtF @@@ 
        Transpose[{#2, {{.1, .9 pr[[2, 2]]}, {-.1, .9 pr[[2, 1]]}, 
                  {.8 pr[[1, 2]], .3}, {.8 pr[[1, 1]], .3}, {.8 pr[[1, 2]], -.3}, 
                  {.8 pr[[1, 1]], -.3}}}]},
     FullGraphics@ ParametricPlot[{{0, pr[[2, 2]] ConditionalExpression[x, 0 <= x]},
        {0, Abs@pr[[2, 1]] ConditionalExpression[x, x < 0]},
        {pr[[1, 2]] ConditionalExpression[x, 0 <= x], 0},
        { Abs@pr[[1, 1]] ConditionalExpression[x, x < 0], 0}},
       {x, pr[[1, 1]], pr[[1, 2]]}, PlotRange -> pr, Axes -> False,
       PlotStyle -> {blueaxis, redaxis, blueaxis, redaxis},
       Epilog -> {labels}, AspectRatio -> 1/GoldenRatio]]] &;


plt1 = Plot[{Xf[x], xf[x]}, {x, -1, 1}, Axes -> False, Frame -> True, 
  PlotRange -> {{-1, 1}, {-3, 3}}, AspectRatio -> 1/GoldenRatio, ImageSize -> 500];

Show[plt1, axesF[plt1, {"ε", "r", "+X", "-X", "-(-X)", "+(-X)"}]]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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