MathGroup Archive 2001

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

Search the Archive

Re: ScatterPlot3D/Plot3D

  • To: mathgroup at smc.vnet.net
  • Subject: [mg28702] Re: ScatterPlot3D/Plot3D
  • From: "Allan Hayes" <hay at haystack.demon.co.uk>
  • Date: Thu, 10 May 2001 07:54:47 -0400 (EDT)
  • References: <F42966A0479AD4118AE6009027D08CEB016BFAED@dlpcexch02.ncsc.navy.mil> <9d85l2$84r@smc.vnet.net>
  • Sender: owner-wri-mathgroup at wolfram.com

Peter,
The main problem seems to be that Graphics3D calculates which points will
obscure others. The time taken for this is proportional to the square of the
number of points - it grows rapidly.

The preliminary code below tackles this by projecting the points onto a
plane and making a 2D display of this. The time taken should be
proportional to the number of points.

The user can style the points with a style function, sf say, that receives
four inputs:
                            sf[d, x, y,z]
where d is the distance from the viewpoint and x,y z are the original
coordinates. There is an option to  have these inputs scaled to 0 to 1 from
min to max.
When this styling is used, covering up is obtained by listing the points by
distance from the viewpoint, closest last.

EXAMPLES

Here are some examples and timings (displays deleted)
--- please evaluate the code before evaluating them yourself.


dat = Flatten[Table[{x,y,2-x^2+y^2},{x,-1.,1.,.02},{y,-1.,1.,.02}],1];


Developer`ClearCache[];
gr=FlatScatterPlot3D[dat];//Timing

        {4.73 Second,Null}

Developer`ClearCache[];
gr=FlatScatterPlot3D[dat,
        StyleFunction->Function[{d,x,y,z},GrayLevel[.9 d]]];//Timing

        {14.55 Second,Null}


Developer`ClearCache[];
gr=FlatScatterPlot3D[dat,
        StyleFunction->Function[{d,x,y,z},Hue[.67 y]]
        ];//Timing


        {15.77 Second,Null}

<<Graphics`Graphics3D`
Developer`ClearCache[];
ScatterPlot3D[dat];//Timing

        {111.34, Null]}

Developer`ClearCache[];
Show[Graphics3D[Point/@dat]];//Timing

        {89.31 Second, Null}

Developer`ClearCache[];
ParametricPlot3D[{x,y,2-x^2+y^2},{x,-1,1},{y,-1,1}];//Timing

        {5.55 Second, Null}

CODE

Clear[FlatScatterPlot3D]

Options[FlatScatterPlot3D] =
    Union[Options[Graphics],
      Options[Graphics3D], {StyleFunction -> Automatic,
        StyleFunctionScaling -> True}];
SetOptions[FlatScatterPlot3D, ViewCenter -> Automatic, ViewPoint ->
Automatic,
     ViewVertical -> Automatic];


