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[ ...

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...

Is there a way to do conditional matrix loop using 'continue'

I have the following: n = 3; m = 5; ww = RandomReal[{0, 0.1}, {n, n}]; uu = RandomReal[{0, 1}, {m, n}]; pp = RandomReal[{0, 1}, {n, n}]; ss = RandomInteger[{0, 5}, {m, n}]; Grid[{{"ww", "uu", "pp", "ss"}, {ww // TableForm, uu // TableForm, pp // TableForm, ss // TableForm}}, Spacings -> {5, 2}, Dividers -> All] where I would like to look at every element of matrix ss and produce a matrix tt , with zeroes at the locations in ss which have zeroes, and in all other positions do the following: tt = (-1/Subscript[ww, m]) Log[(1 - uu)/(Subscript[pp, m - 1])], where Subscript[ww, m] is the value at index of ww matrix and where Subscript[pp, m - 1] is the value at index-1 of pp matrix. So for example if the first value ever read from matrix ss happens to be 2, then value taken from matrix ww would be from the row 2, but from pp would be from row 1. Also how to tell difference between a 0 as a valid value from within the matrix elemen...