Dotted Lines at Discontinuities 2
- To: mathgroup at smc.vnet.net
- Subject: [mg73402] Dotted Lines at Discontinuities 2
- From: "dimitris" <dimmechan at yahoo.com>
- Date: Thu, 15 Feb 2007 05:06:02 -0500 (EST)
Hi again.
As I mentioned in another message Bob Hanlon's solution is by far more
elegant and smarter
since it doesn't need to specify where the singularities are.
The only advantage of mine solution is that it is an one liner (and
more easy to understand for me).
Note that the original query (Sun 17 Sept 2006), I think it belongs to
me.
Being able to write my own code for something that it was a mystery
for me before five months
I should thank persons like Bob and many many many others and
especially David Park.
So just for saying, If you want to learn better Mathematica (apart
from a lot of reading/practising/applying in your own interests) keep
in standard contact with this forum!
Anyway
(*Bob Hanlon's solution*)
plotDisc[args___] := Module[{p, temp},
p = (Plot[args, DisplayFunction -> Identity] //.
(Line[{s___, {x1_, y1_}, {x2_, y2_}, e___}] /;
(Abs[(y2 - y1)/(x2 - x1)] > 10 || Sign[y1] != Sign[y2])) :>
Sequence[Line[{s, {x1, y1}}],
AbsoluteDashing[{5, 5}], temp[{{x1, y1}, {x2, y2}}],
AbsoluteDashing[{}], Line[{{x2, y2}, e}]]) /. temp -> Line;
Show[p, DisplayFunction -> $DisplayFunction]];
(*mine one liner*)
AsymPlot[f_, {x_, a_, b_, c___}, {plotopts___}, {lineopts___}] :=
Show[{(Plot[f, {x, #1[[1]], #1[[2]]}, DisplayFunction -> Identity,
plotopts] & ) /@ Partition[{a, c, b}, 2, 1],
Graphics[{lineopts, (Line[{{#1, Limit[f, x -> #1, Direction ->
1]}, {#1, Limit[f, x -> #1, Direction -> -1]}}] & ) /@
{c}}]}, DisplayFunction -> $DisplayFunction, Axes -> False,
Frame -> {True, True, False, False}, PlotRange -> All]
For example
plotDisc[UnitStep[x - 3.2] + UnitStep[x - 5.125] - 3*UnitStep[x -
6=2E34], {x, 0, 10}, PlotStyle -> Red]
AsymPlot[UnitStep[x - 3.2] + UnitStep[x - 5.125] - 3*UnitStep[x -
6=2E34], {x, 0, 10, 3.2, 5.125, 6.34}, {PlotStyle -> Red}, {Blue,
AbsoluteDashing[{3, 4}]}]
But if the singularity is not given explicitly AsymPlot fails whereas
plotDisc doensn't.
Compare
plotDisc[UnitStep[Cos[x]-x] + UnitStep[x-5.125] - 3*UnitStep[x -
6=2E34], {x, 0, 10}, PlotStyle -> Red,Axes->False,Frame->True]
with
sol = x /. FindRoot[Cos[x] == x, {x, 0}, WorkingPrecision -> 40]
0=2E739085133215160641655312087673873404013411758900757462338`40.
DashPlot[UnitStep[Cos[x] - x] + UnitStep[x - 5.125] - 3*UnitStep[x -
6=2E34], {x, 0, 10, sol, 5.125, 6.34}, {PlotStyle -> Red}, {Blue,
AbsoluteDashing[{3, 4}]}]
Also mine one liner works only for noninfinite singularities. To treat
cases like Tan[x] in x=n Pi/2, n odd integer
it must be modified
A proper modification (in this case it looses its one liner attribute)
is
AsymPlot2[f_, {x_, a_, b_, c___}, {plotopts___}, {asymopts___}] :=
Block[{asymrange}, asymrange = AbsoluteOptions[Plot[f, {x, a, b},
DisplayFunction -> Identity], PlotRange];
Show[(Plot[f, {x, #1[[1]], #1[[2]]}, DisplayFunction -> Identity,
plotopts, PlotRange -> asymrange[[1,2,2]]] & ) /@
Partition[{a, c, b}, 2, 1], (Graphics[{asymopts, Line[{{#1,
asymrange[[1,2,2,1]]}, {#1, asymrange[[1,2,2,2]]}}]}] & ) /@
{c}, DisplayFunction -> $DisplayFunction]]
So for example
AsymPlot2[Tan[x], {x, -2*Pi, 2*Pi, -3*(Pi/2), -Pi/2, Pi/2, 3*(Pi/2)},
{PlotStyle -> Red, ImageSize -> 400, PlotRange->{-10,10},
Frame -> {True, True, False, False}, Axes -> {False, False},
FrameTicks -> {Range[-2*Pi, 2*Pi, Pi/2], Range[-10, 10, 5]}},
{Blue,AbsoluteDashing[{3,3}]}]
Bob Hanlon's solution works properly even in this case
plotDisc[Tan[z], {z, -2Pi, 2Pi}, PlotStyle -> Red, Axes -> False,
Frame -> True, PlotRange -> {-10, 10}]
Best Regards
Dimitris
=C1=D0=CF: Bob Hanlon - =E4=E5=F2 =F4=EF =F0=F1=EF=F6=DF=EB
=C7=CC=C5=D1=CF=CC=C7=CD=C9=C1: =D4=F1 13 =D6=E5=E2=F1 2007 13:54
Email: Bob Hanlon <hanl... at cox.net>
=CF=EC=DC=E4=E5=F2: comp.soft-sys.math.mathematica
=CC=E7 =E2=E1=E8=EC=EF=EB=EF=E3=E7=EC=DD=ED=EF =E1=EA=FC=EC=E1=C2=E1=E8=EC=
=EF=EB=EF=E3=DF=E1:
=F0=F1=EF=E2=EF=EB=DE =E5=F0=E9=EB=EF=E3=FE=ED
=C1=F0=DC=ED=F4=E7=F3=E7 | =C1=F0=DC=ED=F4=E7=F3=E7 =F3=F4=EF=ED =E3=F1=E1=
=F6=DD=E1 | =C1=F0=EF=F3=F4=EF=EB=DE =F3=E5 =DC=EB=EB=EF=ED =DE =F0=EF=EB=
=EB=EF=FD=F2 =F7=F1=DE=F3=F4=E5=F2
| =C5=EA=F4=FD=F0=F9=F3=E7 | =C1=F4=EF=EC=E9=EA=FC =CC=DE=ED=F5=EC=E1 | =C5=
=EC=F6=DC=ED=E9=F3=E7 =F0=F1=F9=F4=EF=F4=FD=F0=EF=F5 | =C1=ED=E1=F6=EF=F1=
=DC =F7=F1=DE=F3=E7=F2 |
=C2=F1=E5=F2 =EC=E7=ED=FD=EC=E1=F4=E1 =E1=F0'=E1=F5=F4=FC=ED =F4=EF=ED =F3=
=F5=E3=E3=F1=E1=F6=DD=E1
I am not a professor/educator.
Send your questions to MathGroup, not to me.
Use a dummy function name temporarily.
plotDisc[args___]:=Module[{p,temp},
p=(Plot[args,DisplayFunction->Identity]//.
(Line[{s___,{x1_,y1_},{x2_,y2_},e___}]/;
(Abs[(y2-y1)/(x2-x1)]>10||Sign[y1]!=Sign[y2])):>
Sequence[Line[{s,{x1,y1}}],
AbsoluteDashing[{5,5}],temp[{{x1,y1},{x2,y2}}],
AbsoluteDashing[{}],Line[{{x2,y2},e}]])/.temp-
>Line;
Show[p,DisplayFunction->$DisplayFunction]];
g=UnitStep[x-3]+UnitStep[x-5]-3UnitStep[x-6];
plotDisc[g,{x,0,10},PlotStyle->Red];
Bob Hanlon
---- Mr Ajit Sen <senr... at yahoo.co.uk> wrote:
- =C1=F0=FC=EA=F1=F5=F8=E7 =F0=E1=F1=E1=E8=DD=EC=E1=F4=EF=F2 -
- =C5=EC=F6=DC=ED=E9=F3=E7 =F0=E1=F1=E1=E8=DD=EC=E1=F4=EF=F2 -
> Dear Prof Hanlon,
> I refer to the nice code you posted in Mathgroup
> (Sun 17 Sept 2006), whereby the vertical lines at
> discontinuities are removed:
> plotDisc[args___] := Module[{p},
> p = Plot[args, DisplayFunction -> Identity] //.
> (Line[{s___, {x1_, y1_}, {x2_, y2_},
> e___}]/;
> (Abs[(y2-y1)/(x2-x1)] > 10^3 &&
> Sign[y1] != Sign[y2])):>
> Sequence[Line[{s, {x1, y1}}], Line[{{x2,
> y2}, e}]];
> Show[p, DisplayFunction -> $DisplayFunction]];
> My problem is I'd like to have them in, but as
> dotted lines instead. At the moment I'm using your
> code with some slight modifications (e.g. 10 instead
> of 10^3, || instead of && ) and then include the
> dotted lines one by one. Thus for the function
> g = UnitStep[x - 3] + UnitStep[x - 5] -
> 3UnitStep[x - 6] ,
> I am doing it as follows :
> p=plotDisc[g,{x,0,10}]
> p1=Graphics[{Red, AbsoluteDashing[{5,10}],
> Line[{{3,0},{3,1}}]}]
> p2=Graphics[{Red, AbsoluteDashing[{5,10}],
> Line[{{5,1},{5,2}}]}]
> p3=Graphics[{Red, AbsoluteDashing[{5,10}],
> Line[{{6,2},{6,-1}}]}]
> Show[p,p1,p2,p3]
> This works fine but I think there should be a neater
> way to go about it for arbitrary discontinuous
> functions. I tried to put
> Graphics[{Red, AbsoluteDashing[{5,10}],
> Line[{{x1,y1},{x1,y2}}]}]
> before the last line in your code, but that just
> didn't work !
> I would be most grateful if you could please help me
> out on this.
> Thank you very much in advance.
> Ajit Sen.