网页资讯视频图片知道文库贴吧地图采购
进入贴吧全吧搜索

 
 
 
日一二三四五六
       
       
       
       
       
       

签到排名:今日本吧第个签到,

本吧因你更精彩,明天继续来努力!

本吧签到人数:0

一键签到
成为超级会员,使用一键签到
一键签到
本月漏签0次!
0
成为超级会员,赠送8张补签卡
如何使用?
点击日历上漏签日期,即可进行补签。
连续签到:天  累计签到:天
0
超级会员单次开通12个月以上,赠送连续签到卡3张
使用连续签到卡
04月23日漏签0天
mathematica吧 关注:19,960贴子:74,301
  • 看贴

  • 图片

  • 吧主推荐

  • 游戏

  • 1回复贴,共1页
<<返回mathematica吧
>0< 加载中...

ImplicitPlot 为什么用不了了啊!

  • 只看楼主
  • 收藏

  • 回复
  • xzcyr
  • 吧主
    15
该楼层疑似违规已被系统折叠 隐藏此楼查看此楼
吧里老人看了这标题可能会纳闷:不是都已经有一个《绘图和动画功能在版本6时有过重大修改,请不要使用过时的教材!)(https://tieba.baidu.com/p/5360020470)了吗,你重复开帖是做什么。因为……前两天我〇蛋地翻看版本5的帮助的时候,发现 ImplicitPlot 的语法并没有被ContourPlot完全取代:

如大家所见,Implicit 是可以仅指定一个变量的范围的……这个语法ContourPlot还真没有。
那么怎么办呢?还能咋办,把版本5的程序包挖出来,把其中与新版不兼容的地方改掉呗——需要改的地方倒也意外地少:
(* :Title:ImplicitPlot*)(* :Copyright:Copyright 1991-2003,Wolfram Research,Inc.*)(* \
:Authors:Jerry B.Keiper,Wolfram Research,Inc.,contour plot method:Theo Gray,Jerry \
Glynn,Dan Grayson*)(* :Summary:The built-in function Plot requires one to specify an \
explicit function.Many simple graphs (e.g.,circles,ellipses,etc.) are not \
functions.ImplicitPlot allows one to plot figures defined by equations.*)(* \
:Context:Graphics`ImplicitPlot`*)(* :Mathematica Version:3.0*)(* :Package Version:2.2*)(* \
:History:V2.0 by Jerry B.Keiper,April 1991. V2.1 Modifications by John M.Novak,April \
1992. V2.2 by John M.Novak,May 1999-- modified core rangeplot routine to be more robust \
as number of solutions changes over plotting area.*)(* :Keywords:solution set,graphics*)(* \
:Sources:The contour plot alternate method is from:Gray,Theodore and \
Glynn,Jerry,Exploring Mathematics with Mathematica,(Addison-Wesley,1991)*)(* :Warning:*)(* \
:Limitation:ImplicitPlot relies on Solve for much of the work.If Solve fails,no plot can \
be made.Subscripted variables (e.g.,x[1],x[2]) cannot be \
used.*)BeginPackage["Graphics`ImplicitPlot`"(*,"Utilities`FilterOptions`"*)]
If[$VersionNumber >= 9,
FilterOptions[a_, b___] := Sequence @@ FilterRules[{b}, Options[a]],
Needs["Utilities`FilterOptions`"]]
Unprotect[ImplicitPlot];
ImplicitPlot::usage = "ImplicitPlot[eqn, {x, a, b}] draws a graph of the set of points
that satisfy the equation eqn. The variable x is associated with
the horizontal axis and ranges from a to b. The remaining
variable in the equation is associated with the vertical axis.
ImplicitPlot[eqn, {x, a, x1, x2, ..., b}] allows the user to specify
values of x where special care must be exercised.
ImplicitPlot[{eqn1, eqn2, ...}, {x, a, b}] allows more than one equation
to be plotted, with PlotStyles set as in the Plot function.
ImplicitPlot[eqn, {x, a, b}, {y, a, b}] uses a contour plot method of
generating the plot. This form does not allow specification
of intermediate points."
Options[ImplicitPlot] = {AspectRatio -> Automatic, Axes -> Automatic, AxesLabel -> None,
AxesOrigin -> Automatic, AxesStyle -> Automatic, Background -> Automatic,
ColorOutput -> Automatic, DefaultColor -> Automatic, Epilog -> {}, Frame -> False,
FrameLabel -> None, FrameStyle -> Automatic, FrameTicks -> Automatic,
GridLines -> None, PlotLabel -> None, PlotPoints -> 39, PlotRange -> Automatic,
PlotRegion -> Automatic, PlotStyle -> Automatic, Prolog -> {}, RotateLabel -> True,
Ticks -> Automatic, DefaultFont :> $DefaultFont, DisplayFunction :> $DisplayFunction,
FormatType :> $FormatType, TextStyle :> $TextStyle, ImageSize -> Automatic}
Begin["`Private`"]
ImplicitPlot[eqns : {__Equal}, xr : {_, _?NumericQ, _?NumericQ},
yr : {_, _?NumericQ, _?NumericQ}, opts___?OptionQ] :=
Module[{ps, df}, {ps} = {PlotStyle} /. {opts} /. Options[ImplicitPlot];
df = FilterOptions[{DisplayFunction}, Options[ImplicitPlot]];
ps = cyclestyles[ps, Length[eqns]];
gr = MapThread[
ImplicitPlot[#1, xr, yr, ContourStyle -> #2, DisplayFunction -> Identity,
opts] &, {eqns, ps}];
gr = Select[gr, Head[#] === ContourGraphics &];
Show[gr, FilterOptions[ContourGraphics, opts, Sequence @@ Options[ImplicitPlot]], df] /;
gr =!= {}]
ImplicitPlot[eqns : {__Equal}, {x_, a_?NumericQ, m___?NumericQ, b_?NumericQ},
opts___?OptionQ] :=
Module[{ps, df, gr, ln}, {ps} = {PlotStyle} /. {opts} /. Options[ImplicitPlot];
df = FilterOptions[{DisplayFunction}, Options[ImplicitPlot]];
ps = cyclestyles[ps, Length[eqns]];
gr = MapThread[
makegr[#1, {x, a, m, b}, PlotStyle -> #2, DisplayFunction -> Identity,
opts] &, {eqns, ps}];
gr = Select[gr, (# =!= $Failed) &];
Show[Graphics[gr], FilterOptions[Graphics, opts, Sequence @@ Options[ImplicitPlot]],
df] /; gr =!= {}]
ImplicitPlot[lhs_ == rhs_, xr : {_, _?NumericQ, _?NumericQ},
yr : {_, _?NumericQ, _?NumericQ}, opts___?OptionQ] :=
With[{ps = PlotStyle /. {opts} /. Options[ImplicitPlot],
copts = FilterOptions[ContourPlot, opts, Sequence @@ Options[ImplicitPlot]]},
ContourPlot[lhs - rhs, xr, yr, copts, ContourStyle -> ps, Contours -> {0},
ContourLines -> True, ContourShading -> False(*,ContourSmoothing\[Rule]True*)]]
ImplicitPlot[eqn_Equal, {x_, a_?NumericQ, m___?NumericQ, b_?NumericQ}, opts___?OptionQ] :=
Module[{ps, df, gr}, {ps} = {PlotStyle} /. {opts} /. Options[ImplicitPlot];
df = FilterOptions[{DisplayFunction}, Options[ImplicitPlot]];
gr = makegr[eqn, {x, a, m, b}, PlotStyle -> ps, opts];
Show[Graphics[gr], FilterOptions[Graphics, opts, Sequence @@ Options[ImplicitPlot]],
df] /; gr =!= $Failed]
cyclestyles[ps_, ln_] :=
Module[{style = ps},
If[Head[ps] =!= List, style = {ps}, If[Length[ps] == 0, style = {{}}]];
While[Length[style] < ln, style = Join[style, style]];
Take[style, ln]]
ImplicitPlot::var = "Equation `1` does not have a single variable other than `2`."
findy[f_, x_] :=
Module[{nf},
nf = Select[
Union[Cases[f, (_Symbol | _[(_?NumberQ) ...]),
Infinity]], (! (NumberQ[N[#]] || # === x)) &];
If[Length[nf] == 1, nf[[1]],(*else*)Message[ImplicitPlot::var, f, x];
$Failed]]
ImplicitPlot::epfail = "Equation `1` could not be solved for points to plot."
makegr[eqn_Equal, {x_, a_, m___, b_}, opts___] :=
Module[{f = eqn[[1]] - eqn[[2]], ranges, plots, ar, y},
If[(y = findy[eqn, x]) === $Failed, Return[$Failed]];
ranges = Solve[f == 0 && D[f, y] == 0, {x, y}];
If[ListQ[ranges] && Length[ranges] > 0, ranges = N[x /. ranges]];
If[! VectorQ[ranges, NumberQ], Message[ImplicitPlot::epfail, eqn];
Return[$Failed]];
ranges = Select[Chop[ranges], FreeQ[#, Complex] &];
ranges = Sort[Select[ranges, (a < # < b) &]];
ranges = Union[Sort[Join[ranges, N[{a, m, b}]]]];
ar = N[b - a]/10^8;
ranges = Transpose[{Drop[ranges + ar, -1], Drop[ranges - ar, 1]}];
(*ranges is now a (sorted) list of disjoint intervals with small gaps between them \
where singularities probably exist.*)plots = Map[rangeplot[f, x, y, #, opts] &, ranges]];
distx[{x_, y_List}] := Transpose[{Table[x, {Length[y]}], y}]
rangeplot[f_, x_, y_, {a_, b_}, opts___] :=
Module[{pp, ps, j, multipoints, mdpt,
len}, {pp, ps} = {PlotPoints - 1, PlotStyle} /. {opts} /. Options[ImplicitPlot];
If[ps === Automatic, ps = {}];
mdpt = (a + b)/2;
len = (b - a)/2;
multipoints =
Split[Map[{#,(*a little bit of kludginess here...*)
If[# =!= y, Sort[Select[Chop[N[#]], FreeQ[#, Complex] &]] /. {} -> y, #] &[
y /. Solve[f == 0 /. x -> #, y]]} &,
Table[N[mdpt + len Cos[j Pi/pp]], {j, pp, 0, -1}]], (Length[Last[#1]] ===
Length[Last[#2]]) &];
multipoints = Map[distx, Select[multipoints, (Last[First[#]] =!= y) &], {2}];
(*connect the dots to form the various curves*)
If[Length[multipoints] > 0,
Map[Flatten[{ps, Line[#]}] &,
Map[Transpose[#, {2, 1, 3}] &, multipoints], {2}],(*else*){}]];
Protect[ImplicitPlot];
End[] (*"`Private`"*)
EndPackage[] (*"Graphics`ImplicitPlot`"*)
(* :Tests:*)
(* :Examples:ImplicitPlot[x^2+2 y^2\[Equal]3,{x,-2,2}] (*ellipse*) \
ImplicitPlot[(x^2+y^2)^2\[Equal](x^2-y^2),{x,-2,2}] (*lemniscate*) \
ImplicitPlot[(x^2+y^2)^2\[Equal]2 x y,{x,-2,2}] (*lemniscate*) ImplicitPlot[x^3+y^3\
\[Equal]3 x y,{x,-3,3}] (*folium of Descarte*) ImplicitPlot[x^2+y^2\[Equal]x \
y+3,{x,-3,3}] (*ellipse*) ImplicitPlot[x^2+y^2\[Equal]3 x \
y+3,{x,-10,10},PlotRange\[Rule]{{-10,10},{-10,10}}] (*hyperbola*) \
ImplicitPlot[(x^2)^(1/3)+(y^2)^(1/3)\[Equal]1,{x,-1,1}] \
ImplicitPlot[(x^2)^(1/3)+(y^2)^(1/3)\[Equal]1,{x,-1,2}] \
ImplicitPlot[{(x^2+y^2)^2\[Equal](x^2-y^2),(x^2+y^2)^2\[Equal]2 x y},{x,-2,2},PlotStyle\
\[Rule]{GrayLevel[0],Hue[0]}] (*combined plots*) \
ImplicitPlot[{(x^2+y^2)^2\[Equal](x^2-y^2),(x^2+z^2)^2\[Equal]2 x z},{x,-2,2},PlotStyle\
\[Rule]{GrayLevel[0],Dashing[{.01}]}] (*combined plots*) ImplicitPlot[{a\[Equal]b,x^2+2 \
y^2\[Equal]3},{x,-1,1}] (*one bad plot*) ImplicitPlot[x^2+y^2\[Equal]Pi,{x,-2,2}] (*OK \
eqn with 3 symbols*) ImplicitPlot[Sin[x]\[Equal]Cos[y],{x,1.5,Pi/2,1.7}]
(*contour method*) ImplicitPlot[Sin[2 x]+Cos[3 y]\[Equal]1,{x,-2 Pi,2 Pi},{y,-2 Pi,2 \
Pi}] ImplicitPlot[x^2+x y+y^2\[Equal]1,{x,-2Pi,2Pi},{y,-2Pi,2Pi}] ImplicitPlot[x^3+x \
y+y^2\[Equal]1,{x,-2Pi,2Pi},{y,-2Pi,2Pi}] \
ImplicitPlot[x^3-x^2\[Equal]y^2-y,{x,-1,2},{y,-1,2}]
(*failure cases*) ImplicitPlot[a\[Equal]b,{x,-1,1}] (*bad plot*) \
ImplicitPlot[x^y\[Equal]y^x,{x,-1,1}] (*bad plot*) \
ImplicitPlot[{a\[Equal]b,c\[Equal]d},{x,-1,1}] (*bad plots*) \
ImplicitPlot[x^2+y^2\[Equal]z,{x,-2,2}] (*bad eqn with 3 vars*) ImplicitPlot[Sin[x]\
\[Equal]y,{x,-3,3}] (*Solve fails...*) ImplicitPlot[Sin[x]\[Equal]Cos[y],{x,-5,5}] \
ImplicitPlot[x^y\[Equal]y^x,{x,-3,3}]*)
测试:
ImplicitPlot[{(x^2 + y^2)^2 == (x^2 - y^2), (x^2 + y^2)^2 == 2 x y}, {x, -2, 2},
PlotStyle -> {GrayLevel[0], Dashing[{.03}]}]

最后,上面的代码只为做了最低限度的修改,那些不太“现代化”但还能用的地方都没动,大家有兴趣可以改改看。


  • xzcyr
  • 吧主
    15
该楼层疑似违规已被系统折叠 隐藏此楼查看此楼
补充一下,这个程序包总共只改了两个地方。一是增加了
If[$VersionNumber >= 9,
FilterOptions[a_, b___] := Sequence @@ FilterRules[{b}, Options[a]],
Needs["Utilities`FilterOptions`"]]
这一行,FilterOptions 的讨论是比较多的,这里就不多谈了。再就是去掉了过时选项
ContourSmoothing -> True
这个选项在现今的帮助里提都没提,不仅如此,连版本5的帮助里都找不到它的踪迹,真是悄悄地我走了,正如我悄悄地来……


登录百度账号

扫二维码下载贴吧客户端

下载贴吧APP
看高清直播、视频!
  • 贴吧页面意见反馈
  • 违规贴吧举报反馈通道
  • 贴吧违规信息处理公示
  • 1回复贴,共1页
<<返回mathematica吧
分享到:
©2026 Baidu贴吧协议|隐私政策|吧主制度|意见反馈|网络谣言警示