Services & ResourcesWolfram ForumsMathGroup Archive

[Date Index] [Thread Index] [Author Index]

Re: Plotting 2D functions with discontinuities

• To: mathgroup at smc.vnet.net
• Subject: [mg49546] Re: [mg49509] Plotting 2D functions with discontinuities
• From: Selwyn Hollis <sh2.7183 at misspelled.erthlink.net>
• Date: Fri, 23 Jul 2004 05:59:35 -0400 (EDT)
• References: <200407220645.CAA21038@smc.vnet.net>
• Sender: owner-wri-mathgroup at wolfram.com

On Jul 22, 2004, at 2:45 AM, Micky Handel wrote:

> Hello
> I m interested in plotting functions with some discontinuities without
> displaying the vertical line that Mathematica plots automatically. I 
> have
> tried using the DiscontinuityPlot and the RLSCF packages that I found 
> and
> downloaded. However, RLSCF does not function when my function is 
> defined by
> a Which command, and the DiscontinuityPlot package does not work well 
> with
> multiple plots. Is there another way of solving this problem?
> Thanks
> Micky

Mickey,

Here's a routine that I wrote form my MmaCalc package (see web link 
below). It's basically an improved version of DiscontinuityPlot.


ShowDiscontinuous::usage = "ShowDiscontinuous[graphic] shows graphic 
after removing near-vertical segments from Line primitives.";
Options[ShowDiscontinuous]={Threshold->1};
SetAttributes[ShowDiscontinuous,HoldFirst];
Needs["Utilities`FilterOptions`"];
der2=
    
Compile[{x0,f0,x1,f1,x2,f2},((f2-f1)/(x2-x1)-(f1-f0)/(x1-x0))/(x2-x0)];
approxD2[{p0_,p1_,p2_}]:= der2@@Flatten[{p0,p1,p2}];

ShowDiscontinuous[graph_, (opts___)?OptionQ] :=
   Module[{plot, plotdata, tells, newplotdata = {}, thresh, n, x, y, z},
   thresh = 1000.*Threshold /. {opts} /. Options[ShowDiscontinuous];
     plotdata = {First[plot=Block[{$DisplayFunction=Identity}, graph]]} 
/.
             {s___,{Line[data_]}} -> {{s},data};
     If[Depth[plotdata]==6,
     	plotdata=First[plotdata] ];
     n=Length[plotdata];
     Do[
		tells = Flatten[(If[Abs[#1] < thresh, 0, #1] & ) /@
                approxD2 /@ Partition[plotdata[[i,2]], 3, 1]];
		tells = Flatten[{1,Position[tells,_Real]+1,
				Length[plotdata[[i,2]]]}];
		x=y=-1;
		Scan[Block[{z=#},
			If[x+1==y==z-1, tells=DeleteCases[tells,y]];x=y;y=z]&, tells];
		tells = tells/.{1,q_,l_}->{1,l};
		AppendTo[newplotdata,
       ({Sequence@@plotdata[[i,1]], Line[plotdata[[i,2,Range @@ 
#1]]]}&)/@
			Partition[tells, 2]], {i, n}];
     Show[Graphics[newplotdata],
     	FilterOptions[Graphics,opts], DisplayFunction->$DisplayFunction, 
Last[plot]]];
     	
(*Example*)

Plot[Floor[x + .5] + .25, {x, -1, 5}]//ShowDiscontinuous


-----
Selwyn Hollis
http://www.appliedsymbols.com
(edit reply-to to reply)

• References:
  • Plotting 2D functions with discontinuities
    • From: "Micky Handel" <hmicky@hotmail.com>