Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2004
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2004

[Date Index] [Thread Index] [Author Index]

Search the Archive

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


  • Prev by Date: Re: Re: Unexpected behaviour of HoldRest
  • Next by Date: Re: typesetting fractions
  • Previous by thread: Re: Stretching X-Axis in Plot[]
  • Next by thread: [Outer [Times, , ] ] Question