Finite Differences:

I am having difficulty implementing finite differences in the correct columns of my code.

f[x_] := -2*x^4 + 8*x^3 + 11*x^2 - 3*x
n = 7; x = Range[1, n];
y = f /@ x;
diffs = NestList[Differences, y, Length[y] - 1] // Transpose;
tabela = Prepend[Transpose[{x, y, Sequence @@ diffs}], {"x", "y", "1ª Diferença", "2ª Diferença", "3ª Diferença", "4ª Diferença"}];
xmin = 0; xmax = 10;
ymin = -1600; ymax = 200;
p = Plot[f[x], {x, xmin, xmax}, PlotRange -> {ymin, ymax}, PlotStyle -> Red];
pDiscreto = ListPlot[Transpose[{x, y}], PlotRange -> {ymin, ymax},PlotStyle -> {PointSize[0.02], Blue}];

Show[p, pDiscreto]
Grid[tabela, Frame -> All]

• The first difference is {56, 74, 20, -154, -496, -1054}, the second is {18, -54, -174, -342, -558}, the third is {-72, -120, -168, -216}, and the fourth is {-48, -48, -48}. Apr 4 at 20:26
• NestList[Differences, y, Length[y] - 1] produces a list of lists of decreasing length rather than, say, a matrix. So it cannot be transposed. Apr 4 at 22:51

Clear["Global*"];
f[x_] := -2*x^4 + 8*x^3 + 11*x^2 - 3*x
n = 7; x = Range[1, n];
y = f /@ x;

diffs = NestList[Differences, y, Length[y] - 1] // Rest //
Flatten[#, {{2}, {1}}] & // PadRight[#, {7, 8}, "-"] & //
Transpose

tabela = Prepend[
Transpose[{x, y, Sequence @@ diffs}], {"x", "y", "1ª Diferença",
"2ª Diferença", "3ª Diferença", "4ª Diferença"}]

xmin = 0; xmax = 10;
ymin = -1600; ymax = 200;

p = Plot[f[x], {x, xmin, xmax}, PlotRange -> {ymin, ymax},
PlotStyle -> Red];

pDiscreto =
ListPlot[Transpose[{x, y}], PlotRange -> {ymin, ymax},
PlotStyle -> {PointSize[0.02], Blue}];

Show[p, pDiscreto]
Grid[tabela, Frame -> All]


• Thank you for the correction, indeed I was unaware of the line of code where you made the correction." Apr 4 at 23:55
• We can use Difference[#,n] to get n order difference.
• Flatten[#,{{2},{1}}] can be use to transpose the irregular matrice.
Clear["Global*"];
f[x_] := -2*x^4 + 8*x^3 + 11*x^2 - 3*x
n = 7; x = Range[1, n];
y = f /@ x;
list = Flatten[
Join[{x, y}, Table[Differences[y, i], {i, 1, 6}]], {{2}, {1}}];
tabela =
Prepend[list, {"x", "y", "1ª Diferença", "2ª Diferença",
"3ª Diferença", "4ª Diferença"}];
Grid[tabela, Frame -> All]


The sole purpose of this post is to illustrate DifferenceDelta (and DiscretePlot): in-built function(s) for discrete calculus in Wolfram Language/Mathematica. I have voted for @Syed's answer which is instructive and follows the style and format of OP code.

(* formulae for i-th finite differenc *)

der = DifferenceDelta[f[i], {i, #}] & /@ Range[0, 4]

(* evaluating finite differences at relevant values*)

val = Reverse@Table[Range[1, j], {j, 3, 7}];
eval = Transpose@
PadRight[MapThread[Function[u, #1 /. i -> u] /@ #2 &, {der, val}], Automatic, "_"];

(* Displaying result*)

tab = TableForm[eval,
TableHeadings -> {Range[7], {"f[x]", "First difference",
"Second difference", "Third difference", "Fourth Difference"}},
TableAlignments -> Right];
Column[{Show[Plot[f[x], {x, 0, 7}, PlotRange -> Full],
DiscretePlot[f[j], {j, 0, 7}, PlotStyle -> {Red, PointSize[0.02]}],
ImageSize -> Medium], tab}, Frame -> All]


The formulae:

{-3 i + 11 i^2 + 8 i^3 -
2 i^4, -2 (-7 - 19 i - 6 i^2 + 4 i^3), -6 (-7 + 4 i^2), -24 (1 +
2 i), -48}


Result:

I reiterate this just to illustrate in-built WL/Mma functions. Stylistic/format choices are for user.