函数图像的交点问题

mathe

现在结合a=b时候的结果，应该是图-10to-0.1.jpg中封闭部分3个解，边界两个解，外部（a<1部分而且b<1部分）一个解
图0.1to0.2.jpg中曲线下面部分(a>1部分而且b>1部分)两个解，曲线上一个解，而上面部分无解
而区域a>1,b<1和区域a<1,b>1显然都是唯一解一种情况，所以我们没有在其中找到边界线

kastin

参数平面图如下:

其中蓝色区域表示只有一个交点，绿色区域表示只有两个交点，红色区域表示有三个交点。白色表示没有交点。
注意，左侧红色区域比较狭窄，放大图如下：

左侧继续放大如下：

mathe

根据图可以得出交换a,b方程解的数目是不变的，这个可以如下证明
$a^x=log_bx$,那么$t=a^x=log_bx$必然是方程$b^t=log_at$的解，所以俩方程解的数目是一致的

kastin

根据图像来看，以 `r` 作为横轴，那么界线都是单值函数，于是可以找出分界线的隐函数方程 `a=F_i(r)`，这样就可以直接用 `F_i(r)<a<F_{i+1}(r)` 这种形式来给出简单的紧凑的结论了。 不过，这种单值函数不一定有解析表达。

kastin

根据16楼的结果，可以给出这个单值函数参数方程形式\[\begin{cases}\D a=\mathrm e^{h\mathrm e^{-1/h}}\\r=\frac{\mathrm e^{\frac 1h-h}}{h^2}\end{cases}\]由于 `x>0`，故 `h<0`.
绘制 `a-r` 边界图，正好就是上图中红色区域边界：

1. ParametricPlot[{Exp[h E^(-1/h)], Exp[1/h - h]/h^2}, {h, -6.08, 0},
   
2. AspectRatio -> 1]

复制代码

F1

shufubisheng

mathe 发表于 2018-1-27 20:58
根据图可以得出交换a,b方程解的数目是不变的，这个可以如下证明
$a^x=log_bx$,那么$t=a^x=log_bx$必然是方 ...

这位老师有高见。也就是说，a—b图的边界曲线有对称轴b=a。

wayne

我还是按我的方式来。考虑$ln|lnx|-xlna-ln|lnb|$的极值的情况。
三个解的情况是在$0 < a <= e^{-e}=0.065988$的时候发生。此时，有两个极值点，x == E^ProductLog[-1, 1/Log[a]] ， x == E^ProductLog[1/Log[a]]

1. Reduce[D[Log[-Log[x]] - Log[a] x, x] == 0 && 0 < a < 1 && x > 0, x]

复制代码

画图如下，跟mathe在13#的图形是一致的

1. n = 1/10;
   
2. RegionPlot[{Log[-Log[E^ProductLog[-1, 1/Log[a]]]] - 1/
   
3.      ProductLog[-1, 1/Log[a]] < Log[-Log[b]] <
   
4.     Log[-Log[E^ProductLog[1/Log[a]]]] - 1/ProductLog[1/Log[a]]}, {a,
   
5.    0, n}, {b, 0, n}] // Quiet

复制代码

\[\log \left(-\log \left(e^{W_{-1}\left(\frac{1}{\log (a)}\right)}\right)\right)-\frac{1}{W_{-1}\left(\frac{1}{\log (a)}\right)}<\log (-\log (b))<\log \left(-\log \left(e^{W\left(\frac{1}{\log (a)}\right)}\right)\right)-\frac{1}{W\left(\frac{1}{\log (a)}\right)}\]

上面的补集是一个解。
======================================
两个解发生在$a>1$的时候.此时只有一个极值点，x=E^ProductLog[1/Log[a]]
\[\log \left(\log \left(e^{W\left(\frac{1}{\log (a)}\right)}\right)\right)-\frac{1}{W\left(\frac{1}{\log (a)}\right)}>\log (\log (b))\]


上面的补集是无解。
======================================
一个解的情况就是上面三个解的补集加上 $0<a<1,b>1$或者$0<b<1,a>1$的情况。


最后画一个全家福,【附注：三个解的区域比较小，放大版本的见前面mathe最先给的图，或者我楼上的图。】

1. n = 2; RegionPlot[{a > 1 &&
   
2.     Log[Log[E^ProductLog[1/Log[a]]]] - 1/ProductLog[1/Log[a]] <
   
3.      Log[Log[b]],
   
4.    b < 1 && (E^-E < a < 1 ||
   
5.        Log[-Log[E^ProductLog[-1, 1/Log[a]]]] - 1/
   
6.          ProductLog[-1, 1/Log[a]] > Log[-Log[b]] ||
   
7.        Log[-Log[b]] >
   
8.         Log[-Log[E^ProductLog[1/Log[a]]]] - 1/
   
9.          ProductLog[1/Log[a]]) || (a - 1) (b - 1) < 0,
   
10.    a > 1 &&
    
11.     Log[Log[E^ProductLog[1/Log[a]]]] - 1/ProductLog[1/Log[a]] >
    
12.      Log[Log[b]],
    
13.    Log[-Log[E^ProductLog[-1, 1/Log[a]]]] - 1/
    
14.      ProductLog[-1, 1/Log[a]] < Log[-Log[b]] <
    
15.     Log[-Log[E^ProductLog[1/Log[a]]]] - 1/ProductLog[1/Log[a]]}, {a,
    
16.    0, n}, {b, 0, n}, PlotLegends -> "Expressions", Frame -> False,
    
17.   Axes -> True] // Quiet

