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

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

Search the Archive

Re: Contour Plotting on a sphere

  • To: mathgroup at smc.vnet.net
  • Subject: [mg15278] Re: Contour Plotting on a sphere
  • From: "Allan Hayes" <hay at haystack.demon.co.uk>
  • Date: Thu, 31 Dec 1998 04:39:33 -0500
  • References: <76cih0$o3s@smc.vnet.net>
  • Sender: owner-wri-mathgroup at wolfram.com

Rangachari Kidambi wrote in message <76cih0$o3s at smc.vnet.net>...
>
>Hi,
>
>I want to plot contours of a function f(theta,phi), where theta and phi
>are standard spherical polar coordinates. These contours will be curves
>on the surface of a sphere. Can Mathematica do such a plot? If yes,
>how? As far as i know, Mathematica can do only contours of f(x,y) where
>x,y are cartesian coordinates. Thanks for any help.
>
>Sincerely,
>Ranga Kidambi
>
>

Ranga:

The package below does this sort of thing: for example

ParametricPlot3DContoured[{x,y,z,w},{u,umin,umax},{v,vmin,vmax}, opts],
for expressions x,y,z,w in u,v, gives the contour lines of w on the
surface given by ParametricPlot3D[{x,y,z},{u,umin,umax},{v,vmin,vmax},
opts].

Allan

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


(* :Title: ContourPlotOnSurface *)
(* :LAST CHANGE: 30 Dec 1998 *)
(* :Author: Allan Hayes, hay at haystack.demon.co.uk *) (* :Summary:
  ContourLines3D has two functions:\n
  ParametricPlot3DContoured and Plot3DContoured, that allow contour
lines
  to be drawn on 3D plots.\n
  There are three special options:ContourLift, ContourColorFunction and
  Surface.
  Graphics3D[Graphics3DContoured[...]] gives a Graphics3D object. *)
(* :Context: haypacks`Graphics`ContourPlotOnSurface ` *) (* :Package
Version: 1.2 *)
(* :Copyright: Copyright 1994,1996,1997,1998 Allan Hayes. *) (*
:History:
  Version 1.4 by Allan Hayes, Nov 1998
   Defined Plot3DContoured in terms of ParametricPlot3DContoured
   instead of coding separately (may slow computation a bit but
   simplifies code).
   Allowed for empty list of contour lines (caused by
   the contour values being outside the height range).
  Version 1.3 by Allan Hayes, March 1997
   Contour lines of function f[s,t] on surface
   {x[s,t],y[s,t],z[s,t]} added.
  Version 1.2 by Allan Hayes, Nov 1994
   ContourLines3DInfo added
  Version 1.2 by Allan Hayes, May 1994.
  Version 1.1 by Allan Hayes, March 1994. *)
(* :Warning: Show is extended to deal with the
 object that is returned by the function PlotContoured.
 Color directives given in ContourStyles are usually not operative; they
must
 usually be given separately by the option ContourColorFunction (but see
the
 entry for ContourColorFunction).
*)
(* :Keywords: Contour *)
(* :Mathematica Version: 2.2 *)
(* :Limitation: The Graphics3DContoured object that is output is
   not yet combining with other graphics and does not respond to
  FullOptions and FullGraphics
*)

BeginPackage[
  "haypacks`Graphics`ContourLines3D`",
  "Utilities`FilterOptions`"
];

Unprotect["`*"];ClearAll["`*"];

(**Usage messages**)


ContourLines3DInfo::usage =
"ContourLines3D is a package with two functions,\n Plot3DContoured,gives
a Plot3D surface with contour lines added,\n ParametricPlot3DContoured,
gives a ParametricPlot3D surface with contour\n lines of a function of
the parameters added;\n extensive options allow variations to be
made.\n \nPlease see the separate entries for more information and
examples. ";


