Interpolation of points in 3D through a Fourier series

Question

I have the following data

Tinterspike200 = {3.01026957638`, 5.314505776636686`, 
   10.494223363285943`, 16.585365853657912`};
Tinterspike400 = {2.5609756097561167`, 3.940949935815186`, 
   6.103979460847167`, 8.921694480102463`, 12.50962772785579`, 
   17.092426187419257`, 22.13093709884531`};
Tinterspike600 = {2.3748395378690628`, 3.177150192554557`, 
   4.358151476251605`, 6.059050064184852`, 8.401797175866495`, 
   11.206675224646983`, 14.80744544287548`, 18.58793324775353`, 
   22.310654685494224`, 26.78433889602054`};
Tinterspike800 = {2.2657252888318355`, 2.7856225930680356`, 
   3.4403080872913994`, 4.2105263157894735`, 5.7124518613607185`, 
   8.318356867779203`, 11.59178433889602`, 14.441591784338895`, 
   17.77920410783055`, 21.059050064184852`, 25.532734274711167`};
Tinterspike1000 = {2.1822849807445444`, 2.593068035943517`, 
   3.0680359435173297`, 3.5879332477535297`, 4.255455712451861`, 
   5.423620025673941`, 8.164313222079588`, 11.07188703465982`, 
   13.49165596919127`, 16.084724005134788`, 19.17201540436457`, 
   22.35558408215661`, 25.84724005134788`};
Nspikes200 = {1, 2, 3, 4};
Nspikes400 = {1, 2, 3, 4, 5, 6, 7};
Nspikes600 = {1, 2, 3, 4, 5, 6, 7, 8, 9, 10};
Nspikes800 = {1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11};
Nspikes1000 = {1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13};
Istim = {200, 400, 600, 800, 1000};

Then, I collect all these data in the following way

(*DATA*)
data1 = 
  Table[{Istim[[1]], Tinterspike200[[i]], Nspikes200[[i]]}, {i, 1, 4}];
data2 = Table[{Istim[[2]], Tinterspike400[[i]], Nspikes400[[i]]}, {i, 
    1, 7}];
data3 = Table[{Istim[[3]], Tinterspike600[[i]], Nspikes600[[i]]}, {i, 
    1, 10}];
data4 = Table[{Istim[[4]], Tinterspike800[[i]], Nspikes800[[i]]}, {i, 
    1, 11}];
data5 = Table[{Istim[[5]], Tinterspike1000[[i]], 
    Nspikes1000[[i]]}, {i, 1, 13}];
data = Join[data1, data2, data3, data4, data5];

The plotted data in the 3D space are the following:

lpp = ListPointPlot3D[data, PlotStyle -> {PointSize[Large], Red}]

I have tried to interpolate such points with the command Interpolation however this gives me a surface, which I am not able to determine its analytical equation. This is the result

(*INTERPOLATION*)
{xmin, xmax} = MinMax[data[[All, 1]]];
{ymin, ymax} = MinMax[data[[All, 2]]];
dataInterp = {Most@#, Last@#} & /@ data;
Istim3D = Interpolation[dataInterp, InterpolationOrder -> 1]
plIstim3D = 
  Plot3D[Istim3D[x, y], {x, xmin, xmax}, {y, ymin, ymax}, 
   PlotStyle -> Opacity[0.8], 
   AxesLabel -> {"Istim", 
     "Interspike times", "Numbers of spikes"}, PlotRange -> All, 
   ImageSize -> 800];
Show[lpp, plIstim3D, ImageSize -> 800]

Then I have tried with a polynomial in x,y, but the problem relies on the fact that increasing the order of the polynomial it interpolates the points but starts to oscillate. I would like to interpolate such points with a two-dimensional Fourier series. Could you please help me to determine it?

Do you have another suggestion about a stable interpolating function which I can use? Could you please provide me a code-example in Mathematica of such further trial?

Thank you very much.

@Akku14 thanks for having spotted it, I forgot to copy it. Now I have inserted the missing part above. — VDF, Nov 10 '20 at 09:37
Have a look at: https://mathematica.stackexchange.com/questions/40163/arbitrary-precision-spline-interpolation/48133#48133 — Daniel Huber, Nov 10 '20 at 13:18
@DanielHuber, if I wanted to use the bidimensionale Fourier series, how should I do? — VDF, Nov 11 '20 at 09:46
FourierSeries is for expressions (functions), not for data lists. For list you would e.g. use FFT and eventually set some coefficients to zero for smooting.. But why is "Interpolation" not good enough. With an InterpolatingFunction you can do almost everything that you can do with ordinary function. — Daniel Huber, Nov 11 '20 at 13:12
@DanielHuber you are right, but I was trying to use an interpolating function for which I know the analytic expression, because I need it for further calculations to develop. — VDF, Nov 11 '20 at 13:43
If you need an analytic expression, then polynomials should do the job. But never use high degree polynomials, because they tend to oscillate. One further note, if you choose your data points on a rectangular grid, calculations are much easier. — Daniel Huber, Nov 11 '20 at 15:06

score 1 · Answer 1 · answered Nov 11 '20 at 15:04

Here is a least square fit of a poly to your data points:

nx = 3; ny = 3; (*degree of poly in x/y direction*)
pol[x_, y_] = Table[ x^i  y^j, {i, 0, nx}, {j, 0, ny}] // Flatten;
m = (pol[#[[1]], #[[2]]]) & /@ data;
b = (#[[3]]) & /@ data;
poly[x_, y_] = pol[x, y].LinearSolve[Transpose[m].m, Transpose[m].b];
{mimax, mimay} = MinMax /@ {data[[All, 1]], data[[All, 2]]};
Show[Plot3D[
  poly[x, y], {x, mimax[[1]], mimax[[2]]}, {y, mimay[[1]], 
   mimay[[2]]}, AxesLabel -> {"x", "y", "z"}]
 , Graphics3D[{Point[data]}]]

Interpolation of points in 3D through a Fourier series

1 Answers1