3
$\begingroup$

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]
$\endgroup$
2
  • $\begingroup$ 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}. $\endgroup$ Apr 4 at 20:26
  • $\begingroup$ NestList[Differences, y, Length[y] - 1] produces a list of lists of decreasing length rather than, say, a matrix. So it cannot be transposed. $\endgroup$ Apr 4 at 22:51

3 Answers 3

4
$\begingroup$
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]

enter image description here

$\endgroup$
1
  • 1
    $\begingroup$ Thank you for the correction, indeed I was unaware of the line of code where you made the correction." $\endgroup$ Apr 4 at 23:55
4
$\begingroup$
  • 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]

enter image description here

$\endgroup$
3
$\begingroup$

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:

enter image description here

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

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.