(* * ----------------------------------------- * PolePlot * * for 2D plots of functions with poles * ----------------------------------------- * * by Ulrich Jentschura, August 14th, 1993 * * Hohenzollernstrasse 90 * 80796 Muenchen * Germany * phone/fax +49-89-308 77 28 * * Compuserve email: 100115,2250 * from Internet: 100115.2250@compuserve.com * ----------------------------------------- *) (* Restriction: Plotting several functions as in PolePlot[{f1[x],f2[x],...,fn[x]},{x,x0,x1},options___] is currently implemented in a very primitive way. Only those graphics options which refer to _all_ functions in the list of functions to be plotted, are allowed. *) BeginPackage["Graphics`PolePlot`"] PolePlot::usage = "PolePlot is used to plot real-valued functions of one real variable which have poles, such as the tangent. The ugly \"asymptotes\" drwan by Mathematica at the poles should vanish in most cases. If they do persist, as in\n\n PolePlot[1 / (x-1) - 1 / x^2,{x,-1,3}]\n\n you may want to consider giving a tighter PlotRange. When you type\n\n PolePlot[1 / (x-1) - 1 / x^2,{x,-1,3},PlotRange -> {-200,100}]\n\n the asymptotes will disappear. Plotting several functions at a time as in\n\n PolePlot[{f1[x],f2[x],...,fn[x]},{x,x0,x1},options___] \n\n is currently implemented in a very primitive way. Only those graphics options which refer to _all_ functions in the list of functions to be plotted, are allowed." Begin["`Private`"] Options[PolePlot] = Options[Plot] PolePlot[f_List,{x_,x0_,x1_},options___Rule] := Module[ {graphicsList}, graphicsList = Map[PolePlot[#,{x,x0,x1}, options]&,f]; Show[graphicsList] ] PolePlot[f_,{x_,x0_,x1_},options___Rule] := Module[{firstplot, minmax, minimum, maximum, pointList, coordList, plotCoords, numberOfPoints, graphicsOptions, displayFunction, i, threshold}, displayFunction = DisplayFunction /. {options} /. Options[Plot]; firstplot = Plot[f,{x,x0,x1},DisplayFunction -> Identity, options]; pointList = Flatten[Apply[List,firstplot[[1,1]],2],2]; graphicsOptions = Sequence @@ firstplot[[2]]; minmax = FullOptions[firstplot,PlotRange][[2]]; {minimum,maximum} = {minmax[[1]],minmax[[2]]}; numberOfPoints = Length[pointList]; plotCoords = {}; coordList = {pointList[[1]]}; Do[If[((pointList[[i-1]][[2]] < minimum && pointList[[i]][[2]] > maximum) || (pointList[[i-1]][[2]] > maximum && pointList[[i]][[2]] < minimum)), AppendTo[plotCoords,coordList]; coordList = {}, AppendTo[coordList,pointList[[i]]] ], {i,2,numberOfPoints - 1}]; AppendTo[coordList,pointList[[numberOfPoints]] ]; AppendTo[plotCoords,coordList]; Show[ Graphics[Table[Line[plotCoords[[j]]],{j,1,Length[plotCoords]}]], DisplayFunction -> displayFunction, graphicsOptions]] /; Not[Head[f] === List] SetAttributes[PolePlot,{Protected,ReadProtected}] End[] EndPackage[]