Mathmatica多项式带余除法代码

几乎没有调用内置函数，除了求多项式最高次数时用了一下 Exponent[]

(*解析多项式*)
(*将f=a0+a1*x+...+an*x^n解析成{{a0,0},{a1,1},...,{an,n}}的形式*)
polyCoefficients[f_] := Module[{
   rules1 = {
     c_*base_^power_ -> {c, power},
     base_^power_ -> {1, power},
     c_*x_ -> {c, 1},
     c_ /; NumberQ[c] -> {c, 0},
     x_ /; AtomQ[x] -> {1, 1}},
   g = If[Head[f] === Plus, f, List[Expand[f]]]},
  Replace[List @@ g, rules1, 1]]

(*把解析出来的列表还原成多项式*)
toPolynomial[list_List] := 
 Sum[list[[i, 1]]*x^list[[i, 2]], {i, Length[list]}]

(*两个多项式 "相除"*)
divide[f_, g_] := 
 Module[{cf = polyCoefficients[f], cg = polyCoefficients[g], lf, lg, 
   p},
  lf = cf[[-1]]; lg = cg[[-1]];
  p = {{lf[[1]]/lg[[1]], lf[[2]] - lg[[2]]}};
  {toPolynomial[p], Simplify[f - g*toPolynomial[p]]}]

(*多项式的带余除法*)
(*对polyQuotient[f,g]，输出{d,r}满足f=g*d+r且degree(r)<degree(g)*)
polyQuotient[f_, g_] := Module[{q = 0, r = f, d = 0},
  While[Exponent[r, x] >= Exponent[g, x],
   {q, r} = Expand[divide[r, g]];
   d = d + q;
   ];
  {d, r}]

简单验证：

[In]:=
f = x^7 + 6 x^5; g = x^3 + x;
{u, r} = polyQuotient[f, g]
u*g + r // Expand

[Out]=
{-5 + 5 x^2 + x^4, 5 x}
6 x^5 + x^7