函数图像的交点问题

wayne

没有mathe大师的参数方程，你的"空话"是难以兑现的。要么我再出一道题，看看你的数学软件能力到底有多高？可不能再出现边界颜色问题。

@shufubisheng 呃呃呃，老前辈，你这是见人就怼吗，我怎么也跟着躺枪了呀。你好像真的有很多细节在认知上存在较大的偏差呀。至少存在如下认知偏差：
认知偏差1）：mathe给的参数方程跟我没关系呀，我又没看他的结论，我也用不了呀。我的方法跟mathe的完全不同。没看到我在18#转化成一个方程的求导求极值问题么？二者的迥然不同都鉴别不出来？在此我很好奇，我不确定你是否有微积分的背景知识，这里其实是隐含了大学数学的微分求导的知识呀。
认知偏差2）：你好像并不懂我为什么在这里用到"空话"这个词。我很多时候喜欢自嘲的，在这里只是一不小心的自嘲了而已。为什么自嘲呢？因为这题目确实简单，而且不太有趣呀。而且的而且，很要命的是，你不太会提问题呀，让很多人都在猜测你到底想要表达什么，这让我一下子耐不住性子了。【首先是好心的kastin在评论区猜测你的出题意图，然后是我在15#猜测你的最终出题意图，然后是mathe在16#在猜测你的意图........】。所以我才自嘲的撂"空话"呢.....
认知偏差3）：在考验我们论坛的数学水平？你在22#的评论区是这么怼我们的。哈哈哈。要考察我们的水平，先做好 怎么没有歧义的把一个数学问题，或者自己的思想表达清楚撒，表达能力是一个人综合的科学素养....
认知偏差4）：关于数学软件的重要性。不赘言了，GET到了就是你自己的，GET不到跟我们也没半毛钱关系。
认知偏差5）：关于全家福的边界线的细节。我都明确的说了，我只画区域图，是RegionPlot。你在各个帖子评论区的留言，吹毛求疵，什么边界线没有涂颜色，天啦，我压根就没觉得这有必要单独拿出来讲呀，这会是个问题吗...
认知偏差6）：来，跳出来。什么样的问题会吸引大家的回答？首先，只有有趣的问题才会吸引我们大家过来回答。其次，有时候，有料的，出了情况了帖子也会吸引人们的回答。比如我被吸引过来的原因完全是关于数学软件的重要性的对话不对劲。
认知偏差7）：我们出于什么样的心态回答你的问题。这个其实就有点严肃了。我先暂不说话了。
===================
码文字是要费时间的，我又开始自嘲了，我真是闲的蛋疼。

kastin

完全图可以做出来，包括边界颜色。其中红色表示三个交点，绿色表示两个交点，蓝色表示1个交点，白色表示没有交点，品红虚线表示间断线。

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. (*使用超越函数表示极值点*)
   
5. x0[a_ /; 0 < a <= E^(-E)] := Exp@ProductLog[-1, 1/Log[a]];
   
6. x1[a_ /; 0 < a] := Exp@ProductLog[1/Log[a]];
   
7. (* (*或 数值求根方式表示极值点*)
   
8. g1[0]=0;
   
9. g1[x_]:=1/(x Log[x] Log[#])-1&;
   
10. g2[x_]:=-(x+Log[x])/(x Log[x])^2/Log[#]&;
    
11. x0[a_/;0<a<=E^(-E)]:=x/.First@FindRoot[g1[x][a],{x,1/E-a}];
    
12. x1[a_/;0<a<=E^(-E)||a>1]:=x/.First@FindRoot[g1[x][a],{x,1/E+a}]; *)
    
13. (*三个交点*)
    
14. s[1] = RegionPlot[
    
15.    f[x1[a], a] < Log[a, Log[a, b]] < f[x0[a], a] &&
    
16.     0 < a < E^(-E), {a, 0, E^(-E)}, {b, 0, 1}, PlotStyle -> Red,
    
17.    BoundaryStyle -> {Thick, Green}];
    
18. (*一个交点*)
    
19. s[2] = RegionPlot[
    
20.    Log[a, Log[a, b]] > f[x0[a], a], {a, 0, E^(-E)}, {b, 0, E^(-E)},
    
21.    PlotStyle -> Blue, BoundaryStyle -> None];
    
22. s[3] = RegionPlot[
    
23.    0 < a < E^(-E) && b > 1, {a, 0, E^(-E)}, {b, 1 + 0.00001, 5},
    
24.    PlotStyle -> Blue, BoundaryStyle -> None];
    
25. s[4] = RegionPlot[
    
26.    Log[a, Log[a, b]] < f[x1[a], a], {a, 0, 1}, {b, 0, E^(-E)},
    
27.    PlotStyle -> Blue, BoundaryStyle -> None];
    
28. s[5] = RegionPlot[a > E^(-E) && 0 < b < E^(-E), {a, E^(-E), 5}, {b, 0, E^(-E)},
    
29.    PlotStyle -> Blue, BoundaryStyle -> None];
    
30. s[6] = RegionPlot[(0 < a < 5 && E^(-E) < b < 1) || (E^(-E) < a < 1 &&
    
31.       0 < b < 5), {a, 0, 5}, {b, 0, 5}, PlotStyle -> Blue,
    
32.    BoundaryStyle -> None];
    
33. (*两个交点*)
    
34. s[7] = RegionPlot[
    
35.    Log[a, Log[a, b]] < f[x1[a], a], {a, 1, 5}, {b, 1, 5},
    
36.    PlotStyle -> Green, BoundaryStyle -> {Thick, Blue}];
    
37. (*间断线*)
    
38. s[8] = ListLinePlot[{{{1, 0}, {1, 5}}, {{0, 1}, {5, 1}}},
    
39.    PlotStyle -> {{Magenta, Thick, Dashed}}];
    
40. Show[Table[s[k], {k, 1, 8}], PlotRange -> All, AspectRatio -> 1,
    
41. FrameLabel -> {a, b}]

复制代码

注意左下角较小范围放大图是

wayne

kastin 发表于 2018-1-28 22:22
完全图可以做出来，包括边界颜色。其中红色表示三个交点，绿色表示两个交点，蓝色表示1个交点，白色表示没 ...

kastin真是有心了。不知道你的毕业论文准备的咋样了，这个可是切身的问题啊，