11
$\begingroup$

I need a function for a series of joined slopes and my solution feels a bit kludgy. Is there a better way?

A list of pairs of transition points and slopes:

dat = {{0, 0}, {18, 1}, {70, 1/4}, {90, -1}, {110, 2}};

Build a function:

ClearAll[f] f[0] = 0; Cases[ Partition[dat, 2, 1], {{lo_, _}, {hi_, slope_}} :> (f[x_ /; x <= hi] := f[lo] + slope (x - lo)) ];

Plot it:

Plot[f[x], {x, 0, 110}, AspectRatio -> Automatic, GridLines -> {{18, 70, 90}, None}]

enter image description here

The input format (dat) is arbitrary and could possibly be better too.

Performance

There are presently three answers using Interpolation including my own. Speed of evaluation of the InterpolatingFunction appears to be the same in each case. Here is a comparison of the speed of generation in 10.1.0 under Windows. I shall cheat for my method by using a pure function (g2) which trades clarity for speed. (Spoiler: it still doesn't win.)

SeedRandom[1] dat = {Accumulate @ RandomReal[{0, 1}, 1000], RandomReal[{-1, 1}, 1000]}\[Transpose]; RepeatedTiming[ f1[x_] = Integrate[Interpolation[dat, InterpolationOrder -> 0][x], x]; ] 
{0.00215, Null} 
g2 = {#2[[1]], #[[2]] + (#2[[1]] - #[[1]]) #2[[2]]} &; RepeatedTiming[ f2 = Interpolation[FoldList[g2, dat], InterpolationOrder -> 1]; ] 
{0.00145, Null} 
RepeatedTiming[ x = dat[[;; , 1]]; y = {#}~Join~(# + Accumulate[Differences[x] dat[[2 ;;, 2]]]) &@dat[[1, 2]]; f3 = Interpolation[Transpose[{x, y}], InterpolationOrder -> 1]; ] 
{0.000972, Null}

So it seems Algohi's code is fastest at less than half the time of Integrate.
(His answer deserves more votes!)

Improve this question
$\endgroup$
10
  • $\begingroup$ @David Sorry for being vague. I'm tired and can't think clearly. :-p I did not mean slope in the proper sense, just the common one. The function behaves just as I want despite the poor terminology. In the dat format the pairs {v, s} should be read as "use slope s up to value v" -- the {0, 0} what just added to make my kludgy function work. $\endgroup$ Commented Jan 9, 2015 at 22:14
  • $\begingroup$ What would you want for your graph if your data did not form a continuous function, e.g., {{0,0}, {10,1}, {20, 5}, {30, -8}}? $\endgroup$ Commented Jan 9, 2015 at 22:17
  • $\begingroup$ @DavidG.Stork: The graph will always be continuous on $(-\infty,m]$ where $m$ is the max bound, irregardless of what data is used. Try using your example with his plot method. $\endgroup$ Commented Jan 9, 2015 at 22:19
  • 1
    $\begingroup$ "vertically offset slightly" - you know different functions that have the same derivative differ only by an arbitrary constant, yes? :) $\endgroup$ Commented May 25, 2015 at 11:21
  • 1
    $\begingroup$ For the case of the accepted answer, I think turning the indefinite integral into a definite one (thus, enforcing a boundary condition) should work; if memory serves, the indefinite integration happens to pick the particular integral that is zero at the left endpoint. $\endgroup$ Commented May 25, 2015 at 11:39

5 Answers 5

Reset to default
23
$\begingroup$

Integrate the zero-order interpolation of the data:

f[x_] = Integrate[Interpolation[dat, InterpolationOrder -> 0][x], x]; Plot[f[x], {x, 0, 110}, AspectRatio -> Automatic, GridLines -> {{18, 70, 90}, None}]

enter image description here

It can efficiently plot piecewise functions with thousands of transition points in milliseconds:

dat = {Accumulate@RandomReal[{0, 1}, 1000], RandomReal[{-1, 1}, 1000]}\[Transpose]; f[x_] = Integrate[Interpolation[dat, InterpolationOrder -> 0][x], x]; Timing@Plot[f[x], {x, dat[[1, 1]], dat[[-1, 1]]}]

enter image description here

Improve this answer
$\endgroup$
6
  • $\begingroup$ See, I had a feeling I was missing something like this. Thanks. :-) $\endgroup$ Commented Jan 10, 2015 at 7:06
  • $\begingroup$ Following my usual practice I shall wait 24 hours from posting the question before Accepting an answer, but I don't imagine this will be beaten. $\endgroup$ Commented Jan 10, 2015 at 7:35
  • 1
    $\begingroup$ @Mr.Wizard The cool thing about Integrate here is that it incorporates the derivative info from Interpolation[dat,..] into the integral. It doesn't make a difference here, but it does when integrating a continuous interpolating function. And it has only half the speed of the Accumulate[Differences[dat[[All, 1]]] dat[[2 ;;, 2]]] method. I found the FoldList method slow on DumpsterDoofus's bigger example, but it seems to be closer this morning. I was tired last night and failed to post an answer. $\endgroup$ Commented Jan 10, 2015 at 16:57
  • 1
    $\begingroup$ To clarify: The output of Integrate is an InterpolatingFunction that has derivative information stored in it; namely, the values of the derivative at the transition points are specified to be the values the input function. Examine the "dataDerivative" and "basicInterpolatingUnit" fields as defined in this answer, which can be extracted with Extract[Head[f2[x]], {{2, 3}, {4}}]. (Note the third element, the input grid, is missing from the answer.) -- Sorry, I felt I was a little vague, so now I'm over-specific. ;) $\endgroup$ Commented Jan 10, 2015 at 20:39
  • $\begingroup$ A variation of this one might try is to form a piecewise-constant function from the given derivatives and then use DSolve[] (if using Piecewise[] or UnitStep[]) or NDSolve[] (if using Interpolation[]) to integrate this piecewise constant function. $\endgroup$ Commented May 25, 2015 at 11:23
10
$\begingroup$

This is a typical Finite Difference Method.

x = dat[[;; , 1]]; y={#}~Join~(# + Accumulate[Differences[x] dat[[2 ;;, 2]]]) &@dat[[1, 2]];

Now

f = Interpolation[Transpose[{x, y}], InterpolationOrder -> 1]; Plot[f[x], {x, 0, 110}, AspectRatio -> Automatic,GridLines -> {x, None}]

enter image description here

Improve this answer
$\endgroup$
1
  • $\begingroup$ Interesting application. Thank you. $\endgroup$ Commented Jan 10, 2015 at 15:13
6
$\begingroup$

funny I just worked this up for this answer here : https://mathematica.stackexchange.com/a/71427/2079

 dat = {{0, 0}, {18, 1}, {70, 1/4}, {90, -1}, {110, 2}}; xmap[x_] = Piecewise[ Fold[Append[#, {(#[[-1, 1]] /. x -> (Last@Last@Last@#)) + #2[[2]] (x - (Last@Last@Last@#)), x < #2[[1]]}] &, {{x dat[[2, 2]], x < dat[[2, 1]]}}, dat[[3 ;;]]]]; Plot[xmap[x], {x, 0, 110}]

enter image description here

Improve this answer
$\endgroup$
1
  • $\begingroup$ Thanks for the implementation. I considered using Piecewise but it seemed even more convoluted, and from this it looks like it is. Nevertheless +1. $\endgroup$ Commented Jan 10, 2015 at 7:10
5
$\begingroup$

Although I like DumpsterDoofus's answer a lot more, now that I am properly awake I realize this works:

dat = {{0, 0}, {18, 1}, {70, 1/4}, {90, -1}, {110, 2}}; g[{x_, y_}, {X_, Y_}] := {X, y + (X - x) Y} f2 = Interpolation[FoldList[g, dat], InterpolationOrder -> 1]; Plot[f2[x], {x, 0, 110}, AspectRatio -> Automatic, GridLines -> {{18, 70, 90}, None}]

enter image description here

Embarrassing that I found that so difficult yesterday but such is life. :^)

Improve this answer
$\endgroup$
1
  • $\begingroup$ I was going to post fun[p_, q_] := p + (q[[1]] - p[[1]]) {1, q[[2]]} llp[d_] := ListLinePlot[FoldList[fun[#1, #2] &, d]] . However, as this is essentially that same approach I will not but i find it reassuring...DumpsterDoofus answer is wonderful and I have voted for it.... $\endgroup$ Commented May 25, 2015 at 3:20
3
$\begingroup$

Here is the method I was alluding to in a comment to DumpsterDoofus's answer:

dat = {{0, 0}, {18, 1}, {70, 1/4}, {90, -1}, {110, 2}}; (* DumpsterDoofus's solution *) fd[x_] = Integrate[Interpolation[dat, InterpolationOrder -> 0][x], x]; {xa, ya} = Transpose[dat]; f1 = y /. First[DSolve[{y'[x] == First[ya] + Differences[ya].UnitStep[x - Most[xa]], y[0] == 0}, y, x]]; f2 = y /. First[DSolve[{y'[x] == Piecewise[Transpose[{Rest[ya], #1 <= x < #2 & @@@ Partition[xa, 2, 1]}], 0], y[0] == 0}, y, x]];

The three are identical within the domain implied by dat:

Plot[{fd[x], f1[x], f2[x]}, {x, 0, 110}, AspectRatio -> Automatic, GridLines -> {{18, 70, 90}, None}]

three piecewise linear functions

but f1 and f2 differ in their extrapolation behavior to the right:

Plot[{f1[x], f2[x]}, {x, 90, 120}, PlotRange -> All]

extrapolated piecewise linear functions

Improve this answer
$\endgroup$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.