# Filter elements in descending order

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).

• Delete[l, Position[Sign[Differences[l[[All, 1]]]], 1] + 1]? – J. M.'s torpor Aug 30 '17 at 10:52
• @J.M. won't work with {{6, data1}, {8, data2}, {7, data3},... – Kuba Aug 30 '17 at 10:53
• Can we assume that you want to always take the first available element? That is, {{6, data1}, {5, data4}, {1, data7}} also satisfies "the resulting list has the value property of its elements sorted", but I assume it's not a valid answer. – aardvark2012 Aug 30 '17 at 11:07
• @aardvark2012 correct, you always have to take the first available element. Thanks for clarifying that, I had not though about it. – José D. Aug 30 '17 at 11:18
• Three answers (plus one deleted) and only one upvote?! If it's worth four answers, it surely must be worth a couple of upvotes too! (+1 so now you have 2). – Szabolcs Aug 30 '17 at 11:36

# Solution 1

A solution using Sow and Reap:

Reap[
Module[
{c = Infinity},
Scan[
If[#[] < c, c = #[]; 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[
If[#1[] == #2, Sow@#1] &,
{
l,
Rest@FoldList[Min[#, #2[]] &, 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[]] &, Infinity, l]
}\[Transpose]
, Apply[#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[], Sow@#2; #2[], #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: 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}} *)

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


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

refine[l_] := Module[{tl = {Infinity}~Join~Transpose[l][]},
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}} *)