How to make a 2D plot of 3 variables (sample picture attached)

Is it possible to plot that kind of graph in Mathematica? (picture attached) 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.
• 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! – user9660 Jan 9 '15 at 9:33
• 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å ? – garej Jan 9 '15 at 13:42
• @garej I'm sorry I was a bit too hasty indeed, you can't play with left/right (or top/bottom) axes independently indeed. – Öskå Jan 9 '15 at 13:45
• Anyway, @Öskå, thank you for your helpful editing and remarks! – garej Jan 9 '15 at 13:51
• Is it normal that you have no ticks on your plot? – Öskå Jan 9 '15 at 14:53

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];
(* 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},
Text[#1, #2] & @@@ Thread@{Flatten@labels, Scaled /@ Flatten[postlabels, 1]}
},
Frame -> True, AspectRatio -> 1/GoldenRatio] Now with p = Plot[{x, x/2, Sin@x}, {x, -10, 10}];: 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}];: 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] 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)"}]] 