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>