# Flagging duplicate elements of a list

I have a list of pairs of observations:

{a,b}
{c,d}
{e,f}
{g,h}
{i,a}
{a,d}


I would like to flag each pair "True" if neither of its elements appear in any other pairs in the list, and "False" otherwise:

{a,b,False}
{c,d,False}
{e,f,True}
{g,h,True}
{i,a,False}
{a,d,False}


I have written inelegant code using 3 For loops that does this, but I am confident there is a better way of doing it.

• Do any pairs have the same element twice? If not, you count how many times each element occurs in the flattened list. Commented Oct 19, 2016 at 4:48
• yes there could be pairs like that. and I like your idea, thanks. Commented Oct 19, 2016 at 5:31

Given:

$pairs = { {a,b}, {c,d}, {e,f}, {g,h}, {i,a}, {a,d} };  We start by counting the occurrences of each element: $counts = $pairs // Flatten // Counts (* <| a -> 3, b -> 1, c -> 1 ,d -> 2, e -> 1, f -> 1, g -> 1, h -> 1, i -> 1 |> *)  ... and then use those counts to assemble the result: {#1, #2,$counts[#1] + $counts[#2] == 2} & @@@$pairs

(* {{a,b,False},{c,d,False},{e,f,True},{g,h,True},{i,a,False},{a,d,False}} *)


Update

As noted in the question's comments (which I originally missed), there is the prospect that both elements of a pair could have the same value. In that case, we need to add Map[DeleteDuplicates] to the counting stage to ensure that each pair value is only counted as belonging to one pair:

$pairs = { {a,b}, {c,d}, {e,f}, {g,h}, {i,a}, {a,d}, {z,z}, {i,i} };$counts = $pairs // Map[DeleteDuplicates] // Flatten // Counts (* <| a->3, b->1, c->1, d->2, e->1, f->1, g->1, h->1, i->2, z->1|> *) {#1, #2,$counts[#1] + $counts[#2] == 2} & @@@$pairs

(* { {a,b,False},{c,d,False},{e,f,True},{g,h,True}
, {i,a,False},{a,d,False},{z,z,True},{i,i,False}
}
*)

