24小时热门版块排行榜    

CyRhmU.jpeg
查看: 2046  |  回复: 18

xxppyy

木虫 (小有名气)

[求助] 用 Mathematica 分解因式

请教:
       如何在实数(实代数数)范围内将整系数高次多项式分解为一次式与不可再分解的二次式的乘积?比如将 x^4+1 分解为 (x^2-√2 x+1)(x^2+√2 x+1)。以及类似地将有理分式分解为部分分式。
回复此楼
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
回帖支持 ( 显示支持度最高的前 50 名 )

walk1997

金虫 (著名写手)


jjdg: 金币+1, 感谢参与 2012-12-16 00:19:35
上面代码显示好像不对 下面这个
f[x_] := x^7 + 2
t1 = x /. Solve[f[x] == 0, x];
t1 = DeleteCases[t1, x_ /; Element[x, Reals]];
t2 = x /. Solve[f[x] == 0, x, Reals];
r1 = Table[
    Solve[ComplexExpand[Im[t1[]^2 - a*t1[] + b]] == 0, a], {i,
     1, Length[t1]}] // Flatten;
r1 = DeleteDuplicates[r1];
r2 = Table[
    Solve[ComplexExpand[Re[t1[]^2 - a*t1[] + b]] == 0, b], {i,
     1, Length[t1]}] // Flatten;
r2 = DeleteDuplicates[r2];
r3 = Table[{r1[], r2[] /. r1[]}, {i, 1, Length[r1]}];
ff1 = Table[temp1 = x^2 - a*x + b /. r3[] // Expand; Print[temp1];
   temp1, {i, 1, Length[r3]}];
ff2 = Table[temp1 = x - t2[]; Print[temp1];
   temp1, {i, 1, Length[t2]}];
ff = Join[ff1, ff2];
Apply[Times, ff]
Apply[Times, ff] // N // Chop
7楼2012-12-15 13:52:59
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
普通回帖

哇塞泡泡

新虫 (初入文坛)

【答案】应助回帖

感谢参与,应助指数 +1
楼主,你能给我发份mathematica软件包吗?我是初学者,但是目前还没找到资源。。。
水村山郭酒旗风
2楼2012-12-11 11:25:31
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

situxuming

新虫 (初入文坛)

【答案】应助回帖

★ ★ ★ ★ ★ ★ ★ ★ ★ ★
感谢参与,应助指数 +1
xxppyy: 金币+10, 有帮助 2012-12-13 14:54:36
Factor[x^4 + 1, Extension -> Sqrt[2]]

-(-1 + Sqrt[2] x - x^2) (1 + Sqrt[2] x + x^2)

多看看Factor一些函数Extension的选项
3楼2012-12-11 17:55:38
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

situxuming

新虫 (初入文坛)

引用回帖:
2楼: Originally posted by 哇塞泡泡 at 2012-12-11 11:25:31
楼主,你能给我发份mathematica软件包吗?我是初学者,但是目前还没找到资源。。。

http://tieba.baidu.com/p/2015697277这里有下载,百度网盘
4楼2012-12-11 17:57:38
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

xxppyy

木虫 (小有名气)

引用回帖:
3楼: Originally posted by situxuming at 2012-12-11 17:55:38
Factor

-(-1 + Sqrt x - x^2) (1 + Sqrt x + x^2)

多看看Factor一些函数Extension的选项

谢谢关注!
我的意思是找一个能处理该类问题的一般方法。
Extension-> Sqrt[2] 选项只在分解 x^4 + 1时有效,对 x^4 + 2 就无能为力,我的问题源自于分解 x^7 + 2,也试过 Extension-> Automatic,无效!
5楼2012-12-13 15:02:59
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

walk1997

金虫 (著名写手)

★ ★
jjdg: 金币+2, 感谢参与 2012-12-16 00:19:27
我写了个很笨的代码求这个问题  
可能内部有非常简洁的方法  另外 也没怎么优化 看样子 能求你说的情况
---------code-------------
Clear["Global`*"];
f[x_] := x^7 + 2
t1 = x /. Solve[f[x] == 0, x];
t1 = DeleteCases[t1, x_ /; Element[x, Reals]];
t2 = x /. Solve[f[x] == 0, x, Reals];
r1 = Table[
    Solve[ComplexExpand[Im[t1[]^2 - a*t1[] + b]] == 0, a], {i,
     1, Length[t1]}] // Flatten;
