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