FlatScatterPlot3D[lst_, opts___?OptionQ] :=
  Module[{sf, sfsc, plotrange, minx, maxx, miny, maxy, minz, maxz,
      rangelengths, vc, vp, vv, un, cp, vx, vy, projnfn, projn, mind, maxd,
      scd, scx, scy, scz, fin},

    {sf, sfsc} = {StyleFunction, StyleFunctionScaling} /. Flatten[{opts}] /.
        Options[FlatScatterPlot3D];


    plotrange = {{minx, maxx}, {miny, maxy}, {minz, maxz}} =
        Transpose[ {Min /@ # , Max /@ #} &[Transpose[lst]]];
    plotrange = Replace[plotrange, {{a_, a_} :> a + {-1.025, 1.025},
            {a_, b_} :> {a , b} +  (b - a) {-0.025, 0.025}}, {1}] // Chop;
    rangelengths = plotrange.{-1, 1};
    {vc, vp, vv} =
      {ViewCenter, ViewPoint, ViewVertical} /. Flatten[{opts}] /.
        Options[FlatScatterPlot3D];
    If[vc == Automatic, vc = Tr[lst, Plus, 1]/Length[lst] // Chop];
    If[vp == Automatic,
      vp = (vc + {1.3, -2.4, 2} Max[rangelengths]) // Chop];
    If[vv == Automatic, vv = {0, 0, 1}];
    un[v_] := v/Sqrt[v.v];
    cp = un[vp - vc];
    vx = Chop[ un[Cross[vv, cp]]];
    vy = Chop[un[ Cross[cp, vx]]];

    (*the projection function adds additional information when needed for \
styling*)

    projn =
      If[sf === Automatic,
        projnfn =
          Compile[{x, y, z},
            Evaluate[Chop[Expand[{#.vx, #.vy} &[{x, y, z} - vc]]]]
            ];
        projnfn @@@ lst
        ,
        projnfn =
          Compile[{x, y, z},
            Evaluate[
              Chop[Expand[{Sqrt[#2.#2], x, y, z, #.vx, #.vy} &[{x, y, z} -
                      vc, {x, y, z} - vp]]]]
            ];
        Reverse[Sort[projnfn @@@ lst]]
        ];

    (*scaling functions*)
    If[ sfsc === True && sf =!= Automatic,
        (mind = Min[#]; maxd = Max[#]) &[projn[[All, 1]]];
        scd = Compile[t, Evaluate[(t - mind)/(maxd - mind)]];
        scx = Compile[t, Evaluate[(t - minx)/(maxx - minx)]];;
        scy = Compile[t, Evaluate[(t - miny)/(maxy - miny)]];;
        scz = Compile[t, Evaluate[(t - minz)/(maxz - minz)]];;
        ]

      (* final conversion*)

      Which[
        sf === Automatic,
         fin[{px_, py_}] := Point[{px, py}],
        ! sfsc ,
         fin[{d_, x_, y_, z_, px_, py_}] :=
          Flatten[{sf[d, x, y, z], Point[{px, py}]}],
        sfsc ,
         Attributes[fin] = {HoldAll};(*scale only used entries*)
         fin[{d_, x_, y_, z_, px_, py_}] :=
           Flatten[{sf[ scd[d], scx[x], scy[y], scz[z]], Point[{px, py}]}]
        ];

    Show[Graphics[fin /@ projn], AspectRatio -> Automatic, PlotRange -> All]
    ]

--
Allan
---------------------
Allan Hayes
Mathematica Training and Consulting
Leicester UK
www.haystack.demon.co.uk
hay at haystack.demon.co.uk
Voice: +44 (0)116 271 4198
Fax: +44 (0)870 164 0565

"peter lindsay" <pl at plindsay.co.uk> wrote in message
news:9d85l2$84r at smc.vnet.net...
> Thanks Jerry, (and to the others who took time to think about my question)
,
> but I think ListSurfacePlot only works only on regular coordinate spacing?
> Correct me if I'm wrong.
>
> My Mathematica code looks like this:
>
> In[1]:=
> SetDirectory["c:\Documents and Settings\P. Lindsay\DESKTOP\alanr"];
> In[2]:=
> t=Table[ReadList["cpp_smlX.txt",Number,RecordLists -> True]];
>
> In[3]:=
> ScatterPlot3D[t,BoxRatios->{10,10,10},Axes->True,
>   AxesLabel->{"fair","num","ratio"},ViewPoint->{3.0,2.5,0.3}]
>
>
>
> and works but is incredibly slow ( pc 450Mz 190Mb ram, Mathematica 3 ). My
Mac Cube
> ( 300 Mb ram, Mathematica 4 ) wont even look at the problem - just hangs
up. Any
> thoughts about why?. Tried fiddling with kernel memory allocation. The
> competition ( vs 6 ) works easily ( pointplot3D ) on either platform but
not
> yet for surface plot.
>
> Can I get a surface plot of the data in "cpp_smlX.txt" - remembering that
> the data is non-linear spacing ?
>
> Thanks for your thoughts,
>
>
>
> Peter Lindsay
>
>
>
>
>
> ----- Original Message -----
> From: "Blimbaum Jerry DLPC" <BlimbaumJE at ncsc.navy.mil>
To: mathgroup at smc.vnet.net
> Subject: [mg28702] RE:  ScatterPlot3D/Plot3D
>
>
> > You might want to use ListSurfacePlot3D...it plots a matrix of
> > points in 3D as a surface...
> >
> > jerry blimbaum  NSWC  Panama City, Fl
> >
> > -----Original Message-----
> > From: peter lindsay [mailto:pl at plindsay.co.uk]
To: mathgroup at smc.vnet.net
> > Sent: Sunday, May 06, 2001 12:12 AM
> > To: mathgroup at smc.vnet.net
> > Subject: [mg28702]  ScatterPlot3D/Plot3D
> >
> >
> > Hi,
> >
> > simple one this probably:
> >
> > I've got ~ 10,000 coordinates (x, y, z) in a text file. The coordinates
> are
> > not linearly spaced and I want to see how they look on a 3D plot.
> >
> > I'm struggling a bit with the syntax, book 4 is remarkaby unhelpful
about
> > scatterplot3d.
> >
> > Any advice appreciated,
> >
> > Thanks,
> >
> > Peter Lindsay
> >
> >
>
>




  • Prev by Date: Re: Re: ScatterPlot3D/Plot3D
  • Next by Date: How to remove, change the assymptotic lines?
  • Previous by thread: Re: ScatterPlot3D/Plot3D
  • Next by thread: Here is a mathematica challenge for fun