4
$\begingroup$

Consider the following table:

tab={{1,2},{3,67},{96,1},{1,19},{894,55},{10111,23},{20000,23},{5,93},{5,97},{22,34},{0,1}};

How to select only those rows for which tab[[i]][[1]]<tab[[i-1]][[1]]? i.e.,

tabSelected = {{1,2},{1,19},{5,93},{0,1}}

An edit. It seems that one of the approaches is:

tabSelected = {tab[[1]]};
For[i = 2, i <= Length[tab], i++, 
 If[tab[[i]][[1]] < tab[[i - 1]][[1]], 
  tabSelected = Join[tabSelected, {tab[[i]]}]]]
tabSelected

But maybe there is a faster/more compact way.

$\endgroup$
5
  • $\begingroup$ Could you please describe this condition in words? Also please fix tabb and {0.1} in the desired output to {0,1}. Thanks. $\endgroup$
    – Syed
    Commented Oct 24, 2022 at 12:15
  • $\begingroup$ @Syed : thanks! I have modified the question. $\endgroup$ Commented Oct 24, 2022 at 12:30
  • $\begingroup$ related mathematica.stackexchange.com/questions/38325/… $\endgroup$ Commented Oct 24, 2022 at 13:03
  • 1
    $\begingroup$ Readable but likely not the fastest way: {First@tab} ~Join~ SequenceCases[Rest@tab, {{a_, b_}, {c_, d_}} /; c < a :> {c, d}] $\endgroup$
    – Syed
    Commented Oct 24, 2022 at 13:14
  • $\begingroup$ For future users searching for a similar question, maybe "How to delete adjacent elements that verify a condition ?" would help them find this. $\endgroup$ Commented Oct 25, 2022 at 16:46

6 Answers 6

