Services & ResourcesWolfram ForumsMathGroup Archive

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

Re: programmatically rotating a function plot

• To: mathgroup at smc.vnet.net
• Subject: [mg99469] Re: [mg99395] programmatically rotating a function plot
• From: DrMajorBob <btreat1 at austin.rr.com>
• Date: Wed, 6 May 2009 05:25:26 -0400 (EDT)
• References: <200905050938.FAA20566@smc.vnet.net>
• Reply-to: drmajorbob at bigfoot.com

pic1 is more complicated today, I suppose, as this shows:

pic1 = Plot[8 Sin[Pi t] Exp[-t], {t, 0, 4}]
Cases[pic1, {x_, y_}, 3]

(output suppressed) Not all the {x, y} matches are points on the line.

To fix that, we operate on Line primitives, rather than arbitrary  
2-element lists. There's ONE line in pic1, with 702 points:

Cases[pic1, Line[x_] :> x, Infinity] // Dimensions

{1, 702, 2}

We transform the graph with, for instance (exploratory first):

lineIn=Cases[pic1,Line[x_]:>x,Infinity]//First;
Short[line,5]
{{8.16327*10^-8,2.05165*10^-6},{0.00122687,0.0307968},<<698>>,{3.99863,-0.000632859},{4.,-3.75773*10^-8}}

lineOut=line.{{0, 1}, {-1, 0}};
Short[lineOut,5]
{{-2.05165*10^-6,8.16327*10^-8},{-0.0307968,0.00122687},<<698>>,{0.000632859,3.99863},{3.75773*10^-8,4.}}

which leads to

pic2 = Replace[pic1, Line[x_] :> Line[x.{{0, 1}, {-1, 0}}], Infinity]

The problem now is that the new graph has the same x and y limits as the  
original; but they should be switched.

AbsoluteOptions[pic1, PlotRange]

{PlotRange -> {{0., 4.}, {-1.87626, 5.1002}}}

AbsoluteOptions[pic2, PlotRange]

{PlotRange -> {{0., 4.}, {-1.87626, 5.1002}}}

That's hidden inside the plot like so:

Cases[pic1, Rule[PlotRange, x_] :> x, Infinity]

{{{0, 4}, {-1.87626, 5.1002}}}

So, to switch the ranges and completely transform the plot requires

pic3 = Replace[
   pic1, {Rule[PlotRange, {x_, y_}] :> Rule[PlotRange, {-y, x}],
    Line[x_] :> Line[x.{{0, 1}, {-1, 0}}]}, Infinity]

And finally we have

pic1 = Plot[8 Sin[Pi t] Exp[-t], {t, 0, 4}];
plot4[p_] := Module[{R, p1, p2, p3},
    R[q_] :=
     Replace[q, {Rule[PlotRange, {x_, y_}] :> Rule[PlotRange, {-y, x}],
        Line[x_] :> Line[x.{{0, 1}, {-1, 0}}]}, Infinity];
    p1 = R[p]; p2 = R[p1]; p3 = R[p2];
    Show[p, p1, p2, p3]];
plot4[pic1]

That also fails, however, since Show takes its options from the first  
graph. We need a PlotRange that reveals all 4 graphs at once, which is  
accomplished with

pic1 = Plot[8 Sin[Pi t] Exp[-t], {t, 0, 4}];
plot4[p_] := Module[{R, p1, p2, p3},
    R[q_] :=
     Replace[q, {Rule[PlotRange, {x_, y_}] :> Rule[PlotRange, {-y, x}],
        Line[x_] :> Line[x.{{0, 1}, {-1, 0}}]}, Infinity];
    p1 = R[p]; p2 = R[p1]; p3 = R[p2];
    Show[p, p1, p2, p3, PlotRange -> All]];
plot4[pic1]

Oddly interesting.

In general, I used FullForm, Cases, and Replace to sleuth the internals of  
plots, and I tried to be as general as possible. I can't promise the final  
code will work in version 8 of Mathematica.

Bobby

On Tue, 05 May 2009 04:38:34 -0500, Rodney <rodneyhoffman at gmail.com> wrote:

> This (from some book) worked in Mathematica 4, but not now:
>
>  - - - - - - - - - - - -
> pic1 = Plot[8 Sin[Pi t] Exp[-t], {t, 0, 4}]
>
> plot4[p_] := Module[{R, p1, p2, p3},
>      R[q_] := Show[q/.{x_, y_}:> {-y,x}];
>      p1 = R[p]; p2 = R[p1]; p3 = R[p2];
>      Show[p,p1,p2,p3]
> ];
>
> plot4[pic1]
>
>  - - - - - - - - - - - - -
>
> I can't figure out how to do it today.  Thanks for any suggestions.
>
>



-- 
DrMajorBob at bigfoot.com

• References:
  • programmatically rotating a function plot
    • From: Rodney <rodneyhoffman@gmail.com>