• This fails for $pairs = {{a, a}, {c, d}} Commented Oct 19, 2016 at 20:45 • @mikado Whoops, I missed your comment under the question. Fixed. Commented Oct 19, 2016 at 21:10 Don't know if your lists are going to be large, but if so, the performance of this s/b decent: mark = Module[{base = ArrayPad[#, {{0, 0}, {0, 1}}, True]}, base[[Union @@ Cases[Ceiling[Values[PositionIndex[Flatten[#]]]/2], {_, __}], 3]] = False; base] &;  Usage: result=mark@listOfPairs  Using: junk = Array[x, 100000]; list = RandomChoice[junk, {100000, 2}];  to generate a test list of pairs, quite a bit quicker than answers so far. If lists are really large, comment, I've some other ideas... • This fails for listOfPairs = {{a, a}, {c, d}} Commented Oct 19, 2016 at 20:47 • @mikado : so do the other answers, OP did not make clear how that's to be handled, simple change w/ nil performance impact "fixes" that, so when/if OP comments, I'll add it. – ciao Commented Oct 19, 2016 at 21:44 • Comment to OP says that duplicates can occur Commented Oct 19, 2016 at 21:56 data = {{a, b}, {c, d}, {e, f}, {g, h}, {i, a}, {a, d}}; Table[ {Sequence @@ data[[n]], ContainsNone[Flatten@Drop[data, {n}], data[[n]]]}, {n, 1, Length[data]} ]  {{a, b, False}, {c, d, False}, {e, f, True}, {g, h, True}, {i, a, False}, {a, d, False}} I thank @mikado for pointing out an error. I did not account for pairs such as {a,a}. I have read the comments in relation to this. I post just to correct. func[x_, lst_] := Module[{c = 2}, If[Length[Union[x]] == 1, c = 1]; Length[Flatten[Intersection[#, x] & /@ lst]] == c] pairs[lst_] := {##, func[{##}, lst]} & @@@ lst  Testing on: dat0 = {{a, b}, {c, d}, {e, f}, {g, h}, {i, a}, {a, d}}; dat1 = {{a, a}, {c, d}}; dat2 = {{a, b}, {c, d}, {e, f}, {g, h}, {i, a}, {a, d}, {z, z}, {i, i}}; Grid[{#, pairs[#]} & /@ {dat0, dat1, dat2}, Alignment -> Left, Frame -> All]  • This fails for dat = {{a, a}, {c, d}}  Commented Oct 19, 2016 at 20:51 • @mikado thank you . A stupid mistake by me. Appreciate you pointing it out. Commented Oct 19, 2016 at 23:11 DisjointQ pairs = { {a,b}, {c,d}, {e,f}, {g,h}, {i,a}, {a,d} }; Append[#, DisjointQ[Flatten @ Complement[pairs, {#}], #]]& /@ pairs  {{a, b, False}, {c, d, False}, {e, f, True}, {g, h, True}, {i, a, False}, {a, d, False}} ConnectedComponents + TransitiveReductionGraph + RelationGraph + IntersectingQ byitselfQ = Join @@ (If[Length @ # == 1, Thread[# -> True], Thread[ # -> False]]&/@ ConnectedComponents @ TransitiveReductionGraph[RelationGraph[IntersectingQ, #]])&; byitselQ @ pairs  {{a, b} -> False, {i, a} -> False, {a, d} -> False, {c, d} -> False, {g, h} -> True, {e, f} -> True} Organize into the desired form: Append @@@ byitselQ[pairs]  {{a, b, False}, {i, a, False}, {a, d, False}, {c, d, False}, {g, h, True}, {e, f, True}} If the order is important, you can use rubeGoldbergF[l_]:= Append[#, #/. byitselQ[l]]& /@ l; rubeGoldbergF @ pairs  {{a, b, False}, {c, d, False}, {e, f, True}, {g, h, True}, {i, a, False}, {a, d, False}} Using TakeList: Clear["Global*"]; data = {{a, b}, {c, d}, {e, f}, {g, h}, {i, a}, {a, d}, {z, z}, {i, i}}; Transpose[{data, Not@*IntersectingQ @@@ (Map[Union, #, {1}] & /@ Map[Flatten[#, 1] &] /@ (TakeList[data, {{#}, {1, Length@data - 1}}] & /@ Range@Length@data) ) } ] // Grid  Result Explanation 1- The TakeList step separates the tuple to be compared to the rest of the list. 2- These two lists per row are subjected to Union before IntersectingQ determines overlap. 3- The Transpose step is for visualization only. Another way using Table, Intersection and DeleteCases: data = {{a, b}, {c, d}, {e, f}, {g, h}, {i, a}, {a, d}, {z, z}, {i, i}}; rule = Rule[x_, y_] :> If[Length[y] == 0, {Sequence @@ x, True}, {Sequence @@ x, False}]; Thread@Rule[data, Map[Intersection[#[[1]], Flatten@#[[2]]] &, Table[{data[[m]], DeleteCases[data, data[[m]]]}, {m, 1, Length[data]}]]] /. rule // MatrixForm  Or more compact: rule = {a_, b_} :> If[! IntersectingQ[a, b], {Sequence @@ a, True}, {Sequence @@ a, False}] Table[{#[[m]], Flatten@DeleteCases[#, #[[m]]]}, {m, Length[#]}] &@data /. rule  • Please run it with data = {{a, b}, {c, d}, {e, f}, {g, h}, {i, a}, {a, d}, {z, z}, {i, i}}; used by @eldo. – Syed Commented Sep 9, 2023 at 19:30 • Thanks mate! I had to change to something more readable to get the correct result. :-) Commented Sep 9, 2023 at 20:26 flagDistinct = MapIndexed[{$$v,$$i} |-> {Splice @ $$v, ContainsNone[$$v] @ Flatten @ Drop[#,$i]}] @ # &;


Example:

pairs = {{a, b}, {c, d}, {e, f}, {g, h}, {i, a}, {a, d}, {z, z}, {i, i}};

flagDistinct @ pairs // Column


Someone will almost certainly have an even simpler way than this

pairs = {{a, b}, {c, d}, {e, f}, {g, h}, {i, a}, {a, d}};
Table[xx = pairs[[nn]]; Append[xx, Intersection[Flatten[
Drop[pairs, {nn}]], xx] == {}], {nn, Length[pairs]}]


(* {{a,b,False}, {c,d,False}, {e,f,True}, {g,h,True}, {i,a,False}, {a,d,False}} *)

pairs = {{a, b}, {c, d}, {e, f}, {g, h}, {i, a}, {a, d}, {z, z}, {i, i}};

dup = Cases[Rule[a_, b_] /; Length[b] > 1 :> a] @
Normal @ PositionIndex @ Flatten @ Map[DeleteDuplicates] @ pairs


{a, d, i}

Transpose[{pairs, ContainsNone[#, dup] & /@ pairs}] // MatrixForm


pairs = {{a, b}, {c, d}, {e, f}, {g, h}, {i, a}, {a, d}, {z, z}, {i, i}};

dup = Keys @ Select[# > 1 &] @ Counts @ Flatten @ ReplaceAll[pairs, {a_, a_} :> a]


{a, d, i}

AssociationThread[pairs, DisjointQ[dup, #] & /@ pairs] // Dataset


A basic approach:

s = {{a, b},
{c, d},
{e, f},
{g, h},
{i, a},
{a, d}};
sub = Subsets[s, {5}];
com = {Splice[Complement[s, #][[1]]],
Intersection[Union @@ #, Complement[s, #][[1]]] == {}} & /@ sub;
Column[Reverse[com]]
`