Wolfram mathematica FindRoot vs Solve、Solve和Reduce_Wolfram Mathematica

Wolfram mathematica FindRoot vs Solve、Solve和Reduce

wolfram-mathematica

Wolfram mathematica FindRoot vs Solve、Solve和Reduce,wolfram-mathematica,Wolfram Mathematica,首先是一些非必要的娱乐环境。我真正的问题就在下面。请不要碰刻度盘我在玩Mathematica 8的新概率函数。目标是做一个简单的电源分析。实验的幂为1减去第二类错误的概率（即，宣布“无影响”，而实际上有影响）作为一个例子，我选择了一个实验来确定一枚硬币是否公平。假设抛尾巴的概率由b给出（一枚公平硬币的b=0.5），那么确定硬币在n次抛硬币实验中有偏的能力由下式给出 1 - Probability[-in <= x - n/2 <= in, x \[Distributed] Bin

首先是一些非必要的娱乐环境。我真正的问题就在下面。请不要碰刻度盘

我在玩Mathematica 8的新概率函数。目标是做一个简单的电源分析。实验的幂为1减去第二类错误的概率（即，宣布“无影响”，而实际上有影响）

作为一个例子，我选择了一个实验来确定一枚硬币是否公平。假设抛尾巴的概率由b给出（一枚公平硬币的b=0.5），那么确定硬币在n次抛硬币实验中有偏的能力由下式给出

1 - Probability[-in <= x - n/2 <= in, x \[Distributed] BinomialDistribution[n, b]]

因此，

Reduce

设法找到了这两种解决方案，但它发现了许多其他完全错误的解决方案

FindRoot

在这里效果最好：

In[57]:= FindRoot[{Probability[-in <= x - n/2 <= in, 
             x \[Distributed] BinomialDistribution[n, b]] - 0.15`}, {b, 0.2, 0, 0.5}]
         FindRoot[{Probability[-in <= x - n/2 <= in, 
             x \[Distributed] BinomialDistribution[n, b]] - 0.15`}, {b, 0.8, 0.5, 1}]

Out[57]= {b -> 0.265122}

Out[58]= {b -> 0.734878}

In[57]：=FindRoot[{Probability[-In嗯，这不是一个正确的答案，而是一个有趣的观察。Solve[]
与使用magic（又名maxextractions
）选项时的Reduce[]

具有相同的行为：

n=40;
in=6;
Solve[Probability[-in<=x-n/2<=in,
      x\[Distributed]BinomialDistribution[n,b]]==0.15 &&
      0<=b<=1,b, MaxExtraConditions->1]

{{b -> 0.265122}, {b -> 0.736488}, {b -> 0.80151}, {b -> 0.825884}, 
 {b -> 0.84573}, {b -> 0.890444}, {b -> 0.931972}, {b -> 0.960252}, 
 {b -> 0.985554}}

n=40；
in=6；
求解[概率[-in 0.80151}，{b->0.825884}，
{b->0.84573}，{b->0.890444}，{b->0.931972}，{b->0.960252}，
{b->0.985554}

我认为问题在于高阶多项式求根的数值不稳定性：

In[1]:= n=40; in=6;
        p[b_]:= Probability[-in<=x-n/2<=in,
                            x\[Distributed]BinomialDistribution[n,b]]

In[3]:= Solve[p[b]==0.15 && 0<=b<=1, b, MaxExtraConditions->0]
        1-p[b]/.%
Out[3]= {{b->0.75}}
Out[4]= {0.896768}

In[5]:= Solve[p[b]==0.15 && 0<=b<=1, b, MaxExtraConditions->1]
        1-p[b]/.%
Out[5]= {{b->0.265122},{b->0.736383},{b->0.801116},{b->0.825711},{b->0.845658},{b->0.889992},{b->0.931526},{b->0.958879},{b->0.986398}}
Out[6]= {0.85,0.855143,0.981474,0.994151,0.998143,0.999946,1.,1.,1.}

In[7]:= Solve[p[b]==3/20 && 0<=b<=1, b, MaxExtraConditions->0]//Short
        1-p[b]/.%//N
Out[7]//Short= {{b->Root[-1+<<39>>+108299005920 #1^40&,2]},{b->Root[<<1>>&,3]}}
Out[8]= {0.85,0.85}

In[9]:= Solve[p[b]==0.15`100 && 0<=b<=1, b, MaxExtraConditions->0]//N
        1-p[b]/.%
Out[9]= {{b->0.265122},{b->0.734878}}
Out[10]= {0.85,0.85}

从该图中，您可以确认零位于（近似值） {b->0.265122}，{b->0.734878}。但是，要获得凸起右侧的平坦部分，需要大量的数值取消。以下是没有显式

工作精度

选项时的情况：

此图清楚说明了使用

MaxConditions->1进行Reduce
（或Solve
）查找（从左到右）的原因，请参见上文[5]

中的

第一个解决方案正确，第二个解决方案几乎正确，然后是一大堆积垢。
处理这一问题时，不同的数值方法的效果会有所不同
（1） 那些找到所有多项式根的人有着最困难的工作，因为他们可能需要处理收缩多项式
（2） 多项式是一个具有大量多重性的扰动，我认为数值方法会有麻烦
（3） 根的大小都在1-2个数量级以内，所以这和根围绕单位圆的一般“坏”多项式并不遥远
（4） 最困难的是处理解[numeric eqn and ineq]。这必须将不等式求解方法（即柱面分解）与机器算法相结合。别指望有什么仁慈。好吧，这是单变量的，因此相当于Sturm序列或笛卡尔符号规则。在数值上表现仍然不好
下面是一些使用各种方法设置的实验
n = 40; in = 6;
p[b_] := Probability[-in <= x - n/2 <= in, 
  x \[Distributed] BinomialDistribution[n, b]]

r1 = NRoots[p[b] == .15, b, Method -> "JenkinsTraub"];
r2 = NRoots[p[b] == .15, b, Method -> "Aberth"];
r3 = NRoots[p[b] == .15, b, Method -> "CompanionMatrix"];
r4 = NSolve[p[b] == .15, b];
r5 = Solve[p[b] == 0.15, b];
r6 = Solve[p[b] == 0.15 && Element[b, Reals], b];
r7 = N[Solve[p[b] == 15/100 && Element[b, Reals], b]]; 
r8 = N[Solve[p[b] == 15/100, b]];

Sort[Cases[b /. {ToRules[r1]}, _Real]]
Sort[Cases[b /. {ToRules[r2]}, _Real]]
Sort[Cases[b /. {ToRules[r3]}, _Real]]
Sort[Cases[b /. r4, _Real]]
Sort[Cases[b /. r5, _Real]]
Sort[Cases[b /. r6, _Real]]
Sort[Cases[b /. r7, _Real]]
Sort[Cases[b /. r8, _Real]]

{-0.128504, 0.265122, 0.728, 1.1807, 1.20794, 1.22063}

{-0.128504, 0.265122, 0.736383, 0.801116, 0.825711, 0.845658, \
0.889992, 0.931526, 0.958879, 0.986398, 1.06506, 1.08208, 1.18361, \
1.19648, 1.24659, 1.25157}

{-0.128504, 0.265122, 0.733751, 0.834331, 0.834331, 0.879148, \
0.879148, 0.910323, 0.97317, 0.97317, 1.08099, 1.08099, 1.17529, \
1.17529, 1.23052, 1.23052}

{-0.128504, 0.265122, 0.736383, 0.801116, 0.825711, 0.845658, \
0.889992, 0.931526, 0.958879, 0.986398, 1.06506, 1.08208, 1.18361, \
1.19648, 1.24659, 1.25157}

{-0.128504, 0.265122, 0.736383, 0.801116, 0.825711, 0.845658, \
0.889992, 0.931526, 0.958879, 0.986398, 1.06506, 1.08208, 1.18361, \
1.19648, 1.24659, 1.25157}

{-0.128504, 0.75}

{-0.128504, 0.265122, 0.734878, 1.1285}

{-0.128504, 0.265122, 0.734878, 1.1285}

Daniel Lichtblau[12]中的30/3不应该是30/2吗？既然绘图是用[3]中的命令绘制的，那么命令中的%如何引用[12]中的展开？我想知道，因为我没有在我的绘图中使用这个WorkingPrecision->100
设置，为什么我的绘图仍然平滑，不像你的第二个绘图那样疯狂？事实上，我根本无法复制你的第二个绘图。输入plot[Expand@（30/3p[b]-1）//Evaluate，{b，-1/10，11/10}
（没有WorkingPrecision
）给我你的第一张图。你在用mma7吗？我在用8，它也许能更好地处理像这样的困难情况。@Sjoerd感谢你指出拼写错误-现在修好了！至于第二张图，它正是它声称的那样。我不确定为什么你的机器会不同。@Sjoerd:比较你的out[55]和out[56]在我的Out[5]和Out[6]中，机器精度下的数字看起来很相似，但不完全相同……您将30/3更改为20/3，而您需要更改为30/2。如果我在Plot命令中粘贴扩展的多项式表达式，我现在可以重现野生行为（我在上面的注释中尝试的n和in值是错误的）有趣的是，如果我绘制<代码>30/2概率[-在@Sjoerd中：我非常确定20/3==1/0.15
…无论如何，是展开
导致了问题-它使多项式的形式在数值上比原始多项式更糟糕。当求解和减少生成根[poly，n]时，展开会自动应用
对象。当根中的多项式变成标准形式且系数只有机器精度时，就会出现数值问题。谢谢Daniel。很好的分析。我只是想知道各种例程是否不应该检查自己的结果。替换原始方程中的答案（b）（p[b]==0.15）例如，案例4的p[b]为{0.15,0.15,0.144968,0.0181931,0.00598588,0.00200976,0.0000353934,1.91439*10^-7,4.91803*10^-10,5.99531*10^-17,2.67065*10^-6,0.0000768558,79.0574,228.802,14741.7,27520.6}，在那里很容易找到正确的。这样的检查看起来不太难实现（在我天真且可能不合理的观点中）。我不确定替换是否会有帮助。很可能的是，根的集合（其中许多是关闭的）将给出一个系数非常接近原始值的多项式（注意：我没有检查这个），如果是这样，那么抛光一个或多个将以牺牲整个“闭合”多项式为代价。抛光所有这些多项式（例如，通过牛顿迭代）可能会有以下任何或所有问题。（1）可能太慢。（2）如果多项式接近一个多根多项式，则条件可能不太好。（3）可能会遇到通货紧缩问题。我承认我只是在猜测。我不是想润色和/或进行另一次迭代，而是想发出警告或从输出中删除不正确的词根。@Daniel-聚会晚了几个月…回忆其他困难/解决方法的演示
In[57]:= FindRoot[{Probability[-in <= x - n/2 <= in, 
             x \[Distributed] BinomialDistribution[n, b]] - 0.15`}, {b, 0.2, 0, 0.5}]
         FindRoot[{Probability[-in <= x - n/2 <= in, 
             x \[Distributed] BinomialDistribution[n, b]] - 0.15`}, {b, 0.8, 0.5, 1}]

Out[57]= {b -> 0.265122}

Out[58]= {b -> 0.734878}

In[42]:= Probability[-in <= x - n/2 <= in, 
 x \[Distributed] BinomialDistribution[n, b]]

Out[42]= 23206929840 (1 - b)^26 b^14 + 40225345056 (1 - b)^25 b^15 + 
 62852101650 (1 - b)^24 b^16 + 88732378800 (1 - b)^23 b^17 + 
 113380261800 (1 - b)^22 b^18 + 131282408400 (1 - b)^21 b^19 + 
 137846528820 (1 - b)^20 b^20 + 131282408400 (1 - b)^19 b^21 + 
 113380261800 (1 - b)^18 b^22 + 88732378800 (1 - b)^17 b^23 + 
 62852101650 (1 - b)^16 b^24 + 40225345056 (1 - b)^15 b^25 + 
 23206929840 (1 - b)^14 b^26

n=40;
in=6;
Solve[Probability[-in<=x-n/2<=in,
      x\[Distributed]BinomialDistribution[n,b]]==0.15 &&
      0<=b<=1,b, MaxExtraConditions->1]

{{b -> 0.265122}, {b -> 0.736488}, {b -> 0.80151}, {b -> 0.825884}, 
 {b -> 0.84573}, {b -> 0.890444}, {b -> 0.931972}, {b -> 0.960252}, 
 {b -> 0.985554}}

In[1]:= n=40; in=6;
        p[b_]:= Probability[-in<=x-n/2<=in,
                            x\[Distributed]BinomialDistribution[n,b]]

In[3]:= Solve[p[b]==0.15 && 0<=b<=1, b, MaxExtraConditions->0]
        1-p[b]/.%
Out[3]= {{b->0.75}}
Out[4]= {0.896768}

In[5]:= Solve[p[b]==0.15 && 0<=b<=1, b, MaxExtraConditions->1]
        1-p[b]/.%
Out[5]= {{b->0.265122},{b->0.736383},{b->0.801116},{b->0.825711},{b->0.845658},{b->0.889992},{b->0.931526},{b->0.958879},{b->0.986398}}
Out[6]= {0.85,0.855143,0.981474,0.994151,0.998143,0.999946,1.,1.,1.}

In[7]:= Solve[p[b]==3/20 && 0<=b<=1, b, MaxExtraConditions->0]//Short
        1-p[b]/.%//N
Out[7]//Short= {{b->Root[-1+<<39>>+108299005920 #1^40&,2]},{b->Root[<<1>>&,3]}}
Out[8]= {0.85,0.85}

In[9]:= Solve[p[b]==0.15`100 && 0<=b<=1, b, MaxExtraConditions->0]//N
        1-p[b]/.%
Out[9]= {{b->0.265122},{b->0.734878}}
Out[10]= {0.85,0.85}

In[12]:= Expand@(20/3 p[b] - 1)
Out[12]= -1 + 154712865600 b^14 - 3754365538560 b^15 + 43996471155000 b^16 - 
         331267547520000 b^17 + 1798966820560000 b^18 - 
         7498851167808000 b^19 + 24933680132961600 b^20 - 
         67846748661120000 b^21 + 153811663157880000 b^22 - 
         294248399084640000 b^23 + 479379683508726000 b^24 - 
         669388358063093760 b^25 + 804553314979680000 b^26 - 
         834351666126339200 b^27 + 747086226686186400 b^28 - 
         577064755104364800 b^29 + 383524395817442880 b^30 - 
         218363285636496000 b^31 + 105832631433929400 b^32 - 
         43287834659596800 b^33 + 14776188957129600 b^34 - 
         4150451102878080 b^35 + 942502182076000 b^36 - 
         168946449235200 b^37 + 22970789150400 b^38 -
         2165980118400 b^39 + 108299005920 b^40
In[13]:= Plot[%, {b, -1/10, 11/10}, WorkingPrecision -> 100]

n = 40; in = 6;
p[b_] := Probability[-in <= x - n/2 <= in, 
  x \[Distributed] BinomialDistribution[n, b]]

r1 = NRoots[p[b] == .15, b, Method -> "JenkinsTraub"];
r2 = NRoots[p[b] == .15, b, Method -> "Aberth"];
r3 = NRoots[p[b] == .15, b, Method -> "CompanionMatrix"];
r4 = NSolve[p[b] == .15, b];
r5 = Solve[p[b] == 0.15, b];
r6 = Solve[p[b] == 0.15 && Element[b, Reals], b];
r7 = N[Solve[p[b] == 15/100 && Element[b, Reals], b]]; 
r8 = N[Solve[p[b] == 15/100, b]];

Sort[Cases[b /. {ToRules[r1]}, _Real]]
Sort[Cases[b /. {ToRules[r2]}, _Real]]
Sort[Cases[b /. {ToRules[r3]}, _Real]]
Sort[Cases[b /. r4, _Real]]
Sort[Cases[b /. r5, _Real]]
Sort[Cases[b /. r6, _Real]]
Sort[Cases[b /. r7, _Real]]
Sort[Cases[b /. r8, _Real]]

{-0.128504, 0.265122, 0.728, 1.1807, 1.20794, 1.22063}

{-0.128504, 0.265122, 0.736383, 0.801116, 0.825711, 0.845658, \
0.889992, 0.931526, 0.958879, 0.986398, 1.06506, 1.08208, 1.18361, \
1.19648, 1.24659, 1.25157}

{-0.128504, 0.265122, 0.733751, 0.834331, 0.834331, 0.879148, \
0.879148, 0.910323, 0.97317, 0.97317, 1.08099, 1.08099, 1.17529, \
1.17529, 1.23052, 1.23052}

{-0.128504, 0.265122, 0.736383, 0.801116, 0.825711, 0.845658, \
0.889992, 0.931526, 0.958879, 0.986398, 1.06506, 1.08208, 1.18361, \
1.19648, 1.24659, 1.25157}

{-0.128504, 0.265122, 0.736383, 0.801116, 0.825711, 0.845658, \
0.889992, 0.931526, 0.958879, 0.986398, 1.06506, 1.08208, 1.18361, \
1.19648, 1.24659, 1.25157}

{-0.128504, 0.75}

{-0.128504, 0.265122, 0.734878, 1.1285}

{-0.128504, 0.265122, 0.734878, 1.1285}

mags4 = Sort[Abs[b /. r4]]

Out[77]= {0.128504, 0.129867, 0.129867, 0.13413, 0.13413, 0.141881, \
0.141881, 0.154398, 0.154398, 0.174443, 0.174443, 0.209069, 0.209069, \
0.265122, 0.543986, 0.543986, 0.575831, 0.575831, 0.685011, 0.685011, \
0.736383, 0.801116, 0.825711, 0.845658, 0.889992, 0.902725, 0.902725, \
0.931526, 0.958879, 0.986398, 1.06506, 1.08208, 1.18361, 1.19648, \
1.24659, 1.25157, 1.44617, 1.44617, 4.25448, 4.25448}

mags8 = Sort[Abs[b /. r8]]

Out[78]= {0.128504, 0.129867, 0.129867, 0.13413, 0.13413, 0.141881, \
0.141881, 0.154398, 0.154398, 0.174443, 0.174443, 0.209069, 0.209069, \
0.265122, 0.543985, 0.543985, 0.575831, 0.575831, 0.685011, 0.685011, \
0.734878, 0.854255, 0.854255, 0.902725, 0.902725, 0.94963, 0.94963, \
1.01802, 1.01802, 1.06769, 1.06769, 1.10183, 1.10183, 1.12188, \
1.12188, 1.1285, 1.44617, 1.44617, 4.25448, 4.25448}

Chop[mags4 - mags8, 10^(-6)]

Out[82]= {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, \
0.00150522, -0.0531384, -0.0285437, -0.0570674, -0.0127339, \
-0.0469044, -0.0469044, -0.0864986, -0.0591449, -0.0812974, \
-0.00263812, -0.0197501, 0.0817724, 0.0745959, 0.124706, 0.123065, 0, \
0, 0, 0}