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.

$\endgroup$
  • $\begingroup$ You mean the first element of column 1 after the FIRST sequence of N consecutive increasing values in column 2? $\endgroup$ – Rojo Sep 3 '12 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$ – VLC Sep 3 '12 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$ – Rojo Sep 3 '12 at 16:34
  • $\begingroup$ @Rojo It depends on the definition. I'm fine with {13,8}. $\endgroup$ – VLC Sep 3 '12 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$ – Rojo Sep 3 '12 at 17:40
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]]
$\endgroup$
  • 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$ – Rojo Sep 3 '12 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$ – Artes Sep 3 '12 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$ – Rojo Sep 3 '12 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} *)
$\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} *)
$\endgroup$
  • 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$ – Rojo Sep 3 '12 at 14:56
  • $\begingroup$ @Rojo, yes, that first version was not quite right. It should be fixed with this version. Thanks. $\endgroup$ – user21 Sep 3 '12 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]
$\endgroup$
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}}
*)
$\endgroup$
  • 4
    $\begingroup$ I think I need an Alka-Seltzer to digest this one. $\endgroup$ – VLC Sep 3 '12 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$ – Dr. belisarius Sep 3 '12 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$ – VLC Sep 3 '12 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}
$\endgroup$
  • $\begingroup$ The increment by 1 was just in my toy example. Thanks anyway. $\endgroup$ – VLC Sep 3 '12 at 15:35
  • $\begingroup$ @VLC, I've generalized the original routine. $\endgroup$ – J. M. will be back soon Sep 3 '12 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} *)
$\endgroup$
  • $\begingroup$ Thanks. Especially the takeNextAfterTest seems to be much faster than Artes solution. $\endgroup$ – VLC Sep 5 '12 at 9:41

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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