Mathematica:求公共切线的 FindRoot [英] Mathematica: FindRoot for common tangent

问题描述

不久前我问了这个问题，这确实有助于找到解决方案.我已经找到了一种可接受的方法，但仍然没有完全达到我想要的效果.假设有两个函数 f1[x] 和 g1[y] 我想确定 x 和 y<的值/code> 用于公切线.我至少可以确定 x 和 y 的切线之一，例如使用以下内容:

I asked this question a little while back that did help in reaching a solution. I've arrived at a somewhat acceptable approach but still not fully where I want it. Suppose there are two functions f1[x] and g1[y] that I want to determine the value of x and y for the common tangent(s). I can at least determine x and y for one of the tangents for example with the following:

f1[x_]:=(5513.12-39931.8x+23307.5x^2+(-32426.6+75662.x-43235.4x^2)Log[(1.-1.33333x)/(1.-1.x)]+x(-10808.9+10808.9x)Log[x/(1.-1.x)])/(-1.+x)
g1[y_]:=(3632.71+3806.87y-51143.6y^2+y(-10808.9+10808.9y)Log[y/(1.-1.y)]+(-10808.9+32426.6y-21617.7y^2)Log[1.-(1.y)/(1.-1.y)])/(-1.+y)

Show[
Plot[f1[x],{x,0,.75},PlotRange->All],
Plot[g1[y],{y,0,.75},PlotRange->All]
]

Chop[FindRoot[
{
(f1[x]-g1[y])/(x-y)==D[f1[x],x]==D[g1[y],y]
},
{x,0.0000001},{y,.00000001}
]
[[All,2]]
]

但是，您会从图中注意到，在 x 和 y(比如 x~ 4 和 y ~ 5).现在，有趣的是，如果我将 f1[x] 和 g1[y] 的上述表达式稍微更改为如下所示:

However, you'll notice from the plot that there exists another common tangent at slightly larger values of x and y (say x ~ 4 and y ~ 5). Now, interestingly if I slightly change the above expressions for f1[x] and g1[y] to something like the following:

    f2[x_]:=(7968.08-59377.8x+40298.7x^2+(-39909.6+93122.4x-53212.8x^2)Log[(1.-1.33333x)/(1.-1.x)]+x(-13303.2+13303.2x)Log[x/(1.-1.x)])/(-1.+x)
    g2[y_]:=(5805.16-27866.2y-21643.y^2+y(-13303.2+13303.2y)Log[y/(1.-1.y)]+(-13303.2+39909.6y-26606.4y^2)Log[1.-(1.y)/(1.-1.y)])/(-1.+y)

    Show[
    Plot[f2[x],{x,0,.75},PlotRange->All],
    Plot[g2[y],{y,0,.75},PlotRange->All]
    ]

    Chop[FindRoot[
    {
    (f2[x]-g2[y])/(x-y)==D[f2[x],x]==D[g2[y],y]
    },
    {x,0.0000001},{y,.00000001}
    ]
    [[All,2]]
    ]

并使用相同的方法确定公切线，Mathematica 选择为正斜切线找到 x 和 y 的较大值.

And use the same method to determine the common tangent, Mathematica chooses to find the larger values of x and y for the positive sloping tangent.

最后，我的问题是:是否有可能让 Mathematica 找到公共切线的高低 x 和 y 值并以类似的方式存储这些值这允许我制作列表图?上面的函数 f 和 g 都是另一个变量 z 的复杂函数，我目前正在使用类似下面的东西来绘制切线点(应该是两个 x 和两个 y)作为 z 的函数.

Finally, my question: is it possible to have Mathematica find both the high and low x and y values for the common tangent and store these values in a similar way that allows me to make a list plot? The functions f and g above are all complex functions of another variable, z, and I am currently using something like the following to plot the tangent points (should be two x and two y) as a function of z.

ex[z_]:=Chop[FindRoot[
{
(f[x,z]-g[y,z])/(x-y)==D[f[x],x]==D[g[y],y]
},
{x,0.0000001},{y,.00000001}
]
[[All,2]]
]

ListLinePlot[
Table[{ex[z][[i]],z},{i,1,2},{z,1300,1800,10}]
]

推荐答案

要找到可以求解方程的 {x, y} 估计值，您可以在 ContourPlot 中绘制它们代码> 并寻找交点.例如

To find estimates for {x, y} that would solve your equations, you could plot them in ContourPlot and look for intersection points. For example

f1[x_]:=(5513.12-39931.8 x+23307.5 x^2+(-32426.6+75662. x- 
    43235.4 x^2)Log[(1.-1.33333 x)/(1.-1.x)]+
    x(-10808.9+10808.9 x) Log[x/(1.-1.x)])/(-1.+x)
g1[y_]:=(3632.71+3806.87 y-51143.6 y^2+y (-10808.9+10808.9y) Log[y/(1.-1.y)]+
    (-10808.9+32426.6 y-21617.7 y^2) Log[1.-(1.y)/(1.-1.y)])/(-1.+y)

plot = ContourPlot[{f1'[x] == g1'[y], f1[x] + f1'[x] (y - x) == g1[y]}, 
   {x, 0, 1}, {y, 0, 1}, PlotPoints -> 40]

如您所见，区间 (0,1) 中有 2 个交点.然后您可以从图中读出点并将它们用作 FindRoot 的起始值:

As you can see there are 2 intersection points in the interval (0,1). You could then read off the points from the graph and use these as starting values for FindRoot:

seeds = {{.6,.4}, {.05, .1}};
sol = FindRoot[{f1'[x] == g1'[y], f1[x] + f1'[x] (y - x) == g1[y]}, 
    {x, #1}, {y, #2}] & @@@ seeds

要从 sol 中获取点对，您可以使用 ReplaceAll:

To get the pairs of points from sol you can use ReplaceAll:

points = {{x, f1[x]}, {y, g1[y]}} /. sol

(* 
 ==> {{{0.572412, 19969.9}, {0.432651, 4206.74}}, 
      {{0.00840489, -5747.15}, {0.105801, -7386.68}}}
*)

为了证明这些是正确的观点:

To show that these are the correct points:

Show[Plot[{f1[x], g1[x]}, {x, 0, 1}],
 {ParametricPlot[#1 t + (1 - t) #2, {t, -5, 5}, PlotStyle -> {Gray, Dashed}],
  Graphics[{PointSize[Medium], Point[{##}]}]} & @@@ points]

这篇关于Mathematica:求公共切线的 FindRoot的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！