14
$\begingroup$

I'm looking for an efficient way of extracting the first element after the first sequence of N consecutive elements in which the values are increasing. If these are the data of a toy example:

data = {{1, 4}, {2, 3}, {3, 4}, {4, 5}, {5, 6}, {6, 4}, {7, 6}, {8, 3}, {9, 4}, {10, 5}, {11, 6}, {12, 7}, {13, 8}, {14, 9}, {15, 10}};

and I would like to get the first element after the first sequence of 5 consecutive increasing values (from those in second position), I should obtain the row {13,8}.

I was playing around with:

Split[data, #2[[2]] > #1[[2]] &]

that groups my data in sequences of increasing values, but I wasn't able to find a way to add the additional constraints I need. Any hint is much appreciated.

Improve this question
$\endgroup$
6
  • $\begingroup$ You mean the first element of column 1 after the FIRST sequence of N consecutive increasing values in column 2? $\endgroup$ Commented Sep 3, 2012 at 14:22
  • $\begingroup$ @Rojo If we talk about columns and rows, I mean the first row after the first sequence of N consecutive increasing values in column 2. I edited the question. $\endgroup$ Commented Sep 3, 2012 at 14:26
  • $\begingroup$ Wouldn't in your example be {14,9} the answer? The increasing sequence is {8,3}->{9,4}->{10, 5}->{11,6}->{12, 7}->{13,8}, so the row after is {14, 9}? $\endgroup$ Commented Sep 3, 2012 at 16:34
  • $\begingroup$ @Rojo It depends on the definition. I'm fine with {13,8}. $\endgroup$ Commented Sep 3, 2012 at 17:01
  • $\begingroup$ My real question isn't 4 vs 5. It's more about: the result is the next row following the sequence or the last one on the sequence? If instead of {13, 8} you had {13, -8} would that row be your result? $\endgroup$ Commented Sep 3, 2012 at 17:40

7 Answers 7

Reset to default
11
$\begingroup$

Following your first approach this satisfies your needs :

Select[Split[data, #2[[2]] > #1[[2]] &], Length @ # > 5 &][[All, 6]] 
{{13, 8}}

Edit

The OP was edited and now it asks for the first element after the first sequence of 5 consecutive increasing values... Thus we can use Select with the third argument n to select the first n elements satisfying the criterion, i.e. in our case (n=1) :

Select[ Split[ data, #2[[2]] > #1[[2]]& ], Length @ # > 5 &, 1][[All, 6]]
Improve this answer
$\endgroup$
3
  • 1
    $\begingroup$ Nice one +1. I'd add 1 as the third argument to Select since he only seems to want the first. Careful however if he has a length 5 increasing sequence, you probably will get an error and you won't be finding the "next row" following the sequence $\endgroup$ Commented Sep 3, 2012 at 15:23
  • $\begingroup$ @Rojo Thanks, interesting remarks ! My solution doesn't produce an error even if there is no increasing sequence of length > 5 as your first method does. Anyway I like them both +1. $\endgroup$ Commented Sep 3, 2012 at 16:17
  • $\begingroup$ Yeah, no error in {}[[All, 6]], I expected that wrongly. Mines both produce an error when there's no sequence $\endgroup$ Commented Sep 3, 2012 at 16:29
6
$\begingroup$

Here's another way, somewhat similar to Rojo's.

selectAfterN[data_, n_] := Pick[data, Accumulate /@ SplitBy@ UnitStep[{0}~Join~Differences[data][[All, 2]]] // Flatten, n] selectAfterN[data, 5] (* {13, 8} *)
Improve this answer
$\endgroup$
6
$\begingroup$

Here is another try at a version that does not unpack; the first version was not quite right.

data = Developer`ToPackedArray@{{1, 4}, {2, 3}, {3, 4}, {4, 5}, {5, 6}, {6, 4}, {7, 6}, {8, 3}, {9, 4}, {10, 5}, {11, 6}, {12, 7}, {13, 8}, {14, 9}, {15, 10}}; (*data={{a,1},{b,2},{c,-2},{d,-1},{e,0},{f,3},{g,5},{h,6},{j,7},{k,8}}\ *) ClearAll[select] select[p_Integer] := Compile[{{in, _Integer, 1}}, Module[{pos = 0, val = 0}, Do[ val += in[[i]]; If[in[[i]] == 0, val = 0; Continue[]]; If[val == p, pos = i; Break[];]; , {i, Length[in]}]; pos ] ] On["Packing"] cf = select[5]; res = UnitStep[data[[All, -1]] - RotateRight[data[[All, -1]]]]; data[[cf[res]]] (* {13, 8} *)
Improve this answer
$\endgroup$
2
  • 1
    $\begingroup$ I don't think this works correctly for other lists. Try {{a, 1}, {b, 2}, {c, -2}, {d, -1}, {e, 0}, {f, 3}, {g, 5}, {h, 6}, {j,7}, {k, 8}} $\endgroup$ Commented Sep 3, 2012 at 14:56
  • $\begingroup$ @Rojo, yes, that first version was not quite right. It should be fixed with this version. Thanks. $\endgroup$ Commented Sep 3, 2012 at 16:09
5
$\begingroup$

Perhaps 

q = 5; Transpose@data /. {_, index_} :> First@Extract[data, 1 + Position[Flatten[Accumulate /@ Split@Sign@Differences@index], q]]

An alternative, somewhat @Verde-ish, is

Replace[data, {___, i : Repeated[{_, _}, {q}] /; q - 1 == Total@Sign@Differences[{i}[[All, 2]]], n_, ___} :> n]
Improve this answer
$\endgroup$
0
4
$\begingroup$ 
Cases[{{{a, 1}, {b, 2}, {c, 3}, {d, 4}, {e, 5}, {f, 6}, {g, 7}, {h, 8}}}, {___, {_, a_}, {_, b_}, {_, c_}, {_, d_}, {_, e_}, {ff_, f_}, ___} /; a < b < c < d < e < f :> {ff, f}] (* -> {f,6} *)

If you want to detect only sequences increasing by 1:

Cases[{{{a, 1}, {b, 2}, {c, 3}, {d, 4}, {e, 5}, {f, 6}, {g, 7}, {h,8}}}, {___, {_, a_}, {_, b_}, {_, c_}, {_, d_}, {_, e_}, {ff_, f_}, ___} /; f == e + 1 == d + 2 == c + 3 == b + 4 == a + 5 :> {ff, f}]

If you want to stick with your StringSplit thing:

data = {{1, 4}, {2, 3}, {3, 4}, {4, 5}, {5, 6}, {6, 4}, {7, 6}, {8, 3}, {9, 4}, {10, 5}, {11, 6}, {12, 7}, {13, 8}, {14, 9}, {15, 10}}; (Select[#, Length@# > 5 &] &@Split[data, #2[[2]] > #1[[2]] &])[[All, 6]] (* -> {{13, 8}} *)
Improve this answer
$\endgroup$
3
  • 4
    $\begingroup$ I think I need an Alka-Seltzer to digest this one. $\endgroup$ Commented Sep 3, 2012 at 14:35
  • $\begingroup$ @VLC Your question is pretty simple, that's why you received so many answers. I stuck by Brian Kerninghan's advice: stackoverflow.com/questions/1103299/… So, don't be unthankful $\endgroup$ Commented Sep 3, 2012 at 15:12
  • $\begingroup$ I always like to see many variations on the theme, so I'm thankful to you and all the others. Some stuff is simply out of my reach now. $\endgroup$ Commented Sep 3, 2012 at 15:22
3
$\begingroup$

Yet another route:

data = {{1, 4}, {2, 3}, {3, 4}, {4, 5}, {5, 6}, {6, 4}, {7, 6}, {8, 3}, {9, 4}, {10, 5}, {11, 6}, {12, 7}, {13, 8}, {14, 9}, {15, 10}}; With[{k = 5}, data[[Total[TakeWhile[Length /@ SplitBy[Differences[data], Composition[Positive, Last]], # < k &]] + k + 1]]] {13, 8}

Using Verde's example:

data2 = {{{a, 1}, {b, 2}, {c, 3}, {d, 4}, {e, 5}, {f, 6}, {g, 7}, {h, 8}}}; With[{k = 5}, data2[[Total[TakeWhile[Length /@ SplitBy[Differences[data2], Composition[Positive, Last]], # < k &]] + k + 1]]] {f, 6}
Improve this answer
$\endgroup$
2
  • $\begingroup$ The increment by 1 was just in my toy example. Thanks anyway. $\endgroup$ Commented Sep 3, 2012 at 15:35
  • $\begingroup$ @VLC, I've generalized the original routine. $\endgroup$ Commented Sep 3, 2012 at 15:46
2
$\begingroup$

Using NestWhile and OrderedQ:

ClearAll[takeNextAfterTest]; takeNextAfterTest = Function[{data, num, col, comp}, With[{temp = NestWhile[Rest, data, (Length@# > num && !OrderedQ[#[[;; num, col]], comp]) &]}, If[Length@temp == num, {}, temp[[1 + num]]]]];

Examples:

data2 = {{1, 4}, {2, 3}, {5, 2}, {3, 4}, {4, 5}, {5, 6}, {6, 4}, {7, 6}, {8, 3}, {9, 4}, {10, 5}, {11, 6}, {12, 7}, {13, 8}, {14, 9}, {15, 10}, {8, 9}, {9, 8}, {10, 7}, {11, 6}, {12, 5}, {13, 10}, {14, 10}, {15, 11}}; takeNextAfterTest[data2, 5, 2, Less] (* {13, 8} *) takeNextAfterTest[data2, 3, 2, #2 == 1 + #1 &] (* {6, 4} *) takeNextAfterTest[data2, 5, 2, Greater] (* {12,5} *) takeNextAfterTest[data2, 2, 2, Equal] (* {15, 11} *)

Using NestWhile and Ordering:

ClearAll[takeNextAfterOrderingPattern]; takeNextAfterOrderingPattern = Function[{data, num, col, orderedlike}, With[{temp = NestWhile[Rest, data, (Length@# > num && (Ordering[#[[;; num, col]]] =!= Ordering[orderedlike])) &]}, If[Length@temp == num, {}, temp[[1 + num]]]]];

Examples:

takeNextAfterOrderingPattern[data2, 5, 2, Range[5]] (* {13,8} *) takeNextAfterOrderingPattern[data2, 5, 2, Range[5, 1, -1]] (* {12,5} *) takeNextAfterOrderingPattern[data2, 5, 2, {3, 4, 2, 4, 1}] (* {9, 4} *)
Improve this answer
$\endgroup$
1
  • $\begingroup$ Thanks. Especially the takeNextAfterTest seems to be much faster than Artes solution. $\endgroup$ Commented Sep 5, 2012 at 9:41

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.