Find the slope between adjacent points in a list

Question

I have a list of two dimensional points that are ordered by their x-coordinate.

I would like to calculate the slope between all adjacent points.

I'm familiar with the use of pure functions in Sort for example that can compare adjacent elements. Is there a way to perform a function on all adjacent elements in a list?

Answer 1

Here is one possibility to compute the slope between each pair of adjacent points. I create a list of random points first and use the Sort function sort them by their x-coordinate (First):

list = SortBy[RandomReal[{0, 10}, {20, 2}], First]

  {{0.0612793, 5.82737}, {0.171386, 6.8975}, {0.704354, 
  8.53224}, {0.798152, 6.39703}, {0.967127, 8.35358}, {1.75119, 
  6.73572}, {3.35177, 6.91908}, {3.81578, 7.8129}, {4.19851, 
  2.66794}, {4.73162, 3.37847}, {5.65875, 4.22096}, {5.80131, 
  8.62895}, {5.8604, 6.61611}, {6.24086, 3.4343}, {7.01985, 
  9.76974}, {7.76579, 1.96783}, {7.90587, 8.20642}, {8.65277, 
  2.30016}, {9.06088, 5.22962}, {9.98638, 6.34865}}

Then, the list of points is partitioned into lists of pairs using Partition with an offset of 1. Now we can use a pure function to compute the slope and use Apply to apply it to the list of pairs.