ParametricPlot3DContoured::usage =
"ParametricPlot3DContoured[{x,y,z,w},{u,umin,umax},{v,vmin,vmax}, opts],
for expressions x,y,z,w in u,v, gives the contour lines of w on the
surface given by ParametricPlot3D[{x,y,z},{u,umin,umax},{v,vmin,vmax},
opts].\n ParametricPlot3DContoured[{x,y,z},{u,umin,umax},{v,vmin,vmax},
opts] gives the same as
ParametricPlot3D[{x,y,z,z},{u,umin,umax},{v,vmin,vmax}, opts].\n The
contour styles are controlled by the options ContourStyles (as for
ContourPlot) and a new option, ContourColorFunction except that color
directives must usually be given separately by the option
ContourColorFunction (but see the entry for ContourColorFunction). The
amount by which contours are moved towards the viewpoint to avoid parts
of them being hidden by the surface is controlled by the option
ContourLift. .\n\n

Options:\n
ParametricPlot3DContoured has the union of the options of
ParametricPlot3D, and ContourPlot as options, together with three new
options  ContourLift, ContourColorFunction and Surface.\n\n

Example:\n
ParametricPlot3DContoured[{t Sin[s] Cos[t], t Cos[s] Cos[t], Sin[t]},
 {s,0,2Pi},{t,-Pi/2, Pi/2}
]\n\n
For more examples please enter ?ParametricPlot3DContouredExamples. ";

Plot3DContoured::usage =
"Plot3DContoured[{z,w},{u,umin,umax},{v,vmin,vmax}, opts], for
expressions z, w in u,v, gives the contour lines of w on the surface
given by Plot3D[z,{u,umin,umax},{v,vmin,vmax}, opts].\n
Plot3DContoured[z,{u,umin,umax},{v,vmin,vmax}, opts] gives the same as
Plot3DContoured[{z,z},{u,umin,umax},{v,vmin,vmax}, opts] gives the same
as .\n

Options:\n
Plot3DContoured has the union of the options of Plot3D and ContourPlot
as options, together with three new options  ContourLift,
ContourColorFunction and Surface.\n
The contour styles are controlled by the options ContourStyles (as for
ContourPlot) except that color directives must usually be given
separately by the new option ContourColorFunction (but see the entry
for ContourColorFunction). The amount by which contours are moved
towards the viewpoint to avoid parts of them being hidden by the
surface is controlled by the option ContourLift.\n\n

Example:\n
Plot3DContoured[2x^4 - y^4, {x,-1,1},{y,-1,1},Axes -> True]\n\n For more
examples please enter ?Plot3DContouredExamples. ";

