Filter elements in descending order

Question

I want to solve the following problem efficiently:

Given a list of pairs (value, data), I want to remove all the pairs so that the resulting list has the value property of its elements sorted. That is, for example:

l = { {6, data1}, {8, data2}, {4, data3}, {5, data4}, {6, data5}, {0, data6}, {1, data7}}

MyFilter[l] should return

{{6, data1}, {4, data3}, {0, data6}}

How can I achieve this efficiently? Should I try a Reap & Sow based approach? I am still not sure how to use them correctly (I am new to functional programming).

Answer 1

Solution 1

A solution using Sow and Reap:

Reap[
  Module[
   {c = Infinity},
   Scan[
    If[#[[1]] < c, c = #[[1]]; Sow@#] &,
    l
    ]
   ]
  ][[2, 1]]

This one keeps track of the current maximum through the variable c, and uses Sow and Reap to collect the data.

Solution 2

Another one, this time without Module:

Reap[
  MapThread[
   If[#1[[1]] == #2, Sow@#1] &,
   {
    l,
    Rest@FoldList[Min[#, #2[[1]]] &, Infinity, l]
    }
   ]
  ][[2, 1]]

This one creates a list of the current minimum at each position using FoldList, and uses this list together with the original one in MapThread

Solution 3

And a third, based on the previous one:

Select[
  {
    l,
    Rest@FoldList[Min[#, #2[[1]]] &, Infinity, l]
    }\[Transpose]
  , Apply[#1[[1]] == #2 &]
  ][[All, 1]]

Pretty similar to the previous one, but we put the lists together using Transpose{l1,l2}, and filter using Select

Solution 4

Reap[
  Fold[
   If[#1 > #2[[1]], Sow@#2; #2[[1]], #1] &,
   Infinity,
   l
   ]
  ][[2, 1]]

This is very similar to the first one, but instead of a local variable c, this one uses Fold to pass the current minimum along.

Timings

I attempted to perform some benchmarking, using randomly generated data:

data[n_] := Table[{RandomInteger[n], Indexed[data, i]}, {i, n}]

The results are the following:

Answer 2

This is one rather compact way:

numbers = l[[All, 1]]
(* {6, 8, 4, 5, 6, 0, 1} *)

steps = FoldList[Min, numbers]
(* {6, 6, 4, 4, 4, 0, 0} *)

Pick[l, steps - numbers, 0]
(* {{6, data1}, {4, data3}, {0, data6}} *)

Answer 3

Fold[If[Min[#1[[All, 1]]] > #2[[1]], Append[#1, #2], #1] &, {l[[1]]}, 
 Rest@l]

Answer 4

This method works by recursively selecting elements that are less than their predecessor.

refine[l_] := Module[{tl = {Infinity}~Join~Transpose[l][[1]]},
  Pick[l, Order @@@ Partition[tl, 2, 1], -1]
  ]
myFilter = FixedPoint[refine, #] &

The example from the question:

l = {{6, data1}, {8, data2}, {4, data3}, {5, data4}, {6, data5}, {0, data6}, {1, data7}};
myFilter[l]

(* {{6, data1}, {4, data3}, {0, data6}} *)

Another example:

l = {{6, data1}, {8, data2}, {7, data3}, {5, data4}, {6, data5}, {0, data6}, {1, data7}};
myFilter[l]

(* {{6, data1}, {5, data4}, {0, data6}} *)