4-degree polynomial passing through given 3 points

Questions
1

I use mathematica 8. This program has a command ‘InterpolatingPolynomial’. We use this command to find the unique n-degree polynomial passing through given n+1 points.
For example

InterpolatingPolynomial[{{-1, 4}, {0, 2}, {1, 6}}, x]

then I get

2 + x + 3 x^2

This means 2 + x + 3 x^2 is the unique 2-degree polynomial passing through (-1, 4), (0, 2), (1, 6). Note that there are infinitely many 3-degree polynomials passing through (-1, 4), (0, 2), (1, 6). And It is not difficult to express ‘the set of all such 3-degree polynomials’, with additional free variable ‘a’. I mean the solution can be expressed, as a polynomial of variable x and a. Similary it is possible to express ‘the set of 4-degree polynomials passing through (-1, 4), (0, 2), (1, 6)’, with additional free variables ‘a,b’.

In general the problem like “find n-degree polynomials of x passing through given m points” can be solved when n is bigger or equal to m-1, and we need n-(m-1) additional free variables like a,b,…But I do not know how to do it with mathematica. Can you tell me how? Thank you.

2

Here is an experimental approach. We can use Fit (linear fitting) to poke around. Note I Rationalize result hoping it is actually exact.

pts = {{-1, 4}, {0, 2}, {1, 6}};

f[x_] = Rationalize[Fit[pts, x^# & /@ Range[0, 4] , x]]
(* Out = 2 + x/2 + (3 x^2)/2 + x^3/2 + (3 x^4)/2 *)

Or try another function with few terms dropped

g[x_] = Rationalize[Fit[pts, x^# & /@ {0, 1, 4} , x]]
(* Out[] = 2 + x + 3 x^4 *)

Now this turns out to be indeed exact:

f /@ pts[[All, 1]] == pts[[All, 2]]
(* True *)

g /@ pts[[All, 1]] == pts[[All, 2]]
(* True *)

We can also plot it:

Plot[{f[x], g[x]}, {x, -1.1, 1.1}, Epilog -> {Red, PointSize[Large], Point[pts]}, PlotRange -> All, Frame -> True]

qwe354f232f5ghdfxf4w45364f.png
qwe354f232f5ghdfxf4w45364f.png424×276 12.4 KB

3

InterpolatingPolynomial accepts symbolic input in 1D, so something like

InterpolatingPolynomial[{{-1, 4}, {0, 2}, {1, 6}, {2, a}, {3, b}}, x]

gives the family of all 4-degree polynomials passing through the given 3 points. For example, to recover Vitaliy’s two polynomials, take a=37, b=152 and a=52, b=248.

4

Ilian, this is a great approach. I built an app to illustrate it:

Manipulate[
 
 Plot[#, {x, -1.1, 3.1}, 
    Epilog -> {{Red, PointSize[Large], Point[{{-1, 4}, {0, 2}, {1, 6}}]}, 
               {Green, PointSize[Large], Point[{{2, a}, {3, b}}]}}, 
    PlotRange -> All, Frame -> True, ImageSize -> 300, PlotLabel -> #] &[
  Collect[InterpolatingPolynomial[{{-1, 4}, {0, 2}, {1, 6}}~Join~
      Rationalize[{{2, a}, {3, b}}], x] // Expand, x]]
 
 , {{a, 2}, 1, 5, Appearance -> "Labeled"}
 , {{b, 3}, 1, 5, Appearance -> "Labeled"}]

2c9m4kvLKJL329032uido.gif

5

Here is a way that allows you to parametrized the family in terms of one of the standard bases for the space of polynomials. Let the basis be called B. The basis B may be specified by one of the built-in functions, such as HermiteH, Laguerre, etc., or by a user-defined function. An augmented matrix for the linear equations defined a polynomial passing through given points is contructed in terms of coordinates with respect to the basis B. The linear system is solved via RowReduce and NullSpace is used to find a basis for the null space. The basis for the null space, whose vectors are B-coordinate vectors, is multiplied by parameters, a table of Slot, which are used to construct a function that takes parameters as its input and returns the corresponding polynomial function.

Examples

In:

interpolatingFamily[{{-1, 4}, {0, 2}, {1, 6}}, 4, "basis" -> HermiteH]

Out:

Function[{x}, 2 + x (1 - 8 #1 + x (3 - 16 #2 + x (8 #1 + 16 x #2)))] &

In:

interpolatingFamily[{{-1, 4}, {0, 2}, {1, 6}}, 4,  "basis" -> HermiteH][1, 2]

Out:

Function[{x}, 2 + x (1 - 8 1 + x (3 - 16 2 + x (8 1 + 16 x 2)))]

In:

interpolatingFamily[{{-1, 4}, {0, 2}, {1, 6}}, 4,  "basis" -> HermiteH][1, 2][x]

Out:

2 + x (-7 + x (-29 + x (8 + 32 x)))

In:

interpolatingFamily[{{-1, 4}, {0, 2}, {1, 6}}, 4, "basis" -> HermiteH][a, b][x] // Collect[#, x] &

Out

 2 + (1 - 8 a) x + (3 - 16 b) x^2 + 8 a x^3 + 16 b x^4

Code:

ClearAll[basis, interpolatingFamily];

Options[basis] = {"reverseDegree" -> False};

basis::usage = 
  "basis[deg,var,basisFunction,opts] returns a basis up to degree deg in the variable var";

basis[deg_Integer, var_, "powers", opts : OptionsPattern[]] := 
  basis[deg, var, Power[#2, #1] &, opts];

  (* for HermiteH, LaguerreL, etc. *)
basis[deg_Integer, var_, 
   fn : Except[_Rule | RuleDelayed] : (Power[#2, #1] &), 
   opts : OptionsPattern[]] := 
  fn[#, var] & /@ 
   If[TrueQ@ OptionValue["reverseDegree"], Range[deg, 0, -1], Range[0, deg]];

interpolatingFamily::usage = 
  "interpolatingFamily[pts, deg, opts] returns a polynomial function \
iFam[a, b, ...][x] with parameters a, b, ... that interpolates pts";

Options[interpolatingFamily] = {"basis" -> "powers", "reverseDegree" -> False};
interpolatingFamily[pts_?MatrixQ, deg_Integer, opts : OptionsPattern[]] /; deg + 1 >= Length@pts :=
 Module[{mat, y0, aug, solCoords, b},
  Block[{x}, 
   b = basis[deg, x, OptionValue["basis"], FilterRules[{opts}, Options[basis]]];
   mat = (b /. x -> First[#]) & /@ pts;
   y0 = Last /@ pts;
   aug = Transpose[Transpose[mat] ~Append~ y0];
   solCoords = Last /@ RowReduce@aug;
   Evaluate[
     Function @@ {
       {x},
       HornerForm[
        solCoords.Take[b, Length@ pts] +
         If[deg < Length@ pts,
          0,
          Table[Slot[i], {i, deg + 1 - Length@pts}] . Reverse@ NullSpace[mat].b],
        x]}
     ] &
   ]]

A Manipulate toy:

Manipulate[
 deg = Clip[deg, {Length@pts - 1, Length@pts + 2}];
 Plot[
  Evaluate@
   interpolatingFamily[pts, deg, "basis" -> basis][p1, p2, p3][x],
  {x, -3, 3},
  PlotRange -> 20],
 
 {{pts, {{-1, 4}, {0, 2}, {1, 6}}}, Locator, LocatorAutoCreate -> True},
 {{basis, HermiteH}, {"powers", "reversePowers", HermiteH, LaguerreL}},
 {{deg, 4}, Range[1, 10], SetterBar},
 {{p1, 0, "param 1"}, -1, 1},  {{p2, 0, "param 2"}, -1, 1},  {{p3, 0, "param 3"}, -1, 1}
 ]

1Example.png
1Example.png616×648 23.1 KB

6

Thank you so much! Replies here are all useful.
I tried to reply, but somehow my internet browser didn’t allow it.
It just copied what I had wrote… Anyway thank you!