ContourLift::usage = "ContourLift is an option for Plot3DContoured,
ParametricPlot3DContoured and Graphics3DContoured.\n For a number r,
ContourLift ->r, causes each contour to be moved towards the viewpoint
by r times the length of the bounding box in the direction of the view
point. This is used to avoid some parts being covered by the surface.\n
The default is ContourLift ->Automatic. ";
ContourColorFunction::usage = "ContourColorFunction is an option for
Plot3DContoured, ParametricPlot3DContoured and Graphics3DContoured. \n
ContourColorFunction ->cf, causes each contour to assigned the color
cf[scaledz] where scaledz runs from 0 at the lower end of the range of
plotted values of z up to 1 at the top of the range.\n The default is
ContourColorFunction ->Hue.\n\n NOTE:\n
Directives set by ContourColorFunction will shadow any coresponding ones
set by ContourStyles, but ContourColorFunction -> ({}&) will allow all
ContourStyles set directives to function. ContourColorFunction can be
used to modify more than the color of the contour lines.
ContourColorFunction -> (Thickness[#/100]&) will set the thickness;
ContourColorFunction -> ((Sequence@@{Hue[#], Thickness[#/100]})&) will
set both color and thickness in.\n
ColorFunction -> Transparent gives a wire frame picture. ";

Surface::usage = "Surface is an option for Plot3DContoured,
ParametricPlot3DContoured and Graphics3DContoured.\n With Surface ->
True, the surface on which the contours are to be drawn is displayed;
with Surface -> False the surface is not displayed (the edges of the
surface patches are not shown) ; with Surface -> Transparent a wire
frame version is displayed (the style of the mesh is then controlled by
the option ColorFunction).\n The default is Surface -> True.
 ";

Graphics3DContoured::usage = "Graphics3DContoured[primitives list,
options] is the kind of graphic object returned by
ParametricPlot3DContoured and Plot3DContoured\n\n
Options:\n
Graphics3DContoured has the union of the options of ContourGraphics,
SurfaceGraphics and Graphics3D as options, together with three new
options ContourLift, ContourColorFunction and Surface. ";
Transparent::usage = "Transparent is a setting for the option Surface in
ContourLines3D which specifies that a wire frame version be
displayed.";

ParametricPlot3DContouredExamples::usage ="

ParametricPlot3DContoured[{t Sin[s] Cos[t], t Cos[s] Cos[t], Sin[t]},
 {s,0,2Pi},{t,-Pi/2, Pi/2}];\n\n

ppc =
ParametricPlot3DContoured[{t Sin[s] Cos[t], t Cos[s] Cos[t], Sin[t],
s+t},
 {s,0,2Pi},{t,-Pi/2, Pi/2}];\n\n
Show[ppc,
 PlotRange -> {All, {-.2,1.1},All},
 ViewPoint->{1.393, -2.988, -0.764}
];\n\n
Show[ppc, Lighting -> False, ColorFunction -> GrayLevel];\n\n Show[ppc,
 Surface -> False,
 Contours -> 36,
 ContourColorFunction -> (Hue[1-#]&) ];\n\n

Show[ppc,
 Surface->Transparent,
 ColorFunction -> Hue,
 (*controls mesh color when Surface->Transparent is set*)
 Boxed -> False,
 Axes -> False
];\n\n
Show[ppc,
 ContourStyle -> Thickness[.007],
 ContourColorFunction->(GrayLevel[0]&),
 Mesh -> True,
 MeshStyle -> GrayLevel[.5],
 Shading -> False
];\n\n
transparentball =
ParametricPlot3DContoured[
 {Sin[s] Cos[t], Cos[s] Cos[t], Sin[t]},
 {s,0,2Pi},{t,-Pi/2, Pi/2},
 ContourLift -> .7,
 AmbientLight -> GrayLevel[.2],
 Boxed -> False,
 Axes -> False
 ];\n\n
(*this shows how the illusion is created*)\n
Show[Graphics3D[transparentball], ViewPoint->{3.265, 0.888, 0.042}]; ";

Plot3DContouredExamples::usage =
"
(***\n
You can evaluate these examples by converting the cell in which they are
generated to an input cell and then evaluatiing the cell.\n ***)\n
Plot3DContoured[2x^4 - y^4, {x,-1,1},{y,-1,1},Axes -> True];\n\n
Show[pc,
 PlotRange -> {All, {-.2,1.1},All},
 ViewPoint->{1.393, -2.988, -0.764}
];\n\n
pc =
Plot3DContoured[{2x^4 - y^4, x y}, {x,-1,1},{y,-1,1},Axes -> True];\n\n
Show[pc,
 PlotRange -> {All, {-.2,1.1},All},
 ViewPoint->{1.393, -2.988, -0.764}
];\n\n
Show[pc, Lighting -> False, ColorFunction -> GrayLevel];\n\n Show[pc,
 Surface -> False,
 ContourColorFunction -> (Hue[1-#]&) ];\n\n
Show[pc,
 Surface->Transparent,
 ColorFunction -> (GrayLevel[.8] &),\n
 (*controls mesh color when Surface->Transparent is set*)
 ContourStyle -> Thickness[.015],
 Boxed -> False,
 Axes -> False,
 PlotRange -> All\n
 (*stops clipping of polygons -- compare earlier pictures*) ];\n\n
Show[pc,
 ContourStyle -> Thickness[.007],
 ContourColorFunction->(GrayLevel[0]&),
 Mesh -> True,
 MeshStyle -> GrayLevel[.5],
 Shading -> False
];
";

(**Private Code**)

Begin["`Private`"];
Clear["`*"];


Format[Graphics3DContoured[x___]] := "-Graphics3DContoured-";

 (* In defining the options I have used Union to avoid the duplication
that
  would result if I used Join.
 *)

Options[Graphics3DContoured] =
 Union@@(


   Options[ContourGraphics],
   Options[SurfaceGraphics],
   Options[Graphics3D],
   { ContourLift -> Automatic,
    ContourColorFunction -> Hue,
    Surface -> True
   }
  }/.


    (AspectRatio-> _ ) -> (AspectRatio-> Automatic),
    (AmbientLight -> _) -> (AmbientLight -> GrayLevel[0.]),
    (Axes -> _) -> (Axes -> True),
    (BoxRatios ->_) -> (BoxRatios -> Automatic),
    (ColorFunction -> _) -> (ColorFunction -> Automatic),
    (ContourShading -> _) -> (ContourShading -> False),
    (ContourSmoothing -> _) -> (ContourSmoothing -> None),
    (ContourStyle -> _) -> (ContourStyle-> {}),
    (Mesh -> _) -> (Mesh ->False),
    (MeshStyle -> _) -> (MeshStyle -> GrayLevel[0])
   }
 );


Options[ParametricPlot3DContoured] =
 Union[{Compiled -> True, PlotPoints -> 25},
Options[Graphics3DContoured]];

Options[Plot3DContoured] =
 Options[ParametricPlot3DContoured]/.
  (BoxRatios -> _) -> (BoxRatios -> {1,1,0.4}) ;

  (* UVP, below, converts the viewpoint, vp, from viewpoint
  coordinates to user coordinates.
  VP converts from user coordinates to viewpoint coordinates
  *)

UVP[vp_,br_,pr_] :=
 pr.{1,1}/2 + pr.{-1,1} Max[br]/br vp; VP[uvp_, br_,pr_] :=
  (uvp - pr.{1,1}/2 )br/Max[br]/pr.{-1,1}; zscaler =
Compile[{n1,n2,n3,n4,m,h}, ((n1+n2+n3+n4)/4 -m)/h];

ParametricPlot3DContoured[
 {x_,y_,z_},{u_,umin_,umax_},{v_,vmin_,vmax_}, opts___?OptionQ ]:=
ParametricPlot3DContoured[
 {x,y,z,z},{u,umin,umax},{v,vmin,vmax}, opts ];

(* define Plot3DContoured in terms of ParametricPlot3DContoured*)

Plot3DContoured[
 {z_, w_}, {u_, umin_, umax_}, {v_, vmin_, vmax_}, opts___?OptionQ ] :=
 ParametricPlot3DContoured[
 {u, v, z, w}, {u, umin, umax}, {v, vmin, vmax}, opts ]

Plot3DContoured[
 z_, {u_, umin_, umax_}, {v_, vmin_, vmax_}, opts___?OptionQ ] :=
ParametricPlot3DContoured[
 {u, v, z, z}, {u, umin, umax}, {v, vmin, vmax}, opts ];


ParametricPlot3DContoured[
 {x_,y_,z_,w_},{u_,umin_,umax_},{v_,vmin_,vmax_}, opts___?OptionQ ] :=

ule[ 
  {px,py,pz,pw,defopts,ppts,polydat,zdat,mr, graphicsobject}, 
  
 (**  
  STEP1: construct the basic data that depends only on the 
  the parametric formulas x,y,z, the u and v ranges and the
  "plot" option PlotPoints. This will be passed on unchanged
  through any uses of Show.
 **)
 
   (* Find the current default options -- to allow control
    by the SetOptions function.  
   *) 
   
  defopts = Sequence@@Options[ParametricPlot3DContoured];
  ppts = PlotPoints/. {opts} /.{defopts};
   
   (* Make compiled or pure functions {px,py,pz,pw} out of 
    {x,y,z,w}: these are convenient for passing. 
   *)  
 
  {px,py,pz,pw} = 
   If[
    Compiled/.{opts,defopts},
    Thread[comp[{u,v},{x,y,z,w}], List,-1]/.comp -> Compile,
    Function/@({x,y,z,w}/.{u:>#1,v:>#2})
   ];  
        
   (* Find the polygons, polydat, for surface on which the 
    contours will be drawn. The extra brackets are to 
    conform to the pattern when directives are added.   
   *)
                      
  polydat =  
   {
    List/@
     ( ParametricPlot3D[
       {x,y,z},
       {u,umin,umax},{v,vmin,vmax},
       DisplayFunction -> Identity,
       PlotPoints -> ppts   
      ][[1]]
     )
   };
   (* Find matrix of heights, wdat, as a function of u,v -- 
    the x,y coordinates will be adjusted later. We also
    need the meshrange mr so that the original values of 
    u and v can be reconstructed. 
   *)
    
  wdat = 
   Plot3D[
    w, {u,umin,umax},{v,vmin,vmax},
    DisplayFunction -> Identity,
    PlotPoints -> ppts 
   ][[1]];
  zdat = 
   Plot3D[
    z, {u,umin,umax},{v,vmin,vmax},
    DisplayFunction -> Identity,
    PlotPoints -> ppts 
   ][[1]];

   
  mr = {{umin,umax},{vmin,vmax}};
  
   (* Pass d
ata on to makegraphics to make a Graphics3DContoured
    object
    The {}'s holds places data that depends on
    Graphics3DContoured options to be added
    metdat will be the value of {Boxratios, PlotRange} that
    have actually been used in a plot. These will be obtained
    using the function FullOptions and need not be the values
    assigned by the options (because, for example, PlotRange ->
    Automatic is a default setting).
    cdat will be the data from which the contour lines will be
    constructed once their number and other properties have been
    specified.
   *)

 (**
  STEP2: Use the function makegraphics ,defined separately, to construct
  a graphics object with new head Graphics3DContoured. This contains all
  the data, including all the options given, from which to display the
  result by means of a suitably extended version of the function Show.
 **)

  graphicsobject =
   makegraphics[
    { {px,py,pz,pw}, zdat,wdat,
     polydat,{}(*for metdat*), {}(*for cdat*)
    },
    FilterOptions[
     Graphics3DContoured,
     MeshRange -> mr,
     opts,
     defopts
    ]
   ];

   (* Show the graphics just constructed. *)

 (**
  STEP3: display the result by means of a suitably extended version
  of the function Show, defined separately.
 **)
  Show[graphicsobject]
 ];


  (* The function makegraphics, defined below, gives a
   ContouredSurfaceGraphics object. A principle aim in designing
   the code has been to keep recomputation as close as sensible
   to the minimum required by new option settings introduced by
   when using Show.
  *)

makegraphics[
 {  {px_,py_,pz_,pw_},  zdat_,wdat_,
  oldpolydat_, oldmetdat_, oldcdat_,
  oldopts___
 },
 newopts___
] :=
 Module[
  { optsset, opts,vp,br,cl,ccf,pcf,clnsQ,edgfm, msh,
   mshs, cs,sur,ppts,lftrat,pr,
   cln,cplot,cplot2D, uvp,center,ucp,maxs,tmin,thbx,zpr,zmin,
   hbx, newcdat,clines, us,vs,zav,xyz,vecs,unitvecs,cyclestyles,
   csc,clip,nearpt,lift,lftpt,dpr,dvp,gr1
  },

   (* Find the list of options that are set in newopts *)

  optsset = First/@{newopts};

   (* Join newopts and oldopts for convenience.*)

  opts = Sequence[newopts,oldopts];

   (* Find the settings of some of the options.*)

  { br, ccf, cl, clnsQ, cs, mshQ, mshs, pcf, vp} =
   { BoxRatios, ContourColorFunction, ContourLift,
    ContourLines, ContourStyle, Mesh, MeshStyle,
    ColorFunction,ViewPoint
   }/.{opts};

  edgfm = If[!mshQ, EdgeForm[], EdgeForm[mshs]];
  newpolydat = {edgfm, Last[oldpolydat]};

   (* If newopts change plotrange or box ratios find their
    new values.
   *)


   MemberQ[optsset, BoxRatios|PlotRange ],

   {newfbr,newfpr} =
    FullOptions[
     Graphics3D[
      newpolydat,
      FilterOptions[Graphics3D, opts]
     ],
     {BoxRatios,PlotRange}
    ],
   {newfbr,newfpr} = oldmetdat
  ];

   (* Find the thickness of the box, thbx, (in user coordinates)
    along the line through the center and the viewpoint.
   *)

  uvp = UVP[vp,newfbr,newfpr]; (*Viewpoint in user coordinates.*)
  center = newfpr.{1,1}/2;
  ucp = uvp - center;
  maxs = Max/@newfpr;
  Off[Power::infy];
  tmin =  Min[Abs[(maxs - center)/ucp]];
  On[Power::infy];
  thbx = 2 tmin Sqrt[ucp.ucp]//N;

   (* Find the ratio lftrat of the thickness of the box in
     the direction of the view point by which the contours
    will be lifted
   *)

  ppts = Dimensions[wdat];
  lftrat := If[cl === Automatic, 0.5/(Plus@@ppts), cl];

   (* Find a display plotrange, dpr, which will include the lifted
    contours. Calculate the corresponding display box ratio dbr
    and display ViewPoint, dvp, the position of the latter in
    user coordinates relative to br and dpr is still uvp (this
    will keep the lifted contours in line with the unlifted
    ones as seen from the view point used in the display).
   *)

  clip[x_, {a_,b_}] := Which[ x<a,a, x>b,b, True,x ];
  nearpt[uvp_, newfpr_] := Thread[clip[uvp,newfpr]];
  lift[uvp_,pr_, d_] :=
   Module[{np},
    np = nearpt[uvp,pr];
    (np + d #/Sqrt[#.#])&[uvp - np]
   ];
  lftpt = lift[uvp, newfpr, lftrat thbx];
  dpr = {Min[#],Max[#]}&/@MapThread[List,{lftpt,newfpr}];
  dbr = If[ br === Automatic, dpr.{-1,1}, br];
  dvp = VP[uvp,dbr,dpr];

   (* Find the height, hbx, of the box in user coordinates,
    needed to find the scaled height used for ContourColorFunction.
   *)

  wmin = Min[wdat];
  wmax = Max[wdat];
  wrange = wmax -wmin;

  znewfpr = newfpr[[-1]];
  zmin = Min[znewfpr];
  zmax = Max[znewfpr];
  hbx = zmax - zmin;

   (*
    Find the 2D contour lines from wdat by using ContourGraphics
    and converting to a Graphics object. The heights will be added
    later and the u,v coordinates will be mapped to the
    corresponding x,y values. The split into styles and lines is
    for efficiency in making changes by options.
   *)

  {styles, lines} =
   If[(gr1=
    Graphics[ContourGraphics[
     wdat,
     ContourShading -> False,
     FilterOptions[
      ContourGraphics,
      PlotRange ->{wmin,wmax} (*newfpr[[-1]]*), (*Not newfpr, which is
in terms of x,y and z*)
      opts
     ]
    ]][[1]]/.{dirs__,ln_Line} -> {{dirs}, ln}) ==={},
    {{},{}},
    Transpose[gr1]
   ];


   (* Do those calculations for lifting the contours that depend
    on the "metric" options BoxRatios, Contours, PlotRange,
    ViewPoint, ContourSmoothing. Store the data as newcdat.
    The full code for the contour lines is constructed later from
    newcdat and styles.
   *)


   clnsQ&&
    MemberQ[
     optsset,
     BoxRatios|ViewPoint|PlotRange|Contours|ContourSmoothing
   ],


   newcdat = If[lines==={}, {},
    lines/.Line[ps_] :>
     ( {us, vs} = Transpose[ps];
      wav = Inner[pw,us,vs]/Length[ps];(*av of w on contour*)
      ws = Table[wav,{Length[ps]}];
      xyz =
       { MapThread[px,{us,vs}],
        MapThread[py,{us,vs}],
        MapThread[pz,{us,vs}]
       };
      vecs = Transpose[uvp - xyz];

      unitvecs =
       Block[{Dot},
        vecs/Sqrt[Thread[Dot[vecs,vecs]]]
       ]; (* unit vecs in direction of viewpoint*)


       (*(zav-zmin)/hbx,*)(wav-wmin)/wrange,
       Transpose[xyz],
       thbx unitvecs

      }
     )],
   (* else - if no changes are needed to cdat. *)

   newcdat = oldcdat
  ];


  (* Insert the directives for the polygons *)

  If[pcf =!= Automatic && MemberQ[optsset, ColorFunction],
   newpolydat =
    newpolydat/.{___,poly:Polygon[pts_]} :>
     {pcf[zscaler[Sequence@@(Last/@pts), zmin, hbx]], poly}
  ];

  (* Complete the code for the contour lines using lftrat (derived
   from the option ContourLift) and ccf (from ContourColourFunction).
  *)

  clines =
   If[clnsQ,
    Apply[
     { Sequence@@Flatten[{##4}],
      ccf[#1],
      Line[#2 + lftrat #3]
     }&,
     MapThread[Join,{newcdat,styles}],
     {1}
    ],
    {}
   ];

  (* Return the data and options as a Graphics3DContoured object.*)

  Graphics3DContoured[


    {px, py, pz,pw}, zdat, wdat,
    newpolydat, {newfbr, newfpr}, newcdat, clines,
    {dpr,dvp}
   },
   opts
  ]

 ];


  (* Extend Show to deal with Graphics3DContoured objects. *)

Graphics3DContoured/:
Show[
 Graphics3DContoured[
  { fn_, zdat_, wdat_,
   polydat_,{fbr_,fpr_}, cdat_, clines_,
   {dpr_, dvp_}
  },
  oldopts___?OptionQ
 ],
 newopts___?OptionQ
] :=


  MemberQ[
   First/@{newopts},
   BoxRatios|ColorFunction|ContourColorFunction|ContourLift|
   Contours|ContourLines|ContourSmoothing|ContourStyle|
   Mesh|MeshStyle|PlotRange|Surface|ViewPoint
  ],

  Show[

egraphics[ 
    { fn, zdat, wdat,
     polydat, {fbr,fpr}, cdat, 
     oldopts
    }, 
    newopts
   ]
  ],
  
  Show[
   Graphics3D[{
    Switch[Surface/.{newopts, oldopts},
     True, 
      polydat,
     Transparent, 
      polydat/. 
       Polygon[z_] :> Line[Append[z,First[z]]],
     _,
      {}
    ],
    If[ContourLines/.{newopts, oldopts},clines,{}]
   }],
   PlotRange -> dpr, ViewPoint -> dvp,
   FilterOptions[
    Graphics3D, newopts,oldopts
   ]
  ]; 
   
  Graphics3DContoured[
   { fn, zdat, wdat,
    polydat,{fbr,fpr},cdat, clines,
    {dpr,dvp}
   },
   newopts,oldopts
  ]
 ];
 
 
  (* Provide for conversion of Graphics3DContoured objects to 
   Graphics3D objects
  *)
  
Graphics3DContoured/: 
Graphics3D[
 Graphics3DContoured[
  { fn_, zdat_, wdat_, (*wdat_ added Nov12 98*)
   polydat_,{fbr_,fpr_}, cdat_, clines_,
   {dpr_, dvp_}  
  }, 
  oldopts___?OptionQ
 ],
 newopts___?OptionQ 
] :=
 Graphics3D[
  { Switch[ Surface/.{newopts, oldopts},
    True, polydat,
    Transparent, 
     polydat/. 
      Polygon[z_] :> Line[Append[z,First[z]]],
    _, {}
   ],
   If[ContourLines/.{newopts, oldopts},clines,{}]
  }, 
  PlotRange -> dpr, ViewPoint -> dvp, 
  FilterOptions[Graphics3D, newopts, oldopts]
 ];
 

End[];
Protect["`*"];
EndPackage[]
	

		





  • Prev by Date: stumping Integrate *correction*
  • Next by Date: Cell Bracket Notation
  • Previous by thread: Contour Plotting on a sphere
  • Next by thread: Re: Contour Plotting on a sphere