Message Boards Message Boards

1
|
32894 Views
|
5 Replies
|
8 Total Likes
View groups...
Share
Share this post:

4-degree polynomial passing through given 3 points

Posted 11 years ago
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.
POSTED BY: yongran kim
5 Replies
Posted 11 years ago
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!
POSTED BY: yongran kim
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 HermiteHLaguerre, 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]}
     ] &
   ]]


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}
]
POSTED BY: Michael Rogers
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"}]

POSTED BY: Vitaliy Kaurov
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.

 
POSTED BY: Ilian Gachevski
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]

POSTED BY: Vitaliy Kaurov
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract