1

如何在 Mathematica 中绘制一组方程的解？即使只有两个变量，这些方程也足够复杂，无法重新排列，因此可以将其中一个变量设置为等于另一个变量的函数（因此对于 具有正确的形式Plot）。

我感兴趣的具体示例如下：

  • 将 a b固定在 (0,1) 中。
  • 让g >= 1 和d >= 1 变化。
  • 然后有一个唯一的x（恰好在 (0,1] 中）使得 x = [(bx + 1) / (x + g)]^d （省略证明）。
  • 我想要 (1 - bg) xd / [(bx + 1) (x + g)] = 1 的对 (d, g) 的图。
4

2 回答 2

3

您想使用 ContourPlot。

http://reference.wolfram.com/mathematica/ref/ContourPlot.html

您也可以使用 ImplicitPlot，但已弃用：

http://reference.wolfram.com/legacy/v5_2/Add-onsLinks/StandardPackages/Graphics/ImplicitPlot.html

于 2011-07-26T17:08:16.713 回答
2

我想你正在寻找一些优雅的方法，但现在这里是如何暴力破解它：

Clear[findx];findx[d_,g_,b_]:=x/.First@FindRoot[x\[Equal]((b x+1)/(x+g))^d,{x,0,1},PrecisionGoal\[Rule]3]
ClearAll[plotQ];
plotQ[d_,g_,b_,eps_]:=Module[
    {x=findx[d,g,b]},
    Abs[(1-b g) x d/((b x+1) (x+g))-1.]<eps]

tbl=Table[{d,g,plotQ[d,g,.1,.001]},{d,4,20,.05},{g,1,1.12,.001}];

（这应该是 10 秒的数量级）。然后绘制点如下：

Reap[
    Scan[
        If[#[[3]] == True,
            Sow@Point[{#[[1]], #[[2]]}]] &,
            Flatten[tbl, 1]]] // Last // Last // 
 Graphics[#, PlotRange -> {{1, 20}, {1, 1.1}}, Axes -> True,
    AspectRatio -> 1, AxesLabel -> {"d", "g"}] &

在此处输入图像描述

痛苦的丑陋方式去解决它，但它就在那里。

请注意，我只是快速写了这个，所以我不保证它是正确的！

编辑：这是仅提供b和步长的方法d：

Clear[findx]; 
findx[d_, g_, b_] := 
 x /. First@
   FindRoot[x \[Equal] ((b x + 1)/(x + g))^d, {x, 0, 1}, 
    PrecisionGoal \[Rule] 3]
ClearAll[plotQ];
plotQ[d_, g_, b_, eps_] := 
 Module[{x = findx[d, g, b]}, 
  Abs[(1 - b g) x d/((b x + 1) (x + g)) - 1.] < eps]

tbl = Table[{d, g, plotQ[d, g, .1, .001]}, {d, 4, 20, .05}, {g, 1, 
    1.12, .001}];

ClearAll[tmpfn];
tmpfn[d_?NumericQ, g_?NumericQ, b_?NumericQ] := 
 With[{x = findx[d, g, b]},
    (1 - b g) x d/((b x + 1) (x + g)) - 1.
  ]

然后

stepsize=.1

(tbl3=Table[
    {d,g/.FindRoot[tmpfn[d,g,.1]\[Equal]0.,
        {g,1,2.},PrecisionGoal\[Rule]2]},
    {d,1.1,20.,stepsize}]);//Quiet//Timing

ListPlot[tbl3,AxesLabel\[Rule]{"d","g"}]

给予

在此处输入图像描述

于 2011-08-01T21:20:32.970 回答