1
|
7187 Views
|
5 Replies
|
8 Total Likes
View groups...
Share
GROUPS:

# 4-degree polynomial passing through given 3 points

Posted 10 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 get2 + x + 3 x^2This 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.
5 Replies
Sort By:
Posted 10 years ago
 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.ExamplesIn: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^4Code: 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} ] Posted 10 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 10 years ago
 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 10 years ago
 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 10 years ago
 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 droppedg[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] 