想绘制一个由一个隐函数组确定的曲线的图像

Question

想绘制一条二维曲线，由于涉及到隐函数组，不知道该怎么处理为好...

当然，绘制y-a图像比较容易，因为

Solve[10 (1 - a) (x - 3 a)^3 == (2 a)^2, x]

会很容易舍弃多余的两个复根，但是求a的表达式就复杂的多了，求大家想个最好通用点的方法，求解隐函数组绘图问题...

另一个函数表达式附上：

y = 2 a/(1 + x - 2 a)

 

Comments

你能不能把你的图片旋转90度再上传。。。

---

我已经裁剪过，重新编辑了，麻烦您看一下怎么解决...

---

是不是一歪脖子就听见“咔吧咔吧”响？（*手动滑稽*）

---

那个电脑转过后上传时还是颠倒了，我已经裁剪过，重新编辑了，麻烦您看一下怎么解决...

Answer 1

solAll = Solve[10 (1 - a) (x - 3 a)^3 == (2 a)^2, x];
Plot[#, {a, 0, 1}] & /@ solAll[[All, 1, 2]]
sol = First@solAll;
xRange = FunctionRange[{sol[[1, 2]], 0 <= a <= 1}, a, x]
yRange = FunctionRange[{2 a/(1 + x - 2 a) /. sol, 0 <= a <= 1}, a, 
   y] // N
Eliminate[{10 (1 - a) (x - 3 a)^3 == (2 a)^2, 
  y == 2 a/(1 + x - 2 a)}, a]
ContourPlot[Evaluate@%, {x, 0, 100}, {y, 0, yRange[[-1]]}, 
 PlotPoints -> 100]

写的有点乱，随便看看。

Comments

好的，谢谢苹果，我自己也多想想试试...

---

如何在最终绘出的y-x图形上标出最大值位置（用实心圆点标注），和最大值的坐标...
因为涉及到隐函数求极值...
ClearAll["Global`*"]
NMaximize[{y,
  Eliminate[y == 2 a/(1 + x - 2 a) && 10 (1 - a) (x - 3 a)^3 == 4 a^2,
    a], {x, y} \[Element] Reals}, {x, y}, MaxIterations -> 200
 ](*增大迭代次数才可以得出正确答案，否则算错了还什么都不说*)

Answer 2

一个纯数值的做法

ContourPlot[(1 - a) (x - 3 a)^3 == (2 a)^2, {a, 0, 1}, {x, 0, 100}, 
   PlotPoints -> 50, MaxRecursion -> 3] // 
  Cases[Normal@#, 
    Line[pts_] :> (pts /. {a_Real, x_Real} :> {x, (2 a)/(
         1 + x - 2 a)}), Infinity] & // ListLinePlot

修改一下减小计算量

ContourPlot[(1 - a) (x - 3 a)^3 == (2 a)^2, {a, 0, 1}, {x, 0, 100}] //
   Cases[Normal@#, 
    Line[pts_] :> (pts /. {a0_Real, 
         x0_Real} :> {x0, (2 a)/(1 + x0 - 2 a) /. 
          FindRoot[(1 - a) (x0 - 3 a)^3 == (2 a)^2, {a, a0}]}), 
    Infinity] & // ListLinePlot

 

Comments

这个好，学习了~