风花醉蝶·【一元五次方程锁根公式定理】

风花飘飘

解方程代码，如果还有谁瞎哔哔说一元五次没有根式解时，你直接运行代码（只需输入方程的6个系数即可），把输出的五个根式表达式砸他脸上…

代码如下：


(*嫦娥灵枢体系·蝶恋花公式新版(p分p=0/p≠0分支)+Bring‑Jerrard退化接口自动切换完整合并代码
适配一般五次方程 a x^5+b x^4+c x^3+d x^2+e x+f==0
第一层判别：B3‑A2C=0？是则转入Bring‑Jerrard配对公理求解全部五根；
第二层非退化时：按p=0、p≠0分支求解q，p≠0用q=B/p，p=0用根式求解q*)
ClearAll["Global`*"];
Off[Solve::ifun]; Off[N::meprec];

(*====================1.参数入口：输入五次方程系数====================*)
{a, b, c, d, e, f} = {1, 0, 0, 0, -1, 1};(*测试方程 x^5‑x+1==0 *)
precision = 1000;(*全局计算精度位数*)

(*====================2.计算蝶恋花体系中间变量A,B,C,D====================*)
A = c/a - b^2/(5 a^2);
B = d/a - (b c)/(5 a^2) + (2 b^3)/(25 a^3);
C = e/a - (2 b d)/(5 a^2) + (b^2 c)/(25 a^3) - (3 b^4)/(125 a^4);
D = f/a - (b e)/(5 a^2) + (b^2 d)/(25 a^3) - (b^3 c)/(125 a^4) + (4 b^5)/(3125 a^5);

Print["=====第一步：中间变量A,B,C,D计算结果====="];
Print["A = ", N[A, 60]];
Print["B = ", N[B, 60]];
Print["C = ", N[C, 60]];
Print["D = ", N[D, 60]];

(*====================3.退化判断基准 base=B3‑A2C====================*)
base = B^3 - A^2*C;
n = Surd[base, 3];
Print["\n=====第二步：退化条件判定====="];
Print["判别式 B3‑A2C = ", base];

If[Chop[base, 10^(-30)] != 0,
(*————————————分支1：非退化情形，执行蝶恋花新版分p=0/p≠0主根公式————————————*)
Print["判定结果：非退化，执行蝶恋花新版分p零值分支求解模式"];
(*对应新版公式里的m，内层表达式 m=‑n*m/n化简为‑m原式：内层根号内(-n*m)/n *)
innerSqrt = Sqrt[(-n*B)/n];(*根号项 Sqrt[‑n*m/n]，此处取m=B*)
p = Surd[n + innerSqrt, 5];
(*分p≠0、p=0两支求q*)
If[Chop[p, 10^(-30)] != 0,
q = B/p;
Print["p≠0分支生效，q = B/p = ", N[q,60]],
q = Surd[n - innerSqrt, 5];
Print["p=0分支生效，用根式求解q = ", N[q,60]];
];
(*新版主根公式 x1=((p+q)-2b)/(10a)*)
x1 = ((p + q) - 2*b)/(10*a);
(*高精度数值计算与验根*)
x1Num = N[x1, precision];
residual = Chop[N[a*x1^5 + b*x1^4 + c*x1^3 + d*x1^2 + e*x1 + f, precision], 10^(-precision + 10)];
(*格式化输出*)
Print["\n=====蝶恋花新版主根求解结果====="];
Print["简约布林标准五次方程：t^5+", A, "t^3+", B, "t^2+", C, "t+", D, "==0，平移代换整合进主根公式x1=((p+q)-2b)/(10a)"];
Print["辅助量n=Surd[B^3‑A2C,3] = ", N[n,60]];
Print["p = ", N[p,60]];
Print["q = ", N[q,60]];
Print["主根符号闭式：x1 = ((p+q)-2b)/(10a)"];
Print["主根高精度数值解：", N[x1Num, 60]];
Print["代入原方程残差：", residual];
Print["说明：剩余四根可按时展开扩充求解"];,

(*————————————分支2：退化情形base≈0，转入Bring‑Jerrard配对公理完整求解五根————————————*)
Print["判定结果：B3‑A2C≈0，蝶恋花主根公式失效，自动转入Bring‑Jerrard配对公理求解接口"];
(*平移代换还原 t=x+b/(5a)，简约Bring‑Jerrard标准型 x^5+pBJ x+qBJ==0 *)
pBJ = C; qBJ = D;
Print["转入Bring‑Jerrard标准简约五次方程：x^5 + ", pBJ, " x + ", qBJ, " == 0"];
(*配对公理方程组 u^5+v^5=‑4√2 qBJ，u v=‑2 pBJ/25 *)
eqs = {u^5 + v^5 == -4*Sqrt[2]*qBJ, u*v == -2*pBJ/25};
sols = Solve[eqs, {u, v}, Complexes];
(*筛选实分支：(u+v)/Sqrt[2]为实数且绝对值最小*)
realCond[sol_] := Abs[Im[(u + v)/Sqrt[2] /. sol]] < 10^(-precision/2);
realSols = Select[sols, realCond];
{U0, V0} = First[Sort[realSols, Abs[N[(u + v)/Sqrt[2] /. #1]] < Abs[N[(u + v)/Sqrt[2] /. #2]] &]];
{u0, v0} = {U0, V0};
(*五次本原单位根*)
w5 = Exp[2*Pi*I/5];
(*生成全部五个根，叠加平移修正&#8209;b/(5a)*)
rootSym = Table[(u0*w5^(k&#8209;1) + v0*w5^(-(k&#8209;1)))/Sqrt[2] - b/(5*a), {k, 1, 5}];
rootNum = N[rootSym, precision];
(*批量验根计算残差*)
residual = Chop[N[a*#^5 + b*#^4 + c*#^3 + d*#^2 + e*# + f & /@ rootNum, precision], 10^(-precision + 10)];
(*根分类：分离实根、共轭复根对*)
realRoots = Select[rootNum, Abs[Im[#]] < 10^(-20) &];
compRoots = Complement[rootNum, realRoots];
(*格式化完整输出全部解信息*)
Print["\n=====Bring&#8209;Jerrard接口求解全部五个根====="];
Do[
Print["第", k, "个根："];
Print["符号根式解：", rootSym[[k]]];
Print["高精度数值解：", N[rootNum[[k]], 60]];
Print["代入原方程残差：", residual[[k]]];
Print[

风花飘飘

任意n阶多项式方程都有固定根式解，没有不可解的方程，只有没看见的方程，只有看见了方程，它的根就可以直接锁死，也就是所见即所得，命名：“风花醉蝶一步锁死直取法”！
面对数学事实，就是这么豪横！

风花飘飘

论坛上传200K限制约束，图片不清晰。