Mathematica 9 is now available
Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2002
*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 2002

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

Search the Archive

RE: Re: PlotVectorField

  • To: mathgroup at smc.vnet.net
  • Subject: [mg34892] RE: [mg34819] Re: PlotVectorField
  • From: "Wolf, Hartmut" <Hartmut.Wolf at t-systems.com>
  • Date: Wed, 12 Jun 2002 02:15:20 -0400 (EDT)
  • Sender: owner-wri-mathgroup at wolfram.com

Selwyn,

here another proposal, which should perform better (I expect, didn't test).
Also this is more along you lines. Again I tried to simplify the cases:

In[1]:= bounds = {{a, b}, {c, d}} = {{1, 2}, {-1, 0}};

In[2]:= xx = Sort[Table[Random[Real, bounds[[1]]], {10}]]
In[3]:= yy = Sort[Table[Random[Real, bounds[[2]]], {10}]]
In[4]:= z1 = Transpose[{xx, yy}]
In[5]:= z = Append[Prepend[z1, {2.5, -1.1}], {2.2, 0.3}]

 


In[7]:= Attributes[pull] = {HoldFirst}

In[8]:= {head, tail} = {1, -1};

In[9]:= {atleft, atright, atbottom, attop} = 
    Unevaluated[{Sequence[1, 1], Sequence[1, -1], Sequence[-1, 1],
Sequence[-1, -1]}];

In[10]:= pull[z_, h_, hv_, dir_] :=
  With[{r = (bounds[[hv, dir]] - z[[h*2, hv]])/(z[[h, hv]] - z[[h*2, hv]])},
    z[[h]] = r z[[h]] + (1 - r)z[[h*2]]
    ]

In[11]:= z

In[12]:=
Scan[Function[end,
    If[z[[end, 1]] < bounds[[atleft]], pull[z, end, atleft],
      If[z[[end, 1]] > bounds[[atright]], pull[z, end, atright]]];
    If[z[[end, -1]] < bounds[[atbottom]], pull[z, end, atbottom],
      If[z[[end, -1]] > bounds[[attop]], pull[z, end, attop]]];
    ], {head, tail}]

In[13]:= z

In[14]:=
ListPlot[z, PlotRange -> bounds + {{-#, #}, {-#, #}} &[.1], 
  Background -> Hue[.3, .1, 1], PlotStyle -> PointSize[.025], 
  AspectRatio -> Automatic, PlotJoined -> True, Axes -> False, 
  Epilog -> {Line[{{a, c}, {b, c}, {b, d}, {a, d}, {a, c}}], PointSize[.02],

      Point /@ z}]

--
Hartmut


> -----Original Message-----
> From: shollis at armstrong.edu [mailto:shollis at armstrong.edu]
To: mathgroup at smc.vnet.net
> Sent: Saturday, June 08, 2002 11:22 AM
> Subject: [mg34892] [mg34819] Re: PlotVectorField
> 
> 
> I guess my original question was a bit cryptic, but Wolf's reply got
> me thinking in the right direction. Actually what I was trying to do
> was to overlay a vector field with several curves created with
> ListPlot. The points given to ListPlot typically spill out beyond the
> rectangle on which I want to plot, so I needed so way to restrict the
> plot to the desired rectangle. PlotRange is the obvious way, but it
> leads to the difficulties I was trying to describe.
> 
> Anyway, I wonder what you all think about the following fix: Instead
> of using PlotRange, I apply a ``pullback" function to the list of
> points to make sure they all lie in the rectangle I want before I give
> the list to ListPlot. The only points in the list that can possibly
> spill out of the rectangle are the first and the last. So I made the
> following functions for each edge of the rectangle a<=x<=b, c<=y<=d.
> Each one just replaces the first/last point in the list with a convex
> combination of first two/last two points in such a way that the result
> is on the edge of the rectangle.
> 
> pulla[z_,a_]:= Module[{r=(z[[1,1]]-a)/(z[[1,1]]-z[[2,1]])},
>     ReplacePart[z, r*z[[2]]+(1-r)*z[[1]], 1]];
> pullb[z_,b_]:= Module[{r=(z[[-1,1]]-b)/(z[[-1,1]]-z[[-2,1]])},
>     ReplacePart[z, r*z[[-2]]+(1-r)*z[[-1]], -1]];
> pullc[z_,c_]:= Module[{r=(z[[1,2]]-c)/(z[[1,2]]-z[[2,2]])},
>     ReplacePart[z, r*z[[2]]+(1-r)*z[[1]], 1]];
> pulld[z_,d_]:= Module[{r=(z[[-1,2]]-d)/(z[[-1,2]]-z[[-2,2]])},
>     ReplacePart[z, r*z[[-2]]+(1-r)*z[[-1]], -1]];
> 
> Then I put everything together like this:
>  
> pullback[z_?MatrixQ,{a_,b_,c_,d_}]:=Module[{zz=z},
>  If[If[If[If[If[If[If[If[zz[[1,1]]<a,
>          zz=pulla[zz,a],zz][[1,2]]<c,
>         zz=pullc[zz,c],zz][[-1,1]]>b,
>        zz=pullb[zz,b],zz][[-1,2]]>d,
>       zz=pulld[zz,d],zz][[-1,1]]<a,
>      zz=pullb[zz,a],zz][[-1,2]]<c,
>     zz=pulld[zz,c],zz][[1,1]]>b,
>    zz=pulla[zz,b],zz][[1,2]]>d,
>   zz=pullc[zz,d],zz];zz]; 
> 
> Now, pullback[pointlist, {a,b,c,d}] gives points that all lie in the
> desired rectangle and still accurately produce the curve.
> 
> If anyone has an ideas as to how this pullback function can be written
> is a more ``MC" (Mathematica-ly Correct) way, I'd appreciate your
> advice.
> 
> Cheers,
> Selwyn
> 


  • Prev by Date: Re: A friendly challenge: Generalized Partition
  • Next by Date: RE: Re: Re: Using Mathgroup Effectively -- cutting and pasting expressions
  • Previous by thread: RE: Re: PlotVectorField
  • Next by thread: On Limit[ f[x,y], x->x0 ]