Services & ResourcesWolfram ForumsMathGroup Archive

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

Re: Re: Mathematica and 3D surface.

• To: mathgroup at smc.vnet.net
• Subject: [mg23167] Re: [mg23138] Re: Mathematica and 3D surface.
• From: Hartmut Wolf <hwolf at debis.com>
• Date: Thu, 20 Apr 2000 23:48:40 -0400 (EDT)
• Organization: debis Systemhaus
• References: <8djlnk$7qi@smc.vnet.net> <200004200720.DAA14484@smc.vnet.net>
• Sender: owner-wri-mathgroup at wolfram.com

Martin Zacho schrieb:
> 
> I do have a problem in putting a surface on a collection of data points
> (3D). The dataset is a collection of point which have been obtained by
> making a measurement on a bucket (or to be more precise a section of the
> bucket). The number of points are approx. 3-4000 (see
> http://www.mip.sdu.dk/~zac/temp/bucket.jpg ).
> 
> The problem is: how do I put a surface on the bucket.
> 
> I've tried normal and ExtendedGraphics with no luck. The points _does
> not_ form a nice regular grid.
> 
and then later

Martin Zacho schrieb:
> 
> Quite nice to make a reply to ones own problem :o)
> 
> > http://www.mip.sdu.dk/~zac/temp/bucket.jpg ).
> 
> Was the original data set. I then transformed the points from cartesian
> coordinates (where I couldn't make an Interpolation on each cross section)
> to cylindrical coordinates (where I was able to make an Interpolation). Then
> I was able to make a nice uniform grid of points which could be used by
> ListSurfacePlot3D (from the Graphics package). The result can be viewed at:
> 
> http://www.mip.sdu.dk/~zac/temp/bucket1.jpg
> 
> But then again... the original problem is still valid because this method
> uses a special property of the data set (the cylindrical nature). A more
> general method would still be appreciated :o)
> 

Dear Martin,

me too, when I tried the Delauynay triangulation on data looking simular
to your bucket, I ran into problems. I cannot yet say whether I did
something wrong/did not understand the method. Anyways, it shows that
pulling out the big guns for the most general problem is not always the
best method.

Normally it is prudent to use as much of the properties of the problem
as possible. You succeeded using better suited coordinates. I now show
you another guerilla method using different assumptions.

Your measurements on the bucket might be done by ¿mechanical? scanning
of the surface in sequential movements at constant z (your lines in the
graph). I assume errors in x and y, and some smaller error for z to make
a model:

data = Table[{-0.25 + z y^2 / 0.25 + 0.004(Random[] - 0.5), 
        y + 0.004(Random[] - 0.5), z + 0.001(Random[] - 0.5)}, {z, 0.95,
1.15,
         0.02}, {y, 0, -0.25, -0.02}];

<< Graphics`Graphics3D`

g = ScatterPlot3D[#, PlotJoined -> True, DisplayFunction -> Identity] &
/@ 
    data

Show[g, DisplayFunction -> $DisplayFunction, 
  PlotRange -> {{-0.25, 0.}, {-0.25, 0.}, {0.94, 1.16}}]

To apply the following method it is not neccessary to have the same
number of sampling points for each scan at a height z.  The idea is
quite simple: span the space between two adjacent scan lines with
polygons (sort of simple minded "Delaunay" triangulation, the easy
case). You see I make no assumption of orientation in space or
coordinates, only about this neighborship relation.

The following code might be unneccessaryly complex or obfuscated, but I
had the gusto to try it out on your problem. Streams as I define them in
the following are simple objects delivering the measured points
sequentially (so as not to have to deal with pointers, counters and the
like).


SetAttributes[{nextStream, rewindStream, span}, {HoldAll}]

Format[_stream] := "-stream-"

makeStream[list_] := stream[0, Length[list], list]

nextStream[s_Symbol] /; Head[s] === stream := Block[{},
    {pos, len, list} = List @@ s;
    If[0 < ++pos <= len, s[[1]] = pos; list[[pos]]]]

rewindStream[s_] /; Head[s] === stream := (s[[1]] = 0; s)


Now we need the scanning procedure to span up the polygons:

d[p1_, p2_] := With[{d2 = p2 - p1}, Sqrt[d2.d2]]

This just is the distance in space (we'll take the nearest neighbors)

span[s1_, s2_] := 
  Module[{last1 = nextStream[s1], next1 = nextStream[s1], 
      last2 = nextStream[s2], next2 = nextStream[s2], p = {}}, 
    While[next1 =!= Null && next2 =!= Null, 
      If[d[last1, next2] <= d[last2, next1], 
        p = {p, Polygon[{last1, last2, next2}]}; last2 = next2; 
        next2 = nextStream[s2],
        p = {p, Polygon[{last1, last2, next1}]}; last1 = next1; 
        next1 = nextStream[s1] 
        ]];
    While[next1 =!= Null,
      p = {p, Polygon[{last1, last2, next1}]}; last1 = next1; 
      next1 = nextStream[s1] ];
    While[next2 =!= Null,
      p = {p, Polygon[{last1, last2, next2}]}; last2 = next2; 
      next2 = nextStream[s2] ];
    Flatten[p]]

Quite simple, we travel along both scan lines spanning the polygons at
nearest distances. First we need a couple of symbols to which the
streams are assigned, as to keep their state (make them to 'objects'):

makelist = Table[Unique[s], {Length[data]}]

We also must keep them unevaluated:

slist = Unevaluated /@ makelist

Here they are assigned:

Evaluate[makelist] = makeStream[Reverse[#]] & /@ data

sslist = Partition[slist, 2, 1]

...this are the pairs of scan lines. We now span the polygons:

pp = {}; Scan[(rewindStream /@ #;
      AppendTo[pp, span @@ #]) &, sslist]

and look at the graphics from different sides:

Show[Graphics3D[pp], AmbientLight -> GrayLevel[.7]]
Show[%, ViewPoint -> {0.5, 3., 0.5}, AmbientLight -> GrayLevel[0.]]
Show[%, ViewPoint -> {0.5, 1., 5.}, AmbientLight -> GrayLevel[0.4]]

You see the whole procedure does not contain a single loop variable.
Also you can not only map with functions but with sequential procedures
too. (The sequence for rewinding and scanning is critical! most lines
are scanned twice)

Kind regards,  Hartmut

• References:
  • Re: Mathematica and 3D surface.
    • From: Martin Zacho <zac@mip.sdu.dk>