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]

enter image description here