flagging duplicate elements of a list
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}
}
*)
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...
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]