复制代码

wayne

我昨天在15#的"空话"已经兑现。解的个数的可行域的全家福见楼上。
附注：三个解的区域比较小，放大版本的见前面mathe最先给的图，或者我楼上的图。

kastin

继续24楼的思路，可给出关于交点个数紧凑形式的结论：
`0 < a < F_ 1 (r) ` 时，有三个交点（对应于22楼红色区域，）；
`a =  F_ 1 (r) ` 时，有两个交点（对应于22楼红色部分的尖状弯曲边界）；
`F_1(r) < a  < 1` 时，有一个交点（对应蓝色区域）；
`1 < a < F_2(r)` 时，有两个交点（绿色区域）；
`a=F_2(r)` 时，有一个交点（绿色区域弯曲边界）；
`a> F_2(r)` 时，没有交点。

其中红色区域的边界就是 `F_1(r)`，即25楼给出的参数方程。求法如下：
因为极值点满足导函数零点方程 `f'(x)=0`，也就是 `x\ln x=1/\ln a`. 若定义 `h=1/\ln x` (`x` 为极值点），那么可知 `a=\exp(h\mathrm e^{-\frac 1h})`.  再根据之前http://bbs.emath.ac.cn/thread-15228-1-1.html中的结论，导函数零点方程有两个根 `x_0,x_1`（即 `f(x)` 有两个极值点）时，根必然落在区间(0,1)内，所以确定参数范围 `h<0`.
利用前面2楼的结果可知，边界曲线就是 `f(x_0)=f(x_1)=0`，即 `\log_a \log_a x-x-\log_a r=0`，将 `x=\mathrm e^{1/h}` 代入可得 `r=\frac{\mathrm e^{\frac 1h-h}}{h^2}`.
这样便利用参数方程隐式地定义了 `a=F_1(r)`, 相应 `a-r` 图前面已经给出。

若想绘制 `a-b` 图，根据根据2楼给出的定义 `r=\ln b/\ln a=\log_a b`，进行坐标变换，求出 `b=a^r=\exp(\frac{e^{-h}}{h})`. 然后绘制 `a-b` 曲线，得到结果跟前面mahte和wayne给出的一样。

但这种参数方式只能给出边界形状，不容易判断 `a>F_1(r)` 到底是在边界的里面还是外面。因为这需要求 `\frac{\dif a}{\dif r}=\frac{\frac{\dif a}{\dif h}}{\frac{\dif r}{\dif h}}`来判断单调性。然而次结果还是参数式，需要通过 `h` 反求 `r`的值，故仍然没能摆脱求根的命运。实际上 `a=\exp(h\mathrm e^{-1/h})` 相当于  `\frac 1h\exp(\frac 1h)=\frac 1{\ln a}`，注意到方程 `w\exp(w)=z` 的解就是27楼中使用的乘积对数函数(ProductLog) `W(z)`，（这是一个数学界定义的超越函数，没有解析表达）。于是 `\frac 1h=W(\frac {1}{\ln a})`，代入 `h=1/\ln x` 中，得到极值点 `x^*=\mathrm e^{W(\frac {1}{\ln a})}`，这样就能求出 `F_2(r)`，也就是或27楼中狭长绿色部分边界线 `a=F_2(r)`：
根据2楼结论可知边界线方程仍然是关于极值点的方程 `\log_a r=\log_a\log_a x^*-x^*`， 且 `x^*=\mathrm e^{W(\frac {1}{\ln a})}`。于是 `r=\D\frac{W(\frac {1}{\ln a})a^{-\exp(W(\frac {1}{\ln a}))}}{\ln a}`，这个结果的反函数就是 `a=F_2(r)` ，可以绘制出 `a-r` 边界线为

1. Plot[ProductLog[1/Log[a] ]a^(-E^ProductLog[1/Log[a]])/Log[a],{a,1,10},AxesLabel->{a,r},PlotRange->{0,10},AxesOrigin->{0,0}]

复制代码

类似地，变换坐标得到 `b=a^r=\exp\left(W(\frac {1}{\ln a}) a^{-\exp(W(\frac {1}{\ln a}))}\right)`，可绘制 `a-b` 边界线

1. Plot[E^(ProductLog[1/Log[a]]a^(-E^ProductLog[1/Log[a]])),{a,1,10},AxesLabel->{a,r},PlotRange->{0,10},AxesOrigin->{0,0}]

复制代码

kastin

这里给一下22楼图像的代码，里面使用的是2楼的方法，纯粹数值求根的方式用软件绘制（因此精度依赖于取点多少，不如wayne那种使用内置超越函数那么精确）。

1. Clear[f, g1, g2, x0, x1, s]
   
2. f[x_ /; x > 0 && x != 1, a_ /; a > 0 && a != 1] :=
   
3.   Log[a, Log[a, x]] - x;
   
4. g1[0] = 0;
   
5. g1[x_] := 1/(x Log[x] Log[#]) - 1 &;
   
6. g2[x_] := -(x + Log[x])/(x Log[x])^2/Log[#] &;
   
7. x0[a_ /; 0 < a <= E^(-E)] :=
   
8.   x /. First@FindRoot[g1[x][a], {x, 1/E - a}];
   
9. x1[a_ /; 0 < a <= E^(-E) || a > 1] :=
   
10.   x /. First@FindRoot[g1[x][a], {x, 1/E + a}];
    
11. (*三个交点*)
    
12. s[1] = RegionPlot[
    
13.    f[x1[a], a] < Log[a, r] < f[x0[a], a] && 0 < a < E^(-E), {a, 0,
    
14.     E^(-E)}, {r, 0, 10}, PlotPoints -> 50, MaxRecursion -> 3,
    
15.    PlotStyle -> Red, BoundaryStyle -> None];
    
16. (*一个交点*)s[2] =
    
17.   RegionPlot[(Log[a, r] < f[x1[a], a] || Log[a, r] > f[x0[a], a]) &&
    
18.     0 < a < E^(-E), {a, 0, E^(-E)}, {r, 0, 10}, PlotStyle -> Blue,
    
19.    BoundaryStyle -> None];
    
20. (*两个个交点*)s[3] =
    
21.   ContourPlot[{f[x1[a], a] == Log[a, r],
    
22.     Log[a, r] == f[x0[a], a]}, {a, 0, E^(-E)}, {r, 0, 10},
    
23.    PlotPoints -> 50, MaxRecursion -> 3,
    
24.    ContourStyle -> {{Thick, Green}}];
    
25. (*一个交点*)
    
26. s[4] = RegionPlot[E^(-E) < a < 1, {a, E^(-E), 1}, {r, 0, 10},
    
27.    PlotStyle -> Blue, BoundaryStyle -> None];
    
28. (*间断线*)s[5] =
    
29.   ListLinePlot[{{1, 0}, {1, 10}}, PlotStyle -> {{Black，Dashed}}];
    
30. s[6] = RegionPlot[
    
31.    a > 1 && Log[a, r] < f[x1[a], a], {a, 1, 10}, {r, 0, 10},
    
32.    PlotStyle -> Green];
    
33. s[7] = ContourPlot[
    
34.    Log[a, r] == f[x1[a], a], {a, 1, E^(1/E)}, {r, 0, 10},
    
35.    PlotPoints -> 50, MaxRecursion -> 3,
    
36.    ContourStyle -> {{Thick, Blue}}];
    
37. s[8] = ListPlot[{{E^(1/E), 1}}, PlotStyle -> {Thick, Blue}];
    
38. s[9] = ContourPlot[
    
39.    Log[a, r] == f[x1[a], a], {a, E^(1/E), 10}, {r, 0, 10},
    
40.    PlotPoints -> 50, MaxRecursion -> 3,
    
41.    ContourStyle -> {{Thick, Blue}}];
    
42. Show[Table[s[k], {k, 1, 6}], PlotRange -> All, FrameLabel -> {a, r}]

复制代码

通过坐标变换，将代码中 `r` 用 `\log_a b` 替换，并注意一下 `b` 的取值范围，上述代码也可用于绘制 `a-b` 图像：
比如，三个解的部分（注意边界上是两个解）

1. Clear[f, g1, g2, x0, x1, s]
   
2. f[x_ /; x > 0 && x != 1, a_ /; a > 0 && a != 1] :=
   
3.   Log[a, Log[a, x]] - x;
   
4. g1[0] = 0;
   
5. g1[x_] := 1/(x Log[x] Log[#]) - 1 &;
   
6. g2[x_] := -(x + Log[x])/(x Log[x])^2/Log[#] &;
   
7. x0[a_ /; 0 < a <= E^(-E)] :=
   
8.   x /. First@FindRoot[g1[x][a], {x, 1/E - a}];
   
9. x1[a_ /; 0 < a <= E^(-E) || a > 1] :=
   
10.   x /. First@FindRoot[g1[x][a], {x, 1/E + a}];
    
11. RegionPlot[
    
12.   f[x1[a], a] < Log[a, Log[a, b]] < f[x0[a], a] && 0 < a < E^(-E), {a,
    
13.     0, E^(-E)}, {b, 0, E^(-E)}, PlotPoints -> 50, MaxRecursion -> 3,
    
14.   PlotStyle -> Red, BoundaryStyle -> None];

复制代码

两个解的部分（注意边界上是1个解）

1. RegionPlot[
   
2.   a > 1 && Log[a, Log[a, b]] < f[x1[a], a], {a, 1, 10}, {b, 1, 10},
   
3.   PlotStyle -> Green];

复制代码