Wolfram mathematica 如何在Mathematica中绘制一组方程的解？

如何在Mathematica中绘制一组方程的解？即使只有两个变量，这些方程也非常复杂，无法重新排列，从而使其中一个变量可以设置为另一个变量的函数，从而具有正确的绘图形式

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

在0,1中固定一个b。 让g>=1和d>=1变化。 然后在0,1]中有一个唯一的x，这样x=[bx+1/x+g]^d证明被省略。 我想要一个d，g对的图，1-bgxd/[bx+1x+g]=1。

---

您想使用轮廓图

您也可以使用隐式绘图，但不推荐使用：

---

您想使用轮廓图

您也可以使用隐式绘图，但不推荐使用：

---

我想你正在寻找一些优雅的方法，但现在这里有一些如何使用暴力的方法：

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}];

这是一种令人痛苦的丑陋方式，但它确实存在

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

编辑：以下是仅为d提供b和步长的方法：

给予

---

我想你正在寻找一些优雅的方法，但现在这里有一些如何使用暴力的方法：

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}];

这是一种令人痛苦的丑陋方式，但它确实存在

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

编辑：以下是仅为d提供b和步长的方法：

给予

---

---

如果我错了，请纠正我，但这两个函数似乎只适用于一个等式。@泰森看一看ContourPlot顶部黄色框中的第三个命令是的，但在“更多信息”下，它说ContourPlot叠加了与第三个命令的所有等式相关联的等高线，这意味着计数包含一个点，如果它是任何方程的解，而不是我要寻找的，这是所有方程的解的点集。如果我错了，请纠正我，但这两个函数似乎只适用于一个等式。@泰森看了看ContourPlot顶部黄色框中的第三个命令是的，但在“更多信息”下，它说ContourPlot叠加了与第三个命令的所有等式相关联的等高线，这意味着如果countour是任何方程的解，而不是我要寻找的，它包含一个点，这是所有方程的解的点集。你能给出一个简单的方程例子吗？有多少个变量和多少个方程？每个方程都是两个变量的函数，对吗？您可以使用该函数。您也可以在同一个绘图中绘制多个3D等式，尽管根据等式的不同，它可能可读，也可能不可读/useful@Simon提供了具体的例子。@Daniel Chisholm One可以解决一个变量，并将问题简化为两个变量。然而，这不是一个3D问题。二维点要么满足方程，要么不满足方程，因此第三维仅为二进制开/关。@Tyson如果你有lefthandsidex，y=righthandsidex，y，那么你对Z=lefthandsidex，y-righthandsidex，y的三维图形感兴趣，它肯定不仅仅是0或1。您对Z=0的图的切片感兴趣。我相信你可以从这里开始；我很久没用mathematica了，你能给我一个简单的等式例子吗？有多少个变量和多少个方程？每个方程都是两个变量的函数，对吗？您可以使用该函数。您也可以在同一个绘图中绘制多个3D等式，尽管根据等式的不同，它可能可读，也可能不可读/useful@Simon提供了具体的例子。@Daniel Chisholm One可以解决一个变量，并将问题简化为两个变量。然而，这不是一个3D问题。二维点要么满足方程，要么不满足方程，因此第三维仅为二进制开/关。@Tyson如果你有lefthandsidex，y=righthandsidex，y，那么你对Z=lefthandsidex，y-righthandsidex，y的三维图形感兴趣，它肯定不仅仅是0或1。您对Z=0的图的切片感兴趣。我相信你可以从这里开始；我很久没用mathematica了别担心，我不是想在这里赢得选美比赛。另外，这也是我所期望的曲线类型。但是，我无法告诉您为此绘图选择的b值。你可能画出了所有的d，g，b三元组，但丢掉了b坐标吗？@Tyson b是plotQ的第三个参数；如果您查看tbl设置为什么，b=.1。顺便说一句，我写这篇文章的方式很难理解，这是一个快速而肮脏的实现，我没有考虑太多。如果你不明白一些事情，继续问我，我真的应该把它清理干净，但是没有太多时间。好的，这个改进怎么样？你说这只是蛮力。好像是李

---

你只需要在2D晶格中寻找所有d，g对中的一个固定b，然后画出真点。正如图中所示，我期望真实点在d中形成一个函数。你能改进它以便只需要给出d的范围和步长吗？@Tyson是的，你理解正确：我只是计算晶格上哪些点是真的，然后绘制它们。@Tyson请参见编辑。你真的试过从分析的角度来简化这个问题吗？别担心，我不是想在这里赢得选美比赛。另外，这也是我所期望的曲线类型。但是，我无法告诉您为此绘图选择的b值。你可能画出了所有的d，g，b三元组，但丢掉了b坐标吗？@Tyson b是plotQ的第三个参数；如果您查看tbl设置为什么，b=.1。顺便说一句，我写这篇文章的方式很难理解，这是一个快速而肮脏的实现，我没有考虑太多。如果你不明白一些事情，继续问我，我真的应该把它清理干净，但是没有太多时间。好的，这个改进怎么样？你说这只是蛮力。看起来你只是在2D晶格中寻找所有的d，g对中的一个固定的b，然后画出真实的点。正如图中所示，我期望真实点在d中形成一个函数。你能改进它以便只需要给出d的范围和步长吗？@Tyson是的，你理解正确：我只是计算晶格上哪些点是真的，然后绘制它们。@Tyson请参见编辑。你真的试过从分析的角度简化它吗？

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"}]