Skip to main content

plotting - Interpolate throughout a 3d data list without extrapolation


I have a 3D list of data for which I'd like to plot an interpolated surface. There are several ways to achieve this, but none I cannot find a method which ONLY plots the ENTIRE interpolated surface without extrapolating at all. I have to use a substantial list of data to demonstrate, so I've uploaded it on dropbox. I hope this is okay.


I'm enthusiastically open to suggestions of other ways to link to the data.


It does seem to import properly on my system (Mathematica 9.0.0.0 on XP SP3):


hcp = Import[

"https://www.dropbox.com/s/a10if7ek4ako5q2/example.dat?dl=1", "TSV"];
data = {Most[ToExpression[#]], Last[ToExpression[#]]} & /@
DeleteDuplicates[hcp];
int = Interpolation[data, InterpolationOrder -> 1]
Show[
Plot3D[int[x, y], {x, -.807372, -.586589}, {y, .31889, .393084}],
ListPointPlot3D[hcp]
]
Show[
ListSurfacePlot3D[hcp],

ListPointPlot3D[hcp]
]
Show[
ContourPlot3D[
z == int[x,
y], {x, -.807372, -.586589}, {y, .31889, .393084}, {z, -.3, 1},
RegionFunction ->
Function[{x, y, z},
Sqrt[2] + 4 Sqrt[3] (z - .204124) >= 0 &&
4 Sqrt[3] (z - .204124) <= 3 Sqrt[2] + 8 Sqrt[6] (x + .57735) &&

4 Sqrt[3] (Sqrt[2] (x + .57735) + (z - .204124)) <=
3 Sqrt[2] (1 + 4 y) &&
4 (Sqrt[6] (x + .57735) + 3 Sqrt[2] y + Sqrt[3] (z - .204124)) <=
3 Sqrt[2]]],
ListPointPlot3D[hcp]
]

The following plots are then generated:


enter image description here


As you can see, Plot3D of the Interpolation does well within the range of the data, but extrapolation always occurs. I want to either avoid extrapolation by specifying variable domains, or to just clip the surface along the edges of the data.



enter image description here


As you can see, ListSurfacePlot3D also does a decent job within the data domain, but issues inevitably arise along the edges, where it either extends 'square flaps' well outside the data, or stops short of the data edges.


enter image description here


Finally, ContourPlot3D is similar to Plot3D in that extrapolation outside the data occurs, which I don't want. In the example I've specified a RegionFunction, so that the surface is clipped within a tetrahedral shape. Perhaps I need an automated way to find the outer {x,y} boundary of the data, and then use that function as a RegionFunction. I neither know how to do that, nor know how to find out how to do that.


EDIT:


A similar question was asked in ListSurfacePlot3D generates ugly artifacts ... I've tried to apply the method of that solution to my data (which I've reformatted and uploaded as a different file):


hcp = ToExpression[
Import["https://www.dropbox.com/s/a7nwxz24a9hjaqb/example2.dat?dl=1", "TSV"]];
Needs["DifferentialEquations`InterpolatingFunctionAnatomy`"];
fu[k_InterpolatingFunction, p_] :=

k[p (Length @@ InterpolatingFunctionCoordinates[k] - 1) + 1]
t = Append[#, First@#] & /@
Transpose@
Table[{fu[Interpolation[#[[All, 1]]], p],
fu[Interpolation[#[[All, 2]]], p], #[[1, 3]]} & /@ hcp, {p, 0,
1, .05}];
s = BSplineFunction[t];
ParametricPlot3D[s[u, v], {u, 0, 1}, {v, 0, 1},
PlotStyle -> {Orange, Specularity[White, 10]}, Axes -> None,
Mesh -> None]

t = Transpose@
Table[{fu[Interpolation[#[[All, 1]]], p],
fu[Interpolation[#[[All, 2]]], p], #[[1, 3]]} & /@ hcp, {p, 0,
1, .05}];
s = BSplineFunction[t];
Show[
ParametricPlot3D[s[u, v], {u, 0, 1}, {v, 0, 1},
PlotStyle -> {Orange, Specularity[White, 10]}, Axes -> None,
Mesh -> None],
ListPointPlot3D[t,

PlotStyle -> {Black, Red, Orange, Yellow, Green, Blue, Purple, Gray}]
]

Which generates this figure:


enter image description here


This again fails to interpolate over the entire data range (the SplineKnots->"Clamped" option does not change this), and it also introduces strange zig-zag surface features, which I'm not sure how to smooth. In the example I'm emulating, each sub-list of "z=constant" data was connected to its neighboring sub-lists by smooth interpolated surfaces. Is the nature of my data spoiling the BSplineFunction, or can this be rectified?


EDIT:


The Non-Grid Interpolation Package at... http://library.wolfram.com/infocenter/MathSource/7760/ ...also comes very close to what I want. It is good at non-grid 3D interpolation which does not extrapolate outside the data. After running that package I use the commands:


hcp = ToExpression[
Import["https://www.dropbox.com/s/a7nwxz24a9hjaqb/example2.dat?dl=1", "TSV"]];

?NonGridInterpolation`*
hcpf = DelaunayTriangulationPiecewiseLinear[
ProcessDuplication[Flatten[hcp, 1]]];
Show[
Plot3D[hcpf[x, y], {x, -1, 0}, {y, -.5, .5}],
ListPointPlot3D[hcp, PlotStyle -> Black]
]

Generating this figure:


enter image description here



By reformatting the data it is possible to have the surface extend to the points not reached in the current example (on the left side in the figure). This does a good job at 3D interpolation without extrapolation. Notably, the ProcessDuplication function is used for duplicate abscissa {x,y} data, which it handles by simply taking the average {z} value for the repeated points. Unfortunately, I got what I wished for in that the package interpolates over the entire dataset. As you can see, the concave curvature of my data (on the right side in the figure) is bridged over by the interpolating surface. I haven't had luck in working around this. This package would nevertheless represent the best solution for the problem as I stated it.




Comments

Popular posts from this blog

plotting - How to draw lines between specified dots on ListPlot?

I would like to create a plot where I have unconnected dots and some connected. So far, I have figured out how to draw the dots. My code is the following: ListPlot[{{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4,13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full] I have thought using ListLinePlot command, but I don't know how to specify to the command to draw only selected lines between the dots. Do have any suggestions/hints on how to do that? Thank you. Answer One possibility would be to use Epilog with Line : ListPlot[ {{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4, 13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full, Epilog -> { Line[ ...

equation solving - Invert and fit implicitly defined curve

I need to fit an implicitly defined curve. I thought I could get some data out of Solve , and then using FindFit . Therefore, I would like to find the relation the parametric curve defined by $F(x,y)=0$: Solve[-(1/2) + 1/2 (0.41202 BesselK[0, 0.1 Sqrt[x^2 + y^2]] + (0.101483 x BesselK[1, 0.1 Sqrt[x^2 + y^2]])/Sqrt[x^2 + y^2]) == 0, y] But I can't get an output: Solve was unable to solve the system with inexact coefficients or the system obtained by direct rationalization of inexact numbers present in the system. Since many of the methods used by Solve require exact input, providing Solve with an exact version of the system may help. >> Edit: In particular, I would like to fit the data coming from the curve with the expression of another curve, and not with a function $f(x)$. In particular, since this clearly looks like a cardioid , I would like it to fit to something like it. What other strategies could I try?

dynamic - How can I make a clickable ArrayPlot that returns input?

I would like to create a dynamic ArrayPlot so that the rectangles, when clicked, provide the input. Can I use ArrayPlot for this? Or is there something else I should have to use? Answer ArrayPlot is much more than just a simple array like Grid : it represents a ranged 2D dataset, and its visualization can be finetuned by options like DataReversed and DataRange . These features make it quite complicated to reproduce the same layout and order with Grid . Here I offer AnnotatedArrayPlot which comes in handy when your dataset is more than just a flat 2D array. The dynamic interface allows highlighting individual cells and possibly interacting with them. AnnotatedArrayPlot works the same way as ArrayPlot and accepts the same options plus Enabled , HighlightCoordinates , HighlightStyle and HighlightElementFunction . data = {{Missing["HasSomeMoreData"], GrayLevel[ 1], {RGBColor[0, 1, 1], RGBColor[0, 0, 1], GrayLevel[1]}, RGBColor[0, 1, 0]}, {GrayLevel[0], GrayLevel...