(Last[#2] - Last[#1])/(First[#2] - First[#1]) & @@@ Partition[list, 2, 1]

{9.71896, 3.06724, -22.7637, 11.5789, -2.06344, 0.114559, 1.92631,
-13.4428, 1.33282, 0.908702, 30.9207, -34.0611, -8.36311, 8.13291,
-10.4592, 44.5349, -7.90772, 7.1782, 1.20911}

This can also be done using the Map function and indexing:

(#[[2, 2]] - #[[1, 2]])/(#[[2, 1]] - #[[1, 1]]) & /@ Partition[list, 2, 1]

{9.71896, 3.06724, -22.7637, 11.5789, -2.06344, 0.114559, 1.92631,
-13.4428, 1.33282, 0.908702, 30.9207, -34.0611, -8.36311, 8.13291,
-10.4592, 44.5349, -7.90772, 7.1782, 1.20911}

EDIT: a much faster version using Transpose, Differences and Apply

For sure there are several ways of dealing with this question. Here's much a faster version to compute the slope between adjacent points in a list using the functions Differences, Transpose and Apply:

#2/#1 & @@ Transpose@Differences[list]

{9.71896, 3.06724, -22.7637, 11.5789, -2.06344, 0.114559, 1.92631,
-13.4428, 1.33282, 0.908702, 30.9207, -34.0611, -8.36311, 8.13291,
-10.4592, 44.5349, -7.90772, 7.1782, 1.20911}

When i apply this to a list of 10^6 pairs in list I get similar timings as the approach presented by Anon. When applied to 10^7 pairs in the list the first approach seems to be a bit faster compared to Anon's approach in most of the runs:

list = SortBy[RandomReal[{0, 10}, {10^6, 2}], First];
{Timing[#2/#1 & @@ Transpose@Differences[list]][[1]], 
Timing[Flatten[Ratios[Differences[list], {0, 1}]]][[1]]}

{0.046800, 0.078001}

list = SortBy[RandomReal[{0, 10}, {10^7, 2}], First];
{Mean@Table[Timing[#2/#1 & @@ Transpose@Differences[list]][[1]], {i, 1, 25}],
Mean@Table[Timing[Flatten[Ratios[Differences[list], {0, 1}]]][[1]], {i, 1, 25}]}

{0.557860, 0.630868}

Answer 2

What rm-rf suggested is this:

#[[2]]/#[[1]] & /@ (#[[2]] - #[[1]] & /@ Partition[data, 2, 1])

Or some version of it (see g3kk0's answer). This can also be written using Differences:

#[[2]]/#[[1]] & /@ Differences[data]

If the slope is calculated using the standard $\frac{\Delta y}{\Delta x}$ formula.

But we don't have to use an anonymous function unless we want to. This is also equivalent to the ones above:

Flatten[Ratios /@ Differences[data]]

EDIT: Here's another way which I find to be the most elegant of them all:

Flatten[Ratios[Differences[list], {0, 1}]]

Answer 3

Two new methods and a comparison of performance. Conceptually I like my second one, but it's slow; similarly I like Anon's second Ratios one, but it's not as fast as the pure function version. The first solution, Anon's fourth, and g3kko's edit are worth looking at if you want to take advantage of Mathematica's efficiencies with vectorized functions and packed arrays. The two slowest ones are slow in part because they unpack list.

SeedRandom[1];
list = SortBy[RandomReal[1, {1000000, 2}], First];

(dlist1 = Divide @@ Reverse @ Transpose @ Differences @ list) // Timing // First
(* 0.087723 *)

(dlist2 = Module[{f},
       f = Interpolation[list, InterpolationOrder -> 1];
       Rest[f'["ValuesOnGrid"]]
     ]) // Timing // First
(* 3.926643 *)

(g3kk0 = (Last[#2] - Last[#1])/(First[#2] - First[#1]) & @@@ 
     Partition[list, 2, 1]) // Timing // First
(* 5.146319 *)

(anon2 = #[[2]]/#[[1]] & /@ Differences[list]) // Timing // First
(* 0.254574 *)

(anon3 = Flatten[Ratios /@ Differences[list]]) // Timing // First
(* 0.427240 *)

Check:

dlist1 == dlist2 == g3kk0 == anon2 == anon3
(* True *)

---

This variation on Anon's is a little faster:

#[[All, 2]] / #[[All, 1]] &@ Differences[list] // Timing // First
(* 0.104045 *)

g3kko's update:

(g3kk03 = #2/#1 & @@ Transpose@Differences[list]) // Timing // First
(* 0.088209 *)

Anon's update is best so far:

(anon4 = Flatten[Ratios[Differences[list], {0, 1}]]) // Timing // First
(* 0.069120 *)

---

Edit: A note on timings

g3kko reports a faster time relative to the others. I've a remarkable variation in the timings of Anon's and g3kko's depending on the version of Mathematica. I ran the following variation of g3kko's test for n = 6, 7; if a 1/0 error occured, I reran the trial.

m = 6 (* 7 *);
Mean@Table[
  list = SortBy[RandomReal[{0, 10}, {10^n, 2}], First];
  {Timing[#2/#1 & @@ Transpose@Differences[list]][[1]], 
   Timing[Flatten[Ratios[Differences[list], {0, 1}]]][[1]]},
 {i, 1, 25}]

               -- n = 6 --          -- n = 7 --
             g3kko     Anon       g3kk0     Anon
V8.0.4    0.0875985  0.158488   0.904362  0.557465
V9.0.1    0.073255   0.096305   0.975468  0.604091

Kind of odd, if you study it. But Timing each individual computation increases the error.

Here the computations are aggregated and I used AbsoluteTiming in place of Timing. (I also reduced the number of trials for n = 7 because I was running out of coffee. :)

n = 6 (* 7 *);
trials = 25 (* 10 *);
SeedRandom[2];
lists = Table[SortBy[RandomReal[{0, 10}, {10^n, 2}], First], {i, trials}];
{AbsoluteTiming[
   Do[#2/#1 & @@ Transpose@Differences[lists[[i]]], {i, trials}]][[1]] / trials,
 AbsoluteTiming[
   Do[Flatten[Ratios[Differences[lists[[i]]], {0, 1}]], {i, trials}]][[1]] / trials}

               -- n = 6 --            -- n = 7 --
             g3kko     Anon         g3kk0     Anon
V8.0.4    0.0577675  0.0478107   0.6060478  0.5632528
V9.0.1    0.0514788  0.0461873   0.6073914  0.5819507

(I probably should have started out with timeAvg, but that's life. :/ )

Answer 4

list = RandomReal[{0, 10}, {20, 2}]
1/Divide @@ Subtract @@@ Transpose@# & /@ Partition[list, 2, 1]
1/Divide @@@ Differences[list]
#2/#1 & @@@ Differences[list]

Answer 5

My two cents. Without using Differences, but a slower replacement rule. I believe subtracting the rotated list can be much faster then mapping function on list itself.

list - RotateLeft[list, 1] /. {dx_, dy_} -> dy/dx // Most

The replacement, though, takes its toll on the timings.