我曾经问过question一段时间,这有助于达成解决方案。我已经达成了一种可接受的方法,但仍然没有完全达到我想要的程度。假设我有两个函数f1[x]
和g1[y]
,我想确定公共切线的x
和y
的值。我至少可以为其中一个切线确定x
和y
,例如:
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]
的上述表达式略微更改为以下内容:
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
的较大值。
最后,我的问题是:是否可以让Mathematica找到公共切线的高和低x
和y
值,并以类似的方式存储这些值,这样我就可以列表情节?上面的函数f
和g
都是另一个变量z
的复杂函数,我现在使用类似下面的内容来绘制切点(应该是两个x
}和两个y
)作为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}]
]
答案 0 :(得分:3)
要查找可以求解方程的{x, y}
估算值,可以在ContourPlot
中绘制它们并查找交点。例如
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
的起始值:
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
:
points = {{x, f1[x]}, {y, g1[y]}} /. sol
(*
==> {{{0.572412, 19969.9}, {0.432651, 4206.74}},
{{0.00840489, -5747.15}, {0.105801, -7386.68}}}
*)
要表明这些是正确的要点:
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]
答案 1 :(得分:1)
好的,让我们快速重写你到目前为止所做的事情:
使用您的f1
和g1
,我们有了情节
plot = Plot[{f1[x], g1[x]}, {x, 0, .75}]
和
的第一个共享切线sol1 = Chop[FindRoot[{(f1[x] - g1[y])/(x - y) == D[f1[x], x] == D[g1[y], y]},
{x, 0.0000001}, {y, .00000001}]]
(* {x -> 0.00840489, y -> 0.105801} *)
定义功能
l1[t_] = (1 - t) {x, f1[x]} + t {y, g1[y]} /. sol1
然后,您可以使用
绘制切线Show[plot, Graphics[Point[{l1[0], l1[1]}]],
ParametricPlot[l1[t], {t, -1, 2}],
PlotRange -> {{-.2, .4}, {-10000, 10000}}]
我简单地(为了我自己)注意你使用的等式
(例如,要生成上面的sol1
)
来自要求f1
x
处的切线
在某一点g1
切向点击y
,即
LogicalExpand[{x, f[x]} + t {1, f'[x]} == {y, g[y]} && f'[x] == g'[y]]
要调查共享切线所在的位置,您可以使用Manipulate
:
Manipulate[Show[plot, ParametricPlot[{x, f1[x]} + t {1, f1'[x]}, {t, -1, 1}]],
{x, 0, .75, Appearance -> "Labeled"}]
产生类似
的东西
使用x
和y
的眼球值,您可以使用
sol = Chop[Table[
FindRoot[{(f1[x] - g1[y])/(x - y) == D[f1[x], x] == D[g1[y], y]},
{x, xy[[1]]}, {y, xy[[2]]}], {xy, {{0.001, 0.01}, {0.577, 0.4}}}]]
使用
定义两条切线l[t_] = (1 - t) {x, f1[x]} + t {y, g1[y]} /. sol
然后
Show[plot, Graphics[Point[Flatten[{l[0], l[1]}, 1]]],
ParametricPlot[l[t], {t, -1, 2}, PlotStyle -> Dotted]]
这个过程可以自动化,但我不确定如何有效地完成它。