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]