mathematica是否可以把複雜代數方程(帶根號)轉化成多項式方程？

mathematica可以求出符號解，但是結果太複雜

原方程是個含幾個二次根號的代數方程，按道理經過有限次平方就可以轉成普通高次方程，儘管這個高次方程的解很多會是增根

有沒有方法讓mathematica直接輸出這個多項式方程表達式？

方程的形式是

1 + x + d1 x + a1 x^2 + e1 (e2 + d2 x + Sqrt[c2 + x (b2 + a2 x)]) +

b1 x (e2 + d2 x + Sqrt[c2 + x (b2 + a2 x)]) +

c1 (e2 + d2 x + Sqrt[c2 + x (b2 + a2 x)])^2 = 0

---

發現內置函數：GroebnerBasis

The set of polynomials in a Gr?bner basis have the same collection of roots as the original polynomials.

完全滿足你的要求。

對於這種需求的使用方法：

GroebnerBasis[expr,var][[1]]


例如：

GroebnerBasis[
1 + x + d1 x + a1 x^2 + e1 (e2 + d2 x + Sqrt[c2 + x (b2 + a2 x)]) +
b1 x (e2 + d2 x + Sqrt[c2 + x (b2 + a2 x)]) +
c1 (e2 + d2 x + Sqrt[c2 + x (b2 + a2 x)])^2 == 0,
x][[1]]~Collect~x


和我昨天寫的程序對比圖如下，得到的結果是一樣的：

--------------------------------------------

寫了一段代碼

ExpandEquationWithSqrt[expr_, var_] :=
Module[{process, sqrts, iter, expr2}, expr2 = Expand[expr];
process = {ReleaseHold[Delete[Hold[Evaluate@expr2], {1, 0}]]};
sqrts = DeleteDuplicates@
Select[Flatten@(If[
ToString[#[[0]]] ==
"Times", {ReleaseHold[
Delete[Hold[Evaluate@#], {1, 0}]]}, #] /@
process), #[[0]] == Power #[[2]] == 1/2 ];
sqrts = Select[sqrts,
MemberQ[DeleteDuplicates@Cases[#, _Symbol, Infinity], var] ];
iter[1] = expr2;
If[Length[sqrts] &>= 1,
Do[iter[i] = Collect[iter[i], sqrts[[i]]];
iter[i +
1] = (iter[i] -
PolynomialMod[iter[i], sqrts[[i]]])^2 - (PolynomialMod[
iter[i], sqrts[[i]]])^2, {i, Length[sqrts]}];
ExpandEquationWithSqrt[iter[Length[sqrts] + 1], var],
Collect[Expand@expr2, var]]]


效果如下，我覺得這個才是你想要的（等於零我沒有加上）：

（update2：增加了功能，1.只化簡所需變數，需指定。2.可以處理nested square root）

效果：

（update：修復了一處bug）

（mma新手，並不能保證沒有bug，歡迎指出）

----------------------------------

不知道你要算的是什麼樣子的方程，也不知道這樣的方法可不可行。

吐槽：知乎上的語言為什麼沒有mma？

---

推薦閱讀：