# Deleting duplicates only if they are a certain kind of duplicate

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}}

• Before I clicked into the post I thought it was a meta question (from the title) :P Commented Oct 17, 2018 at 19:21

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}}

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}}

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}}

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}}*)


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.