# Interpolation of points in 3D through a Fourier series

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.

• What is data1,data2, ... – Akku14 Nov 10 '20 at 9:35
• @Akku14 thanks for having spotted it, I forgot to copy it. Now I have inserted the missing part above. – VDF Nov 10 '20 at 9:37
• Have a look at: mathematica.stackexchange.com/questions/40163/… – 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 9: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

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]}]]