6
$\begingroup$
tab={{1,2},{3,67},{96,1},{1,19},{894,55},{10111,23},{20000,23},{5,93},{5,97},{22,34},{0,1}};
Catenate[Rest /@ Split[tab, #2[[1]] < #1[[1]] &]]
(* {{1, 19}, {5, 93}, {0, 1}} *)

It looks like you want to keep the first element, even though there is no zeroth element to compare to. So, you can get that with the following adjustment:

Catenate[Rest /@ Split[Prepend[tab, {Infinity, Infinity}], #2[[1]] < #1[[1]] &]]

Using a 100000 element random list, AbsoluteTiming gives around 0.15 seconds

$\endgroup$
1
5
$\begingroup$

No loops using Position and Extract

negativePositions = Position[Differences[tab], x_ /; Negative[x[[1]]]];
selected = {First[tab]}~Join~Extract[tab, negativePositions + 1] 

{{1, 2}, {1, 19}, {5, 93}, {0, 1}}

Which is about 5x faster than the looped method

Seed = 1;
n = 100000;
bigArray = RandomInteger[{1, 1000}, {n, 2}];

AbsoluteTiming[
 tabSelected = {bigArray[[1]]};
 For[
  i = 2,
  i <= Length[bigArray],
  i++,
  If[
   bigArray[[i]][[1]] < bigArray[[i - 1]][[1]],
   tabSelected = Join[tabSelected, {bigArray[[i]]}]
   ]
  ];
 ] (*5.4155*)

AbsoluteTiming[
 negativePositions = Position[Differences[bigArray], x_ /; Negative[x[[1]]]];
 selected = {First[bigArray]}~Join~Extract[bigArray, negativePositions + 1];
 ] (*1.09293*)

tabSelected == selected (*True*)

$\endgroup$
1
  • $\begingroup$ I realise I did not seed the random number generator correctly here; this is reflected and corrected in my second answer. $\endgroup$ Commented Oct 24, 2022 at 22:31
4
$\begingroup$

One can use

Prepend[MapThread[If[#1[[1]]>#2[[1]],#2,Nothing]&,
        {Most[tab],Rest[tab]}],First[tab]];

or

Prepend[Map[Last,Select[Partition[tab,2,1],
        (#[[1,1]]>#[[2,1]])&]],First[tab]]

Both give

{{1,2},{1,19},{5,93},{0,1}}

in OP's example.

$\endgroup$
4
$\begingroup$

EDIT

The new DeleteAdjacentDuplicates in version 13.1 is exactly adapted to this scenario.

tab = {{1, 2}, {3, 67}, {96, 1}, {1, 19}, {894, 55}, {10111, 
23}, {20000, 23}, {5, 93}, {5, 97}, {22, 34}, {0, 1}};

DeleteAdjacentDuplicates[tab, #1[[1]] <= #2[[1]] &]

Using Differences and Pick

tab = {{1, 2}, {3, 67}, {96, 1}, {1, 19}, {894, 55}, {10111, 
23}, {20000, 23}, {5, 93}, {5, 97}, {22, 34}, {0, 1}};

Pick[tab, Thread[{-1}~Join~Differences@tab[[All, 1]] < 0]]

Or Using RotateRight and Pick

Pick[tab, {True}~Join~Thread[ (RotateRight@tab)[[2 ;; -1, 1]]
> tab[[2 ;; -1, 1]]]]; // AbsoluteTiming

With tab = RandomReal[1, {10^6, 2}] or tab = RandomInteger[10^2, {10^6, 2}] both took around 0.4-0.5 seconds.

$\endgroup$
6
  • 1
    $\begingroup$ Fast and compact ! $\endgroup$ Commented Oct 24, 2022 at 22:34
  • $\begingroup$ @IntroductionToProbability (: . I noticed after that you used Differences too and thought that using Pick and Thread was sufficiently different that it still deserved a spot as a separate answer. To justify the separate answer more I included the RotateRight option. After seeing how some of the best answers use Pick on stack exchange I try to use it more. It also looks closer to using the numpy package in Python. $\endgroup$ Commented Oct 25, 2022 at 15:23
  • $\begingroup$ Yes Pick is always very fast, I need to use it more. Your DeleteAdjacentDuplicates method is a great find. Wish I could +1 again. Edited my second answer to include the timings. $\endgroup$ Commented Oct 25, 2022 at 16:10
  • 1
    $\begingroup$ @IntroductionToProbability nice I had already left a plus one. I would suggest mentioning in bold at the beginning of the answer that you included the timings since with so many answers here one is likely to gloss over most of the answers. $\endgroup$ Commented Oct 25, 2022 at 16:23
  • 1
    $\begingroup$ @IntroductionToProbability I did not know we completed the 10 fold. There was a challenge earlier this year to give 10 answers for every list related question. $\endgroup$ Commented Oct 25, 2022 at 16:27
3
$\begingroup$

Using the test setup from @IntroductionToProbability :

SeedRandom[1];
n = 100000;
bigArray = RandomInteger[{1, 1000}, {n, 2}];

Using the Partition command to compare pairs of sublists:

{t, selected2} = {First@bigArray}~
   Join~(Last /@ 
     Select[Partition[bigArray, 2, 1], 
      First@Last@# < First@First@# &]) // AbsoluteTiming

t

0.258892

tabSelected == selected2

True


EDIT

Using Reap/Sow:

{t, selected3} = First@Last@Reap@{Sow[bigArray[[1]]],
      For[i = 2, i <= Length[bigArray], i++, 
       If[bigArray[[i]][[1]] < bigArray[[i - 1]][[1]], 
        Sow@bigArray[[i]]
        ]]
      } // AbsoluteTiming

(0.393928, True)

$\endgroup$
1
  • 1
    $\begingroup$ You beat me to it with Reap + Sow. I think you might get a small speed up putting it in a Block and Do Loop $\endgroup$ Commented Oct 24, 2022 at 14:28
3
$\begingroup$

Update: I have included timings for all the different answers at the bottom of this post

Here is an answer with Do loop and Compile. It has forced me to learn about Bag which I have previously avoided as it is part of Internal and undocumented.

Excluding compile time it is very fast though, approx 976x faster than the original For loop with Join and 30x faster than the For loop with Reap + Sow

fCompileLoop =
  Compile[
   {{tab, _Integer, 2}},
   Block[
    {tabSelected = 
      Internal`Bag[Most[{0}]](*make the bag hold integers*)},
    Internal`StuffBag[tabSelected, tab[[1]],1];(*third argument 1 says you are stuffing a list*)
    Do[
     If[
      tab[[i]][[1]] < tab[[i - 1]][[1]],
      Internal`StuffBag[tabSelected, tab[[i]], 1]
      ],
     {i, 2, Length[tab]}
     ];
    Partition[Internal`BagPart[tabSelected, All], 2]],
   CompilationTarget -> "C",
   RuntimeOptions -> "Speed"
   ];
fCompileLoop [tab] (* {{1, 2}, {1, 19}, {5, 93}, {0, 1}} *)

EDIT: Updated timings

Functions

(* John Taylor original *)
fOriginalForLoop[tab_] :=
  Module[
   {tabSelected, i},
   tabSelected = {tab[[1]]}; 
   For[i = 2, i <= Length[tab], i++, 
    If[tab[[i]][[1]] < tab[[i - 1]][[1]], 
     tabSelected = Join[tabSelected, {tab[[i]]}]]];
   tabSelected
   ];

(* IntroductionToProbability 1*)
fPositionExtract[tab_] :=
  Module[
   {negativePositions, selected},
    negativePositions = 
    Position[Differences[tab], x_ /; Negative[x[[1]]]];
   selected = {First[tab]}~Join~Extract[tab, negativePositions + 1]
   ];

(* lericr *)
fRestSplit[tab_] := 
  Catenate[
   Rest /@ Split[
     Prepend[tab, {Infinity, Infinity}], #2[[1]] < #1[[1]] &]];

(* Syed 1*)
fSelectPartition[tab_] := {First@tab}~
   Join~(Last /@ 
     Select[Partition[tab, 2, 1], First@Last@# < First@First@# &]);

(* Syed 2*)
fSowReap[tab_] := 
  Module[{i}, 
   First@Last@
     Reap@{Sow[tab[[1]]], 
       For[i = 2, i <= Length[tab], i++, 
        If[tab[[i]][[1]] < tab[[i - 1]][[1]], Sow@tab[[i]]]]}];

(* user293787 1*)
fMapThread[tab_] := 
  Prepend[MapThread[
    If[#1[[1]] > #2[[1]], #2, Nothing] &, {Most[tab], Rest[tab]}], 
   First[tab]];

(* user293787 2*)
fMapSelectPartition[tab_] := 
  Prepend[Map[Last, 
    Select[Partition[tab, 2, 1], (#[[1, 1]] > #[[2, 1]]) &]], 
   First[tab]];

(* IntroductionToProbability 2*)
fCompileLoop =
  Compile[
   {{tab, _Integer, 2}},
   Block[
    {tabSelected = 
      Internal`Bag[Most[{0}]](*make the bag hold integers*)},
    Internal`StuffBag[tabSelected, tab[[1]], 
     1];(*third argument 1 says you are stuffing a list*)
    Do[
     If[
      tab[[i]][[1]] < tab[[i - 1]][[1]],
      Internal`StuffBag[tabSelected, tab[[i]], 1]
      ],
     {i, 2, Length[tab]}
     ];
    Partition[Internal`BagPart[tabSelected, All], 2]],
   CompilationTarget -> "C",
   RuntimeOptions -> "Speed"
   ];

(*  userrandrand 1*)
fDifferencesPick[tab_] := 
  Pick[tab, Thread[{-1}~Join~Differences@tab[[All, 1]] < 0]];

(*  userrandrand 2*)
fRotateRightPick[tab_] := 
  Pick[tab, {True}~Join~
    Thread[(RotateRight@tab)[[2 ;; -1, 1]] > tab[[2 ;; -1, 1]]]];

(*  userrandrand 3*)
fDeleteAdjacentDuplicates[tab_] := 
  DeleteAdjacentDuplicates[tab, #1[[1]] <= #2[[1]] &];

Times


SeedRandom[1];
n = 100000;
bigArray = RandomInteger[{1, 1000}, {n, 2}];

RepeatedTiming[result = fOriginalForLoop[bigArray];] (*10.1189*)
RepeatedTiming[result1 = fPositionExtract[bigArray];] (*1.1596*)
RepeatedTiming[result2 = fRestSplit[bigArray];] (*0.161716*)
RepeatedTiming[result3 = fSelectPartition[bigArray];] (*0.307968*)
RepeatedTiming[result4 = fSowReap[bigArray];] (*0.312946*)
RepeatedTiming[result5 = fMapThread[bigArray];] (*0.299152*)
RepeatedTiming[result6 = fMapSelectPartition[bigArray];] (*0.273186*)
RepeatedTiming[result7 = fCompileLoop[bigArray];] (*0.0103619*)
RepeatedTiming[result8 = fDifferencesPick[bigArray];] (*0.134042*)
RepeatedTiming[result9 = fRotateRightPick[bigArray];] (*0.145216*)
RepeatedTiming[result10 = fDeleteAdjacentDuplicates[bigArray];](*0.128746*)

result == result1 (*True*)
result == result2 (*True*)
result == result3 (*True*)
result == result4 (*True*)
result == result5 (*True*)
result == result6 (*True*)
result == result7 (*True*)
result == result8 (*True*)
result == result9 (*True*)
result == result10 (*True*)

$\endgroup$

Your Answer

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

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