9
$\begingroup$

I have a listed of Tupels

list = {{10, 5}, {20, 4}, {20, 3}, {10, 6}};

If there are two elements a and b for which

a[[1]] <= b[[1]] && a[[2]] <= b[[2]]

then I would like to delete the element a. If I implement this via for loops,

For[i = Length@list, i > 0, i--,
  For[j = Length@list, j > 0, j--,
        If[i != j && list[[i, 1]] <= list[[j, 1]] && list[[i, 2]] <= list[[j, 2]], list = Delete[list, i]; Break[];];
    ];
  ];

then this works but seems to be quite slow. As I need to implement this for many elements, I thought there could be a better/more performant way to solve this directly with Mathematica functions, like DeleteCases. Do you have an idea?

Thanks a lot!

$\endgroup$

4 Answers 4

8
$\begingroup$
list = {{10, 5}, {20, 4}, {20, 3}, {10, 6}};

1. You can use the function Internal`ListMin as follows:

- Internal`ListMin[-list]
 {{20, 4}, {10, 6}}

2. You can also use DeleteDuplicates:

DeleteDuplicates[ReverseSort@list, And @@ Thread[GreaterEqual[##]] &]
{{20, 4}, {10, 6}}

3. ... and SequenceReplace:

 SequenceReplace[Sort @ list, 
  {a__} /; (And @@ Thread[LessEqual[a]]) :> Last[{a}]]
{{10, 6}, {20, 4}}
$\endgroup$
3
  • $\begingroup$ Thanks a lot for your quick answer! In the second alternative, I could not obtain your result but, instead, only the first three elements of the original list. Regarding the first alternative: is it possible to apply this to other nested lists to, e.g. to list = {{{10, 5}}, {{20, 4}}, {{20, 3}}, {{10, 6}}};? $\endgroup$
    – fravity
    Apr 13, 2020 at 10:13
  • $\begingroup$ @fravity. re the second method it could be version/os related (I am using version 11.3 on Windows 10). Re the first method with nested lists, you can apply Internal`ListMin after processing the nested list into a list of pairs, e.g. list1 = {{{10, 5}}, {{20, 4}}, {{20, 3}}, {{10, 6}}}; list = Join @@ list1; and then -Internal`ListMin[-list]. $\endgroup$
    – kglr
    Apr 13, 2020 at 10:27
  • $\begingroup$ Thanks! I added the extra step and finally used DeleteCases[] to remove all elements which do not correspond to the maximum. Now that's almost ten times faster, thanks! $\endgroup$
    – fravity
    Apr 13, 2020 at 11:10
2
$\begingroup$

You can sort the list into ascending order using plain old Sort, and then Split it into sublists where the second element is ascending. The Last element of each such sublist will be the one you want to keep:

Last /@ Split[Sort[list], #1[[2]] <= #2[[2]] &]
(* {{10, 6}, {20, 4}} *)

If you need the operation to keep the remaining elements in their original order, you can sort again based on PositionIndex.

SortBy[
 Last /@ Split[Sort[list], #1[[2]] <= #2[[2]] &],
 PositionIndex[list]]
(* {{20, 4}, {10, 6}} *)
$\endgroup$
2
$\begingroup$
f = Last /@ DeleteCases[{{__}}] @ GatherBy[Sort @ #, First]&;

list like in question

list = {{10, 5}, {20, 4}, {20, 3}, {10, 6}};

f @ list

{{10, 6}, {20, 4}}

A more complicated list (with single elements like {15, 0})

list = {{10, 5}, {20, 4}, {20, 3}, {10, 6}, {10, 8}, {15, 0}, {16, 0}};

f @ list

{{10, 8}, {20, 4}}

$\endgroup$
2
$\begingroup$
l = {{10, 5}, {20, 4}, {20, 3}, {10, 6}};

Using the third argument of GroupBy:

Values[Sort@GroupBy[ReverseSort@l, First, If[Length@# > 1, #[[1]], Nothing] &]]

Result:

{{10, 6}, {20, 4}}

Or using SequenceCases:

SequenceCases[Sort@l, s : {a_, b_} /; And @@ Thread[LessEqual[s]] :> s[[-1]]]

Result:

{{10, 6}, {20, 4}}

$\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.