r1 = DeleteDuplicates[r1];
r2 = Table[
    Solve[ComplexExpand[Re[t1[]^2 - a*t1[] + b]] == 0, b], {i,
     1, Length[t1]}] // Flatten;
r2 = DeleteDuplicates[r2];
r3 = Table[{r1[], r2[] /. r1[]}, {i, 1, Length[r1]}];
ff1 = Table[temp1 = x^2 - a*x + b /. r3[] // Expand; Print[temp1];
   temp1, {i, 1, Length[r3]}];
ff2 = Table[temp1 = x - t2[]; Print[temp1];
   temp1, {i, 1, Length[t2]}];
ff = Join[ff1, ff2];
Apply[Times, ff]
Apply[Times, ff] // N // Chop
------------------------------------------------------
结果:
解析形式:
(x+Power[2, (7)^-1]) (x^2-Power[2, (7)^-1] x cos((3 \[Pi])/14) csc(\[Pi]/7)-2^(2/7) sin((3 \[Pi])/14)+2^(2/7) cos((3 \[Pi])/14) cot(\[Pi]/7)) (x^2-Power[2, (7)^-1] x sin(\[Pi]/7) sec(\[Pi]/14)+2^(2/7) cos(\[Pi]/7)+2^(2/7) sin(\[Pi]/7) tan(\[Pi]/14)) (x^2+Power[2, (7)^-1] x cos(\[Pi]/14) sec((3 \[Pi])/14)+2^(2/7) sin(\[Pi]/14)+2^(2/7) cos(\[Pi]/14) tan((3 \[Pi])/14))
数值化:
(x+1.10409) (x^2-1.9895 x+1.21901) (x^2-0.491366 x+1.21901) (x^2+1.37678 x+1.21901)
6楼2012-12-15 13:50:02
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

walk1997

金虫 (著名写手)

jjdg: 您可以把正确的贴一次或直接在上面的代码里边改吗? 2012-12-16 00:24:03
看样子 有些行数太长 显示始终不对
上面斜着的代码里面 [[]] 里头都有个 i 的  copy过来丢了....
8楼2012-12-15 13:55:08
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

xxppyy

木虫 (小有名气)

引用回帖:
7楼: Originally posted by walk1997 at 2012-12-15 13:52:59
上面代码显示好像不对 下面这个
f := x^7 + 2
t1 = x /. Solve;
t1 = DeleteCases;
t2 = x /. Solve;
r1 = Table[
    Solve[ComplexExpand[Im[t1[]^2 - a*t1] == 0, a], {i,
     1, Length}] // Flatten; ...

抱歉,我不懂程序,试运行了一下也没有重现你的结果。不知道是否有内部命令?无论如何十分感谢你的帮助!
9楼2012-12-15 18:32:54
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

walk1997

金虫 (著名写手)

下面这个代码应该可以直接copy过去运行 我用mathematica8.04
第一行的函数可以改成其他多项式
--------------------
f[x_] := x^7 + 2
t1 = x /. Solve[f[x] == 0, x];
t1 = DeleteCases[t1, x_ /; Element[x, Reals]];
t2 = x /. Solve[f[x] == 0, x, Reals];
eq1 := {ComplexExpand[Im[t1[]^2 - a*t1[] + b]] == 0};
r1 = Table[Solve[eq1, a], {i, 1, Length[t1]}] // Flatten;
r1 = DeleteDuplicates[r1];
eq2 := {ComplexExpand[Re[t1[]^2 - a*t1[] + b]] == 0};
r2 = Table[Solve[eq2, b], {i, 1, Length[t1]}] // Flatten;
r2 = DeleteDuplicates[r2];
r3 = Table[{r1[], r2[] /. r1[]}, {i, 1, Length[r1]}];
ff1 = Table[temp1 = x^2 - a*x + b /. r3[] // Expand; Print[temp1];
   temp1, {i, 1, Length[r3]}];
ff2 = Table[temp1 = x - t2[]; Print[temp1];
   temp1, {i, 1, Length[t2]}];
ff = Join[ff1, ff2];
N[Apply[Times, ff], 20]
10楼2012-12-16 10:52:12
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
相关版块跳转 我要订阅楼主 xxppyy 的主题更新
信息提示
请填处理意见