[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
Prev by Date:
**Re: "Sticky" options when using Plot[] -- bug or feature?**
Next by Date:
**Re: Introducing the Wolfram Mathematica Tutorial Collection**
Previous by thread:
**programmatically rotating a function plot**
Next by thread:
**Re: programmatically rotating a function plot**
| |