9
$\begingroup$

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

$\endgroup$
  • $\begingroup$ Delete[l, Position[Sign[Differences[l[[All, 1]]]], 1] + 1]? $\endgroup$ – J. M. is away Aug 30 '17 at 10:52
  • $\begingroup$ @J.M. won't work with {{6, data1}, {8, data2}, {7, data3},... $\endgroup$ – Kuba Aug 30 '17 at 10:53
  • $\begingroup$ 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. $\endgroup$ – aardvark2012 Aug 30 '17 at 11:07
  • $\begingroup$ @aardvark2012 correct, you always have to take the first available element. Thanks for clarifying that, I had not though about it. $\endgroup$ – José D. Aug 30 '17 at 11:18
  • 3
    $\begingroup$ 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). $\endgroup$ – Szabolcs Aug 30 '17 at 11:36
10
$\begingroup$

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: enter image description here

$\endgroup$
8
$\begingroup$

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}} *)
$\endgroup$
2
$\begingroup$
Fold[If[Min[#1[[All, 1]]] > #2[[1]], Append[#1, #2], #1] &, {l[[1]]}, 
 Rest@l]
$\endgroup$
2
$\begingroup$

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}} *)
$\endgroup$

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.