RE: Stretching X-Axis in Plot[]
- To: mathgroup at smc.vnet.net
- Subject: [mg45838] RE: [mg45799] Stretching X-Axis in Plot[]
- From: "Wolf, Hartmut" <Hartmut.Wolf at t-systems.com>
- Date: Tue, 27 Jan 2004 04:50:31 -0500 (EST)
- Sender: owner-wri-mathgroup at wolfram.com
>-----Original Message----- >From: Harold.Noffke at wpafb.af.mil [mailto:Harold.Noffke at wpafb.af.mil] To: mathgroup at smc.vnet.net >Sent: Sunday, January 25, 2004 9:05 AM >To: mathgroup at smc.vnet.net >Subject: [mg45838] [mg45799] Stretching X-Axis in Plot[] > > >MathGroup: > >I have a function I want to Plot between 0.5 and 1.0 with a "stretched >out" x-axis. I want to put a "horizontal magnifying glass" on the >function between 0.65 and 0.75, because it wiggles a lot in this part >of its domain. > >I tried to find a Plot option which allows the x-axis to stretch >horizontally across the screen. I experimented with AspectRatio -> >10, and found I could do y-axis (Range) stretch with no problem. But >when I tried AspectRatio -> 0.1, the y-axis collapsed, and the x-axis >did not stretch at all. > >I'm stumped. I can't find an x-axis stretching option that produces >more on-screen horizontal plot details. > >Does anyone know a way to stretch the x-axis in Mathematica Plots? > >Regards, >Harold > Well, Harold, let me dig up a hands-on sample (it's always better to give an example of your real problem in the posting). I leave it up to you, to distill out a method for your application. Let's assume we look at this function graph: Plot[Sin[20/(1 + x^2)], {x, -10, 10}] and want to enlage the x-axis at the more rapid oscillating part between -1 < x < 1. First manufature Graphics objects of the three sections: gm = Plot[Sin[20/(1 + x^2)], {x, -1, 1}, PlotRange -> All] g1 = Plot[Sin[20/(1 + x^2)], {x, -9, -1}, Axes -> {True, False}, PlotRange -> All] g2 = Plot[Sin[20/(1 + x^2)], {x, 1, 9}, Axes -> {True, False}, PlotRange -> All] (For the final Graphics we only want the y-axis from one part, therefore we suppress it for g1, g2; but we need to keep the x-axes, to indicate the different scaling in the final output. PlotRange -> All is necessary to get not too much from the x-axis for each graph (which would overlap later)) Then, the idea is to transform (compress) the x-coordinates of the (not so interesting) sides. scg1f = FullGraphics[ g1] /. {Line[{linepts__}] :> Line[{Unevaluated[linepts] /. {x_, y_} :> {(x + 1)/4 - 1, y}}], Text[exp_, coord_, rest___] :> Text[exp, coord /. {x_, y_} :> {(x + 1)/4 - 1, y}, rest]} scg2f = FullGraphics[ g2] /. {Line[{linepts__}] :> Line[{Unevaluated[linepts] /. {x_, y_} :> {(x - 1)/4 + 1, y}}], Text[exp_, coord_, rest___] :> Text[exp, coord /. {x_, y_} :> {(x - 1)/4 + 1, y}, rest]} We have to transform the x-coordinates of all points within Lines, as well as for the Text positions (the numbers indicated at the x-axes). The transformations of the Lines are a bit tricky, as to avoid false matches of pairs (for short Lines) we transform sequences. They must not expand within ReplaceAll, hence they are confined within Unevaluated[<the sequence>]. For the transformation of the Text primitives, we have to carefully select the coordinates. Show[scg1f, Graphics[{Hue[0, 0.3, 1], Rectangle[{-1, -1}, {1, 1}]}], FullGraphics[gm], scg2f, AspectRatio -> 1/3] (I also highlighted the region of particular interest.) A small problem seems to rest: the connection of the lines at the borders is not perfect. Of course I could manage this, but I currently see no really elegant solution for it. (If your not content I'll try!) ok, here it is: line1 = Extract[g1, Position[g1, Line[_]]] /. Line[{linepts__}] :> Line[{Unevaluated[linepts] /. {x_, y_} :> {(x + 1)/4 - 1, y}}]; line2 = Extract[g2, Position[g2, Line[_]]] /. Line[{linepts__}] :> Line[{Unevaluated[linepts] /. {x_, y_} :> {(x - 1)/4 + 1, y}}]; linem = Extract[gm, Position[gm, Line[_]]]; fullline = Apply[Join, Thread[Join[line1, linem, line2], Line], {1}]; g1emb = FullGraphics[g1][[1, 2]] /. {Line[{linepts__}] :> Line[{Unevaluated[linepts] /. {x_, y_} :> {(x + 1)/4 - 1, y}}], Text[exp_, coord_, rest___] :> Text[exp, coord /. {x_, y_} :> {(x + 1)/4 - 1, y}, rest]}; g2emb = FullGraphics[g2][[1, 2]] /. {Line[{linepts__}] :> Line[{Unevaluated[linepts] /. {x_, y_} :> {(x - 1)/4 + 1, y}}], Text[exp_, coord_, rest___] :> Text[exp, coord /. {x_, y_} :> {(x - 1)/4 + 1, y}, rest]}; gmemb = FullGraphics[gm][[1, 2]]; Show[Graphics[{{Hue[0, 0.3, 1], Rectangle[{-1, -1}, {1, 1}]}, fullline, g1emb, g2emb, gmemb}], AspectRatio -> 1/3] Perhaps it's not worth the effort as -- I fear -- it will be much less robust. The basic idea is clear however: extract the lines from the graphics, transform them accordingly and join them. For the embellishments, extract them from the FullGraphics (at the right place!) and also transform them accordingly as seen above. Finally built the Graphics from all parts and Show. -- Hartmut Wolf --- P.S. to David Park: David, in case you don't have this in your Draw package (but I suppose you do, or better!) Cheers, Hartmut