4
$\begingroup$

In this case if two lists with the same total then one list is deleted. Can I add one more condition to choose which one to be deleted, for example the deleted list between the two is the one where sum of the first three elements of the list is larger than 0?

   list = {{0, 1, 0, 0, 0}, {1, 0, 1, 0, 1}, {1, 1, 1, 0, 0}, {0, 0, 0,
    0, 1}, {1, 1, 1, 0, 1}};
    DeleteDuplicates[list, Total[#1] == Total[#2] &]

EDIT: This is the whole problem actually I'm trying to solve. I have tup1 and I removed some elements to get tup2 like below. However, now I want to add one more condition for which one to deleted from the pair. The list1 from the pair is deleted if Total[#1[[1 ;; 3]]]< Total[#2[[1 ;; 3]]] .

tup1 = Tuples@{{-1, 0, 1}, {-1, 0, 1}, {-1, 0, 1}, {-1, 0, 1}, {-1, 0,
      1}, {-1, 0, 1}};
tup2 = DeleteDuplicates[
   tup1, (#1[[1 ;; 3]] == #2[[4 ;; 6]]) && (#1[[4 ;; 6]] == #2[[1 ;; 
           3]]) || (#1 == -#2) &];
$\endgroup$
10
  • 1
    $\begingroup$ chooseTheRightOne /@ GatherBy[list, Total]? $\endgroup$
    – Jason B.
    Jan 6, 2021 at 20:29
  • $\begingroup$ chooseTheRightOne? what do you mean by that? $\endgroup$
    – emnha
    Jan 6, 2021 at 20:32
  • $\begingroup$ the function that, given a list of lists, each with the same total, chooses the one you want $\endgroup$
    – Jason B.
    Jan 6, 2021 at 20:33
  • $\begingroup$ Would it be able to modify by adding condition for DeleteDuplicates because I have a code needs to use that? $\endgroup$
    – emnha
    Jan 6, 2021 at 20:36
  • 1
    $\begingroup$ @anhnha Thank you for the update. Unfortunately, DeleteDuplicates only removes identical elements, under some condition. It does not have a mechanism to make further choices on which element to delete, so it is not the appropriate approach for your problem. You can still use it to obtain tup2 (although answers to your previous question suggested much faster approaches for that too), but then you will have to further work on tup2, for example in the way I showed below, to get the final result. $\endgroup$
    – MarcoB
    Jan 6, 2021 at 21:03

3 Answers 3

6
$\begingroup$

Update: You can use your test function with Gather to group the elements of your input list:

gathered = Gather[tup1, (#1[[1 ;; 3]] == #2[[4 ;; 6]]) && (#1[[4 ;; 6]] == #2[[1 ;; 3]])
   || (#1 == -#2) &];

Now, you can select a representative for each group using your desired criterion:

tup3 = Map[First @* MaximalBy[Total @* (Take[#, 3] &)]] @ gathered;

Compare sums of first three columns in tup3 versus tup2:

And @@ NonNegative[Total[tup3[[All, ;; 3]], {2}] - Total[tup2[[All, ;; 3]], {2}]]
True

FWIW, an alternative way to construct your tup1 and tup2 that makes it easier to select from duplicates:

First, construct a list of 2X3 lists:

tup1B =  Tuples[{-1, 0, 1}, {2, 3}];
Flatten /@ tup1B == tup1
True

Alternatively, you can construct tup1B from your tup1 using tup1B = Partition[#, 3] & /@ tup1;.

Defining input list this way makes application of your test functions more straightforward:

tup2B = DeleteDuplicates[tup1B, # == Reverse[#2] || (#1 == -#2) &];

When Flattened, tup2B is same as your tup2:

Flatten /@ tup2B == tup2

We can use the same test function to group input list elements:

gatheredB = Gather[tup1B, # == Reverse[#2] || (#1 == -#2) &];

If we take the first elements from each group and Flatten them we get tup2 again:

Flatten /@ First /@ gatheredB == tup2

Select representatives from groups using your desired criterion:

tup3B = Map[Flatten @* First @* MaximalBy[Total @* First]] @ gatheredB;

Compare the totals of first 3 columns in tup3B versus tup2:

And @@ NonNegative[Total[tup3B[[All, ;; 3]], {2}] - Total[tup2[[All, ;; 3]], {2}]]
 True

Original answer:

You can also use GroupBy and use the third argument to reduce the groups:

gb = GroupBy[list, Total, First @* MaximalBy[Total[Take[#, 3]] &]]
<|1 -> {0, 1, 0, 0, 0}, 3 -> {1, 1, 1, 0, 0}, 4 -> {1, 1, 1, 0, 1}|>
Values @ gb
{{0, 1, 0, 0, 0}, {1, 1, 1, 0, 0}, {1, 1, 1, 0, 1}}
$\endgroup$
1
  • $\begingroup$ Thank you for the comprehensive answer. I'll need to play with them for a while. $\endgroup$
    – emnha
    Jan 7, 2021 at 9:59
6
$\begingroup$

The second criterion you mentioned (i.e. positive sum of first three elements) is not sufficient to break all ties in your list, once grouped by Total. Instead, in the following I first gather the sub-lists into groups by their total, then in each group I select the one with the highest sum of the first three elements.

First@*TakeLargestBy[Total[#[[;; 3]]] &, 1] /@
 GatherBy[list, Total]

(* Out: {{0, 1, 0, 0, 0}, {1, 1, 1, 0, 0}, {1, 1, 1, 0, 1}} *)
$\endgroup$
4
$\begingroup$

Using DeleteDuplicates

You can sort the input list by the sum of first 3 columns before using DeleteDuplicates:

DeleteDuplicates[ReverseSortBy[Total[Take[#, 3]] &] @ list, Total[#1] == Total[#2] &]
 {{1, 1, 1, 0, 1}, {1, 1, 1, 0, 0}, {0, 1, 0, 0, 0}} 

Applying this to tup1:

tup2sorted = DeleteDuplicates[SortBy[-Total[Take[#, 3]] &]@ tup1, 
 (#1[[1 ;; 3]] == #2[[4 ;; 6]]) && (#1[[4 ;; 6]] == #2[[1 ;; 3]]) || (#1 == -#2)&];

To verify that the first 3 column sums of undeleted elements are greater-or-equal than those of their deleted counterparts we can use Gather as follows:

And @@ Map[GreaterEqual @@ (Total /@ #[[All, ;; 3]]) &]@
  Select[Length@# > 1 &]@ Gather[SortBy[-Total[Take[#, 3]] &]@ tup1, 
   (#1[[1 ;; 3]] == #2[[4 ;; 6]]) && (#1[[4 ;; 6]] == #2[[1 ;; 3]]) || (#1 == -#2)&]
  True

Note: Why does this work?

Take a simpler example to see how DeleteDuplicates work:

DeleteDuplicates[Range[4], Abs[#2 - #] == 1 &]
{1, 3}     

DeleteDuplicates applies the test function to 2-subsets of the the input list

Subsets[Range@4, {2}]
{{1, 2}, {1, 3}, {1, 4}, {2, 3}, {2, 4}, {3, 4}}

and skips testing on 2-subsets whose first element is already deleted as can be seen from the Trace output below:

Trace[DeleteDuplicates[Range[4], Abs[#2 - #] == 1 &]] // Rest // 
    Rest // Column

enter image description here

So if we sort the input list in desired order, DeleteDuplicates will eliminate elements that come later in the sorted list as duplicate:

DeleteDuplicates[Reverse @ Range[4], Abs[#2 - #] == 1 &] 
{4, 2} 

Gather works the same way:

Gather[Range[4], Abs[#2 - #] == 1 &]
{{1, 2}, {3, 4}}
Trace[Gather[Range[4], Abs[#2 - #] == 1 &]] // Rest // Rest // Column

enter image description here

Gather[Reverse@Range[4], Abs[#2 - #] == 1 &]
{{4, 3}, {2, 1}}
$\endgroup$

Your Answer

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

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