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

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

Search the Archive

Re: contour plots

  • To: mathgroup at yoda.physics.unc.edu (Martin W. Lo)
  • Subject: Re: contour plots
  • From: fschwab at daffy.cv.nrao.edu (Fred Schwab)
  • Date: Thu, 3 Jun 93 16:54:00 EDT

> 
> Hi,
> 
> I have a list of x,y,z values from which I would like to generate
> a contour plot.  However, the x,y values are not evenly distributed.
> I don't think ListContourPlot can do this.  Has someone written such a
> contour plot function?  Does anyone know of some simple way of making
> such a contour plot in Mathematica?
> 
> Thanks in advance.
> 
> Martin Lo (jpl 818-354-7169, mwl at trantor.jpl.nasa.gov)
> 
> 
> Here is the xyz list:
> 
> xyz={
> { 0.1,-0.05,     20016.715},
> {-0.1,-0.05,     19601.308},
> {-0.2,-0.05,     19442.067},
> {-0.3,-0.05,     19314.687},
> {-1.0,-0.05,     19288.602},
> {-2.0,-0.05,     21726.612},
> {-2.0,-0.06,     22459.494},
> {-2.0,-0.04,     21042.437},
> {-1.5,-0.04,     19660.199},
> {-1.5,-0.03,     19209.398},
> {-1.5,-0.02,     18805.495},
> {-1.5,-0.01,     18448.132},
> {-1.5,+0.00,     18136.952},
> {-1.5,+0.01,     17871.608},
> {-1.5,+0.02,     17651.756},
> {-1.5,+0.03,     17477.064},
> {-1.6,+0.03,     17443.239},
> {-1.7,+0.03,     17437.437},
> {-1.7,+0.04,     17236.060},
> {-1.7,+0.05,     17079.506}
> }
> 
> 

     Have you gotten help on this problem yet?  I saved your message,
intending to reply, but then I forgot.
     I use an interpolation method, appropriate to the problem of
scattered-data interpolation, which is known as Shepard interpolation.
My implementation is very inefficient, but it should work well for as few
data points as you have.  (I've used it for up to 1200, at which point
it starts to become too time-consuming.)
     If you still need help, I'd be pleased to show you how I've dealt
with this problem.  (In fact I guess I'll do it now, since all I have
to do is to append a Mathematica batch file to this message).

                                   - Regards
 
                                     Fred Schwab
                                     fschwab at nrao.edu
                                     National Radio Astron. Obs.
                                     Charlottesville, VA

P.S.  If you're interested, I can provide some literature ref.'s to
Shepard interpolation.  My implementation is very kludgy; in particular,
my routine will blow up if you try to evaluate the interpolant at
one of the original absissae.  (This can easily be fixed, however,
and the limit as you approach one of these abscissae is correct.)  So,
if you happen on one of these points then subsequently with your
call to ContourPlot, you have to try again with, say, the plot range
slightly altered.  I haven't done this up properly since it was for
a one-shot application.

----------------------------------------------------------------------


l=ReadList["dispzen.nas",Number]
m=Partition[l,8]
n1=Length[m]
l1=Table[{m[[i,3]],m[[i,4]],m[[i,8]]},{i,n1}];

l=ReadList["dispzen.nisa",Number]
m=Partition[l,8]
n2=Length[m]
l2=Table[{m[[i,3]],m[[i,4]],m[[i,8]]},{i,n2}];

<<Graphics`Graphics3D`
<<Graphics`Colors`
<<Graphics`Legend`
$DefaultFont={"Times-Roman",10}
(*
plt1=ScatterPlot3D[l1,BoxRatios->{1,1,1},Axes->True,
     AxesLabel->{"x","y","z"},
     PlotStyle->Red]
plt2=ScatterPlot3D[l2,BoxRatios->{1,1,1},Axes->True,
     AxesLabel->{"x","y","z"},
     PlotStyle->Green]
*)
shepard[x_,y_,list_]:=Module[{},
    m=Length[list];
    Sum[list[[l,3]]/((x-list[[l,1]])^2+(y-list[[l,2]])^2),{l,1,m}]/
    Sum[1/((x-list[[l,1]])^2+(y-list[[l,2]])^2),{l,1,m}]]

fun1=Compile[{x,y},Evaluate[shepard[x,y,l1]]];
fun2=Compile[{x,y},Evaluate[shepard[x,y,l2]]];
circ=Graphics[Circle[{0,54/.0254},50/.0254]]
f1[x_,y_]:=fun1[Abs[x],y]
f2[x_,y_]:=fun2[Abs[x],y]

(*
plt1=ContourPlot[f1[x,y],{x,-50/.0254,50/.0254},{y,4/.0254,104/.0254},
                 ColorFunction->Hue,
                 Contours->Table[xx,{xx,-2,0,.05}],
                 DisplayFunction->Identity]
plt2=Show[plt1,circ,DisplayFunction->$DisplayFunction]
plta=ShowLegend[plt2,{Hue,30,"-2","0",LegendShadow->None,
                LegendPosition->{1.1,-.4},LegendSize->{.2,1}}]
pltb=Plot3D[f1[x,y],{x,-50/.0254,50/.0254},{y,4/.0254,104/.0254},
            PlotPoints->50]
*)

plt3=ContourPlot[f2[x,y],{x,-50/.0254,50/.0254},{y,4/.0254,104/.0254},
                 ColorFunction->Hue,
                 Contours->Table[xx,{xx,-2,0,.05}],
                 DisplayFunction->Identity]
plt4=Show[plt3,circ,DisplayFunction->$DisplayFunction]
pltc=ShowLegend[plt4,{Hue,30,"-2","0",LegendShadow->None,
                LegendPosition->{1.1,-.4},LegendSize->{.2,1}}]
pltd=Plot3D[f2[x,y],{x,-50/.0254,50/.0254},{y,4/.0254,104/.0254},
            PlotPoints->50]

plt5=ContourPlot[f1[x,y]-f2[x,y],{x,-50/.0254,50/.0254},{y,4/.0254,104/.0254},
                 ColorFunction->Hue,
                 Contours->Table[xx,{xx,0,1.25,.05}],
                 DisplayFunction->Identity]
plt6=Show[plt5,circ,DisplayFunction->$DisplayFunction]
plte=ShowLegend[plt6,{Hue,20,"0","1.25",LegendShadow->None,
                LegendPosition->{1.1,-.4},LegendSize->{.2,1}}]
pltf=Plot3D[f1[x,y]-f2[x,y],{x,-50/.0254,50/.0254},{y,4/.0254,104/.0254},
            PlotPoints->50]

Display["!psfix -land|lpr -Ppscolor",pltc]
Display["!psfix -land|lpr -Ppscolor",pltd]
Display["!psfix -land|lpr -Ppscolor",plte]
Display["!psfix -land|lpr -Ppscolor",pltf]


  • Prev by Date: Re: Object Oriented...(really Math. Journal)
  • Next by Date: Request to join Mathgroup
  • Previous by thread: Re: Object Oriented...(really Math. Journal)
  • Next by thread: Request to join Mathgroup