11
$\begingroup$

I have a list of tuples like this:

{{1,a,b},{1,1,b},{1,a,a},{b,a,1},{b,a,b}}

I would like to find a way to delete all those tuples in the list that contain a duplicate unless that duplicate is a 1. Therefore, the desired result given the example input above would be:

{{1,a,b},{1,1,b},{b,a,1}}

I will also need to delete duplicate elements within the list (irrespective of sorting) but that is easily done (i.e. only keep one of {1,a,b} and {b,a,1}).

I would like it to work for generic length tuples too, for example:

{{1,1,1,1},{1,a,a,b},{a,b,b,c},{1,a,b,c},{1,1,a,b}}

would become

{{1,1,1,1},{1,a,b,c},{1,1,a,b}}
$\endgroup$
1
  • 1
    $\begingroup$ Before I clicked into the post I thought it was a meta question (from the title) :P $\endgroup$ Commented Oct 17, 2018 at 19:21

5 Answers 5

13
$\begingroup$
list = {{1, a, b}, {1, 1, b}, {1, a, a}, {b, a, 1}, {b, a, b}};
l1 = Select[list,DuplicateFreeQ[DeleteCases[#,1]]&]

{{1, a, b}, {1, 1, b}, {b, a, 1}}

DeleteDuplicatesBy[Sort]@l1

{{1, a, b}, {1, 1, b}}

list2 = {{1, 1, 1, 1}, {1, a, a, b}, {a, b, b, c}, {1, a, b, c}, {1,  1, a, b}};
l2 = Select[list2, DuplicateFreeQ[DeleteCases[#, 1]] &] 

{{1, 1, 1, 1}, {1, a, b, c}, {1, 1, a, b}}

DeleteDuplicatesBy[Sort]@l2

{{1, 1, 1, 1}, {1, a, b, c}, {1, 1, a, b}}

$\endgroup$
2
$\begingroup$
list = {{1, a, b}, {1, 1, b}, {1, a, a}, {b, a, 1}, {b, a, b}};

Using OrderlessPatternSequence

DeleteCases[list, {OrderlessPatternSequence[a_, a_, _] /; a =!= 1}]

{{1, a, b}, {1, 1, b}, {b, a, 1}}

list = {{1, 1, 1, 1}, {1, a, a, b}, {a, b, b, c}, {1, a, b, c}, {1, 1, a, b}};

DeleteCases[list, {OrderlessPatternSequence[a_, a_, __] /; a =!= 1}]

{{1, 1, 1, 1}, {1, a, b, c}, {1, 1, a, b}}

$\endgroup$
1
$\begingroup$

This defines a function which deletes duplicates while ignoring the duplicates of given parameters:

ClearAll[deleteDuplicates];
deleteDuplicates[a__] := Pick[#, 
    SameQ[#, DeleteDuplicates[#, 
       Apply[And, Join[{SameQ[#1, #2]}, 
         Function[temp, UnsameQ[temp, #1]] /@ {a}]
       ]& ]
    ] & /@ #] &;

For example:

deleteDuplicates[1][{{1, 1}, {1, 2}, {2, 2}, {2, 3}, {3, 3}}]

deleteDuplicates[2][{{1, 1}, {1, 2}, {2, 2}, {2, 3}, {3, 3}}]

deleteDuplicates[1, 2][{{1, 1}, {1, 2}, {2, 2}, {2, 3}, {3, 3}}]

gives

{{1, 1}, {1, 2}, {2, 3}}

{{1, 2}, {2, 2}, {2, 3}}

{{1, 1}, {1, 2}, {2, 2}, {2, 3}}

$\endgroup$
1
$\begingroup$
list = {{1, a, b}, {1, 1, b}, {1, a, a}, {b, a, 1}, {b, a, b}};

Using Cases and DeleteElements:

patt = Cases[#, s : {__Symbol, _} | {_, __Symbol} /; ! DuplicateFreeQ[s]] &;

DeleteElements[#, patt@#] &@list

(*{{1, a, b}, {1, 1, b}, {b, a, 1}}*)
$\endgroup$
1
$\begingroup$

Using Tally:

Clear["Global`*"];

list = {{1, a, b}, {1, 1, b}, {1, a, a}, {b, a, 1}, {b, a, b}, {1, 1, 
    1}, {a, 1, b, c, 1}};
picker = Tally /@ list /. {_, 1} :> Nothing /. {1, _} :> Nothing // 
   Map[Length];
Pick[list, picker, 0]

{{1, a, b}, {1, 1, b}, {b, a, 1}, {1, 1, 1}, {a, 1, b, c, 1}}


From the Tally output, every tally that is not a duplicate is deleted and then every pair where 1 is counted any number of times is deleted. Anything that is left represents represents a duplicate other than 1. A 0 output from the picker means no duplicates except for 1 and only such sublists are picked up.

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