Re: Drawing a Line From One Plot to Another
- To: mathgroup at smc.vnet.net
- Subject: [mg127878] Re: Drawing a Line From One Plot to Another
- From: "Alexander Elkins" <alexander_elkins at hotmail.com>
- Date: Wed, 29 Aug 2012 01:13:25 -0400 (EDT)
- Delivered-to: l-mathgroup@mail-archive0.wolfram.com
- Delivered-to: l-mathgroup@wolfram.com
- Delivered-to: mathgroup-newout@smc.vnet.net
- Delivered-to: mathgroup-newsend@smc.vnet.net
- References: <k0d4b9$m8b$1@smc.vnet.net>
The uGraphicsDecorations function defined below converts the Frame,
Axes and *Ticks Options output by Plot into graphics.
uGraphicsDecorations @@ Plot[...] produces a better and faster result
than can be obtained by FullGraphics[Plot[...]][[1]].
Example usage (a line connects the two plots and remains connected as
their positions and rotations are changed):
Block[{g1, g2, mv1, mv2},
Manipulate[mv1 = {RotationMatrix[t1], pts[[1]]};
mv2 = {RotationMatrix[t2], pts[[2]]};
Graphics[{GeometricTransformation[g1, mv1],
GeometricTransformation[g2, mv2], Red, PointSize[Medium],
Point[AffineTransform[mv1]@{2, 4}], Green,
Point[AffineTransform[mv2]@{2, 4}], Orange,
Line[{AffineTransform[mv1]@{2, 4}, AffineTransform[mv2]@{2, 4}}]},
AspectRatio -> Full, PlotRange -> {{-7, 7}, {-10, 17}}]
, {{t1, 0 , "Angle 1"}, -Pi, Pi}, {{t2, 0 , "Angle 2"}, -Pi,
Pi}, {{pts, {{-2, 6}, {3, -5}}}, Locator},
Initialization :> (g1 = uGraphicsDecorations @@ Plot[x^2, {x, -1, 3}];
g2 = uGraphicsDecorations @@ Plot[2 x, {x, -1, 3}])]]
Please note:
* Styling is not implemented in this example.
* It not fully tested -- the full behavior is not implemented.
* The PlotRange option is supplied in the output of plot.
* The ImagePadding option may be needed for the container to
display tick mark labels which lie outside of the
PlotRange with PlotRangePadding area.
* Only None and Automatic are supported for GridLines,
FrameTicks and Ticks which means this example does
not support *Log*Plot.
uGraphicsDecorations[g_,
o : OptionsPattern[{
AspectRatio -> Automatic,(*Ignored*)
Axes -> False,
AxesOrigin -> {0, 0},
CoordinatesToolOptions -> {},(*Not supported*)
GridLines -> None,
Frame -> False,
FrameTicks -> None,
Method -> Null,(*Not supported*)
PlotRange -> {{-1, 1}, {-1, 1}},
PlotRangeClipping -> False,(*Not supported*)
PlotRangePadding -> Scaled[0.02],
Ticks -> None}]] :=
Block[{pr, dpr, prp, ao, ur, fd, fdlh, fdth, fdlv, fdtv, tm, drawAxes, axes,
drawTicks, tickMarks, gcdh, ndh, nfh, gcdv, ndv, nfv, tickMarkLabels,
drawFrame, drawGridLines, gridLines, frame, drawFrameTicks,
frameTickMarks, frameTickMarkLabels},
uGraphicsDecorations::unsupported =
"The option setting `1` is not supported.";
If[Length[#] != 0,
Message[uGraphicsDecorations::unsupported,
StringReplace[ToString[#], "#1" -> "#"]]] &[
FilterRules[{o}, #]] & /@ {CoordinatesToolOptions, Method};
(*If[OptionValue[PlotRangeClipping]=!=False,Message[
uGraphicsDecorations::unsupported,ToString[FilterRules[{o},
PlotRangeClipping]]]];
Print[o];*)
pr = OptionValue[PlotRange];
dpr = Subtract @@ Reverse@Transpose@pr;
prp = OptionValue[PlotRangePadding];
If[Head[prp] =!= List, prp = {{prp, prp}, {prp, prp}},
If[Head[prp[[1]]] =!= List, prp[[1]] = {prp[[1]], prp[[1]]}];
If[Head[prp[[2]]] =!= List, prp[[2]] = {prp[[2]], prp[[2]]}]];
pr += {{-If[Head[prp[[1, 1]]] =!= Scaled, prp[[1, 1]],
prp[[1, 1, 1]]*dpr[[1]]],
If[Head[prp[[1, 2]]] =!= Scaled, prp[[1, 2]],
prp[[1, 2, 1]]*dpr[[1]]]}, {-If[Head[prp[[2, 1]]] =!= Scaled,
prp[[2, 1]], prp[[2, 1, 1]]*dpr[[2]]],
If[Head[prp[[2, 2]]] =!= Scaled, prp[[2, 2]], prp[[2, 2, 1]]*dpr[[2]]]}};
ao = OptionValue[AxesOrigin];
ur[r_Rational] := N[r];
ur[r_Integer] := r;
ur[r_Real] := r;
drawAxes = OptionValue[Axes];
If[Head[drawAxes] == Symbol, drawAxes = {drawAxes, drawAxes}];
axes = If[Or @@ drawAxes, {#, Line @@ #2} & @@ Reap[
If[drawAxes[[1]], Sow[{{pr[[1, 1]], ao[[2]]}, {pr[[1, 2]], ao[[2]]}}]];
If[drawAxes[[2]], Sow[{{ao[[1]], pr[[2, 1]]}, {ao[[1]], pr[[2, 2]]}}]];
Directive[Antialiasing -> False]]];
fd = Function[{r, n},
Select[FindDivisions[r, n], LessEqual @@ Riffle[r, #] &]];
fdlh = fd[pr[[1]], 7];
fdth = Complement[fd[pr[[1]], 30], fdlh];
fdlv = fd[pr[[2]], 7];
fdtv = Complement[fd[pr[[2]], 30], fdlv];
tm = Function[{pt, d}, {ur /@ pt, Offset[d, ur /@ pt]}];
drawTicks = OptionValue[Ticks];
If[Or @@ drawAxes && Length[FilterRules[{o}, Ticks]] == 0,
drawTicks = Automatic];
If[Head[drawTicks] == Symbol, drawTicks = {drawTicks, drawTicks}];
tickMarks = If[drawTicks =!= {None, None},
{#, Line@Flatten[#2, 2]} & @@ Reap[
If[drawTicks[[1]] =!= None,
Sow[tm[{ao[[1]], #}, {4, 0}] & /@ fdlv];
Sow[tm[{ao[[1]], #}, {2, 0}] & /@ fdtv]];
If[drawTicks[[2]] =!= None,
Sow[tm[{#, ao[[2]]}, {0, 4}] & /@ fdlh];
Sow[tm[{#, ao[[2]]}, {0, 2}] & /@ fdth]];
Directive[Antialiasing -> False]]];
gcdh = GCD @@ fdlh;
If[Denominator[gcdh] > 1, ndh = Length[#1] - #2 & @@ RealDigits[gcdh];
nfh[h_] := ToString[NumberForm[N@h, {Infinity, ndh}]],
nfh[ h_] := ToString[h]];
gcdv = GCD @@ fdlv;
If[Denominator[gcdv] > 1, ndv = Length[#1] - #2 & @@ RealDigits[gcdv];
nfv[v_] := ToString[NumberForm[N@v, {Infinity, ndv}]],
nfv[v_] := ToString[v]];
tickMarkLabels =
If[drawTicks =!= {None, None}, Reap[
If[drawTicks[[1]] =!= None,
Sow[
Text[nfv[#], Offset[{-3, 0}, ur /@ {ao[[1]], #}], {1, 0}] & /@
Complement[fdlv, {ao[[2]]}]]];
If[drawTicks[[2]] =!= None,
Sow[
Text[nfh[#], Offset[{0, -3}, ur /@ {#, ao[[2]]}], {0, 1}] & /@
Complement[fdlh, {ao[[1]]}]]];]];
(*GridLines*)
drawGridLines = OptionValue[GridLines];
If[Head[drawGridLines] == Symbol,
drawGridLines = {drawGridLines, drawGridLines}];
gridLines = If[drawGridLines =!= {None, None}, {#, Line @@ #2} & @@ Reap[
If[drawGridLines[[1]] =!= None,
Sow[{{pr[[1, 1]], #}, {pr[[1, 2]], #}}] & /@ fdlv];
If[drawGridLines[[2]] =!= None,
Sow[{{#, pr[[2, 1]]}, {#, pr[[2, 2]]}}] & /@ fdlh];
Directive[Antialiasing -> False]]];
(*Frame*)
drawFrame = OptionValue[Frame];
If[Head[drawFrame] =!= List,
drawFrame = {{drawFrame, drawFrame}, {drawFrame, drawFrame}},
If[Head[drawFrame[[1]]] =!= List,
drawFrame[[1]] = {drawFrame[[1]], drawFrame[[1]]}];
If[Head[drawFrame[[2]]] =!= List,
drawFrame[[2]] = {drawFrame[[2]], drawFrame[[2]]}]];
frame = If[Or @@ Flatten@drawFrame,
tickMarks = {};
tickMarkLabels = {};
{#, Line @@ #2} & @@ Reap[
If[drawFrame[[1, 1]],
Sow[{{pr[[1, 1]], pr[[2, 1]]}, {pr[[1, 1]], pr[[2, 2]]}}]];
If[drawFrame[[1, 2]],
Sow[{{pr[[1, 2]], pr[[2, 1]]}, {pr[[1, 2]], pr[[2, 2]]}}]];
If[drawFrame[[2, 1]],
Sow[{{pr[[1, 1]], pr[[2, 1]]}, {pr[[1, 2]], pr[[2, 1]]}}]];
If[drawFrame[[2, 2]],
Sow[{{pr[[1, 1]], pr[[2, 2]]}, {pr[[1, 2]], pr[[2, 2]]}}]];
Directive[Antialiasing -> False]]];
drawFrameTicks = OptionValue[FrameTicks];
If[Or @@ Flatten@drawFrame && Length[FilterRules[{o}, FrameTicks]] == 0,
drawFrameTicks = Automatic];
If[Head[drawFrameTicks] =!= List,
drawFrameTicks = {{drawFrameTicks, drawFrameTicks}, {drawFrameTicks,
drawFrameTicks}},
If[Head[drawFrameTicks[[1]]] =!= List,
drawFrameTicks[[1]] = {drawFrameTicks[[1]], drawFrameTicks[[1]]}];
If[Head[drawFrameTicks[[2]]] =!= List,
drawFrameTicks[[2]] = {drawFrameTicks[[2]], drawFrameTicks[[2]]}]];
frameTickMarks = If[drawFrameTicks =!= {{None, None}, {None, None}},
{#, Line@Flatten[#2, 2]} & @@ Reap[
If[drawFrameTicks[[1, 1]] =!= None,
Sow[tm[{pr[[1, 1]], #}, {4, 0}] & /@ fdlv];
Sow[tm[{pr[[1, 1]], #}, {2, 0}] & /@ fdtv]];
If[drawFrameTicks[[1, 2]] =!= None,
Sow[tm[{pr[[1, 2]], #}, {-4, 0}] & /@ fdlv];
Sow[tm[{pr[[1, 2]], #}, {-2, 0}] & /@ fdtv]];
If[drawFrameTicks[[2, 1]] =!= None,
Sow[tm[{#, pr[[2, 1]]}, {0, 4}] & /@ fdlh];
Sow[tm[{#, pr[[2, 1]]}, {0, 2}] & /@ fdth]];
If[drawFrameTicks[[2, 2]] =!= None,
Sow[tm[{#, pr[[2, 2]]}, {0, -4}] & /@ fdlh];
Sow[tm[{#, pr[[2, 2]]}, {0, -2}] & /@ fdth]];
Directive[Antialiasing -> False]]];
frameTickMarkLabels =
If[drawFrameTicks =!= {{None, None}, {None, None}}, Reap[
If[drawFrameTicks[[1, 1]] =!= None,
Sow[
Text[nfv[#], Offset[{-3, 0}, ur /@ {pr[[1, 1]], #}], {1, 0}] & /@
fdlv]];
If[drawFrameTicks[[1, 2]] =!= None,
Sow[
Text[nfv[#], Offset[{3, 0}, ur /@ {pr[[1, 2]], #}], {-1, 0}] & /@
fdlv]];
If[drawFrameTicks[[2, 1]] =!= None,
Sow[
Text[nfh[#], Offset[{0, -3}, ur /@ {#, pr[[2, 1]]}], {0, 1}] & /@
fdlh]];
If[drawFrameTicks[[2, 2]] =!= None,
Sow[
Text[nfh[#], Offset[{0, 3}, ur /@ {#, pr[[2, 2]]}], {0, -1}] & /@
fdlh]];
]];
{g, axes, gridLines, tickMarks, tickMarkLabels, frame, frameTickMarks,
frameTickMarkLabels}
];
"Gregory Lypny" <gregory.lypny at videotron.ca> wrote in message
news:k0d4b9$m8b$1 at smc.vnet.net...
> Hello everyone,
>
> Say I have two plots, y=x^2 and y=2x, aligned vertically using
GraphicsColumn. Their domains are aligned because x runs from -3 to +3 in
both. I'd like to be able to draw a line from a point in the top graph to a
point in the bottom graph. How can I do that?
>
> Regards,
>
> Gregory
>