12
$\begingroup$

When I do:

l = {5, 6, 6, 5, 6, 6, 5};
f = Interpolation@l;
g[t_] = D[f[t], t];
p1 = Plot[{f@x, g@x + 4}, {x, 1, Length@l}, Evaluated -> True,   Exclusions -> True]

I expect:

Mathematica graphics

However, since Plot[] doesn't detect the discontinuities, I get:

Mathematica graphics

I have two ways to overcome this, but none of them is robust enough.

The first one is excluding explicitly those points where the derivative changes a lot in a small interval. The problem here is that "a lot" and "small" are not defined clearly in my textbook.
Please note that Exclusions -> doesn't accept inequalities (well, it does, but only as an AND clause for equalities)

Off[InterpolatingFunction::dmval];
Plot[{f@x, g@x + 4}, {x, 1, Length@l}, 
      Exclusions -> {UnitStep[Abs[g[x] - g[x + .01]] - .5] == 1},
      Evaluated -> True]
On[InterpolatingFunction::dmval];

The second one displays the same problems.

Plot[{f@x, g[x] + 4}, {x, 1, 7}, Evaluated -> True] //. 
     Line[{a___, {x1_, y1_}, {x2_, y2_}, b___}] /; Abs[(y1 - y2)/(x1 - x2)] > 10 -> 
    {Line[{a, {x1, y1}}], Line[{{x2, y2}, b}]}

I tried a few things, including PlotPoints-> and MaxRecursion-> to no avail.
For example RegionFunction[] gives disappointing results and has the same drawbacks (I know this can be fixed, but the drawbacks remain):

Plot[{f@x, g@x + 4}, {x, 1, Length@l}, 
     RegionFunction -> Function[{x, y}, Abs[g[x] - g[x + .01]] < 0.05],
     Evaluated -> True]

Mathematica graphics

So: Is there a better (ie. more robust and natural) way to manage the exclusions in these cases?

Credits

To Heike and Szabolcs for their unbelievable useful torn() and upload palette respectively.

Edit

Please note that the following is not what I want, since it requires previous knowledge of the function build up:

g[t_] = D[f[t], t];
Plot[{f@x, g[x] + 4}, {x, 1, Length@l}, Exclusions -> l, Evaluated -> True]

In any case it is irrelevant, since it doesn't work either

Edit 2

After a conversation with @Rojo about this, we (he) came up to the following interesting conclusion: Plot[] detects exclusions only when it can manipulate the functions symbolically. Just look at this:

iPN[x_?NumberQ] := IntegerPart[x];
Framed[GraphicsRow[Plot[#, {x, 0, 3}] & /@ {IntegerPart[x], iPN[x]}]]

Mathematica graphics

Which by the way is strongly linked to my other question: What does “suitable for symbolic manipulation” in the documentation mean?

Moreover, you can see that Plot[] employs the same effort exploring the discontinuities for both functions, albeit the Exclusions results are different.

data = Reap[ Plot[ #, {x, 1, 7}, EvaluationMonitor :> Sow[{x, #}]] ][[-1,1]] & /@ 
                                                          {IntegerPart[x], iPN[x]};
p = Framed@GraphicsRow[ListPlot[#, Filling -> Axis] & /@ data]

Mathematica graphics

$\endgroup$
8
  • $\begingroup$ Most probably because Mathematica does not know that it is discontinuous. Limit[g[t], t -> 4, Direction -> #] & /@ {1, -1} $\endgroup$
    – rm -rf
    Jul 21, 2012 at 20:13
  • $\begingroup$ @R.M Yep, that was my first try :D $\endgroup$ Jul 21, 2012 at 20:15
  • $\begingroup$ You could have done g = f', y'know... :) $\endgroup$ Jul 22, 2012 at 2:46
  • $\begingroup$ Anyway, for clarity: you want a routine that automagically detects jump discontinuities, or is it kosher for the user to tell the routine where to cut up the plot? $\endgroup$ Jul 22, 2012 at 2:49
  • $\begingroup$ Your second "solution" could be done slightly more cleanly, though: Plot[{f[x], g[x] + 4}, {x, 1, Length[l]}] /. Line[l_List?MatrixQ, rest___] :> Line[Split[l, Abs[Apply[Divide, Reverse[#2 - #1]]] < 10 &], rest] $\endgroup$ Jul 22, 2012 at 3:02

1 Answer 1

8
$\begingroup$

You have

l = {5, 6, 6, 5, 6, 6, 5};
f = Interpolation@l;
g[t_] = D[f[t], t];
p1 = Plot[{f@x, g@x + 4}, {x, 1, Length@l}, Evaluated -> True, 
  Exclusions -> True]

and your plot

plot = Plot[{f@x, g[x] + 4}, {x, 1, 7}, Evaluated -> True];

I suggest

With[{multiplier = {AspectRatio, PlotRange} /. 
     AbsoluteOptions[plot, {AspectRatio, PlotRange}] /. {ar_, pl_} :> 
     ar Divide @@ Subtract @@@ Reverse /@ pl}, 
  (plot //. 
   Line[{a___, {x1_, y1_}, {x2_, y2_}, b___}] /; 
     Abs[(y1 - y2)/(x1 - x2)] > 10/multiplier :> {Line[{a, {x1, y1}}],
      Line[{{x2, y2}, b}]})
 ]

With your second suggestion, one gets the same resulting image

plot //. 
     Line[{a___, {x1_, y1_}, {x2_, y2_}, b___}] /; Abs[(y1 - y2)/(x1 - x2)] > 10 -> 
    {Line[{a, {x1, y1}}], Line[{{x2, y2}, b}]}

Mathematica graphics

However it breaks by just changing the scales:

plot = Plot[1000. {f@x, g[x] + 4}, {x, 1, 7}, Evaluated -> True];

Mathematica graphics

Incorporating the multiplyer, for this second example, one gets

Mathematica graphics

Perhaps it would be smart to also add a condition not to filter vertical lines that are too short (relative to the plot range)

$\endgroup$
1
  • $\begingroup$ Hi Rojo! Thanks for your answer, see update. $\endgroup$ Jul 22, 2012 at 13:52

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.