Services & ResourcesWolfram ForumsMathGroup Archive

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

Re: A 3D-list-plot problem

• To: mathgroup at smc.vnet.net
• Subject: [mg23166] Re: [mg23112] A 3D-list-plot problem
• From: Hartmut Wolf <hwolf at debis.com>
• Date: Thu, 20 Apr 2000 23:48:39 -0400 (EDT)
• Organization: debis Systemhaus
• References: <200004190630.CAA07492@smc.vnet.net>
• Sender: owner-wri-mathgroup at wolfram.com

Hans Friedrich Steffani schrieb:
> 
> I have a matrix of tripples {x,y,z}. The x is the same for all
> tripples in a row the y is the same for each tripples in column.
> Some tripples a substitude bei Null as the represent unvalid results.
> 
> The may be deleted by
> Delete[lumpi, Position[lumpi, Null]]
> 
> Now I want a nice 3D-picture.
> 
> Flatten[%, 1];
> ScatterPlot3D[%, BoxRatios -> {1, 1, 0.8}];
> 
> is not very good as there arre only points.
> 
> Flatten[%, 1];
> Show[Map[ScatterPlot3D[#, DisplayFunction -> Identity,
>           PlotJoined -> True] &, %%%], DisplayFunction -> $DisplayFunction,
>     BoxRatios -> {1, 1, .8}];
> 
> does ScatterPlot3D to each row which looks better but not perfekt.
> 
> Any ideas to build a "nice" picture?
> 
> Many thanks, also for answers to my other questions.
> 


Hans Friedrich,

let me make a model of your problem:

xlist = Table[Random[], {15}] // Sort

ylist = Table[Random[], {15}] // Sort

These are the x and y values which shall make up regular, although not
evenly spaced grid:

xylist = Outer[{#1, #2} &, xlist, ylist];

g1 = ListPlot[Flatten[xylist, 1], PlotRange -> {{0, 1}, {0, 1}}, 
    PlotStyle -> PointSize[0.02], AspectRatio -> Automatic]

Here we saw the points of our grind; now let's define some values at
them (forget the undefined points for a while):

plist = Outer[{#1, #2, #1(1 - #1)#2(1 - #2)} &, xlist, ylist];

We want to make a 3D Plot; ScatterPlot3D is an alternative, as you said,
which can greatly be enhanced by makeing a stereographic image by two
slightly shifted ViewPoints (one for each eye, see e.g. Heikki
Ruskeepaa: "Mathematica Navigator : Graphics and Methods of Applied
Mathematics"), or by animated movement of the ViewPoint. Here I'll show
how to make a Graphic in Plot3D-style:


ppoly = plist // Map[Partition[#, 2, 1] &, #, {1}] & // Transpose // 
          Map[Partition[#, 2, 1] &, #, {1}] & // 
        Apply[Polygon[Join[#1, Reverse[#2]]] &, #, {2}] & // Flatten;

Show[Graphics3D[ppoly], Axes -> True, BoxRatios -> {1, 1, 0.4}]

You might like to compare this with

Plot3D[x(1 - x)y(1 - y), {x, 0, 1}, {y, 0, 1}]


Now for the undefined values. We pick some by random, these are the
indices on plist:

bi = Table[Random[Integer, {1, 15}], {5}, {2}]

we look where they are:

g2 = ListPlot[Extract[xylist, bi], PlotStyle -> {PointSize[0.02],
Hue[0.]}, 
    DisplayFunction -> Identity]

Show[g1, g2]

Now for plist we replace the z-value of the broken points by Null, but
it is important that they are still present in the grid. (You could also
replace them entirely by Null, but then modify accordingly the
replacement in the Show statement below.)

pbroken = 
    ReplacePart[plist, {#1, #2, Null} & @@@ Extract[plist, bi], bi, 
      List /@ Range[Length[bi]]];

This is a fine use of ReplacePart, haven't seen it before. Now we
generate the polygons (with the Nulls in) same way as above:

pbpoly = pbroken // Map[Partition[#, 2, 1] &, #, {1}] & // Transpose // 
          Map[Partition[#, 2, 1] &, #, {1}] & // 
        Apply[Polygon[Join[#1, Reverse[#2]]] &, #, {2}] & // Flatten;

But before showing we remove the broken points in the polygons:

Show[Graphics3D[pbpoly /. {_, _, Null} -> Sequence[]], Axes -> True, 
  BoxRatios -> {1, 1, 0.4}]

Now you see holes in the surface at the broken points. Also look from
above:

Show[%, ViewPoint -> {1.3, -2.4, 10}]


I hope to have helped somewhat, although there are still nicer
3D-pictures possible, more or less straightforeward, but work.

Hartmut

• References:
  • A 3D-list-plot problem
    • From: hans.steffani@e-technik.tu-chemnitz.de (Hans Friedrich Steffani)