Mathematica 9 is now available
Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2000
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2000

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

Search the Archive

RE: avoid spurious vertical segment in step function plot

  • To: mathgroup at smc.vnet.net
  • Subject: [mg23363] RE: [mg23327] avoid spurious vertical segment in step function plot
  • From: hwolf at debis.com
  • Date: Thu, 4 May 2000 02:59:30 -0400 (EDT)
  • Sender: owner-wri-mathgroup at wolfram.com

my answer see below:

	-----Ursprüngliche Nachricht-----
	Von:	Murray Eisenberg [SMTP:murray at math.umass.edu]
	Gesendet am:	Dienstag, 2. Mai 2000 06:43
	An:	mathgroup at smc.vnet.net
	Betreff:	[mg23327] avoid spurious vertical segment in step
function plot

	Several packages available from MathSource deal with eliminating the
	spurious parts of plots of discontinuous functions across vertical
	asymptotes.

	Is there some simple way of dealing with the similar problem of
	eliminating the spurious vertical line segment in plotting a
function
	with jumps -- for example, in the following?

	  Plot[UnitStep[x], {x, -1, 1}]

Hello Murray,

this certainly is a question coming up repeatedly;  I'll forward (and 
translate) you two answers, I had given at DMUG (a math user group in 
German).

The first one is applicable if you know the positions of the 
singularities (infinities, jumps):

In[22]:= Unprotect[Plot]

In[23]:= 
Plot[f_, {var_Symbol, min_, singularities__, max_}, opts___] := 
  Module[{ranges = (Prepend[#1, var] & ) /@ 
      Partition[{min, singularities, max}, 2, 1], g, df}, 
   g = (Plot[f, #1, DisplayFunction -> Identity, opts] & ) /@ ranges; 
   df = DisplayFunction /. Flatten[{opts}] /. 
      Options[Plot, DisplayFunction]; 
   Show[g, DisplayFunction -> df]]

In[24]:= Protect[Plot]

This solution in fact uses the display function you specify, try:

In[31]:=
Plot[ UnitStep[x - 1]UnitStep[2 - x], {x, 0, 1, 2, 3}, 
  PlotStyle -> {Thickness[0.02], Hue[0., 1., 0.7]}, 
  DisplayFunction -> ((Print["Hallo!"]; $DisplayFunction[#]) &)]


More difficult is the case where you don't know in advance where the 
jumps were (and how many there are).  The following may be a pragmatic 
way to deal with that: Take e.g. the function

In[1]:=
cc[x_] := Which[x > 1, 1,
                x > 1/2,  (1 +  cc[2x - 1])/2,
                x > 0, 1/2,
                True, 0 ]
In[2]:=
Plot[cc[x], {x, -0.1, 1.1}, PlotRange -> {0, 1}]

There are a lot of jumps, and it may not be sensibel to suppress too low 
jumps.


In[4]:= Attributes[suppressSteep] = {HoldFirst};
In[5]:=
suppressSteep[g_, limit_] := 
  Module[{pts, posLine, steep, pp, seqs}, 
   posLine = Position[g, Line[_]]//First;
   pts = Part[g, Sequence@@posLine, 1] ; 
   steep = (#1[[2]]/#1[[1]] & ) /@ 
      (Subtract @@ Reverse[#1] & ) /@ Partition[pts, 2, 1]; 
   pp = Flatten[Position[steep, x_ /; Abs[x] > limit]]; 
   seqs = Transpose[
      {Prepend[pp + 1, 1], Append[pp, Length[pts]]}]; 
   ReplacePart[g, Line /@ (Take[pts, #1] & ) /@ seqs, posLine]
  ]

In[6]:=
suppressSteep[Plot[f_List, range_, opts___], limits_List] /; Length[f]
== Length[limits]:= 
  Module[{g, df, pstyles}, 
   pstyles = PlotStyle /. Flatten[{opts}] /. 
   Options[Plot, PlotStyle];
   pstyles = Replace[{pstyles}, {{x__}} -> {x}];
   PadRight[pstyles, Length[f], pstyles];
   g = Plot[#1, range, PlotStyle -> #2, 
            DisplayFunction -> Identity, opts]& 
       @@@ Transpose[{f, pstyles}];
   df = DisplayFunction /. Flatten[{opts}] /. 
        Options[Plot, DisplayFunction];  
   Show[MapThread[suppressSteep,{g, limits}], 
        DisplayFunction -> df]
  ]

In[7]:=
suppressSteep[Plot[f_List, range_, opts___], limits_] := 
  Module[{ll = Flatten[{limits}]},
  ll = PadRight[ll, Length[f], ll];
  suppressSteep[Plot[f, range, opts], ll]
  ]

In[8]:=
suppressSteep[Plot[f_, range_, opts___], limit_?Positive] := 
  Module[{g, df},
   g = Plot[f, range, DisplayFunction -> Identity, opts];
   df = DisplayFunction /. Flatten[{opts}] /. 
        Options[Plot, DisplayFunction];  
   Show[suppressSteep[g, limit], DisplayFunction -> df]
  ]


The plot will be generated first, and then the plot line will be 
cut where the steepness exeeds 'limit'.  You may have to try and 
find out for an appropriate value for 'limit' in the case of 
application. So try

suppressSteep[Plot[cc[x], {x, -0.1, 1.1}], 5]

and with

f1 = 1/((1 - x)(2 - x)); f2 = 5 UnitStep[x - 0.5]UnitStep[2.5 - x];

suppressSteep[
  Plot[{f1, f2}, {x, 0, 3}, PlotRange -> {All, {-10, 10}}, 
    PlotStyle -> {{Hue[1/3, 1., 0.5]}, {Thickness[0.02], 
          Hue[0., 1., 0.7]}}], {100, 5}]

suppressSteep[
  Plot[f2, {x, 0, 3}, PlotRange -> {All, {-10, 10}}, 
    PlotStyle -> {Thickness[0.02], Hue[0., 1., 0.7]}], 5]

suppressSteep[
  Plot[f1, {x, 0, 3}, PlotRange -> {All, {-10, 10}}, 
    PlotStyle -> {{Hue[1/3, 1., 0.5]}, {Thickness[0.02], 
          Hue[0., 1., 0.7]}}], 100]

suppressSteep[
  Plot[{f1}, {x, 0, 3}, PlotRange -> {All, {-10, 10}}, 
    PlotStyle -> {{Hue[1/3, 1., 0.5]}}], 100]

suppressSteep[
  Plot[{f1}, {x, 0, 3}, PlotRange -> {All, {-10, 10}}, 
    PlotStyle -> {{Hue[1/3, 1., 0.5]}}], {100}]


One of the drawbacks of this solution is, that there will remain a 
small but finite gap. This certainly can be improved, e.g. try to 
dispense with 'limit' by utilizing the specifications for MaxBend 
and PlotDivision; but this may amount to write a new Plot function 
from the scratch.

Kind regards,  Hartmut


  • Prev by Date: Why is Timing so irregular? How should I measure efficiency?
  • Next by Date: Re: RE: [Q] Equation solving?
  • Previous by thread: Re: avoid spurious vertical segment in step function plot
  • Next by thread: Re: avoid spurious vertical segment in step function plot