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]